From 0c3453de28e7ec4fc962ace0a57135dfd4cef43b Mon Sep 17 00:00:00 2001 From: Frank Duncan Date: Wed, 31 Jan 2018 11:43:32 -0600 Subject: [PATCH] UI/Model Parse - Textboxes --- resources/UI-test.nlogo | 30 ++++++++++++++++++++++++++++ src/main/interface.lisp | 33 +++++++++++++++++++++++++++++-- src/main/main.lisp | 2 ++ src/main/model.lisp | 44 ++++++++++++++++++++++++++++++++++++++++- src/main/package.lisp | 2 +- 5 files changed, 107 insertions(+), 4 deletions(-) diff --git a/resources/UI-test.nlogo b/resources/UI-test.nlogo index b7eed22..1ff8bf1 100644 --- 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 6d2ae37..6b2d85e 100644 --- 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 4b845cf..3e1d981 100644 --- 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 c947987..8adc472 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 @@ -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 c21d38e..032dfa5 100644 --- 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 -- 2.25.1