/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

  1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2. (glutInit (vector 0) (vector ""))
  3. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  4. (glutInitWindowPosition 100 100)
  5. (glutInitWindowSize 500 500)
  6. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  7. (let ((win (create-window "Golden Section")))
  8. ((-> win 'ortho-2d) -400.0 400.0 -400.0 400.0)
  9. ((-> win 'display-function)
  10. (let ((pen (pen)))
  11. ((-> pen 'set-stroke-color) (rgba 0.0 0.0 0.0 1.0))
  12. (let ((move-to (-> pen 'move-to))
  13. (set-fill-color (-> pen 'set-fill-color))
  14. (circle (-> pen 'circle))
  15. (set-stroke-width (-> pen 'set-stroke-width)))
  16. (lambda ()
  17. (glClearColor 1.0 1.0 1.0 1.0)
  18. (glClear GL_COLOR_BUFFER_BIT)
  19. (for 720
  20. (lambda (i)
  21. (let ((i (+ i 0.0)))
  22. (let ((x (* 0.5 i (cos (* 2 pi (- phi 1) i))))
  23. (y (* 0.5 i (sin (* 2 pi (- phi 1) i))))
  24. (radius (* 15 (sin (/ (* i pi) 720)))))
  25. (let ((diameter (* radius 2)))
  26. (set-fill-color (rgba (/ i 360.0) (/ i 360.0) 0.25 1.0))
  27. (move-to (vec x y))
  28. (set-stroke-width (* diameter 0.15))
  29. (circle diameter)))))))))))
  30. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  31. (glutMainLoop)