X-Git-Url: https://code.consxy.com/gitweb/gitweb.cgi?p=clnl;a=blobdiff_plain;f=src%2Fmain%2Finterface.lisp;h=88dfac51c42b16b38a3120714a80435dc9a31076;hp=0f6fb596b4a1f0ecc9e8f1d506d54f17f04ac71b;hb=v0.1.0;hpb=268b16dea9f447b3cf41090c44130d9b60807d7d

diff --git a/src/main/interface.lisp b/src/main/interface.lisp
index 0f6fb59..88dfac5 100644
--- a/src/main/interface.lisp
+++ b/src/main/interface.lisp
@@ -6,6 +6,8 @@
 (defvar *glut-window-opened* nil)
 (defvar *dimensions* nil)
 
+(defvar *default-shapes* nil)
+
 ; For now, shapes can live in here
 ; header is
 ; * name <like default>
@@ -46,7 +48,7 @@
   ((parse-points (sections)
     (when sections
      (cons
-      (list (parse-integer (car sections)) (parse-integer (cadr sections)))
+      (list (- 300 (parse-integer (car sections))) (parse-integer (cadr sections)))
       (parse-points (cddr sections))))))
   (list
    :polygon
@@ -131,30 +133,30 @@
       (t (triangulate (append (cdr points) (list (car points))) ccw))))))))
 
 (defun element->gl-list (shape)
- (case (car shape)
-  (:polygon
-   (progn
-    (gl:begin :triangles)
+ (progn
+  (when (not (getf (cdr shape) :marked))
+   (gl:push-attrib :all-attrib-bits)
+   (gl:color
+    (/ (ash (ldb (byte 24 0) (getf (cdr shape) :color)) -16) 255)
+    (/ (ash (ldb (byte 16 0) (getf (cdr shape) :color)) -8) 255)
+    (/ (ldb (byte 8 0) (getf (cdr shape) :color)) 255)))
+  (gl:begin :triangles)
+  (case (car shape)
+   (:polygon
     (mapcar
      (lambda (point) (gl:vertex (car point) (cadr point) 0))
-     (apply #'append (triangulate (getf (cdr shape) :coords))))
-    (gl:end)))
-  (:rectangle
-   (progn
-    (gl:begin :triangles)
+     (apply #'append (triangulate (getf (cdr shape) :coords)))))
+   (:rectangle
     (mapcar
      (lambda (point) (gl:vertex (car point) (cadr point) 0))
      (apply #'append
       (triangulate
        (list
-        (list (getf (cdr shape) :left) (getf (cdr shape) :top))
-        (list (getf (cdr shape) :right) (getf (cdr shape) :top))
-        (list (getf (cdr shape) :right) (getf (cdr shape) :bottom))
-        (list (getf (cdr shape) :left) (getf (cdr shape) :bottom))))))
-    (gl:end)))
-  (:circle
-   (progn
-    (gl:begin :triangles)
+        (list (- 300 (getf (cdr shape) :left)) (getf (cdr shape) :top))
+        (list (- 300 (getf (cdr shape) :right)) (getf (cdr shape) :top))
+        (list (- 300 (getf (cdr shape) :right)) (getf (cdr shape) :bottom))
+        (list (- 300 (getf (cdr shape) :left)) (getf (cdr shape) :bottom)))))))
+   (:circle
     (mapcar
      (lambda (point) (gl:vertex (car point) (cadr point) 0))
      (apply #'append
@@ -169,8 +171,10 @@
         :for n := 0 :then x
         :for x := r :then (- (* c x) (* s y))
         :for y := 0 :then (+ (* s n) (* c y))
-        :collect (list (+ (+ x left) r) (+ (+ y top) r))))))
-    (gl:end)))))
+        :collect (list (- 300 (+ (+ x left) r)) (+ (+ y top) r))))))))
+  (gl:end)
+  (when (not (getf (cdr shape) :marked))
+   (gl:pop-attrib))))
 
 (defun parse-shapes (str)
  (let
@@ -180,6 +184,10 @@
 (defun default-shapes ()
  (with-open-file (str "resources/defaultshapes") (parse-shapes str)))
 
+(eval-when (:load-toplevel)
+ (when (probe-file "resources/defaultshapes")
+  (setf *default-shapes* (default-shapes))))
+
 (defvar *colors*
  '((140 140 140) ; gray       (5)
    (215 48 39) ; red       (15)
@@ -288,7 +296,7 @@
       (gl:translate -150d0 -150d0 -0.0d0)
       (mapcar #'element->gl-list (getf shape :elements)))
      turtle-list))
-   (default-shapes))))
+   (or *default-shapes* (default-shapes)))))
 
 (defun set-patch-list ()
  (setf *patch-list* (gl:gen-lists 1))