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)))) |
---|