+(defun button-defs->buttons (button-defs)
+ (let
+ ((known-button-names nil))
+ (mapcar
+ (lambda (button-def)
+ (let*
+ ((idx (length (remove (getf button-def :display) known-button-names :test-not #'equal)))
+ (toggle-button nil)
+ (button
+ (clnl-gltk:button
+ (getf button-def :left)
+ (- *window-height* (getf button-def :height) (getf button-def :top))
+ (getf button-def :width)
+ (getf button-def :height)
+ (getf button-def :display)
+ (lambda ()
+ (when toggle-button (funcall toggle-button))
+ (execute
+ (format nil ":button \"~A\"~A"
+ (getf button-def :display)
+ (if (zerop idx) "" (format nil " ~A" idx)))))
+ :forever (getf button-def :forever))))
+ (push (getf button-def :display) known-button-names)
+ (when (getf button-def :forever) (setf toggle-button (lambda () (clnl-gltk:toggle button))))
+ (list :button button-def button idx)))
+ button-defs)))
+
+(defun switch-defs->switches (switch-defs)
+ (mapcar
+ (lambda (switch-def)
+ (let*
+ ((switch
+ (clnl-gltk:switch
+ (getf switch-def :left)
+ (- *window-height* clnl-gltk:*switch-height* (getf switch-def :top))
+ (getf switch-def :width)
+ (getf switch-def :display)
+ (lambda (state) (execute (format nil "set ~A ~A" (getf switch-def :display) (if state "true" "false"))))
+ (getf switch-def :initial-value))))
+ (list :switch (append switch-def (list :height clnl-gltk:*switch-height*)) switch nil)))
+ switch-defs))
+
+(defun slider-defs->sliders (slider-defs)
+ (mapcar
+ (lambda (slider-def)
+ (let*
+ ((slider
+ (clnl-gltk:slider
+ (getf slider-def :left)
+ (- *window-height* clnl-gltk:*slider-height* (getf slider-def :top))
+ (getf slider-def :width)
+ (getf slider-def :display)
+ (lambda (state) (execute (format nil "set ~A ~A" (getf slider-def :display) state)))
+ (read-from-string (getf slider-def :min))
+ (read-from-string (getf slider-def :max))
+ (read-from-string (getf slider-def :step))
+ (getf slider-def :initial-value))))
+ (list :slider (append slider-def (list :height clnl-gltk:*slider-height*)) slider nil)))
+ slider-defs))
+
+(defun textbox-defs->textboxes (textbox-defs)
+ (mapcar
+ (lambda (textbox-def)
+ (let*
+ ; we adjust to make it match jvm netlogo more accurately because
+ ; of what we do with width/height (in terms of characters)
+ ((adjusted-top (+ (getf textbox-def :top) 3))
+ (adjusted-left (- (getf textbox-def :left) 3))
+ (textbox
+ (clnl-gltk:textbox
+ adjusted-left
+ (- *window-height* (* (getf textbox-def :height) clnl-gltk:*font-height*) adjusted-top)
+ (getf textbox-def :width)
+ (getf textbox-def :height)
+ :text (getf textbox-def :display)
+ :border nil
+ :word-wrap t)))
+ (list
+ :textbox
+ (append
+ (list
+ :left adjusted-left
+ :top adjusted-top
+ :height (* (getf textbox-def :height) clnl-gltk:*font-height*))
+ textbox-def)
+ textbox nil)))
+ textbox-defs))
+
+(defun initialize (&key dims view buttons switches sliders textboxes)
+ "INITIALIZE &key DIMS VIEW BUTTONS SWITCHES => RESULT