[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
circle-frisk 0.20020913
From: |
Thien-Thi Nguyen |
Subject: |
circle-frisk 0.20020913 |
Date: |
Fri, 13 Sep 2002 16:38:03 -0700 |
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
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- circle-frisk 0.20020913,
Thien-Thi Nguyen <=