Interface - add resize capabilities

diff --git a/bin/diagnose-test b/bin/diagnose-test
index 52d7c4c9b07ff188aebf85fcb0a0283f42f4d239..1c99a31d7be266d13bbe50c6c487e8a2a1804260 100755 (executable)
--- a/bin/diagnose-test
+++ b/bin/diagnose-test
@@ -10,6 +10,7 @@ sbcl --eval "(asdf:load-system :clnl-test)" --eval "(quit)" &> /dev/null
 
 runtestfn() {
   sbcl --noinform --disable-ldb --lose-on-corruption --end-runtime-options \
+    --eval "(asdf:initialize-source-registry \`(:source-registry (:tree ,(car (directory \"src\"))) :INHERIT-CONFIGURATION))" \
     --eval "(asdf:load-system :clnl-test)" \
     --eval "(clnl-test::$1 \"$TEST\")" \
     --eval "(quit)" 2> /dev/null | sed -n '/^----$/,$p' | tail -n +2

diff --git a/bin/diagnose-view-test b/bin/diagnose-view-test
index 73dd422978ed11a381cdfe817047abf6532e1f3a..efa99f34837620b31fb1333fa01a816a7e72f8d3 100755 (executable)
--- a/bin/diagnose-view-test
+++ b/bin/diagnose-view-test
@@ -11,6 +11,7 @@ sbcl --eval "(asdf:load-system :clnl-test)" --eval "(quit)" &> /dev/null
 runtestfn() {
   sbcl \
     --noinform --disable-ldb --lose-on-corruption --end-runtime-options \
+    --eval "(asdf:initialize-source-registry \`(:source-registry (:tree ,(car (directory \"src\"))) :INHERIT-CONFIGURATION))" \
     --eval "(asdf:load-system :clnl-test)" \
     --eval "(clnl-test::$1 \"$TEST\")" \
     --eval "(quit)" 2> /dev/null | sed -n '/^----$/,$p' | tail -n +2

diff --git a/src/main/interface.lisp b/src/main/interface.lisp
index 6033740249a3be3843873e70b9d670e1056cb948..95e2911aa1577959d657cd5fbc322d7ae79cbffb 100644 (file)
--- a/src/main/interface.lisp
+++ b/src/main/interface.lisp
@@ -1,7 +1,5 @@
 (in-package #:clnl-interface)
 
-(defvar *patch-size* 13d0)
-
 (defvar *turtle-list* nil)
 (defvar *patch-list* nil)
 
@@ -38,7 +36,12 @@
  (gl:clear :color-buffer-bit :depth-buffer-bit)
  (gl:matrix-mode :projection)
  (gl:load-identity)
- (gl:ortho -71 71 -71 71 1 5000)
+ (gl:ortho
+  (floor (* (- (getf *dimensions* :xmin) 0.5) (patch-size)))
+  (floor (* (+ (getf *dimensions* :xmax) 0.5) (patch-size)))
+  (floor (* (- (getf *dimensions* :ymin) 0.5) (patch-size)))
+  (floor (* (+ (getf *dimensions* :ymax) 0.5) (patch-size)))
+  0 5000)
  (gl:matrix-mode :modelview)
  (gl:load-identity)
  (destructuring-bind (turtles patches) (clnl-nvm:current-state)
@@ -48,9 +51,9 @@
      ((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: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
@@ -61,10 +64,10 @@
     (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 (* (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:scale (patch-size) (patch-size) 1)
        (gl:scale (getf turtle :size) (getf turtle :size) 1)
        (gl:call-list *turtle-list*)))
      (list 0 (1- (world-width-in-pixels)) (- (1- (world-width-in-pixels))) 0 0)
@@ -95,8 +98,8 @@
  (setf *turtle-list* (gl:gen-lists 1))
  (gl:with-new-list (*turtle-list* :compile)
   (gl:rotate 180 0 0 -1)
-  (gl:scale (/ 1d0 300d0) (/ 1d0 300d0) 1)
-  (gl:translate -150 -150 -4.0)
+  (gl:scale (/ 1 300d0) (/ 1d0 300d0) 1)
+  (gl:translate -150 -150 -0.0)
   (gl:begin :polygon)
   (gl:vertex 150 5 0)
   (gl:vertex 40 250 0)
@@ -107,7 +110,6 @@
 (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)
@@ -118,7 +120,7 @@
 (defun initialize (&key dims)
  "INITIALIZE &key DIMS => RESULT
 
-  DIMS: (:xmin XMIN :xmax XMAX :ymin YMIN :ymax YMAX)
+  DIMS: (:xmin XMIN :xmax XMAX :ymin YMIN :ymax YMAX :patch-size PATCH-SIZE)
 
 ARGUMENTS AND VALUES:
 
@@ -127,6 +129,7 @@ ARGUMENTS AND VALUES:
   XMAX: An integer representing the maximum patch coord in X
   YMIN: An integer representing the minimum patch coord in Y
   YMAX: An integer representing the maximum patch coord in Y
+  PATCH-SIZE: A double representing the size of the patches in pixels
 
 DESCRIPTION:
 
@@ -134,7 +137,9 @@ DESCRIPTION:
   the interface lives.  From here, one can go into headless or running
   mode, but for certain things this interface will still need to act,
   and also allows for bringing up and taking down of visual elements."
- (setf *dimensions* dims))
+ (setf *dimensions* dims)
+ (when *glut-window-opened*
+  (cl-glut:reshape-window (world-width-in-pixels) (world-height-in-pixels))))
 
 (defun run ()
  "RUN => RESULT
@@ -169,11 +174,13 @@ DESCRIPTION:
   (set-patch-list)
   (cl-glut:main-loop)))
 
+(defun patch-size () (getf *dimensions* :patch-size))
+
 (defun world-width-in-pixels ()
- (floor (* *patch-size* (1+ (- (getf *dimensions* :xmax) (getf *dimensions* :xmin))))))
+ (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))))))
+ (floor (* (patch-size) (1+ (- (getf *dimensions* :ymax) (getf *dimensions* :ymin))))))
 
 (defun export-view ()
  "EXPORT-VIEW => IMAGE-DATA
@@ -205,12 +212,12 @@ DESCRIPTION:
    ((fbo (first (gl:gen-framebuffers 1)))
     (render-buf (first (gl:gen-renderbuffers 1)))
    ;(width
-   ; (floor (* *patch-size* (1+ (-
+   ; (floor (* (patch-size) (1+ (-
    ;                             (getf *dimensions* :ymax)
    ;                             (getf *dimensions* :ymin))))))
    ;(height
-   ; (floor (* *patch-size* (1+ (- (getf *world-dims* :xmax) (getf *world-dims* :xmin))))))
-   ; (floor (* *patch-size* (1+ (-
+   ; (floor (* (patch-size) (1+ (- (getf *world-dims* :xmax) (getf *world-dims* :xmin))))))
+   ; (floor (* (patch-size) (1+ (-
    ;                            (getf *dimensions* :xmax)
    ;                            (getf *dimensions* :xmin)))))
     (width (world-width-in-pixels))  ; Hard coded for now, yay v1 (if you see this comment in a year, please cry for me)

diff --git a/src/main/main.lisp b/src/main/main.lisp
index 48c3c58c59d5cf82534eb368c4fc6355478bfee2..5bb93610de52d79184902ca9325800131c1ac319 100644 (file)
--- a/src/main/main.lisp
+++ b/src/main/main.lisp
@@ -24,7 +24,6 @@ ARGUMENTS AND VALUES:
 DESCRIPTION:
 
   RUN starts up the CLNL system."
-
  (boot)
  (sb-thread:make-thread #'clnl-cli:run)
  (clnl-interface:run))

diff --git a/src/main/model.lisp b/src/main/model.lisp
index 022a658625af2db43e384fb9c797db9e33a50e26..5e0dde7bf806531009e9ce2e170d7ba01da63878 100644 (file)
--- a/src/main/model.lisp
+++ b/src/main/model.lisp
@@ -29,7 +29,7 @@ DESCRIPTION:
  (make-model
   :code ""
   :interface (list
-              (make-view :min-pxcor -5 :max-pxcor 5 :min-pycor -5 :max-pycor 5))))
+              (make-view :min-pxcor -5 :max-pxcor 5 :min-pycor -5 :max-pycor 5 :patch-size 13d0))))
 
 (defun read-from-nlogo (str)
  "READ-FROM-NLOGO STR => MODEL
@@ -221,7 +221,8 @@ DESCRIPTION:
    :xmin (view-min-pxcor view)
    :xmax (view-max-pxcor view)
    :ymin (view-min-pycor view)
-   :ymax (view-max-pycor view))))
+   :ymax (view-max-pycor view)
+   :patch-size (view-patch-size view))))
 
 (defun widget-globals (model)
  "WIDGET-GLOBALS MODEL => GLOBALS

diff --git a/src/test/viewtests.lisp b/src/test/viewtests.lisp
index 9135e47106404886ab65dfd89c252caaaa5df4fb..3455b2857052ae734388fe4b1b642366f1537451 100644 (file)
--- a/src/test/viewtests.lisp
+++ b/src/test/viewtests.lisp
@@ -4,25 +4,25 @@
  "62B8B468D5ED63CDFB567C984E0CAB53DBD03CEB")
 
 (defviewtest "Basic 1" "crt 1"
- "67F7062D7485C3A31D0065549AB8BED71A48BFEE")
+ "BB7774BC721E16BD92B18228BBBAC8D7BAAA6271")
 
 (defviewtest "Basic 2" "crt 10 ask turtles [ fd 1 ]"
- '("FC3B914602A7F41C5044B7A605DFF36D866B3A7F" "E09857180035872901B8BE27FE5470FD3D987966"))
+ '("D7A3F7FC99CB46A9AC07A5FFAC8DBE4F3C8DFAEE" "CDDDB68DC28E1D1EE72AE3C3474E91381E45D7AB"))
 
 (defviewtest "Wrapping" "crt 10 ask turtles [ fd 6 ]"
- '("72065F4E85CAE90DCFAE85AFC5A09295D46CD3D0" "CAABD296A8C72B18401F19C14C0DC83BB07718A9"))
+ '("51DACC1A8EE0758F94E8C3C1EC46467D46F796D0" "E08B45180949AB58E3F75A07DDC3CC07BC71DFDB"))
 
 (defviewtest "Die" "crt 10 ask turtles [ fd 1 ] ask turtles [ die ]"
  "62B8B468D5ED63CDFB567C984E0CAB53DBD03CEB")
 
 (defviewtest "rt" "crt 20 ask turtles [ fd 2 rt 100 fd 2 ]"
- '("7E4DB3DBDE0F1C7D821629B89B8DC20ECFBF06AD" "9143414BB6DF425455C7ACBA6620FD51C9EC5E3A"))
+ '("1C325D14717E92D6368EF3D0276250A49AC94E3C" "6B8AE7C1F8AAB44934EFC17D3F8DC02EA93D42D0"))
 
 (defviewtest "lt" "crt 20 ask turtles [ fd 2 lt 100 fd 2 ]"
- '("BF49775097BBFAE12E42D6F13FAFC93090B7ACAC" "ABAEAF8DDD68E7F0FED6CB243F27DB312588A1E8"))
+ '("5A9976BA3BFF49B9232CC8285E40709B43BB97C6" "24F764D346E607CD10C1CDA83CEF0091FDFBC280"))
 
 (defviewtest "pcolor green" "ask patches [ set pcolor green ]"
  "90F5F4870955B9FF02224F00E3C9814B8A6F766E")
 
 (defviewtest "size" "crt 10 ask turtles [ fd 2 set size 3 ] "
- '("66E47E4579C2CA48CA672052B99F25DE94456D3A" "0A8EC908783A913CD15E9A0F19E6B8DBBA4EF5D9"))
+ '("E71BD61118B3B735DE4ADD2EF7897465084DD372" "6A4D9F29F10EAFCF5AB6156CCB35680EF4E41677"))