UI/Model Parse - Textboxes

[clnl] / src / main / model.lisp

diff --git a/src/main/model.lisp b/src/main/model.lisp
index c947987f2dadb12eafb42b1a45682ac21c6762cc..8adc4726e4a46a1333c082391eb6b5a53330c9ea 100644 (file)
--- 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
 
@@ -512,4 +555,3 @@ DESCRIPTION:
                   (#\" #\")
                   (t (error "Invalid escape sequence"))))
     :do (write-char (or aux c) out)))))
-