From 213ed30b45140af3f34b7e003aa60394178d524c Mon Sep 17 00:00:00 2001 From: Frank Duncan Date: Sat, 2 Apr 2016 09:18:07 -0500 Subject: [PATCH] World size from view --- src/main/interface.lisp | 37 ++++++++++++++++++++++++++++++++----- src/main/main.lisp | 22 +++++++++++++++++----- src/main/model.lisp | 41 +++++++++++++++++++++++++++++++++++++++++ src/main/nvm.lisp | 15 +++++++++------ src/main/package.lisp | 4 ++-- src/test/main.lisp | 12 ++++++------ 6 files changed, 107 insertions(+), 24 deletions(-) diff --git a/src/main/interface.lisp b/src/main/interface.lisp index 27d5eed..f59a242 100644 --- a/src/main/interface.lisp +++ b/src/main/interface.lisp @@ -1,12 +1,12 @@ (in-package #:clnl-interface) (defvar *patch-size* 13d0) -(defvar *world-dims* '(:xmin -5 :xmax 5 :ymin -5 :ymax 5)) (defvar *turtle-list* nil) ; It may be useful to keep windows around (defvar *glut-window-opened* nil) +(defvar *model* nil) (defvar *colors* '((140 140 140) ; gray (5) @@ -84,6 +84,22 @@ (gl:vertex 260 250 0) (gl:end))) +(defun initialize (model) + "INITIALIZE MODEL => RESULT + +ARGUMENTS AND VALUES: + + MODEL: A clnl-model:model to use to initialize the interface + RESULT: undefined + +DESCRIPTION: + + This is where the initialization of the interface that sits behind + 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 *model* model)) + (defun run () "RUN => RESULT @@ -103,8 +119,12 @@ DESCRIPTION: (sb-int:with-float-traps-masked (:invalid) (cl-glut:init) (cl-glut:init-window-size - (floor (* *patch-size* (1+ (- (getf *world-dims* :xmax) (getf *world-dims* :xmin))))) - (floor (* *patch-size* (1+ (- (getf *world-dims* :ymax) (getf *world-dims* :ymin)))))) + (floor + (* *patch-size* + (1+ (- (getf (clnl-model:world-dimensions *model*) :xmax) (getf (clnl-model:world-dimensions *model*) :xmin))))) + (floor + (* *patch-size* + (1+ (- (getf (clnl-model:world-dimensions *model*) :ymax) (getf (clnl-model:world-dimensions *model*) :ymin)))))) (cl-glut:init-display-mode :double :rgba) (cl-glut:create-window "CLNL Test Window") (setf *glut-window-opened* t) @@ -144,8 +164,15 @@ DESCRIPTION: (let ((fbo (first (gl:gen-framebuffers 1))) (render-buf (first (gl:gen-renderbuffers 1))) - ;(width (floor (* *patch-size* (1+ (- (getf *world-dims* :xmax) (getf *world-dims* :xmin)))))) - ;(height (floor (* *patch-size* (1+ (- (getf *world-dims* :ymax) (getf *world-dims* :ymin)))))) + ;(width + ; (floor (* *patch-size* (1+ (- + ; (getf (clnl-model:world-dimensions *model*) :ymax) + ; (getf (clnl-model:world-dimensions *model*) :ymin)))))) + ;(height + ; (floor (* *patch-size* (1+ (- (getf *world-dims* :xmax) (getf *world-dims* :xmin)))))) + ; (floor (* *patch-size* (1+ (- + ; (getf (clnl-model:world-dimensions *model*) :xmax) + ; (getf (clnl-model:world-dimensions *model*) :xmin))))) (width 143) ; Hard coded for now, yay v1 (if you see this comment in a year, please cry for me) (height 143)) (gl:bind-framebuffer :framebuffer fbo) diff --git a/src/main/main.lisp b/src/main/main.lisp index dcc7ca0..70be24d 100644 --- a/src/main/main.lisp +++ b/src/main/main.lisp @@ -25,22 +25,25 @@ DESCRIPTION: RUN starts up the CLNL system." + (boot) (sb-thread:make-thread #'clnl-cli:run) (clnl-interface:run)) -(defun boot () - "BOOT => RESULT +(defun boot (&optional file) + "BOOT &optional FILE => RESULT ARGUMENTS AND VALUES: + FILE: nlogo file with which to initialize state RESULT: undefined DESCRIPTION: BOOT does exactly that, boots the clnl system in a clean state. The seed - is set so that multiple runs will evaluate to the same." - (clnl-random:set-seed 15) - (clnl-nvm:create-world)) + is set so that multiple runs will evaluate to the same. + + When FILE is not provided, a default model is used." + (eval (model->lisp (if file (with-open-file (str file) (clnl-model:read-from-nlogo str)) (clnl-model:default-model))))) (defun run-commands (cmds) "RUN-COMMANDS CMDS => RESULT @@ -69,3 +72,12 @@ DESCRIPTION: RUN-REPORTER will take a NetLogo REPORTER, put it through the various stages need to turn them into Common Lisp code, run it, and return the RESULT." (eval (clnl-transpiler:transpile-reporter (car (clnl-parser:parse (clnl-lexer:lex reporter)))))) + +; Everything gets tied together here +; The intention of this method is to generate the common lisp equivalent of a model file, +; such that if you decided to no longer use nlogo, you could use the engine without it. +(defun model->lisp (model) + `(progn + (clnl-random:set-seed 15) ; should the seed always be 15? + (clnl-nvm:create-world ,model) + (clnl-interface:initialize ,model))) diff --git a/src/main/model.lisp b/src/main/model.lisp index ee776c7..3812ac2 100644 --- a/src/main/model.lisp +++ b/src/main/model.lisp @@ -16,6 +16,20 @@ model-settings delta-tick) +(defun default-model () + "DEFAULT-MODEL => MODEL + +ARGUMENTS AND VALUES: + + MODEL: an object representing the model + +DESCRIPTION: + + Returns the default startup model." + (make-model + :interface (list + (make-view :min-pxcor -5 :max-pxcor 5 :min-pycor -5 :max-pycor 5)))) + (defun read-from-nlogo (str) "READ-FROM-NLOGO STR => MODEL @@ -148,3 +162,30 @@ DESCRIPTION: ((parser (find-if (lambda (validator) (funcall validator widget-as-strings)) *widget-parsers* :key #'car))) (when parser (funcall (cadr parser) widget-as-strings)))) widgets-as-strings)))) + +;; INFORMATION ABOUT MODEL + +(defun world-dimensions (model) + "WORLD-DIMENSIONS MODEL => DIMS + + DIMS: (:xmin XMIN :xmax XMAX :ymin YMIN :ymax YMAX) + +ARGUMENTS AND VALUES: + + MODEL: A valid model containing a view + XMIN: An integer representing the minimum patch coord in X + 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 + +DESCRIPTION: + + Returns the dimensions of MODEL. MODEL must be a valid model + as parsed by CLNL, and have a valid view in it." + (let + ((view (find-if #'view-p (model-interface model)))) + (list + :xmin (view-min-pxcor view) + :xmax (view-max-pxcor view) + :ymin (view-min-pycor view) + :ymax (view-max-pycor view)))) diff --git a/src/main/nvm.lisp b/src/main/nvm.lisp index 41f47b2..37df1cb 100644 --- a/src/main/nvm.lisp +++ b/src/main/nvm.lisp @@ -6,6 +6,7 @@ (defvar *turtles* nil) (defvar *myself* nil) (defvar *self* nil) +(defvar *model* nil) (defun show (value) "SHOW VALUE => RESULT @@ -22,9 +23,6 @@ DESCRIPTION: See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#show" (format t "Showing: ~A~%" (dump-object value))) -(defun world-dimensions () - (list :xmin -10 :xmax 10 :ymin -10 :ymax 10)) - (defun create-turtle () (setf *turtles* @@ -165,11 +163,12 @@ DESCRIPTION: See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#create-turtles" (loop :for i :from 1 :to n :do (create-turtle))) -(defun create-world () - "CREATE-WORLD => RESULT +(defun create-world (model) + "CREATE-WORLD MODEL => RESULT ARGUMENTS AND VALUES: + MODEL: A clnl-model:model to use to initialize the vm RESULT: undefined DESCRIPTION: @@ -178,6 +177,7 @@ DESCRIPTION: This should be called before using the engine in any real capacity. If called when an engine is already running, it may do somethign weird." + (setf *model* model) (setf *turtles* nil) (setf *current-id* 0)) @@ -259,7 +259,10 @@ DESCRIPTION: (format nil "~A~A" "\"min-pxcor\",\"max-pxcor\",\"min-pycor\",\"max-pycor\",\"perspective\",\"subject\"," "\"nextIndex\",\"directed-links\",\"ticks\",") - (format nil "\"-1\",\"1\",\"-1\",\"1\",\"0\",\"nobody\",\"~A\",\"\"\"NEITHER\"\"\",\"-1\"" *current-id*) + (format nil "\"~A\",\"~A\",\"~A\",\"~A\",\"0\",\"nobody\",\"~A\",\"\"\"NEITHER\"\"\",\"-1\"" + (getf (clnl-model:world-dimensions *model*) :xmin) (getf (clnl-model:world-dimensions *model*) :xmax) + (getf (clnl-model:world-dimensions *model*) :ymin) (getf (clnl-model:world-dimensions *model*) :ymax) + *current-id*) "" (format nil "~S" "TURTLES") (format nil "~A~A" diff --git a/src/main/package.lisp b/src/main/package.lisp index 83df57f..73202aa 100644 --- a/src/main/package.lisp +++ b/src/main/package.lisp @@ -72,7 +72,7 @@ The primary code responsible for tokenizing NetLogo code.")) (defpackage #:clnl-interface (:use :common-lisp) - (:export #:run #:export-view) + (:export #:run #:export-view #:initialize) (:documentation "CLNL Interface @@ -92,7 +92,7 @@ is where all the features that the traditional NetLogo UI lives.")) (defpackage #:clnl-model (:use :common-lisp :cl-charms/low-level) - (:export #:read-from-nlogo) + (:export #:default-model #:read-from-nlogo #:world-dimensions) (:documentation "CLNL Model diff --git a/src/test/main.lisp b/src/test/main.lisp index 5006e06..a063e43 100644 --- a/src/test/main.lisp +++ b/src/test/main.lisp @@ -53,11 +53,11 @@ `(defsimpletest (format nil "Simple Command - ~A" ,name) (lambda () - (clnl:boot) + (clnl:boot "resources/empty.nlogo") (clnl:run-commands ,commands) (checksum= ,checksum (checksum-world))) (lambda () - (clnl:boot) + (clnl:boot "resources/empty.nlogo") (clnl:run-commands ,commands) (format nil "~A~A" (clnl-nvm:export-world) @@ -69,12 +69,12 @@ `(defsimpletest (format nil "Simple Reporter - ~A" ,name) (lambda () - (clnl:boot) + (clnl:boot "resources/empty.nlogo") (and (string= (funcall (intern "DUMP-OBJECT" :clnl-nvm) (clnl:run-reporter ,reporter)) ,value) (checksum= ,checksum (checksum-world)))) (lambda () - (clnl:boot) + (clnl:boot "resources/empty.nlogo") (format nil "~A~%~A~A" (funcall (intern "DUMP-OBJECT" :clnl-nvm) (clnl:run-reporter ,reporter)) (clnl-nvm:export-world) @@ -86,7 +86,7 @@ `(defsimpletest (format nil "Simple View - ~A" ,name) (lambda () - (clnl:boot) + (clnl:boot "resources/empty.nlogo") (clnl:run-commands ,commands) (let ((viewsum (checksum-view))) @@ -94,7 +94,7 @@ (format t "~c[1;35m-- For ~A, got ~A but expected ~A~c[0m~%" #\Esc ,name viewsum ,checksum #\Esc)) (checksum= ,checksum (checksum-view)))) (lambda () - (clnl:boot) + (clnl:boot "resources/empty.nlogo") (clnl:run-commands ,commands) (save-view-to-ppm) (format nil "~A" (checksum-view))) -- 2.25.1