From: Frank Duncan <frank@kank.net>
Date: Fri, 22 Apr 2016 00:23:03 +0000 (-0500)
Subject: Parse widgets v2 - globals
X-Git-Tag: v0.1.0~58
X-Git-Url: https://code.consxy.com/gitweb/gitweb.cgi?a=commitdiff_plain;h=b4f2bfd;p=clnl

Parse widgets v2 - globals
---

diff --git a/.travis.yml b/.travis.yml
index 39f79ca..fa44e4a 100644
--- a/.travis.yml
+++ b/.travis.yml
@@ -6,7 +6,7 @@ addons:
 before_install:
   - export DISPLAY=:99.0
   - /sbin/start-stop-daemon --start --quiet --pidfile /tmp/custom_xvfb_99.pid --make-pidfile --background --exec /usr/bin/Xvfb -- :99 -ac -screen 0 1280x1024x24
-  - wget http://frank.kank.net/travissbcl/clnl/213ed30/$(git rev-parse HEAD)/travissbcl
+  - wget http://frank.kank.net/travissbcl/clnl/72aabe5/$(git rev-parse HEAD)/travissbcl
   - chmod +x travissbcl
 script:
   - ./travissbcl --script bin/all.lisp
diff --git a/bin/buildtravisexec.sh b/bin/buildtravisexec.sh
index 28dfd60..a7757e2 100755
--- a/bin/buildtravisexec.sh
+++ b/bin/buildtravisexec.sh
@@ -26,7 +26,7 @@ mkdir -p tmp/deps/
   tar zxf ../../deps/common-lisp/trivial-features_0.8.tar.gz &&
   tar zxf ../../deps/common-lisp/cl-charms-9bb94ef.tar.gz &&
   tar zxf ../../deps/common-lisp/style-checker_0.1.tar.gz &&
-  tar zxf ../../deps/common-lisp/docgen_0.1.tar.gz &&
+  tar zxf ../../deps/common-lisp/docgen_0.2.tar.gz &&
   tar zxf ../../deps/common-lisp/ieee-floats-92e481a.tar.gz &&
   tar zxf ../../deps/common-lisp/strictmath_0.1.tar.gz
 )
diff --git a/deps/common-lisp/docgen_0.1.tar.gz b/deps/common-lisp/docgen_0.1.tar.gz
deleted file mode 100644
index 9798899..0000000
Binary files a/deps/common-lisp/docgen_0.1.tar.gz and /dev/null differ
diff --git a/deps/common-lisp/docgen_0.2.tar.gz b/deps/common-lisp/docgen_0.2.tar.gz
new file mode 100644
index 0000000..d1cc757
Binary files /dev/null and b/deps/common-lisp/docgen_0.2.tar.gz differ
diff --git a/src/main/main.lisp b/src/main/main.lisp
index b6cce46..09244a0 100644
--- a/src/main/main.lisp
+++ b/src/main/main.lisp
@@ -1,5 +1,26 @@
 (in-package #:clnl)
 
+(defvar *model-package* (find-package :cl-user)
+ "*MODEL-PACKAGE*
+
+VALUE TYPE:
+
+  a package
+
+INITIAL VALUE:
+
+  The common-lisp-user package
+
+DESCRIPTION:
+
+  *MODEL-PACKAGE* is used for interning symbols as a NetLogo code
+  gets compiled.
+
+  Any local symbols are interned in this package, for use either
+  by other code, or in order to have all symbols interned in the
+  same placakge.  This is also the package in which a model should
+  be run, whether by clnl code or independently.")
+
 (defun e (ast) ast)
 
 (defun r (str)
@@ -47,7 +68,7 @@ DESCRIPTION:
   ((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)))
+   (*package* *model-package*))
   (eval netlogoed-lisp)))
 
 (defun run-commands (cmds)
@@ -82,7 +103,8 @@ DESCRIPTION:
 ; The intention of this method is to generate the common lisp equivalent of a model file,
 ; such that if you decided to no longer use nlogo, you could use the engine without it.
 (defun model->lisp (model)
- `(progn
+ `(let
+   ,(clnl-model:globals model)
    (clnl-random:set-seed 15) ; should the seed always be 15?
    (clnl-nvm:create-world :dims ',(clnl-model:world-dimensions model))
    (clnl-interface:initialize :dims ',(clnl-model:world-dimensions model))))
diff --git a/src/main/model.lisp b/src/main/model.lisp
index 8aa3715..83179a0 100644
--- a/src/main/model.lisp
+++ b/src/main/model.lisp
@@ -221,3 +221,31 @@ DESCRIPTION:
    :xmax (view-max-pxcor view)
    :ymin (view-min-pycor view)
    :ymax (view-max-pycor view))))
+
+(defun globals (model)
+ "GLOBALS MODEL => GLOBALS
+
+  GLOBALS: GLOBAL*
+
+ARGUMENTS AND VALUES:
+
+  MODEL: A valid model
+  GLOBAL: A symbol interned in clnl:*model-package*
+
+DESCRIPTION:
+
+  Returns the globals that get declared in the model, from widgets or
+  from code.  They are interned in the package set for clnl, so
+  that they can later be used by functions in that package."
+ (mapcar
+  (lambda (pair)
+   (list
+    (intern (string-upcase (car pair)) clnl:*model-package*)
+    (cadr pair)))
+  (remove nil
+   (mapcar
+    (lambda (widget)
+     (typecase widget
+      (slider (list (slider-varname widget) (slider-default widget)))
+      (switch (list (switch-varname widget) (switch-on widget)))))
+    (model-interface model)))))
diff --git a/src/main/package.lisp b/src/main/package.lisp
index 207fc87..3998b00 100644
--- a/src/main/package.lisp
+++ b/src/main/package.lisp
@@ -1,5 +1,5 @@
 (defpackage #:clnl (:use :common-lisp)
- (:export #:run #:boot #:run-commands #:run-reporter)
+ (:export #:run #:boot #:run-commands #:run-reporter #:*model-package*)
  (:documentation
   "Main CLNL package
 
@@ -92,7 +92,7 @@ is where all the features that the traditional NetLogo UI lives."))
 
 (defpackage #:clnl-model
  (:use :common-lisp)
- (:export #:default-model #:read-from-nlogo #:world-dimensions)
+ (:export #:default-model #:read-from-nlogo #:world-dimensions #:globals)
  (:documentation
   "CLNL Model