From: Frank Duncan Date: Wed, 12 Jul 2017 10:51:14 +0000 (-0500) Subject: UI - View positioned correctly X-Git-Tag: 0.1.1~8 X-Git-Url: https://code.consxy.com/gitweb/?a=commitdiff_plain;h=bc0c65622016066a82bc03b065f7138118c5b3cd;p=clnl UI - View positioned correctly --- diff --git a/resources/UI-test.nlogo b/resources/UI-test.nlogo index 2ba8b49..51bc137 100644 --- a/resources/UI-test.nlogo +++ b/resources/UI-test.nlogo @@ -80,6 +80,23 @@ NIL NIL 1 +BUTTON +78 +182 +160 +215 +forever +go +T +1 +T +OBSERVER +NIL +NIL +NIL +NIL +1 + @#$#@#$#@ ## WHAT IS IT? diff --git a/src/main/interface.lisp b/src/main/interface.lisp index 330135b..413a408 100644 --- a/src/main/interface.lisp +++ b/src/main/interface.lisp @@ -4,7 +4,7 @@ (defvar *patch-list* nil) (defvar *glut-window-opened* nil) -(defvar *dimensions* nil) +(defvar *dimensions* nil) ; This is a useful placeholder for other view properties (defvar *window-width* 1024) (defvar *window-height* 768) @@ -282,27 +282,35 @@ (gl:viewport 0 0 *window-width* *window-height*) (gl:matrix-mode :projection) - (gl:with-pushed-matrix - (gl:load-identity) - (gl:ortho 0 *window-width* 0 *window-height* 0 5000) - (render-widgets) + (let* + ((left (getf *dimensions* :left)) + (top (getf *dimensions* :top)) + (view-x1 left) + (view-x2 (+ view-x1 width)) + (view-y1 (- *window-height* height top)) + (view-y2 (- *window-height* top))) + + (gl:with-pushed-matrix + (gl:load-identity) + (gl:ortho 0 *window-width* 0 *window-height* 0 5000) + (render-widgets) - (gl:begin :lines) - (gl:vertex (- *window-width* width 10) (- *window-height* height 10)) - (gl:vertex (- *window-width* width 10) (- *window-height* 9)) + (gl:begin :lines) + (gl:vertex view-x1 view-y1) + (gl:vertex view-x1 (+ view-y2 1)) - (gl:vertex (- *window-width* width 10) (- *window-height* 9)) - (gl:vertex (- *window-width* 9) (- *window-height* 9)) + (gl:vertex view-x1 (+ view-y2 1)) + (gl:vertex (+ view-x2 1) (+ view-y2 1)) - (gl:vertex (- *window-width* 9) (- *window-height* 9)) - (gl:vertex (- *window-width* 9) (- *window-height* height 10)) + (gl:vertex (+ view-x2 1) (+ view-y2 1)) + (gl:vertex (+ view-x2 1) (- view-y1 1)) - (gl:vertex (- *window-width* 9) (- *window-height* height 10)) - (gl:vertex (- *window-width* width 10) (- *window-height* height 10)) - (gl:end)) + (gl:vertex (+ view-x2 1) view-y1) + (gl:vertex (- view-x1 1) view-y1) + (gl:end)) - (gl:viewport (- *window-width* width 10) (- *window-height* height 10) width height) - (render-scene))) + (gl:viewport view-x1 view-y1 width height) + (render-scene)))) (defun display () (render) @@ -414,10 +422,11 @@ You can enter in various netlogo commands below, or use :q to quit the program. 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 buttons) - "INITIALIZE &key DIMS BUTTONS => RESULT +(defun initialize (&key dims view buttons) + "INITIALIZE &key DIMS VIEW BUTTONS => 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) @@ -441,7 +450,7 @@ 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." - (setf *dimensions* dims) + (setf *dimensions* (append dims view)) (let ((known-button-names nil)) (setf *widgets* diff --git a/src/main/main.lisp b/src/main/main.lisp index f737978..2f32d3b 100644 --- a/src/main/main.lisp +++ b/src/main/main.lisp @@ -217,6 +217,7 @@ EXAMPLES: ,@(when initialize-interface `((clnl-interface:initialize :dims ',(clnl-model:world-dimensions model) + :view ',(clnl-model:view model) :buttons ',(clnl-model:buttons model))))))))) (setf (documentation 'model->single-form-lisp 'function) @@ -271,6 +272,7 @@ DESCRIPTION: ,@(when initialize-interface `((clnl-interface:initialize :dims ',(clnl-model:world-dimensions model) + :view ',(clnl-model:view model) :buttons ',(clnl-model:buttons 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 f31b182..7ff6efb 100644 --- a/src/main/model.lisp +++ b/src/main/model.lisp @@ -75,7 +75,7 @@ DESCRIPTION: (make-model :code "" :interface (list - (make-view :min-pxcor -5 :max-pxcor 5 :min-pycor -5 :max-pycor 5 :patch-size 13d0)))) + (make-view :left 10 :top 10 :min-pxcor -5 :max-pxcor 5 :min-pycor -5 :max-pycor 5 :patch-size 13d0)))) (defun read-from-nlogo (str) "READ-FROM-NLOGO STR => MODEL @@ -381,6 +381,25 @@ DESCRIPTION: :display (button-display-name widget))))) (model-interface model)))) +(defun view (model) + "BUTTONS MODEL => VIEW-DEF + + VIEW-DEF: (:left LEFT :top TOP) + +ARGUMENTS AND VALUES: + + MODEL: A valid model + LEFT: An integer representing the left position + TOP: An integer representing the top position + +DESCRIPTION: + + Returns the view definition that get declared in the view of the + MODEL. This is used to initialize the interface." + (let + ((view (find-if #'view-p (model-interface model)))) + (list :left (view-left view) :top (view-top view)))) + (defun code (model) "CODE MODEL => CODE diff --git a/src/main/package.lisp b/src/main/package.lisp index 973b5c8..970535e 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 #:interface #:set-current-interface #:set-callback) + #:buttons #:view #:interface #:set-current-interface #:set-callback) (:documentation "CLNL Model