Add patches

[clnl] / src / main / interface.lisp

diff --git a/src/main/interface.lisp b/src/main/interface.lisp
index dd6c4ce9be01face6ef10a9cf2f38680d1b5259c..c9cc43223b1dc4ac5c5f8ac5613aeb545de1d9ab 100644 (file)
--- a/src/main/interface.lisp
+++ b/src/main/interface.lisp
@@ -3,6 +3,7 @@
 (defvar *patch-size* 13d0)
 
 (defvar *turtle-list* nil)
+(defvar *patch-list* nil)
 
 ; It may be useful to keep windows around
 (defvar *glut-window-opened* nil)
@@ -40,16 +41,34 @@
  (gl:ortho -71 71 -71 71 1 5000)
  (gl:matrix-mode :modelview)
  (gl:load-identity)
- (mapcar
-  (lambda (turtle)
-   (let
-    ((color (nl-color->rgb (getf turtle :color))))
-    (gl:color (car color) (cadr color) (caddr color)))
-   (gl:with-pushed-matrix
-    (gl:translate (* (getf turtle :xcor) *patch-size*) (* (getf turtle :ycor) *patch-size*) 0)
-    (gl:rotate (getf turtle :heading) 0 0 -1)
-    (gl:call-list *turtle-list*)))
-  (clnl-nvm:current-state))
+ (destructuring-bind (turtles patches) (clnl-nvm:current-state)
+  (mapcar
+   (lambda (patch)
+    (let
+     ((color (nl-color->rgb (getf patch :color))))
+     (gl:color (car color) (cadr color) (caddr color)))
+    (gl:with-pushed-matrix
+     (gl:translate (* (getf patch :xcor) *patch-size*) (* (getf patch :ycor) *patch-size*) 0)
+     (gl:translate (floor (* -.5d0 *patch-size*)) (floor (* -.5d0 *patch-size*)) 0)
+     (gl:scale *patch-size* *patch-size* 1)
+     (gl:call-list *patch-list*)))
+   patches)
+  (mapcar
+   (lambda (turtle)
+    (let
+     ((color (nl-color->rgb (getf turtle :color))))
+     (gl:color (car color) (cadr color) (caddr color)))
+    (mapcar
+     (lambda (x-modification y-modification)
+      (gl:with-pushed-matrix
+       (gl:translate (* (getf turtle :xcor) *patch-size*) (* (getf turtle :ycor) *patch-size*) 0)
+       (gl:translate x-modification y-modification 0)
+       (gl:rotate (getf turtle :heading) 0 0 -1)
+       (gl:scale *patch-size* *patch-size* 1)
+       (gl:call-list *turtle-list*)))
+     (list 0 (1- (world-width-in-pixels)) (- (1- (world-width-in-pixels))) 0 0)
+     (list 0 0 0 (1- (world-height-in-pixels)) (- (1- (world-height-in-pixels))))))
+   turtles))
  (gl:flush))
 
 (defun display ()
@@ -75,7 +94,7 @@
  (setf *turtle-list* (gl:gen-lists 1))
  (gl:with-new-list (*turtle-list* :compile)
   (gl:rotate 180 0 0 -1)
-  (gl:scale (* (/ 1d0 300d0) 13) (* (/ 1d0 300d0) 13) 1)
+  (gl:scale (/ 1d0 300d0) (/ 1d0 300d0) 1)
   (gl:translate -150 -150 -4.0)
   (gl:begin :polygon)
   (gl:vertex 150 5 0)
@@ -84,6 +103,17 @@
   (gl:vertex 260 250 0)
   (gl:end)))
 
+(defun set-patch-list ()
+ (setf *patch-list* (gl:gen-lists 1))
+ (gl:with-new-list (*patch-list* :compile)
+  (gl:translate 0d0 0d0 -4.0)
+  (gl:begin :polygon)
+  (gl:vertex 0 0 0)
+  (gl:vertex 0 1 0)
+  (gl:vertex 1 1 0)
+  (gl:vertex 1 0 0)
+  (gl:end)))
+
 (defun initialize (&key dims)
  "INITIALIZE &key DIMS => RESULT
 
@@ -124,8 +154,8 @@ DESCRIPTION:
  (sb-int:with-float-traps-masked (:invalid)
   (cl-glut:init)
   (cl-glut:init-window-size
-   (floor (* *patch-size* (1+ (- (getf *dimensions* :xmax) (getf *dimensions* :xmin)))))
-   (floor (* *patch-size* (1+ (- (getf *dimensions* :ymax) (getf *dimensions* :ymin))))))
+   (world-width-in-pixels)
+   (world-height-in-pixels))
   (cl-glut:init-display-mode :double :rgba)
   (cl-glut:create-window "CLNL Test Window")
   (setf *glut-window-opened* t)
@@ -135,8 +165,15 @@ DESCRIPTION:
   (cl-glut:idle-func (cffi:get-callback 'idle))
   (cl-glut:close-func (cffi:get-callback 'close-func))
   (set-turtle-list)
+  (set-patch-list)
   (cl-glut:main-loop)))
 
+(defun world-width-in-pixels ()
+ (floor (* *patch-size* (1+ (- (getf *dimensions* :xmax) (getf *dimensions* :xmin))))))
+
+(defun world-height-in-pixels ()
+ (floor (* *patch-size* (1+ (- (getf *dimensions* :ymax) (getf *dimensions* :ymin))))))
+
 (defun export-view ()
  "EXPORT-VIEW => IMAGE-DATA
 
@@ -161,6 +198,7 @@ DESCRIPTION:
    (cl-glut:create-window "CLNL Test Window")
    (gl:clear-color 0 0 0 1)
    (set-turtle-list)
+   (set-patch-list)
    (setf *glut-window-opened* t))
   (let
    ((fbo (first (gl:gen-framebuffers 1)))
@@ -174,8 +212,8 @@ DESCRIPTION:
    ; (floor (* *patch-size* (1+ (-
    ;                            (getf *dimensions* :xmax)
    ;                            (getf *dimensions* :xmin)))))
-    (width 143)  ; Hard coded for now, yay v1 (if you see this comment in a year, please cry for me)
-    (height 143))
+    (width (world-width-in-pixels))  ; Hard coded for now, yay v1 (if you see this comment in a year, please cry for me)
+    (height (world-height-in-pixels)))
    (gl:bind-framebuffer :framebuffer fbo)
    (gl:bind-renderbuffer :renderbuffer render-buf)
    (gl:renderbuffer-storage :renderbuffer :rgba8 width height)