+ :ymax (view-max-pycor view)
+ :patch-size (view-patch-size view))))
+
+(defun widget-globals (model)
+ "WIDGET-GLOBALS MODEL => GLOBALS
+
+ GLOBALS: GLOBAL*
+ GLOBAL: (NAME DEFAULT)
+
+ARGUMENTS AND VALUES:
+
+ MODEL: A valid model
+ NAME: A symbol interned in the keyworkd package
+ DEFAULT: The widget default value
+
+DESCRIPTION:
+
+ Returns the globals that get declared in the model from widgets.
+ They are interned in the keyword package package set for clnl, so
+ that they can later be used for multiple purposes."
+ (remove nil
+ (mapcar
+ (lambda (widget)
+ (typecase widget
+ (slider (list (intern (string-upcase (slider-varname widget)) :keyword) (slider-default widget)))
+ (switch (list (intern (string-upcase (switch-varname widget)) :keyword) (switch-on widget)))))
+ (model-interface model))))
+
+(defun buttons (model)
+ "BUTTONS MODEL => BUTTON-DEFS
+
+ BUTTON-DEFS: BUTTON-DEF*
+ BUTTON-DEF: (:left LEFT :top TOP :height HEIGHT :width WIDTH :forever FOREVER :display DISPLAY)
+
+ARGUMENTS AND VALUES:
+
+ MODEL: A valid model
+ LEFT: An integer representing the left position
+ TOP: An integer representing the top position
+ HEIGHT: An integer representing height
+ WIDTH: An integer representing width
+ FOREVER: A boolean representing whether this button is a forever button
+ DISPLAY: A string representing display name
+
+DESCRIPTION:
+
+ Returns button definitions that get declared in the buttons of the
+ MODEL. This is used to initialize the interface."
+ (remove nil
+ (mapcar
+ (lambda (widget)
+ (typecase widget
+ (button
+ (list
+ :left (button-left widget)
+ :top (button-top widget)
+ :width (- (button-right widget) (button-left widget))
+ :height (- (button-bottom widget) (button-top widget))
+ :forever (button-forever widget)
+ :display (button-display-name widget)))))
+ (model-interface model))))
+
+(defun textboxes (model)
+ "TEXTBOXES MODEL => TEXTBOX-DEFS
+
+ TEXTBOX-DEFS: TEXTBOX-DEF*
+ TEXTBOX-DEF: (:left LEFT :top TOP :height HEIGHT :width WIDTH :display DISPLAY)
+
+ARGUMENTS AND VALUES:
+
+ MODEL: A valid model
+ LEFT: An integer representing the left position
+ TOP: An integer representing the top position
+ HEIGHT: An integer representing height, in characters
+ WIDTH: An integer representing width, in characters
+ DISPLAY: A string representing display name
+
+DESCRIPTION:
+
+ Returns textbox definitions that get declared in the textboxes of the
+ MODEL. This is used to initialize the interface."
+ (remove nil
+ (mapcar
+ (lambda (widget)
+ (typecase widget
+ (textbox
+ (list
+ :left (textbox-left widget)
+ :top (textbox-top widget)
+ :width (truncate (- (textbox-right widget) (textbox-left widget)) clnl-gltk:*font-width*)
+ :height (truncate (- (textbox-bottom widget) (textbox-top widget)) clnl-gltk:*font-height*)
+ :display (textbox-display widget)))))
+ (model-interface model))))
+
+(defun switches (model)
+ "SWITCHES MODEL => SWITCH-DEFS
+
+ SWITCH-DEFS: SWITCH-DEF*
+ SWITCH-DEF: (:left LEFT :top TOP :width WIDTH :var VAR :display DISPLAY :initial-value INITIAL-VALUE)
+
+ARGUMENTS AND VALUES:
+
+ MODEL: A valid model
+ LEFT: An integer representing the left position
+ TOP: An integer representing the top position
+ WIDTH: An integer representing width
+ VAR: A symbole representing variable
+ DISPLAY: A string representing variable name
+ INITIAL-VALUE: The initial value
+
+DESCRIPTION:
+
+ Returns switch definitions that get declared in the switches of the
+ MODEL. This is used to initialize the interface."
+ (remove nil
+ (mapcar
+ (lambda (widget)
+ (typecase widget
+ (switch
+ (list
+ :left (switch-left widget)
+ :top (switch-top widget)
+ :width (- (switch-right widget) (switch-left widget))
+ :var (intern (string-upcase (switch-varname widget)) :keyword)
+ :display (switch-varname widget)
+ :initial-value (switch-on widget) ))))
+ (model-interface model))))
+
+(defun sliders (model)
+ (remove nil
+ (mapcar
+ (lambda (widget)
+ (typecase widget
+ (slider
+ (list
+ :left (slider-left widget)
+ :top (slider-top widget)
+ :width (- (slider-right widget) (slider-left widget))
+ :var (intern (string-upcase (slider-varname widget)) :keyword)
+ :display (slider-varname widget)
+ :min (slider-min widget)
+ :max (slider-max widget)
+ :step (slider-step widget)
+ :initial-value (slider-default widget)))))
+ (model-interface model))))
+
+(defun view (model)
+ "VIEW MODEL => VIEW-DEF
+
+ VIEW-DEF: (:left LEFT :top TOP)
+
+ARGUMENTS AND VALUES:
+
+ MODEL: A valid model
+ LEFT: An integer representing the left position
+ TOP: An integer representing the top position
+
+DESCRIPTION:
+
+ Returns the view definition that get declared in the view of the
+ MODEL. This is used to initialize the interface."
+ (let
+ ((view (find-if #'view-p (model-interface model))))
+ (list :left (view-left view) :top (view-top view))))
+
+(defun code (model)
+ "CODE MODEL => CODE
+
+ARGUMENTS AND VALUES:
+
+ MODEL: A valid model
+ CODE: The string representing the netlogo code in this model
+
+DESCRIPTION:
+
+ Returns the code from the model."
+ (model-code model))
+
+; This should get cached eventually, though maybe just cached via a display list is good enough
+(defun button-display-name (button)
+ (or
+ (button-display button)
+ (cl-ppcre:regex-replace-all "\\s+" (button-code button) " ")))
+
+(defun unescape-code (code)
+ (with-output-to-string (out)
+ (with-input-from-string (in code)
+ (loop
+ :for c := (read-char in nil)
+ :while c
+ :for aux := (when (eql #\\ c)
+ (case (read-char in)
+ (#\n #\Newline)
+ (#\r #\Return)
+ (#\t #\Tab)
+ (#\\ #\\)
+ (#\" #\")
+ (t (error "Invalid escape sequence"))))
+ :do (write-char (or aux c) out)))))