1 (in-package #:clnl-model)
3 (defvar *separator* "@#$#@#$#@")
19 (defun default-model ()
20 "DEFAULT-MODEL => MODEL
24 MODEL: an object representing the model
28 Returns the default startup model."
32 (make-view :min-pxcor -5 :max-pxcor 5 :min-pycor -5 :max-pycor 5 :patch-size 13d0))))
34 (defun read-from-nlogo (str)
35 "READ-FROM-NLOGO STR => MODEL
39 STR: a readable stream
40 MODEL: an object representing the model
44 Takes a stream STR, reads in a nlogo file, parses it, and then
45 returns the model object."
49 ((read-sections (&optional section)
51 ((line (read-line str nil)))
53 (if (string= *separator* line)
54 (cons section (read-sections))
55 (read-sections (append section (list line))))))))
58 :code (format nil "~{~A~^~%~}" (nth 0 sections))
59 :interface (parse-interface (nth 1 sections))
60 :info (nth 2 sections)
61 :turtle-shapes (nth 3 sections)
62 :version (nth 4 sections)
63 :preview-commands (nth 5 sections)
64 :system-dynamics (nth 6 sections)
65 :behavior-space (nth 7 sections)
66 :hub-net-client (nth 8 sections)
67 :link-shapes (nth 9 sections)
68 :model-settings (nth 10 sections)
69 :delta-tick (nth 11 sections))))
73 (defparameter *widget-parsers* nil)
75 (defmacro defwidget-definition (type &rest definitions)
83 (when (find (car def) (list :int :double :inverted-boolean :boolean :choice :string :option)) (second def)))
93 ((line `(nth ,n ,lines)))
95 (:specified `(string= ,(second def) ,line))
96 (:int `(parse-integer ,line :junk-allowed t))
97 (:double `(ignore-errors (coerce (read-from-string ,line) 'double-float)))
98 (:boolean `(or (string= "1" ,line) (string= "0" ,line)))
99 (:inverted-boolean `(or (string= "0" ,line) (string= "1" ,line)))
100 (:choice `(find ,line ',(mapcar #'car (third def)) :test #'string=)))))
102 (loop for i to (length definitions) collect i)))))
104 (,(read-from-string (format nil "make-~A" type))
109 ((line `(nth ,n ,lines))
112 (:int `(parse-integer ,line))
113 (:double `(coerce (read-from-string ,line) 'double-float))
114 (:boolean `(string= "1" ,line))
115 (:inverted-boolean `(string= "0" ,line))
116 (:choice `(cadr (find ,line ',(third def) :key #'car :test #'string=)))
117 (:option `(when (string/= ,line ,(third def)) ,line))
119 (when val-getter (list (intern (symbol-name (cadr def)) :keyword) val-getter))))
121 (loop for i to (length definitions) collect i))))))
124 (defwidget-definition view
125 (:specified "GRAPHICS-WINDOW")
139 (:boolean wrapping-allowed-in-x)
140 (:boolean wrapping-allowed-in-y)
146 (:choice update-mode (("0" :continuous) ("1" :tick-based)))
148 (:boolean show-tick-counter)
149 (:string tick-counter-label)
150 (:double frame-rate 30))
152 (defwidget-definition slider
153 (:specified "SLIDER")
165 (:option units "NIL")
166 (:choice direction (("HORIZONTAL" :horizontal) ("VERTICAL" :vertical))))
168 (defwidget-definition switch
169 (:specified "SWITCH")
176 (:inverted-boolean on)
180 (defun parse-interface (interface-as-strings)
184 ((separate-widgets-as-strings (lines &optional widget-as-strings)
186 (if (string= "" (car lines))
187 (cons widget-as-strings (separate-widgets-as-strings (cdr lines)))
188 (separate-widgets-as-strings (cdr lines) (append widget-as-strings (list (car lines))))))))
189 (separate-widgets-as-strings interface-as-strings))))
193 (lambda (widget-as-strings)
195 ((parser (find-if (lambda (validator) (funcall validator widget-as-strings)) *widget-parsers* :key #'car)))
196 (when parser (funcall (cadr parser) widget-as-strings))))
197 widgets-as-strings))))
199 ;; INFORMATION ABOUT MODEL
201 (defun world-dimensions (model)
202 "WORLD-DIMENSIONS MODEL => DIMS
204 DIMS: (:xmin XMIN :xmax XMAX :ymin YMIN :ymax YMAX)
206 ARGUMENTS AND VALUES:
208 MODEL: A valid model containing a view
209 XMIN: An integer representing the minimum patch coord in X
210 XMAX: An integer representing the maximum patch coord in X
211 YMIN: An integer representing the minimum patch coord in Y
212 YMAX: An integer representing the maximum patch coord in Y
216 Returns the dimensions of MODEL. MODEL must be a valid model
217 as parsed by CLNL, and have a valid view in it."
219 ((view (find-if #'view-p (model-interface model))))
221 :xmin (view-min-pxcor view)
222 :xmax (view-max-pxcor view)
223 :ymin (view-min-pycor view)
224 :ymax (view-max-pycor view)
225 :patch-size (view-patch-size view))))
227 (defun widget-globals (model)
228 "WIDGET-GLOBALS MODEL => GLOBALS
231 GLOBAL: (NAME DEFAULT)
233 ARGUMENTS AND VALUES:
236 NAME: A symbol interned in the keyworkd package
237 DEFAULT: The widget default value
241 Returns the globals that get declared in the model from widgets.
242 They are interned in the keyword package package set for clnl, so
243 that they can later be used for multiple purposes."
248 (slider (list (intern (string-upcase (slider-varname widget)) :keyword) (slider-default widget)))
249 (switch (list (intern (string-upcase (switch-varname widget)) :keyword) (switch-on widget)))))
250 (model-interface model))))
255 ARGUMENTS AND VALUES:
258 CODE: The string representing the netlogo code in this model
262 Returns the code from the model."