circle-frisk

more application test load for 1.4.2 precursors (by way of guile-xlib).
hey, this graphical display stuff might be more than a fad!

thi

____________________________________________________________
#!/bin/sh
exec guile-xlib -s $0 "$@"		# -*- scheme -*-
!#
;;; circle-frisk --- visualize frisk results

;;; Copyright (C) 2002 Thien-Thi Nguyen
;;; This program is part of xplay, released under GNU GPL v2 with ABSOLUTELY
;;; NO WARRANTY.  See http://www.gnu.org/copyleft/gpl.txt for details.

;;; Version: 0.20020908

;;; Commentary:

;; Usage: circle-frisk [root] [FILE ...]
;;
;; circle-frisk shows frisk results in a window.  each line is an edge.
;; internal modules are on the inner circle, and external the outer.
;; optional first arg "root" means use the root window.
;;
;; TODO: animate

;;; Code:

(set! *random-state* (seed->random-state (current-time)))

(define report #f)                      ; ugh

(use-modules (scripts frisk))

(define (report! files)
  (set! report ((make-frisker) files))
  ;;(for-each write-line (report 'modules))
  )

(use-modules (xlib core) (xlib xlib) (local-utils))

(define put set-object-property!)
(define get object-property)

(define (vmac-exact! v i m ofs)
  (vector-set! v i (inexact->exact (+ ofs (* m (vector-ref v i))))))

(define (random-pos radius cx cy)
  (let ((pos (make-vector 2)))
    (random:hollow-sphere! pos *random-state*)
    (vmac-exact! pos 0 radius cx)
    (vmac-exact! pos 1 radius cy)
    pos))

(define (px pos) (vector-ref pos 0))
(define (py pos) (vector-ref pos 1))

(define (circle-frisk d w gc show clear)
  (let* ((center-x (compute-center-x d w))
         (center-y (compute-center-y d w))
         (width  (x-display-width d))
         (height (x-display-height d)))
    (clear)
    (show)
    (format #t "~A modules\n" (length (report 'modules)))
    (for-each (lambda (module)
                (put module 'pos
                     (random-pos (* (min center-x center-y)
                                    (if (mod-int? module)
                                        0.666666 ; the beast inside!
                                        1))
                                 center-x
                                 center-y)))
              (report 'modules))
    (for-each (lambda (edge)
                (let ((x0 (px (get (edge-up   edge) 'pos)))
                      (y0 (py (get (edge-up   edge) 'pos)))
                      (x1 (px (get (edge-down edge) 'pos)))
                      (y1 (py (get (edge-down edge) 'pos))))
                  (x-draw-line! w gc x0 y0 x1 y1)
                  (x-flush! d)
                  ))
              (report 'edges))
    (x-flush! d)
    (sleep 30)                          ; todo: use event-loop
    (clear)))

(let ((those (if (member "root" (command-line)) cddr cdr)))
  (report! (those (command-line))))
(simple-kick circle-frisk)

;;; circle-frisk ends here


_______________________________________________
Guile-user mailing list
[email protected]
http://mail.gnu.org/mailman/listinfo/guile-user