(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)
(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
(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)
(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)
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
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)))
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
((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))))
(defvar *turtles* nil)
(defvar *myself* nil)
(defvar *self* nil)
+(defvar *model* nil)
(defun show (value)
"SHOW VALUE => RESULT
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*
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:
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))
(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"
(defpackage #:clnl-interface
(:use :common-lisp)
- (:export #:run #:export-view)
+ (:export #:run #:export-view #:initialize)
(:documentation
"CLNL Interface
(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
`(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)
`(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)
`(defsimpletest
(format nil "Simple View - ~A" ,name)
(lambda ()
- (clnl:boot)
+ (clnl:boot "resources/empty.nlogo")
(clnl:run-commands ,commands)
(let
((viewsum (checksum-view)))
(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)))
projects / clnl / commitdiff