circle-frisk 0.20020912

now fully animated (and using xor, and w/ `(guile-uesr)' centralized,
and w/ inner circle radius reduced).  next step is double-buffering (see
TOO-DAMN-EFFICIENT-draw-edges), or color, but probably these can wait a
bit.

note that there is numerical instability here due to not caching the
radius.  bonus points to anyone who can post a characterization of the
divergence other than "orbital decay!".

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

;;; 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 (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)))
            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)
                (array-set! ra (px (get (edge-up   edge) 'pos))     i  0)
                (array-set! ra (py (get (edge-up   edge) 'pos))     i  1)
                (array-set! ra (px (get (edge-down edge) 'pos)) (1+ i) 0)
                (array-set! ra (py (get (edge-down edge) 'pos)) (1+ i) 1)
                (set! i (+ 2 i)))
              edges)
    (x-draw-lines! w gc ra)
    (x-flush! d)))

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

(define (compute-angle dx dy hyp)
  (if (< dx 0)
      (* (acos (/ dx hyp))
         (if (< dy 0)
             -1
             1))
      (asin (/ dy hyp))))

(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 (compute-angle dx dy hyp)
                (+ angle (* mult (/ pi 4 200)))))
        ((= i 200))
      (bye!)
      (px! pos (+ cx (* (cos angle) hyp)))
      (py! pos (+ cy (* (sin angle) hyp)))
      (hello!))))

(define (circle-frisk d w gc show clear)
  (let* ((modules (report 'modules))
         (count (length modules))
         (random-module (lambda () (list-ref modules (random count))))
         (center-x (compute-center-x d w))
         (center-y (compute-center-y d w))
         (egc (erasing-gc d w))
         (xgc (xor-gc d w)))
    (clear)
    (show)
    (format #t "~A modules\n" (length (report 'modules)))
    (for-each (lambda (module)
                (put module 'pos
                     (if (equal? '(guile-user) module)
                         (vector (+ center-x 15) (+ center-y 0))
                         (random-pos (* (min center-x center-y)
                                        (if (mod-int? module)
                                            0.333333
                                            ;;0.666666 ; the beast inside!
                                            1))
                                     center-x
                                     center-y))))
              (report 'modules))
    (let loop ()
      (let ((mult (map (lambda (module)
                         (if (mod-int? module)
                             (- (random 29) 14)
                             (- (random 3)  1)))
                       (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))
          (for-each (lambda (module mult)
                      (let* ((pos (get module 'pos))
                             (x (px pos))
                             (y (py pos))
                             (dx (- x center-x))
                             (dy (- y center-y))
                             (hyp (sqrt (+ (* dx dx) (* dy dy))))
                             (angle (+ (compute-angle dx dy hyp)
                                       (* mult (/ pi 4 100)))))
                        (px! pos (+ center-x (* (cos angle) hyp)))
                        (py! pos (+ center-y (* (sin angle) hyp)))))
                    (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) 9)
                   (get module 'pos) center-x center-y
                   (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)))

(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


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