(defvar *glut-window-opened* nil)
(defvar *dimensions* nil)
+(defvar *default-shapes* nil)
+
; For now, shapes can live in here
; header is
; * name <like default>
((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
(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
: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
(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)
(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))