From e7b815abdbba91fd3e06e0fe3265c665c994cac8 Mon Sep 17 00:00:00 2001 From: Javier Sancho Date: Sat, 13 Oct 2012 15:29:48 +0200 Subject: [PATCH] Drawing circles --- src/video.scm | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/src/video.scm b/src/video.scm index a9db7be..2cf97a6 100644 --- 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)) - ((= 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)) @@ -328,6 +329,14 @@ (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 @@ -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 (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)) -- 2.39.2