UI - View positioned correctly

diff --git a/resources/UI-test.nlogo b/resources/UI-test.nlogo
index 2ba8b49e4f425cf93f2990b5ae6e59d5b80c59f1..51bc13783c95ab2bd41801bbba655929414812bf 100644 (file)
--- 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 330135bc91c5baa4f0ad3848da1980630b15b6f8..413a4089763eb9b3ab64784cc76eb1d8082b8709 100644 (file)
--- 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 f7379786669763f6adc54d22b68a2972526c47cf..2f32d3b8b408c74ef7a41fff3cc3eee1f3dfb2f2 100644 (file)
--- 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 f31b182e385e645913c95b015924eb4a62953c7c..7ff6efb5b20152573d6bac0ffe6cfcd13999ff69 100644 (file)
--- 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 973b5c87ae6f93149c58cf9d0b07eafa1d009f18..970535e0085f0e250c92182370ac8dc1d85dac0a 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 #:interface #:set-current-interface #:set-callback)
+  #:buttons #:view #:interface #:set-current-interface #:set-callback)
  (:documentation
   "CLNL Model