source: project/release/5/ezxdisp/trunk/examples/3d_clock.scm @ 38155

Last change on this file since 38155 was 38155, checked in by Ivan Raikov, 2 months ago

C5 port of ezxdisp

File size: 2.3 KB
Line 
1;;;; 3d_clock.scm
2
3(import scheme (chicken base) (chicken time) (chicken time posix)
4        srfi-4 ezxdisp matchable)
5
6(define +pi+ 3.14159265358979323846)
7
8(define *ezx* (ezx-init 640 480 " 3D clock "))
9
10(ezx-set-background *ezx* (make-ezx-color 1 1 1))
11
12(ezx-select-layer *ezx* 3)
13
14(define *green* (make-ezx-color 0 1 0))
15(define *blue* (make-ezx-color 0 0 1))
16(define *black* (make-ezx-color 0 0 0))
17(define *red* (make-ezx-color 1 0 0))
18
19(ezx-line-3d *ezx* 120 120 20 -120 120 20 *green* 1)
20(ezx-line-3d *ezx* -120 120 20 -120 -120 20 *green* 1)
21(ezx-line-3d *ezx* -120 -120 20 120 -120 20 *green* 1)
22(ezx-line-3d *ezx* 120 -120 20 120 120 20 *green* 1)
23
24(ezx-line-3d *ezx* 120 120 -20 -120 120 -20 *blue* 1)
25(ezx-line-3d *ezx* -120 120 -20 -120 -120 -20 *blue* 1)
26(ezx-line-3d *ezx* -120 -120 -20 120 -120 -20 *blue* 1)
27(ezx-line-3d *ezx* 120 -120 -20 120 120 -20 *blue* 1)
28
29(do ([i 0 (add1 i)])
30    ((>= i 12))
31  (let ([x (* 100. (cos (- (/ (* 2 +pi+ i) 12) (/ +pi+ 2))))]
32        [y (* 100. (sin (- (/ (* 2 +pi+ i) 12) (/ +pi+ 2))))]
33        [z 0] )
34    (ezx-circle-3d *ezx* x y z
35                   (if (zero? (modulo i 3)) 15 20)
36                   (if (zero? i) *black* *red*)) ) )
37(ezx-redraw *ezx*)
38
39
40(let ([a 0.001])
41  (ezx-select-layer *ezx* 4)
42  (let loop ()
43    (sleep 1)
44    (match-let ([#(s m h _ _ _ _ _ _ _) (seconds->local-time (current-seconds))])
45      (ezx-wipe-layer *ezx* 4)
46      (let ([x (* 40 (cos (- (/ (* -2 +pi+ (+ h (* m (/ 60.0)))) 12) (/ +pi+ 2))))]
47            [y (* 40 (sin (- (/ (* -2 +pi+ (+ h (* m (/ 60.0)))) 12) (/ +pi+ 2))))] )
48        (ezx-line-3d *ezx* 0 0 0 x y 0 *black* 6) )
49      (let ([x (* 80 (cos (- (/ (* -2 +pi+ (+ m (* s (/ 60.0)))) 60) (/ +pi+ 2))))]
50            [y (* 80 (sin (- (/ (* -2 +pi+ (+ m (* s (/ 60.0)))) 60) (/ +pi+ 2))))] )
51        (ezx-line-3d *ezx* 0 0 0 x y 0 *black* 6) )
52      (let ([x (* 80 (cos (- (/ (* -2 +pi+ s) 60.0) (/ +pi+ 2))))]
53            [y (* 80 (sin (- (/ (* -2 +pi+ s) 60.0) (/ +pi+ 2))))] )
54        (ezx-line-3d *ezx* 0 0 0 x y 0 *black* 1) )
55      (let* ([x (sin (* a 0.12))]
56             [y (sin (* a 0.79))]
57             [z (+ (* (cos (* a 1.02)) 0.5) 0.5)]
58             [r (sqrt (+ (* x x) (* y y) (* z z)))] 
59             [x (/ (* x 400) r)]
60             [y (/ (* y 400) r)]
61             [z (/ (* z 400) r)] )
62        (ezx-set-view-3d *ezx* x y z 0 0 0 5)
63        (ezx-redraw *ezx*) )
64      (set! a (+ a 0.01))
65      (loop) ) ) )
Note: See TracBrowser for help on using the repository browser.