circle-frisk 0.20020913

[Thien-Thi Nguyen]

now does global translation (moves across the screen) and uses guile
"native" complex numbers (perhaps not optimally but more than before).
btw, here is xor-gc (for local-utils.scm) that works on the root window:

(define (xor-gc d w)
  (x-create-gc! w
                GCFunction GXxor
                GCForeground ((if (eq? w (x-root-window d))
                                  x-white-pixel
                                  x-black-pixel)
                              d)))

overall it kind of looks like a punk-rock ameoba given enough edges...

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.20020913

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

;;(debug-enable 'debug 'backtrace)

(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 center-x #f)                    ; global to enable motion
(define center-y #f)

(define (new-pos! module pos)
  (put module 'pos pos)
  (put module 'x (+ center-x (inexact->exact (real-part pos))))
  (put module 'y (+ center-y (inexact->exact (imag-part pos)))))

(define (assign-random-pos! module radius)
  (put module 'radius radius)
  (new-pos! module (make-polar radius
                               ;; this is not random at all!
                               ;; however, it has a nice flower effect.
                               (/ pi 2)
                               ;;(random (* 2 pi))
                               )))

(define (SLOWER-BUT-MORE-EYE-PLEASING-draw-edges! d w gc edges)
  (for-each (lambda (edge)
              (let ((u-mod (edge-up   edge))
                    (d-mod (edge-down edge)))
                (x-draw-line! w gc
                              (get u-mod 'x) (get u-mod 'y)
                              (get d-mod 'x) (get d-mod 'y))))
            edges)
  (x-flush! d))

(define (TOO-DAMN-EFFICIENT-draw-edges! d w gc edges)
  (let ((ra (dimensions->uniform-array (list (* 2 (length edges)) 2) 's))
        (i 0))
    (for-each (lambda (edge)
                (let ((u-mod (edge-up   edge))
                      (d-mod (edge-down edge)))
                  (array-set! ra (get u-mod 'x)     i  0)
                  (array-set! ra (get u-mod 'y)     i  1)
                  (array-set! ra (get d-mod 'x) (1+ i) 0)
                  (array-set! ra (get d-mod 'y) (1+ i) 1)
                  (set! i (+ 2 i))))
              edges)
    (x-draw-lines! w gc ra)
    (x-flush! d)))

(define draw-edges!
  SLOWER-BUT-MORE-EYE-PLEASING-draw-edges!
  ;;TOO-DAMN-EFFICIENT-draw-edges!
  )

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

(define (rotate! mult module bye! hello!)
  (let ((pos (get module 'pos))
        (r (get module 'radius))
        (da (* mult (/ pi 4 200))))
    (do ((i 0 (1+ i))
         (a (angle pos) (+ a da)))
        ((= i 200))
      (bye!)
      (new-pos! module (make-polar r a))
      (hello!))))

(define (random-mult module)
  (if (mod-int? module)
      (- (random 29.0) 14.0)
      (- (random  5.0)  2.0)))

(define (circle-frisk d w gc show clear)
  (let* ((modules (report 'modules))
         (count (length modules))
         (random-module (lambda () (list-ref modules (random count))))
         (center (make-rectangular (compute-center-x d w)
                                   (compute-center-y d w)))
         (small-x-border (- (inexact->exact (real-part center))))
         (big-x-border (* 3 (inexact->exact (real-part center))))
         (small-y-border (- (inexact->exact (imag-part center))))
         (big-y-border (* 3 (inexact->exact (imag-part center))))
         (egc (erasing-gc d w))
         (xgc (xor-gc d w)))
    (set! center-x (inexact->exact (real-part center)))
    (set! center-y (inexact->exact (imag-part center)))
    (clear)
    (show)
    (format #t "~A modules\n" (length (report 'modules)))
    (for-each (lambda (module)
                (assign-random-pos!     ; that is, random angle ...
                 module
                 ;; ... since the radius is this hairy function, which
                 ;; trys to be interesting but who can say for sure?
                 (* (min (real-part center) (imag-part center))
                    (cond ((equal? '(guile-user) module) 0.05)
                          ((not (mod-int? module)) 1)
                          (else
                           (min 1.0
                                (+ 0.3 (/ (length (mod-up-ls module))
                                          count)))))))
                (put module 'mult (random-mult module)))
              (report 'modules))
    (let loop ()
      (let ((mult (map (lambda (module)
                         (if (< 0.2 (random 1.0))
                             (get module 'mult)
                             (let ((new (random-mult module)))
                               (put module 'mult new)
                               new)))
                       (report 'modules))))
        (draw-edges! d w egc (report 'edges))
        (draw-edges! d w xgc (report 'edges))
        (do ((i 0 (1+ i)))
            ((= i 100))
          (draw-edges! d w xgc (report 'edges))
          (set! center-x (1- center-x))
          (and (= center-x small-x-border) (set! center-x big-x-border))
          (set! center-y (1- center-y))
          (and (= center-y small-y-border) (set! center-y big-y-border))
          (for-each (lambda (module mult)
                      (new-pos! module
                                (make-polar (get module 'radius)
                                            (+ (angle (get module 'pos))
                                               (* mult (/ pi 4 100))))))
                    (report 'modules)
                    mult)
          (draw-edges! d w xgc (report 'edges))
          (usleep 10000)
          ))
      (draw-edges! d w gc (report 'edges))
      (let loop ((module (random-module)) (so-far 5))
        (let* ((UP (mod-up-ls module))
               (DN (mod-down-ls module))
               (edges (append UP DN)))
          (format #t "~A ~A ~A ~A\n"
                  (if (mod-int? module) #\i #\x)
                  module (length UP) (length DN))
          (draw-edges! d w egc edges)
          (draw-edges! d w xgc edges)
          (rotate! (- (random 19.0) 9.0) module
                   (lambda () (draw-edges! d w xgc edges))
                   (lambda () (draw-edges! d w xgc edges)))
          (draw-edges! d w gc (report 'edges))
          (usleep 400000)
          (or (= 0 so-far)
              (loop (random-module) (1- so-far)))))
      (usleep 400000)
      (loop))
    (clear)))

(define (main)
  (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)))

;; do it!
(main)

;;; circle-frisk ends here