(defstruct ,type
,@(remove nil
(mapcar
- (lambda (def) (when (find (car def) (list :int :double :boolean :choice :string :option)) (second def)))
+ (lambda (def)
+ (when (find (car def) (list :int :double :inverted-boolean :boolean :choice :string :option)) (second def)))
definitions)))
(push
(list
(:int `(parse-integer ,line :junk-allowed t))
(:double `(ignore-errors (coerce (read-from-string ,line) 'double-float)))
(:boolean `(or (string= "1" ,line) (string= "0" ,line)))
+ (:inverted-boolean `(or (string= "0" ,line) (string= "1" ,line)))
(:choice `(find ,line ',(mapcar #'car (third def)) :test #'string=)))))
definitions
(loop for i to (length definitions) collect i)))))
(:int `(parse-integer ,line))
(:double `(coerce (read-from-string ,line) 'double-float))
(:boolean `(string= "1" ,line))
+ (:inverted-boolean `(string= "0" ,line))
(:choice `(cadr (find ,line ',(third def) :key #'car :test #'string=)))
(:option `(when (string/= ,line ,(third def)) ,line))
(:string line))))
(:option units "NIL")
(:choice direction (("HORIZONTAL" :horizontal) ("VERTICAL" :vertical))))
+(defwidget-definition switch
+ (:specified "SWITCH")
+ (:int left)
+ (:int top)
+ (:int right)
+ (:int bottom)
+ (:string display)
+ (:string varname)
+ (:inverted-boolean on)
+ (:reserved)
+ (:reserved))
+
(defun parse-interface (interface-as-strings)
(let
((widgets-as-strings
:xmax (view-max-pxcor view)
:ymin (view-min-pycor view)
:ymax (view-max-pycor view))))
+
+(defun globals (model)
+ "GLOBALS MODEL => GLOBALS
+
+ GLOBALS: GLOBAL*
+
+ARGUMENTS AND VALUES:
+
+ MODEL: A valid model
+ GLOBAL: A symbol interned in clnl:*model-package*
+
+DESCRIPTION:
+
+ Returns the globals that get declared in the model, from widgets or
+ from code. They are interned in the package set for clnl, so
+ that they can later be used by functions in that package."
+ (mapcar
+ (lambda (pair)
+ (list
+ (intern (string-upcase (car pair)) clnl:*model-package*)
+ (cadr pair)))
+ (remove nil
+ (mapcar
+ (lambda (widget)
+ (typecase widget
+ (slider (list (slider-varname widget) (slider-default widget)))
+ (switch (list (switch-varname widget) (switch-on widget)))))
+ (model-interface model)))))