[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
circle-frisk
From: |
Thien-Thi Nguyen |
Subject: |
circle-frisk |
Date: |
Sun, 08 Sep 2002 13:21:55 -0700 |
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
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- circle-frisk,
Thien-Thi Nguyen <=