PageRenderTime 68ms CodeModel.GetById 33ms app.highlight 5ms RepoModel.GetById 0ms app.codeStats 0ms

/examples/golden-section/source.scm

http://github.com/dharmatech/abstracting
Scheme | 57 lines | 27 code | 26 blank | 4 comment | 0 complexity | 76609d83435f0af9ac90bc1da98255b3 MD5 | raw file
Possible License(s): BSD-3-Clause
 1
 2;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 3
 4(glutInit (vector 0) (vector ""))
 5
 6;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 7
 8(glutInitWindowPosition 100 100)
 9(glutInitWindowSize 500 500)
10
11;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12
13(let ((win (create-window "Golden Section")))
14
15  ((-> win 'ortho-2d) -400.0 400.0 -400.0 400.0)
16
17  ((-> win 'display-function)
18
19   (let ((pen (pen)))
20
21    ((-> pen 'set-stroke-color) (rgba 0.0 0.0 0.0 1.0))
22
23    (let ((move-to          (-> pen 'move-to))
24	  (set-fill-color   (-> pen 'set-fill-color))
25	  (circle           (-> pen 'circle))
26	  (set-stroke-width (-> pen 'set-stroke-width)))
27
28      (lambda ()
29
30	(glClearColor 1.0 1.0 1.0 1.0)
31
32	(glClear GL_COLOR_BUFFER_BIT)
33
34	(for 720
35
36	     (lambda (i)
37
38	       (let ((i (+ i 0.0)))
39
40		 (let ((x (* 0.5 i (cos (* 2 pi (- phi 1) i))))
41		       (y (* 0.5 i (sin (* 2 pi (- phi 1) i))))
42
43		       (radius (* 15 (sin (/ (* i pi) 720)))))
44
45		   (let ((diameter (* radius 2)))
46
47		     (set-fill-color (rgba (/ i 360.0) (/ i 360.0) 0.25 1.0))
48		       
49		     (move-to (vec x y))
50
51		     (set-stroke-width (* diameter 0.15))
52
53		     (circle diameter)))))))))))
54
55;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
56
57(glutMainLoop)