From 0d6408c2ba880e77c422c1d1b022b3046c9c0a24 Mon Sep 17 00:00:00 2001 From: Frank Duncan Date: Sun, 15 May 2016 14:58:35 -0500 Subject: [PATCH] Interface - add resize capabilities --- bin/diagnose-test | 1 + bin/diagnose-view-test | 1 + src/main/interface.lisp | 43 ++++++++++++++++++++++++----------------- src/main/main.lisp | 1 - src/main/model.lisp | 5 +++-- src/test/viewtests.lisp | 12 ++++++------ 6 files changed, 36 insertions(+), 27 deletions(-) diff --git a/bin/diagnose-test b/bin/diagnose-test index 52d7c4c..1c99a31 100755 --- 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 73dd422..efa99f3 100755 --- 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 6033740..95e2911 100644 --- 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 48c3c58..5bb9361 100644 --- 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 022a658..5e0dde7 100644 --- 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 9135e47..3455b28 100644 --- 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")) -- 2.25.1