X-Git-Url: https://git.jsancho.org/?p=gacela.git;a=blobdiff_plain;f=src%2Fvideo.scm;h=2cf97a62e8517e7b53967a80950d3128b6d50b74;hp=87ba9e0e43e78a42e9cb07784e7bd3f9560806fd;hb=e7b815abdbba91fd3e06e0fe3265c665c994cac8;hpb=361f23e1a9ef0d905cc879f9a4b0a4832a1d4287

diff --git a/src/video.scm b/src/video.scm
index 87ba9e0..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
@@ -564,18 +573,6 @@
 
 ;;; Primitives
 
-(define-macro (define-mesh header . body)
-  (let ((name (car header))
-	(args (cdr header)))
-    `(define* ,header
-       (let ((m (make-mesh
-		 ',name
-		 (lambda (props)
-		   (apply (lambda* ,args ,@body)
-			  ((@ (gacela utils) arguments-apply) ,name props))))))
-	 (mesh-properties-set! m (list ,@(map (lambda (a) `(cons ',a ,a)) (names-arguments args))))
-	 m))))
-
 (define-macro (primitive header . body)
   (let* ((type (car header))
 	 (args (cdr header))
@@ -607,6 +604,12 @@
 (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))
+
 
 (module-map (lambda (sym var)
 	      (if (not (eq? sym '%module-public-interface))