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

diff --git a/src/main/interface.lisp b/src/main/interface.lisp
index b9e8e68..6d2ae37 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,30 @@ 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 initialize (&key dims view buttons switches)
+ "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 +514,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 +532,9 @@ DESCRIPTION:
  (boot-interface-thread)
  (setf *dimensions* (append dims view))
  (setf *widgets*
-  (button-defs->buttons buttons)))
+  (append
+   (button-defs->buttons buttons)
+   (switch-defs->switches switches))))
 
 (defun run ()
  "RUN => RESULT