X-Git-Url: https://code.consxy.com/gitweb/gitweb.cgi?p=clnl;a=blobdiff_plain;f=src%2Fmain%2Finterface.lisp;h=e5bcc38f2ca6f9d375c893992fd8892eee0b1c82;hp=6d2ae373572a8822f84ef90f0624a96363f87d74;hb=89cb3482de1fefc2d8e5f67e1e04a0790e8cd243;hpb=5f87a9fd0bed8832115f11073e5ee9a968ee95c0

diff --git a/src/main/interface.lisp b/src/main/interface.lisp
index 6d2ae37..e5bcc38 100644
--- a/src/main/interface.lisp
+++ b/src/main/interface.lisp
@@ -496,7 +496,53 @@ keep apprised of any updates that may happen.")
     (list :switch (append switch-def (list :height clnl-gltk:*switch-height*)) switch nil)))
   switch-defs))
 
-(defun initialize (&key dims view buttons switches)
+(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
 
   DIMS: (:xmin XMIN :xmax XMAX :ymin YMIN :ymax YMAX :patch-size PATCH-SIZE)
@@ -534,7 +580,9 @@ DESCRIPTION:
  (setf *widgets*
   (append
    (button-defs->buttons buttons)
-   (switch-defs->switches switches))))
+   (textbox-defs->textboxes textboxes)
+   (switch-defs->switches switches)
+   (slider-defs->sliders sliders))))
 
 (defun run ()
  "RUN => RESULT
@@ -578,7 +626,7 @@ DESCRIPTION:
    (clnl-gltk:textbox
     5 (+ clnl-gltk:*font-height* 14)
     10 12
-    (format nil *initial-banner* (asdf:component-version (asdf:find-system :clnl)))))
+    :text (format nil *initial-banner* (asdf:component-version (asdf:find-system :clnl)))))
   (setf *inputbox* (clnl-gltk:inputbox 5 5 10))
   (cl-glut:main-loop)))