Parse widgets v1 - view

diff --git a/src/main/model.lisp b/src/main/model.lisp
index 5af89f24b2e929bfd701252811d2f722ba76f4f6..ee776c7178743f6c9385c79cec7ce05fe69feb00 100644 (file)
--- a/src/main/model.lisp
+++ b/src/main/model.lisp
@@ -41,7 +41,7 @@ DESCRIPTION:
      (read-sections))))
   (make-model
    :code (nth 0 sections)
-   :interface (nth 1 sections)
+   :interface (parse-interface (nth 1 sections))
    :info (nth 2 sections)
    :turtle-shapes (nth 3 sections)
    :version (nth 4 sections)
@@ -52,3 +52,99 @@ DESCRIPTION:
    :link-shapes (nth 9 sections)
    :model-settings (nth 10 sections)
    :delta-tick (nth 11 sections))))
+
+;;; INTERFACE PARSER
+
+(defparameter *widget-parsers* nil)
+
+(defmacro defwidget-definition (type &rest definitions)
+ (let
+  ((lines (gensym)))
+  `(progn
+    (defstruct ,type
+     ,@(remove nil
+        (mapcar
+         (lambda (def) (when (find (car def) (list :int :double :boolean :choice :string)) (second def)))
+         definitions)))
+    (push
+     (list
+      (lambda (,lines)
+       (and
+        ,@(remove nil
+           (mapcar
+            (lambda (def n)
+             (let
+              ((line `(nth ,n ,lines)))
+              (case (car def)
+               (:specified `(string= ,(second def) ,line))
+               (:int `(parse-integer ,line :junk-allowed t))
+               (:double `(ignore-errors (coerce (read-from-string ,line) 'double-float)))
+               (:boolean `(or (string= "1" ,line) (string= "0" ,line)))
+               (:choice `(find ,line ',(mapcar #'car (third def)) :test #'string=)))))
+            definitions
+            (loop for i to (length definitions) collect i)))))
+      (lambda (,lines)
+       (,(read-from-string (format nil "make-~A" type))
+        ,@(apply #'append
+           (mapcar
+            (lambda (def n)
+             (let*
+              ((line `(nth ,n ,lines))
+               (val-getter
+                (case (car def)
+                 (:int `(parse-integer ,line))
+                 (:double `(coerce (read-from-string ,line) 'double-float))
+                 (:boolean `(string= "1" ,line))
+                 (:choice `(cadr (find ,line ',(third def) :key #'car :test #'string=)))
+                 (:string line))))
+              (when val-getter (list (intern (symbol-name (cadr def)) :keyword) val-getter))))
+            definitions
+            (loop for i to (length definitions) collect i))))))
+     *widget-parsers*))))
+
+(defwidget-definition view
+ (:specified "GRAPHICS-WINDOW")
+ (:int left)
+ (:int top)
+ (:int right)
+ (:int bottom)
+ (:reserved "-1")
+ (:reserved "-1")
+ (:double patch-size)
+ (:reserved)
+ (:int font-size)
+ (:reserved)
+ (:reserved)
+ (:reserved)
+ (:reserved)
+ (:boolean wrapping-allowed-in-x)
+ (:boolean wrapping-allowed-in-y)
+ (:reserved)
+ (:int min-pxcor)
+ (:int max-pxcor)
+ (:int min-pycor)
+ (:int max-pycor)
+ (:choice update-mode (("0" :continuous) ("1" :tick-based)))
+ (:dump update-mode)
+ (:boolean show-tick-counter)
+ (:string tick-counter-label)
+ (:double frame-rate 30))
+
+(defun parse-interface (interface-as-strings)
+ (let
+  ((widgets-as-strings
+    (labels
+     ((separate-widgets-as-strings (lines &optional widget-as-strings)
+       (when lines
+        (if (string= "" (car lines))
+         (cons widget-as-strings (separate-widgets-as-strings (cdr lines)))
+         (separate-widgets-as-strings (cdr lines) (append widget-as-strings (list (car lines))))))))
+     (separate-widgets-as-strings interface-as-strings))))
+  (remove
+   nil
+   (mapcar
+    (lambda (widget-as-strings)
+     (let
+      ((parser (find-if (lambda (validator) (funcall validator widget-as-strings)) *widget-parsers* :key #'car)))
+      (when parser (funcall (cadr parser) widget-as-strings))))
+    widgets-as-strings))))

diff --git a/src/main/package.lisp b/src/main/package.lisp
index dcebaf8eae291ab63b8b9b6393d0cdf1214eff53..83df57fe535f4ea2e4cbab7c94e15a45a01ae23a 100644 (file)
--- 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)
  (:documentation
   "Main CLNL package
 
@@ -8,7 +8,7 @@ the place that ties all the parts together into a cohesive whole."))
 
 (defpackage #:clnl-parser
  (:use :common-lisp)
- (:export :parse)
+ (:export #:parse)
  (:documentation
   "CLNL Parser
 
@@ -28,7 +28,7 @@ to match how java.util.Random works.  Turtles, all the way down."))
 
 (defpackage #:clnl-transpiler
  (:use :common-lisp)
- (:export :transpile-commands :transpile-reporter)
+ (:export #:transpile-commands #:transpile-reporter)
  (:documentation
   "CLNL Transpiler
 
@@ -49,7 +49,7 @@ into an ast that can be transpiled later."))
 
 (defpackage #:clnl-nvm
  (:use :common-lisp)
- (:export :export-world :create-world :current-state
+ (:export #:export-world #:create-world #:current-state
   ; API as used by transpiled NetLogo programs
   #:ask
   #:create-turtles
@@ -64,7 +64,7 @@ NetLogo Virtual Machine: the simulation engine."))
 
 (defpackage #:clnl-lexer
  (:use :common-lisp)
- (:export :lex)
+ (:export #:lex)
  (:documentation
   "CLNL Lexer
 
@@ -72,7 +72,7 @@ The primary code responsible for tokenizing NetLogo code."))
 
 (defpackage #:clnl-interface
  (:use :common-lisp)
- (:export :run :export-view)
+ (:export #:run #:export-view)
  (:documentation
   "CLNL Interface
 
@@ -82,7 +82,7 @@ components."))
 
 (defpackage #:clnl-cli
  (:use :common-lisp :cl-charms/low-level)
- (:export :run)
+ (:export #:run)
  (:documentation
   "CLNL CLI
 
@@ -92,7 +92,7 @@ is where all the features that the traditional NetLogo UI lives."))
 
 (defpackage #:clnl-model
  (:use :common-lisp :cl-charms/low-level)
- (:export :read-from-nlogo)
+ (:export #:read-from-nlogo)
  (:documentation
   "CLNL Model
 

diff --git a/src/test/package.lisp b/src/test/package.lisp
index 2d3102747c2683ccc92272e166d912a5351f9085..ea018f92ca0750550e76cf9e7acc142771b6b3c0 100644 (file)
--- a/src/test/package.lisp
+++ b/src/test/package.lisp
@@ -1,2 +1,2 @@
 (defpackage #:clnl-test (:use :common-lisp)
- (:export :run-all-tests :run :test-debug))
+ (:export #:run-all-tests #:run #:test-debug))

diff --git a/wiki b/wiki
index ca4828046b38fc4f505d0ff3931a16aaf9a85e23..769e5e8f99137d05ee9ea7eb5232d923f14b6286 160000 (submodule)
--- a/wiki
+++ b/wiki
@@ -1 +1 @@
-Subproject commit ca4828046b38fc4f505d0ff3931a16aaf9a85e23
+Subproject commit 769e5e8f99137d05ee9ea7eb5232d923f14b6286