Parse widgets v1 - slider
authorFrank Duncan <frank@kank.net>
Wed, 20 Apr 2016 05:33:51 +0000 (00:33 -0500)
committerFrank Duncan <frank@kank.net>
Wed, 20 Apr 2016 05:33:51 +0000 (00:33 -0500)
src/main/interface.lisp
src/main/main.lisp
src/main/model.lisp
src/main/nvm/base.lisp
src/main/nvm/nvm.lisp
src/main/nvm/utils.lisp

index f59a242fcabd90c8e4f65903cb975bb08f3b0978..dd6c4ce9be01face6ef10a9cf2f38680d1b5259c 100644 (file)
@@ -6,7 +6,7 @@
 
 ; It may be useful to keep windows around
 (defvar *glut-window-opened* nil)
 
 ; It may be useful to keep windows around
 (defvar *glut-window-opened* nil)
-(defvar *model* nil)
+(defvar *dimensions* nil)
 
 (defvar *colors*
  '((140 140 140) ; gray       (5)
 
 (defvar *colors*
  '((140 140 140) ; gray       (5)
   (gl:vertex 260 250 0)
   (gl:end)))
 
   (gl:vertex 260 250 0)
   (gl:end)))
 
-(defun initialize (model)
- "INITIALIZE MODEL => RESULT
+(defun initialize (&key dims)
+ "INITIALIZE &key DIMS => RESULT
+
+  DIMS: (:xmin XMIN :xmax XMAX :ymin YMIN :ymax YMAX)
 
 ARGUMENTS AND VALUES:
 
 
 ARGUMENTS AND VALUES:
 
-  MODEL: A clnl-model:model to use to initialize the interface
   RESULT: undefined
   RESULT: undefined
+  XMIN: An integer representing the minimum patch coord in X
+  XMAX: An integer representing the maximum patch coord in X
+  YMIN: An integer representing the minimum patch coord in Y
+  YMAX: An integer representing the maximum patch coord in Y
 
 DESCRIPTION:
 
 
 DESCRIPTION:
 
@@ -98,7 +103,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."
   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 *model* model))
+ (setf *dimensions* dims))
 
 (defun run ()
  "RUN => RESULT
 
 (defun run ()
  "RUN => RESULT
@@ -119,12 +124,8 @@ DESCRIPTION:
  (sb-int:with-float-traps-masked (:invalid)
   (cl-glut:init)
   (cl-glut:init-window-size
  (sb-int:with-float-traps-masked (:invalid)
   (cl-glut:init)
   (cl-glut:init-window-size
-   (floor
-    (* *patch-size*
-     (1+ (- (getf (clnl-model:world-dimensions *model*) :xmax) (getf (clnl-model:world-dimensions *model*) :xmin)))))
-   (floor
-    (* *patch-size*
-     (1+ (- (getf (clnl-model:world-dimensions *model*) :ymax) (getf (clnl-model:world-dimensions *model*) :ymin))))))
+   (floor (* *patch-size* (1+ (- (getf *dimensions* :xmax) (getf *dimensions* :xmin)))))
+   (floor (* *patch-size* (1+ (- (getf *dimensions* :ymax) (getf *dimensions* :ymin))))))
   (cl-glut:init-display-mode :double :rgba)
   (cl-glut:create-window "CLNL Test Window")
   (setf *glut-window-opened* t)
   (cl-glut:init-display-mode :double :rgba)
   (cl-glut:create-window "CLNL Test Window")
   (setf *glut-window-opened* t)
@@ -166,13 +167,13 @@ DESCRIPTION:
     (render-buf (first (gl:gen-renderbuffers 1)))
    ;(width
    ; (floor (* *patch-size* (1+ (-
     (render-buf (first (gl:gen-renderbuffers 1)))
    ;(width
    ; (floor (* *patch-size* (1+ (-
-   ;                             (getf (clnl-model:world-dimensions *model*) :ymax)
-   ;                             (getf (clnl-model:world-dimensions *model*) :ymin))))))
+   ;                             (getf *dimensions* :ymax)
+   ;                             (getf *dimensions* :ymin))))))
    ;(height
    ; (floor (* *patch-size* (1+ (- (getf *world-dims* :xmax) (getf *world-dims* :xmin))))))
    ; (floor (* *patch-size* (1+ (-
    ;(height
    ; (floor (* *patch-size* (1+ (- (getf *world-dims* :xmax) (getf *world-dims* :xmin))))))
    ; (floor (* *patch-size* (1+ (-
-   ;                            (getf (clnl-model:world-dimensions *model*) :xmax)
-   ;                            (getf (clnl-model:world-dimensions *model*) :xmin)))))
+   ;                            (getf *dimensions* :xmax)
+   ;                            (getf *dimensions* :xmin)))))
     (width 143)  ; Hard coded for now, yay v1 (if you see this comment in a year, please cry for me)
     (height 143))
    (gl:bind-framebuffer :framebuffer fbo)
     (width 143)  ; Hard coded for now, yay v1 (if you see this comment in a year, please cry for me)
     (height 143))
    (gl:bind-framebuffer :framebuffer fbo)
index 70be24dfa7f0f2beafe2ce72ab7ae5fdc35f72b5..b6cce463cf762402adfa246bbdad7c6959a67ef0 100644 (file)
@@ -43,7 +43,12 @@ DESCRIPTION:
   is set so that multiple runs will evaluate to the same.
 
   When FILE is not provided, a default model is used."
   is set so that multiple runs will evaluate to the same.
 
   When FILE is not provided, a default model is used."
- (eval (model->lisp (if file (with-open-file (str file) (clnl-model:read-from-nlogo str)) (clnl-model:default-model)))))
+ (let
+  ((netlogoed-lisp
+    (model->lisp
+     (if file (with-open-file (str file) (clnl-model:read-from-nlogo str)) (clnl-model:default-model))))
+   (*package* (find-package :cl)))
+  (eval netlogoed-lisp)))
 
 (defun run-commands (cmds)
  "RUN-COMMANDS CMDS => RESULT
 
 (defun run-commands (cmds)
  "RUN-COMMANDS CMDS => RESULT
@@ -79,5 +84,5 @@ DESCRIPTION:
 (defun model->lisp (model)
  `(progn
    (clnl-random:set-seed 15) ; should the seed always be 15?
 (defun model->lisp (model)
  `(progn
    (clnl-random:set-seed 15) ; should the seed always be 15?
-   (clnl-nvm:create-world ,model)
-   (clnl-interface:initialize ,model)))
+   (clnl-nvm:create-world :dims ',(clnl-model:world-dimensions model))
+   (clnl-interface:initialize :dims ',(clnl-model:world-dimensions model))))
index 3812ac24cedd5bb9da35ab3d5d9eb4aae118a09f..a919120b7d9fec6ac996486d34102cfd23bfa476 100644 (file)
@@ -78,7 +78,7 @@ DESCRIPTION:
     (defstruct ,type
      ,@(remove nil
         (mapcar
     (defstruct ,type
      ,@(remove nil
         (mapcar
-         (lambda (def) (when (find (car def) (list :int :double :boolean :choice :string)) (second def)))
+         (lambda (def) (when (find (car def) (list :int :double :boolean :choice :string :option)) (second def)))
          definitions)))
     (push
      (list
          definitions)))
     (push
      (list
@@ -110,6 +110,7 @@ DESCRIPTION:
                  (:double `(coerce (read-from-string ,line) 'double-float))
                  (:boolean `(string= "1" ,line))
                  (:choice `(cadr (find ,line ',(third def) :key #'car :test #'string=)))
                  (:double `(coerce (read-from-string ,line) 'double-float))
                  (:boolean `(string= "1" ,line))
                  (:choice `(cadr (find ,line ',(third def) :key #'car :test #'string=)))
+                 (:option `(when (string/= ,line ,(third def)) ,line))
                  (:string line))))
               (when val-getter (list (intern (symbol-name (cadr def)) :keyword) val-getter))))
             definitions
                  (:string line))))
               (when val-getter (list (intern (symbol-name (cadr def)) :keyword) val-getter))))
             definitions
@@ -144,6 +145,22 @@ DESCRIPTION:
  (:string tick-counter-label)
  (:double frame-rate 30))
 
  (:string tick-counter-label)
  (:double frame-rate 30))
 
+(defwidget-definition slider
+ (:specified "SLIDER")
+ (:int left)
+ (:int top)
+ (:int right)
+ (:int bottom)
+ (:string display)
+ (:string varname)
+ (:string min)
+ (:string max)
+ (:double default)
+ (:string step)
+ (:reserved)
+ (:option units "NIL")
+ (:choice direction (("HORIZONTAL" :horizontal) ("VERTICAL" :vertical))))
+
 (defun parse-interface (interface-as-strings)
  (let
   ((widgets-as-strings
 (defun parse-interface (interface-as-strings)
  (let
   ((widgets-as-strings
index ea427fa7572763ace4fdd2d612a06e3ada503642..dfd3fc2172fb1ce0de5f95c092790e5722a9f1dd 100644 (file)
@@ -5,7 +5,7 @@
 (defvar *turtles* nil)
 (defvar *myself* nil)
 (defvar *self* nil)
 (defvar *turtles* nil)
 (defvar *myself* nil)
 (defvar *self* nil)
-(defvar *model* nil)
+(defvar *dimensions* nil)
 (defvar *topology* :torus)
 
 (defstruct turtle who color heading xcor ycor)
 (defvar *topology* :torus)
 
 (defstruct turtle who color heading xcor ycor)
index b18faf1f3552a4502c926d63279f4ef1dfac5773..287513e445265ab4a683bf56e14b592be520547a 100644 (file)
@@ -173,13 +173,18 @@ DESCRIPTION:
   See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#create-turtles"
  (loop :for i :from 1 :to n :do (create-turtle)))
 
   See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#create-turtles"
  (loop :for i :from 1 :to n :do (create-turtle)))
 
-(defun create-world (model)
- "CREATE-WORLD MODEL => RESULT
+(defun create-world (&key dims)
+ "CREATE-WORLD &key DIMS => RESULT
+
+  DIMS: (:xmin XMIN :xmax XMAX :ymin YMIN :ymax YMAX)
 
 ARGUMENTS AND VALUES:
 
 
 ARGUMENTS AND VALUES:
 
-  MODEL: A clnl-model:model to use to initialize the vm
   RESULT: undefined
   RESULT: undefined
+  XMIN: An integer representing the minimum patch coord in X
+  XMAX: An integer representing the maximum patch coord in X
+  YMIN: An integer representing the minimum patch coord in Y
+  YMAX: An integer representing the maximum patch coord in Y
 
 DESCRIPTION:
 
 
 DESCRIPTION:
 
@@ -187,7 +192,7 @@ DESCRIPTION:
 
   This should be called before using the engine in any real capacity.  If
   called when an engine is already running, it may do somethign weird."
 
   This should be called before using the engine in any real capacity.  If
   called when an engine is already running, it may do somethign weird."
- (setf *model* model)
+ (setf *dimensions* dims)
  (setf *turtles* nil)
  (setf *current-id* 0))
 
  (setf *turtles* nil)
  (setf *current-id* 0))
 
index 06941f562ecc3bfb85b12ee2ad0d27253b88772d..22242f5f2f285fda1e2dd834546251ae90efb291 100644 (file)
@@ -1,6 +1,6 @@
 (in-package #:clnl-nvm)
 
 (in-package #:clnl-nvm)
 
-(defun min-pxcor () (getf (clnl-model:world-dimensions *model*) :xmin))
-(defun max-pxcor () (getf (clnl-model:world-dimensions *model*) :xmax))
-(defun min-pycor () (getf (clnl-model:world-dimensions *model*) :ymin))
-(defun max-pycor () (getf (clnl-model:world-dimensions *model*) :ymax))
+(defun min-pxcor () (getf *dimensions* :xmin))
+(defun max-pxcor () (getf *dimensions* :xmax))
+(defun min-pycor () (getf *dimensions* :ymin))
+(defun max-pycor () (getf *dimensions* :ymax))