PageRenderTime 7ms CodeModel.GetById 1ms app.highlight 4ms RepoModel.GetById 1ms app.codeStats 0ms

/examples/trails/source.scm

http://github.com/dharmatech/abstracting
Scheme | 72 lines | 36 code | 29 blank | 7 comment | 0 complexity | 4603153e5d8d0f6d91738d4230dec606 MD5 | raw file
 1
 2;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 3
 4(define *mouse-position* (vec 0.0 0.0))
 5
 6(define (passive-motion-func x y)
 7  (set! *mouse-position* (vec (inexact x) (inexact y))))
 8
 9;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10
11(define *length* 100)
12
13(define *points*
14  (circular-list-tabulate *length*
15                          (lambda (i)
16                            (vec 0.0 0.0))))
17
18;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
19
20(define (idle-func)
21  (set-car! *points* *mouse-position*)
22  (set! *points* (cdr *points*))
23  (glutPostRedisplay))
24
25;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
26
27(glutInitDisplayMode GLUT_DOUBLE)
28
29(glutInitWindowPosition 100 100)
30(glutInitWindowSize 500 500)
31
32(glutInit (vector 0) (vector ""))
33
34;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
35
36(let ((win (create-window "Trails")))
37
38  (-> win 'ortho-standard)
39
40  ((-> win 'display-function)
41
42   (let ((pen (pen)))
43
44     ((-> pen 'set-stroke-color) (rgba 0.0 0.0 0.0 0.0)) ; no stroke
45     
46     ((-> pen 'set-fill-color) (rgba 1.0 1.0 1.0 0.1)) ; White with transparency
47
48     (let ((move-to (-> pen 'move-to))
49	   (circle  (-> pen 'circle)))
50
51       (lambda ()
52
53         (background black)
54
55         (circular-list-each-index
56          (lambda (i point)
57            (move-to point)
58            (let ((fraction (/ i *length*)))
59              (circle (max 5.0 (* fraction 25.0)))))
60          *points*)
61
62	 (glutSwapBuffers))))))
63
64;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
65
66(glutPassiveMotionFunc passive-motion-func)
67(glutIdleFunc          idle-func)
68
69(glutMainLoop)
70
71;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
72