UI/Model Parse - Textboxes

diff --git a/resources/UI-test.nlogo b/resources/UI-test.nlogo
index b7eed22761bc5b286aa9ffe8d1df10b8e514796a..1ff8bf16ce1c36c578609932149b45efee94a427 100644 (file)
--- a/resources/UI-test.nlogo
+++ b/resources/UI-test.nlogo
@@ -131,6 +131,36 @@ new-turtles-green
 1
 -1000
 
+TEXTBOX
+45
+335
+147
+367
+Textbox 1
+12
+0.0
+1
+
+TEXTBOX
+48
+387
+141
+438
+this is a larger test
+12
+0.0
+1
+
+TEXTBOX
+54
+485
+142
+544
+this\nis a test and it goes like\nthis
+12
+0.0
+1
+
 @#$#@#$#@
 ## WHAT IS IT?
 

diff --git a/src/main/interface.lisp b/src/main/interface.lisp
index 6d2ae373572a8822f84ef90f0624a96363f87d74..6b2d85e5a5432eab6aff37f15a78f085ee7d4ed2 100644 (file)
--- a/src/main/interface.lisp
+++ b/src/main/interface.lisp
@@ -496,7 +496,35 @@ keep apprised of any updates that may happen.")
     (list :switch (append switch-def (list :height clnl-gltk:*switch-height*)) switch nil)))
   switch-defs))
 
-(defun initialize (&key dims view buttons switches)
+(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 textboxes)
  "INITIALIZE &key DIMS VIEW BUTTONS SWITCHES => RESULT
 
   DIMS: (:xmin XMIN :xmax XMAX :ymin YMIN :ymax YMAX :patch-size PATCH-SIZE)
@@ -534,6 +562,7 @@ DESCRIPTION:
  (setf *widgets*
   (append
    (button-defs->buttons buttons)
+   (textbox-defs->textboxes textboxes)
    (switch-defs->switches switches))))
 
 (defun run ()
@@ -578,7 +607,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)))
 

diff --git a/src/main/main.lisp b/src/main/main.lisp
index 4b845cff37d0b0a3b7f4b435a05a0e0b3d729ce2..3e1d98143b4710844a18b37fb45f3e6982a761cb 100644 (file)
--- a/src/main/main.lisp
+++ b/src/main/main.lisp
@@ -224,6 +224,7 @@ EXAMPLES:
             :dims ',(clnl-model:world-dimensions model)
             :view ',(clnl-model:view model)
             :buttons ',(clnl-model:buttons model)
+            :textboxes ',(clnl-model:textboxes model)
             :switches ',(clnl-model:switches model)))))))))
 
 (setf (documentation 'model->single-form-lisp 'function)
@@ -280,6 +281,7 @@ DESCRIPTION:
             :dims ',(clnl-model:world-dimensions model)
             :view ',(clnl-model:view model)
             :buttons ',(clnl-model:buttons model)
+            :textboxes ',(clnl-model:textboxes model)
             :switches ',(clnl-model:switches model)))))
      ,@(when netlogo-callback-fn
         `((defun ,netlogo-callback-fn (,(intern "NETLOGO-CODE" *model-package*))

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)))))
-

diff --git a/src/main/package.lisp b/src/main/package.lisp
index c21d38e63672e69440f3c807c35979f0c0d73591..032dfa5dbc97e4bed0906fe12eeaebb186055aaa 100644 (file)
--- a/src/main/package.lisp
+++ b/src/main/package.lisp
@@ -87,7 +87,7 @@ components."))
  (:use :common-lisp)
  (:export
   #:execute-button #:default-model #:read-from-nlogo #:world-dimensions #:widget-globals #:code
-  #:buttons #:forever-button-on #:switches #:view #:interface #:set-current-interface #:set-callback)
+  #:buttons #:textboxes #:forever-button-on #:switches #:view #:interface #:set-current-interface #:set-callback)
  (:documentation
   "CLNL Model