(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
+; the interface state. We keep it seperate from the main system display thread for two reasons:
+; 1) It should run even if there's no active display
+; 2) We want it to run slower than the current display thread
+(defvar *interface-thread* nil)
+
+(defgeneric update-widget (type def widget extra-info))
+(defmethod update-widget (type def widget extra-info))
+
+(defmethod update-widget ((type (eql :button)) button-def button idx)
+ (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))
+ *widgets*))
+
+(defun boot-interface-thread ()
+ (when (not *interface-thread*)
+ (setf *interface-thread*
+ (sb-thread:make-thread (lambda () (loop (update-interface) (sleep .1))) :name "Interface Thread"))))
+
; For now, shapes can live in here
; header is
; * name <like default>
(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
(defun render-widgets ()
(clnl-gltk:render *textbox*)
(clnl-gltk:render *inputbox*)
- (mapcar #'clnl-gltk:render (mapcar #'cadr *widgets*)))
+ (mapcar #'clnl-gltk:render (mapcar #'third *widgets*)))
(defun render ()
(gl:clear :color-buffer-bit :depth-buffer-bit)
(gl:ortho 0 *window-width* 0 *window-height* 0 5000)
(render-widgets)
+ (gl:color 1 1 1)
(gl:begin :lines)
(gl:vertex view-x1 view-y1)
(gl:vertex view-x1 (+ view-y2 1))
(clnl-gltk:resize *textbox* box-width 12)
(clnl-gltk:resize *inputbox* box-width 1))
(mapcar
- (lambda (pair)
- (clnl-gltk:reposition (cadr pair)
- (getf (car pair) :left)
- (- *window-height* (getf (car pair) :height) (getf (car pair) :top))))
+ (lambda (widget)
+ (clnl-gltk:reposition (third widget)
+ (getf (second widget) :left)
+ (- *window-height* (getf (second widget) :height) (getf (second widget) :top))))
*widgets*)))
(defun execute (str)
(lambda (w)
(when (eql state :down) (clnl-gltk:mousedown w x (- *window-height* y)))
(when (eql state :up) (clnl-gltk:mouseup w x (- *window-height* y))))
- (mapcar #'cadr *widgets*)))
+ (mapcar #'third *widgets*)))
(defun motion (x y)
(mapcar
(lambda (w) (clnl-gltk:mousemove w x (- *window-height* y)))
- (mapcar #'cadr *widgets*)))
+ (mapcar #'third *widgets*)))
(cffi:defcallback display :void () (display))
(cffi:defcallback idle :void () (idle))
See http://github.com/frankduncan/clnl for more information about CLNL and to
keep apprised of any updates that may happen.")
-(defun initialize (&key dims view buttons)
- "INITIALIZE &key DIMS VIEW BUTTONS => RESULT
+(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
DIMS: (:xmin XMIN :xmax XMAX :ymin YMIN :ymax YMAX :patch-size PATCH-SIZE)
VIEW: (:left LEFT :top TOP)
BUTTONS: BUTTON-DEF*
- BUTTON-DEF: (:left LEFT :top TOP :height HEIGHT :width WIDTH :display DISPLAY)
+ 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:
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
+ VAR: A string representing the variable name
DISPLAY: A string representing display name
+ INITIAL-VALUE: The initial value
DESCRIPTION:
the interface lives. From here, one can go into headless or running
mode, but for certain things this interface will still need to act,
and also allows for bringing up and taking down of visual elements."
+ (boot-interface-thread)
(setf *dimensions* (append dims view))
- (let
- ((known-button-names nil))
- (setf *widgets*
- (mapcar
- (lambda (button-def)
- (let
- ((idx (length (remove (getf button-def :display) known-button-names :test-not #'equal))))
- (push (getf button-def :display) known-button-names)
- (list
- button-def
- (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 ()
- (execute
- (format nil ":button \"~A\"~A"
- (getf button-def :display)
- (if (zerop idx) "" (format nil " ~A" idx)))))))))
- buttons))))
+ (setf *widgets*
+ (append
+ (button-defs->buttons buttons)
+ (textbox-defs->textboxes textboxes)
+ (switch-defs->switches switches)
+ (slider-defs->sliders sliders))))
(defun run ()
"RUN => RESULT
(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)))
projects / clnl / blobdiff