UI/Model Parse - Sliders - WIP

[clnl] / src / main / main.lisp

diff --git a/src/main/main.lisp b/src/main/main.lisp
index b0d82ebb2a00d2c721c6da4664a093f177509ddc..920e4e8445d69143a036710ead791d7e1233d335 100644 (file)
--- a/src/main/main.lisp
+++ b/src/main/main.lisp
@@ -14,18 +14,18 @@
 
 (defun p (result) result)
 
-(defun run ()
- "RUN => RESULT
+(defun run (&optional file)
+ "RUN &optional FILE => RESULT
 
 ARGUMENTS AND VALUES:
 
+  FILE: nlogo file with which to initialize
   RESULT: undefined, the system terminates at the end of the loop
 
 DESCRIPTION:
 
   RUN starts up the CLNL system."
- (boot)
- (sb-thread:make-thread #'clnl-cli:run)
+ (boot file)
  (clnl-interface:run))
 
 (defvar *callback* nil)
@@ -57,6 +57,8 @@ DESCRIPTION:
    (*package* *model-package*))
   (eval netlogoed-lisp)))
 
+(defvar *commands-mutex* (sb-thread:make-mutex))
+
 (defun run-commands (cmds)
  "RUN-COMMANDS CMDS => RESULT
 
@@ -69,8 +71,11 @@ DESCRIPTION:
 
   RUN-COMMANDS will take NetLogo commands, put them through the various
   stages need to turn them into Common Lisp code, and run it."
- (clnl-nvm:with-stop-handler
-  (funcall *callback* cmds)))
+
+ ; This mutex is a necessary because we haven't yet moved to a job thread
+ (sb-thread:with-mutex (*commands-mutex*)
+  (clnl-nvm:with-stop-handler
+   (funcall *callback* cmds))))
 
 (defun run-reporter (reporter)
  "RUN-REPORTER REPORTER => RESULT
@@ -205,12 +210,23 @@ EXAMPLES:
         (lambda (proc) (create-proc-body proc prims))
         (clnl-code-parser:procedures code-ast))
       (clnl-random:set-seed ,seed)
+      (clnl-model:set-current-interface ',(clnl-model:interface model))
+      ,@(when netlogo-callback
+         `((clnl-model:set-callback
+            (lambda (,(intern "NETLOGO-CODE" *model-package*)) ,(netlogo-callback-body prims)))))
       ,(create-world-call model globals code-ast)
       ,@(when netlogo-callback
          `((funcall ,netlogo-callback
             (lambda (,(intern "NETLOGO-CODE" *model-package*))
              ,(netlogo-callback-body prims)))))
-      ,@(when initialize-interface `((clnl-interface:initialize :dims ',(clnl-model:world-dimensions model)))))))))
+      ,@(when initialize-interface
+         `((clnl-interface:initialize
+            :dims ',(clnl-model:world-dimensions model)
+            :view ',(clnl-model:view model)
+            :buttons ',(clnl-model:buttons model)
+            :textboxes ',(clnl-model:textboxes model)
+            :sliders ',(clnl-model:sliders model)
+            :switches ',(clnl-model:switches model)))))))))
 
 (setf (documentation 'model->single-form-lisp 'function)
  "MODEL->SINGLE-FORM-LISP MODEL &key SEED INITIALIZE-INTERFACE NETLOGO-CALLBACK => FORM
@@ -258,8 +274,17 @@ DESCRIPTION:
         (clnl-code-parser:procedures code-ast))
      (defun ,boot-fn ()
       (clnl-random:set-seed ,seed)
+      (clnl-model:set-current-interface ',(clnl-model:interface model))
+      (clnl-model:set-callback (symbol-function ',netlogo-callback-fn))
       ,(create-world-call model globals code-ast)
-      ,@(when initialize-interface `((clnl-interface:initialize :dims ',(clnl-model:world-dimensions model)))))
+      ,@(when initialize-interface
+         `((clnl-interface:initialize
+            :dims ',(clnl-model:world-dimensions model)
+            :view ',(clnl-model:view model)
+            :buttons ',(clnl-model:buttons model)
+            :textboxes ',(clnl-model:textboxes model)
+            :sliders ',(clnl-model:sliders model)
+            :switches ',(clnl-model:switches model)))))
      ,@(when netlogo-callback-fn
         `((defun ,netlogo-callback-fn (,(intern "NETLOGO-CODE" *model-package*))
            ,(netlogo-callback-body prims))))))))