source: project/release/4/spock/stuff/threads.scm @ 27294

Last change on this file since 27294 was 27294, checked in by felix winkelmann, 9 years ago

moved threads test

File size: 2.4 KB
Line 
1;;;; threads.scm
2
3
4;; http://www.pixelwit.com/blog/2008/04/how-to-draw-a-spiral/
5
6;; centerX-- X origin of the spiral.
7;; centerY-- Y origin of the spiral.
8;; radius--- Distance from origin to outer arm.
9;; sides---- Number of points or sides along the spiral's arm.
10;; coils---- Number of coils or full rotations. (Positive numbers spin clockwise, negative numbers spin counter-clockwise)
11;; rotation- Overall rotation of the spiral. ('0'=no rotation, '1'=360 degrees, '180/360'=180 degrees)
12     
13(define (spiral ctx center-x center-y radius sides coils rotation)
14  (let* ((away-step (/ radius sides))
15         (around-step (/ coils sides))
16         (around-radians (* around-step 2 Math.PI))
17         (rotation (* rotation 2 Math.PI)))
18    (let loop ((i 0) (px center-x) (py center-y))
19      (yield)
20      (cond ((<= i sides)
21             (%inline ".beginPath" ctx)
22             (%inline ".moveTo" ctx px py)
23             (let* ((away (* i away-step))
24                    (around (+ (* i around-radians) rotation))
25                    (x (+ center-x (* (%inline "Math.cos" around) away)))
26                    (y (+ center-y (* (%inline "Math.sin" around) away))))
27               (%inline ".lineTo" ctx x y)
28               (%inline ".stroke" ctx)
29               (loop (+ i 1) x y)))
30            (else
31             (%inline 
32              ".fillRect" ctx 
33              (- center-x radius 10) (- center-y radius 10)
34              (+ 20 (* radius 2)) (+ 20 (* radius 2)))
35             (loop 0 center-x center-y))))))
36
37(define canvas (%inline "document.getElementById" "canvas"))
38(define ctx (%inline ".getContext" canvas "2d"))
39
40(set! (.lineWidth ctx) 5)
41(set! (.lineStyle ctx) "rgb(0, 0, 255)")
42(set! (.fillStyle ctx) "rgb(255, 200, 255)")
43
44(%inline ".fillRect" ctx 0 0 600 600)
45
46(define halt #f)
47(define threads '())
48
49(let* ((n 3)
50       (wh (/ 600 n)))
51  (do ((x 1 (+ x 1)))
52      ((> x n))
53    (let ((cx (- (* wh x) (/ wh 2))))
54      (do ((y 1 (+ y 1)))
55          ((> y n))
56        (let ((cy (- (* wh y) (/ wh 2))))
57          (set! threads
58            (cons
59             (lambda () 
60               ;;(%inline "console.log" cx cy)
61               (spiral ctx cx cy (/ wh 2) 100 4 (%inline "Math.random")))
62             threads)))))))
63
64(define current threads)
65
66(define (yield)
67  (call-with-current-continuation
68   (lambda (k)
69     (set-car! current (lambda () (k #f)))
70     (set! current (cdr current))
71     (when (null? current) (set! current threads))
72     (%inline "setTimeout" (callback (lambda () ((car current)))) 10)
73     (halt))))
74
75(call-with-current-continuation
76 (lambda (k)
77   (set! halt (lambda () (k #f)))
78   ((car threads))))
Note: See TracBrowser for help on using the repository browser.