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

diff --git a/src/main/interface.lisp b/src/main/interface.lisp
index b9e8e68..e5bcc38 100644
--- a/src/main/interface.lisp
+++ b/src/main/interface.lisp
@@ -13,6 +13,8 @@
 (defvar *textbox* nil)
 (defvar *inputbox* nil)
 
+(defvar *current-globals* nil)
+
 (defvar *widgets* nil) ; this is going to be pairs to save the original definition
 
 ; This is the thread that does the work of querying the currently running system to update
@@ -28,6 +30,11 @@
  (when (getf button-def :forever)
   (clnl-gltk:toggle button (clnl-model:forever-button-on (getf button-def :display) idx))))
 
+(defmethod update-widget ((type (eql :switch)) switch-def switch nothing)
+ (let
+  ((global (find (getf switch-def :var) *current-globals* :key (lambda (def) (getf def :name)))))
+  (clnl-gltk:toggle switch (getf global :value))))
+
 (defun update-interface ()
  (mapcar
   (lambda (widget) (apply #'update-widget widget))
@@ -256,7 +263,8 @@
   (gl:matrix-mode :modelview)
   (gl:with-pushed-matrix
    (gl:load-identity)
-   (destructuring-bind (turtles patches) (clnl-nvm:current-state)
+   (destructuring-bind (turtles patches globals) (clnl-nvm:current-state)
+    (setf *current-globals* globals)
     (mapcar
      (lambda (patch)
       (let
@@ -473,13 +481,76 @@ keep apprised of any updates that may happen.")
      (list :button button-def button idx)))
    button-defs)))
 
-(defun initialize (&key dims view buttons)
- "INITIALIZE &key DIMS VIEW BUTTONS => RESULT
+(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
 
   DIMS: (:xmin XMIN :xmax XMAX :ymin YMIN :ymax YMAX :patch-size PATCH-SIZE)
   VIEW: (:left LEFT :top TOP)
   BUTTONS: BUTTON-DEF*
+  SWITCHES: SWITCH-DEF*
   BUTTON-DEF: (:left LEFT :top TOP :height HEIGHT :width WIDTH :forever FOREVER :display DISPLAY)
+  SWITCH-DEF: (:left LEFT :top TOP :width WIDTH :var VAR :display DISPLAY :initial-value INITIAL-VALUE)
 
 ARGUMENTS AND VALUES:
 
@@ -489,12 +560,14 @@ ARGUMENTS AND VALUES:
   YMIN: An integer representing the minimum patch coord in Y
   YMAX: An integer representing the maximum patch coord in Y
   PATCH-SIZE: A double representing the size of the patches in pixels
+  HEIGHT: An integer representing height
+  FOREVER: A boolean representing the forever status
   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 the forever status
+  VAR: A string representing the variable name
   DISPLAY: A string representing display name
+  INITIAL-VALUE: The initial value
 
 DESCRIPTION:
 
@@ -505,7 +578,11 @@ DESCRIPTION:
  (boot-interface-thread)
  (setf *dimensions* (append dims view))
  (setf *widgets*
-  (button-defs->buttons buttons)))
+  (append
+   (button-defs->buttons buttons)
+   (textbox-defs->textboxes textboxes)
+   (switch-defs->switches switches)
+   (slider-defs->sliders sliders))))
 
 (defun run ()
  "RUN => RESULT
@@ -549,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)))