Drawing circles

diff --git a/src/video.scm b/src/video.scm
index a9db7be0b7e03dce39f93e0c0bb611acbd9331a9..2cf97a62e8517e7b53967a80950d3128b6d50b74 100644 (file)
--- a/src/video.scm
+++ b/src/video.scm
@@ -247,7 +247,8 @@
 (define (begin-draw number-of-points)
   (cond ((= number-of-points 2) (glBegin GL_LINES))
        ((= number-of-points 3) (glBegin GL_TRIANGLES))
 (define (begin-draw number-of-points)
   (cond ((= number-of-points 2) (glBegin GL_LINES))
        ((= number-of-points 3) (glBegin GL_TRIANGLES))

-       ((= number-of-points 4) (glBegin GL_QUADS))))
+       ((= number-of-points 4) (glBegin GL_QUADS))
+       ((> number-of-points 4) (glBegin GL_POLYGON))))

 
 (define (draw-vertexes vertexes)
   (cond ((not (null? vertexes))
 
 (define (draw-vertexes vertexes)
   (cond ((not (null? vertexes))


@@ -328,6 +329,14 @@
          (else
           (draw (list 0 l) (list 0 (- l)))))))
 
          (else
           (draw (list 0 l) (list 0 (- l)))))))
 

+(define (draw-circle radius)
+  (glBegin GL_POLYGON)
+  (do ((i 0 (1+ i)))
+      ((>= i 360))
+    (let ((a (degrees-to-radians i)))
+      (draw-vertex (list (* radius (cos a)) (* radius (sin a))))))
+  (glEnd))
+

 (define* (draw-quad v1 v2 v3 v4 #:key texture color (texture-coord '((0 0) (1 1))))
   (cond (texture
         (progn-textures
 (define* (draw-quad v1 v2 v3 v4 #:key texture color (texture-coord '((0 0) (1 1))))
   (cond (texture
         (progn-textures


@@ -595,6 +604,9 @@
 (define-primitive (rectangle width height #:key texture color texture-coord)
   (draw-rectangle width height #:texture texture #:color color #:texture-coord texture-coord))
 
 (define-primitive (rectangle width height #:key texture color texture-coord)
   (draw-rectangle width height #:texture texture #:color color #:texture-coord texture-coord))
 

+(define-primitive (circle radius)
+  (draw-circle radius))
+

 (define-primitive (picture filename #:key (min-filter GL_LINEAR) (mag-filter GL_LINEAR) (zoom 1) (sprite '((0 0) (1 1))))
   (draw-texture (load-texture filename #:min-filter min-filter #:mag-filter mag-filter) #:zoom zoom #:sprite sprite))
 
 (define-primitive (picture filename #:key (min-filter GL_LINEAR) (mag-filter GL_LINEAR) (zoom 1) (sprite '((0 0) (1 1))))
   (draw-texture (load-texture filename #:min-filter min-filter #:mag-filter mag-filter) #:zoom zoom #:sprite sprite))