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."
31 (make-view :min-pxcor -5 :max-pxcor 5 :min-pycor -5 :max-pycor 5))))
33 (defun read-from-nlogo (str)
34 "READ-FROM-NLOGO STR => MODEL
38 STR: a readable stream
39 MODEL: an object representing the model
43 Takes a stream STR, reads in a nlogo file, parses it, and then
44 returns the model object."
48 ((read-sections (&optional section)
50 ((line (read-line str nil)))
52 (if (string= *separator* line)
53 (cons section (read-sections))
54 (read-sections (append section (list line))))))))
57 :code (format nil "~{~A~^~%~}" (nth 0 sections))
58 :interface (parse-interface (nth 1 sections))
59 :info (nth 2 sections)
60 :turtle-shapes (nth 3 sections)
61 :version (nth 4 sections)
62 :preview-commands (nth 5 sections)
63 :system-dynamics (nth 6 sections)
64 :behavior-space (nth 7 sections)
65 :hub-net-client (nth 8 sections)
66 :link-shapes (nth 9 sections)
67 :model-settings (nth 10 sections)
68 :delta-tick (nth 11 sections))))
72 (defparameter *widget-parsers* nil)
74 (defmacro defwidget-definition (type &rest definitions)
82 (when (find (car def) (list :int :double :inverted-boolean :boolean :choice :string :option)) (second def)))
92 ((line `(nth ,n ,lines)))
94 (:specified `(string= ,(second def) ,line))
95 (:int `(parse-integer ,line :junk-allowed t))
96 (:double `(ignore-errors (coerce (read-from-string ,line) 'double-float)))
97 (:boolean `(or (string= "1" ,line) (string= "0" ,line)))
98 (:inverted-boolean `(or (string= "0" ,line) (string= "1" ,line)))
99 (:choice `(find ,line ',(mapcar #'car (third def)) :test #'string=)))))
101 (loop for i to (length definitions) collect i)))))
103 (,(read-from-string (format nil "make-~A" type))
108 ((line `(nth ,n ,lines))
111 (:int `(parse-integer ,line))
112 (:double `(coerce (read-from-string ,line) 'double-float))
113 (:boolean `(string= "1" ,line))
114 (:inverted-boolean `(string= "0" ,line))
115 (:choice `(cadr (find ,line ',(third def) :key #'car :test #'string=)))
116 (:option `(when (string/= ,line ,(third def)) ,line))
118 (when val-getter (list (intern (symbol-name (cadr def)) :keyword) val-getter))))
120 (loop for i to (length definitions) collect i))))))
123 (defwidget-definition view
124 (:specified "GRAPHICS-WINDOW")
138 (:boolean wrapping-allowed-in-x)
139 (:boolean wrapping-allowed-in-y)
145 (:choice update-mode (("0" :continuous) ("1" :tick-based)))
147 (:boolean show-tick-counter)
148 (:string tick-counter-label)
149 (:double frame-rate 30))
151 (defwidget-definition slider
152 (:specified "SLIDER")
164 (:option units "NIL")
165 (:choice direction (("HORIZONTAL" :horizontal) ("VERTICAL" :vertical))))
167 (defwidget-definition switch
168 (:specified "SWITCH")
175 (:inverted-boolean on)
179 (defun parse-interface (interface-as-strings)
183 ((separate-widgets-as-strings (lines &optional widget-as-strings)
185 (if (string= "" (car lines))
186 (cons widget-as-strings (separate-widgets-as-strings (cdr lines)))
187 (separate-widgets-as-strings (cdr lines) (append widget-as-strings (list (car lines))))))))
188 (separate-widgets-as-strings interface-as-strings))))
192 (lambda (widget-as-strings)
194 ((parser (find-if (lambda (validator) (funcall validator widget-as-strings)) *widget-parsers* :key #'car)))
195 (when parser (funcall (cadr parser) widget-as-strings))))
196 widgets-as-strings))))
198 ;; INFORMATION ABOUT MODEL
200 (defun world-dimensions (model)
201 "WORLD-DIMENSIONS MODEL => DIMS
203 DIMS: (:xmin XMIN :xmax XMAX :ymin YMIN :ymax YMAX)
205 ARGUMENTS AND VALUES:
207 MODEL: A valid model containing a view
208 XMIN: An integer representing the minimum patch coord in X
209 XMAX: An integer representing the maximum patch coord in X
210 YMIN: An integer representing the minimum patch coord in Y
211 YMAX: An integer representing the maximum patch coord in Y
215 Returns the dimensions of MODEL. MODEL must be a valid model
216 as parsed by CLNL, and have a valid view in it."
218 ((view (find-if #'view-p (model-interface model))))
220 :xmin (view-min-pxcor view)
221 :xmax (view-max-pxcor view)
222 :ymin (view-min-pycor view)
223 :ymax (view-max-pycor view))))
225 (defun parse-code (model)
226 (clnl-code-parser:parse (clnl-lexer:lex (model-code model))))
228 ; For now, we keep the code hidden in this package
229 (defun globals (model)
230 "GLOBALS MODEL => GLOBALS
234 ARGUMENTS AND VALUES:
237 GLOBAL: A symbol interned in clnl:*model-package*
241 Returns the globals that get declared in the model, from widgets or
242 from code. They are interned in the package set for clnl, so
243 that they can later be used by functions in that package."
247 (intern (string-upcase (car pair)) clnl:*model-package*)
250 (clnl-code-parser:globals (parse-code model))
255 (slider (list (slider-varname widget) (slider-default widget)))
256 (switch (list (switch-varname widget) (switch-on widget)))))
257 (model-interface model))))))