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

diff --git a/src/main/model.lisp b/src/main/model.lisp
index c947987..3942110 100644
--- a/src/main/model.lisp
+++ b/src/main/model.lisp
@@ -248,6 +248,17 @@ DESCRIPTION:
  (:reserved)
  (:boolean go-time)) ; should it wait for ticks to be initialized
 
+(defwidget-definition textbox
+ (:specified "TEXTBOX")
+ (:int left)
+ (:int top)
+ (:int right)
+ (:int bottom)
+ (:code display) ; We use code here because the original netlogo treats this display like it does code
+ (:int font-size)
+ (:double color)
+ (:boolean transparent))
+
 (defun parse-interface (interface-as-strings)
  (let
   ((widgets-as-strings
@@ -425,6 +436,38 @@ DESCRIPTION:
        :display (button-display-name widget)))))
    (model-interface model))))
 
+(defun textboxes (model)
+ "TEXTBOXES MODEL => TEXTBOX-DEFS
+
+  TEXTBOX-DEFS: TEXTBOX-DEF*
+  TEXTBOX-DEF: (:left LEFT :top TOP :height HEIGHT :width WIDTH :display DISPLAY)
+
+ARGUMENTS AND VALUES:
+
+  MODEL: A valid model
+  LEFT: An integer representing the left position
+  TOP: An integer representing the top position
+  HEIGHT: An integer representing height, in characters
+  WIDTH: An integer representing width, in characters
+  DISPLAY: A string representing display name
+
+DESCRIPTION:
+
+  Returns textbox definitions that get declared in the textboxes of the
+  MODEL.  This is used to initialize the interface."
+ (remove nil
+  (mapcar
+   (lambda (widget)
+    (typecase widget
+     (textbox
+      (list
+       :left (textbox-left widget)
+       :top (textbox-top widget)
+       :width (truncate (- (textbox-right widget) (textbox-left widget)) clnl-gltk:*font-width*)
+       :height (truncate (- (textbox-bottom widget) (textbox-top widget)) clnl-gltk:*font-height*)
+       :display (textbox-display widget)))))
+   (model-interface model))))
+
 (defun switches (model)
  "SWITCHES MODEL => SWITCH-DEFS
 
@@ -459,6 +502,24 @@ DESCRIPTION:
        :initial-value (switch-on widget) ))))
    (model-interface model))))
 
+(defun sliders (model)
+ (remove nil
+  (mapcar
+   (lambda (widget)
+    (typecase widget
+     (slider
+      (list
+       :left (slider-left widget)
+       :top (slider-top widget)
+       :width (- (slider-right widget) (slider-left widget))
+       :var (intern (string-upcase (slider-varname widget)) :keyword)
+       :display (slider-varname widget)
+       :min (slider-min widget)
+       :max (slider-max widget)
+       :step (slider-step widget)
+       :initial-value (slider-default widget)))))
+   (model-interface model))))
+
 (defun view (model)
  "VIEW MODEL => VIEW-DEF
 
@@ -512,4 +573,3 @@ DESCRIPTION:
                   (#\" #\")
                   (t (error "Invalid escape sequence"))))
     :do (write-char (or aux c) out)))))
-