1 (in-package #:clnl-model)
3 (defvar *separator* "@#$#@#$#@")
19 (defun read-from-nlogo (str)
20 "READ-FROM-NLOGO STR => MODEL
24 STR: a readable stream
25 MODEL: an object representing the model
29 Takes a stream STR, reads in a nlogo file, parses it, and then
30 returns the model object."
34 ((read-sections (&optional section)
36 ((line (read-line str nil)))
38 (if (string= *separator* line)
39 (cons section (read-sections))
40 (read-sections (append section (list line))))))))
43 :code (nth 0 sections)
44 :interface (parse-interface (nth 1 sections))
45 :info (nth 2 sections)
46 :turtle-shapes (nth 3 sections)
47 :version (nth 4 sections)
48 :preview-commands (nth 5 sections)
49 :system-dynamics (nth 6 sections)
50 :behavior-space (nth 7 sections)
51 :hub-net-client (nth 8 sections)
52 :link-shapes (nth 9 sections)
53 :model-settings (nth 10 sections)
54 :delta-tick (nth 11 sections))))
58 (defparameter *widget-parsers* nil)
60 (defmacro defwidget-definition (type &rest definitions)
67 (lambda (def) (when (find (car def) (list :int :double :boolean :choice :string)) (second def)))
77 ((line `(nth ,n ,lines)))
79 (:specified `(string= ,(second def) ,line))
80 (:int `(parse-integer ,line :junk-allowed t))
81 (:double `(ignore-errors (coerce (read-from-string ,line) 'double-float)))
82 (:boolean `(or (string= "1" ,line) (string= "0" ,line)))
83 (:choice `(find ,line ',(mapcar #'car (third def)) :test #'string=)))))
85 (loop for i to (length definitions) collect i)))))
87 (,(read-from-string (format nil "make-~A" type))
92 ((line `(nth ,n ,lines))
95 (:int `(parse-integer ,line))
96 (:double `(coerce (read-from-string ,line) 'double-float))
97 (:boolean `(string= "1" ,line))
98 (:choice `(cadr (find ,line ',(third def) :key #'car :test #'string=)))
100 (when val-getter (list (intern (symbol-name (cadr def)) :keyword) val-getter))))
102 (loop for i to (length definitions) collect i))))))
105 (defwidget-definition view
106 (:specified "GRAPHICS-WINDOW")
120 (:boolean wrapping-allowed-in-x)
121 (:boolean wrapping-allowed-in-y)
127 (:choice update-mode (("0" :continuous) ("1" :tick-based)))
129 (:boolean show-tick-counter)
130 (:string tick-counter-label)
131 (:double frame-rate 30))
133 (defun parse-interface (interface-as-strings)
137 ((separate-widgets-as-strings (lines &optional widget-as-strings)
139 (if (string= "" (car lines))
140 (cons widget-as-strings (separate-widgets-as-strings (cdr lines)))
141 (separate-widgets-as-strings (cdr lines) (append widget-as-strings (list (car lines))))))))
142 (separate-widgets-as-strings interface-as-strings))))
146 (lambda (widget-as-strings)
148 ((parser (find-if (lambda (validator) (funcall validator widget-as-strings)) *widget-parsers* :key #'car)))
149 (when parser (funcall (cadr parser) widget-as-strings))))
150 widgets-as-strings))))