World size from view
authorFrank Duncan <frank@kank.net>
Sat, 2 Apr 2016 14:18:07 +0000 (09:18 -0500)
committerFrank Duncan <frank@kank.net>
Sat, 2 Apr 2016 18:34:54 +0000 (13:34 -0500)
src/main/interface.lisp
src/main/main.lisp
src/main/model.lisp
src/main/nvm.lisp
src/main/package.lisp
src/test/main.lisp

index 27d5eed3ebec4e1b33a25fc5c2e9c2cc4e41850a..f59a242fcabd90c8e4f65903cb975bb08f3b0978 100644 (file)
@@ -1,12 +1,12 @@
 (in-package #:clnl-interface)
 
 (defvar *patch-size* 13d0)
 (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 *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)
 
 (defvar *colors*
  '((140 140 140) ; gray       (5)
   (gl:vertex 260 250 0)
   (gl:end)))
 
   (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
 
 (defun run ()
  "RUN => RESULT
 
@@ -103,8 +119,12 @@ DESCRIPTION:
  (sb-int:with-float-traps-masked (:invalid)
   (cl-glut:init)
   (cl-glut:init-window-size
  (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)
   (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)))
   (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)
     (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)
index dcc7ca0c4573b732192e8d5bc4de4d29a3855b2d..70be24dfa7f0f2beafe2ce72ab7ae5fdc35f72b5 100644 (file)
@@ -25,22 +25,25 @@ DESCRIPTION:
 
   RUN starts up the CLNL system."
 
 
   RUN starts up the CLNL system."
 
+ (boot)
  (sb-thread:make-thread #'clnl-cli:run)
  (clnl-interface:run))
 
  (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:
 
 
 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
   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
 
 (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))))))
   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)))
index ee776c7178743f6c9385c79cec7ce05fe69feb00..3812ac24cedd5bb9da35ab3d5d9eb4aae118a09f 100644 (file)
  model-settings
  delta-tick)
 
  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
 
 (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))))
       ((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))))
index 41f47b242026e2c3542342546f34ea04cbbc112f..37df1cb5de69985fea895d25ee1d4486e70ed372 100644 (file)
@@ -6,6 +6,7 @@
 (defvar *turtles* nil)
 (defvar *myself* nil)
 (defvar *self* nil)
 (defvar *turtles* nil)
 (defvar *myself* nil)
 (defvar *self* nil)
+(defvar *model* nil)
 
 (defun show (value)
  "SHOW VALUE => RESULT
 
 (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)))
 
   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*
 (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)))
 
   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:
 
 
 ARGUMENTS AND VALUES:
 
+  MODEL: A clnl-model:model to use to initialize the vm
   RESULT: undefined
 
 DESCRIPTION:
   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."
 
   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))
 
  (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 "~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"
    ""
    (format nil "~S" "TURTLES")
    (format nil "~A~A"
index 83df57fe535f4ea2e4cbab7c94e15a45a01ae23a..73202aaf31c1ca174b0164865ee88f8c947e4547 100644 (file)
@@ -72,7 +72,7 @@ The primary code responsible for tokenizing NetLogo code."))
 
 (defpackage #:clnl-interface
  (:use :common-lisp)
 
 (defpackage #:clnl-interface
  (:use :common-lisp)
- (:export #:run #:export-view)
+ (:export #:run #:export-view #:initialize)
  (:documentation
   "CLNL Interface
 
  (: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)
 
 (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
 
  (:documentation
   "CLNL Model
 
index 5006e06255660b0c12e52dc4ee6060f4e96d6766..a063e433621e59010c4eaaab21d48c79b3ed77b7 100644 (file)
  `(defsimpletest
    (format nil "Simple Command - ~A" ,name)
    (lambda ()
  `(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: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)
     (clnl:run-commands ,commands)
     (format nil "~A~A"
      (clnl-nvm:export-world)
  `(defsimpletest
    (format nil "Simple Reporter - ~A" ,name)
    (lambda ()
  `(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 ()
     (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)
     (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 ()
  `(defsimpletest
    (format nil "Simple View - ~A" ,name)
    (lambda ()
-    (clnl:boot)
+    (clnl:boot "resources/empty.nlogo")
     (clnl:run-commands ,commands)
     (let
      ((viewsum (checksum-view)))
     (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 ()
       (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)))
     (clnl:run-commands ,commands)
     (save-view-to-ppm)
     (format nil "~A" (checksum-view)))