circle-frisk 0.20020909

[Thien-Thi Nguyen]

well, here's the animated version.  appreciated would be a patch to do
proper xor instead of the cheesy erasing-gc.  example usage (makes a
nice screensaver):

  dir=`guile-tools --help | tail -1 | sed 's/.* //g'`
  circle-frisk root $dir/*

happy hacking,
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.20020909

;;; 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.  modules move
;; about; info on currently active module is sent to stdout.

;;; 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)))

(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 (px! pos x) (vector-set! pos 0 (inexact->exact x)))
(define (py! pos y) (vector-set! pos 1 (inexact->exact y)))

(define (draw-edges! d w gc edges)
  (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)
                ))
            edges))

(define pi (* 2 (asin 1)))

(define (rotate! mult pos cx cy bye! hello!)
  (let* ((x (px pos))
         (y (py pos))
         (dx (- x cx))
         (dy (- y cy))
         (hyp (sqrt (+ (* dx dx) (* dy dy))))) ; todo: pass in
    (do ((i 0 (1+ i))
         (angle (if (< dx 0)
                    (* (acos (/ dx hyp))
                       (if (< dy 0)
                           -1
                           1))
                    (asin (/ dy hyp)))
                (+ angle (* mult (/ pi 4 100)))))
        ((= i 100))
      (bye!)
      (px! pos (+ cx (* (cos angle) hyp)))
      (py! pos (+ cy (* (sin angle) hyp)))
      (hello!))))

(define (circle-frisk d w gc show clear)
  (let* ((center-x (compute-center-x d w))
         (center-y (compute-center-y d w))
         (egc (erasing-gc d w)))
    (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))
    (draw-edges! d w gc (report 'edges))
    (let loop ()
      (let* ((module (cond (#t (list-ref (report 'modules)
                                         (random (length (report 'modules)))))
                           ((member name (report 'modules)) => car)
                           (else #f)))
             (UP (mod-up-ls module))
             (DN (mod-down-ls module))
             (edges (append UP DN)))
        (format #t "~A ~A U:~A D:~A\n"
                (if (mod-int? module) #\i #\x)
                module (length UP) (length DN))
        (rotate! (- (random 5) 2)
                 (get module 'pos) center-x center-y
                 (lambda () (draw-edges! d w egc edges))
                 (lambda () (draw-edges! d w gc edges)))
        (draw-edges! d w gc (report 'edges))
        (usleep 400000)
        (loop)))
    (clear)))

(let ((those (if (member "root" (command-line)) cddr cdr)))
  (report! (those (command-line))))
(if (null? (report 'modules))
    (write-line "no modules specified")
    (simple-kick circle-frisk))

;;; circle-frisk ends here