X-Git-Url: https://code.consxy.com/gitweb/gitweb.cgi?p=clnl;a=blobdiff_plain;f=src%2Fmain%2Fmodel.lisp;h=8aa37159b3e70ddec0cd4b228f264a0eec2f8af7;hp=ee776c7178743f6c9385c79cec7ce05fe69feb00;hb=72aabe5;hpb=2d8a7c97e20e7b68b11ee2d70d4a59da84b0d862 diff --git a/src/main/model.lisp b/src/main/model.lisp index ee776c7..8aa3715 100644 --- a/src/main/model.lisp +++ b/src/main/model.lisp @@ -16,6 +16,20 @@ model-settings delta-tick) +(defun default-model () + "DEFAULT-MODEL => MODEL + +ARGUMENTS AND VALUES: + + MODEL: an object representing the model + +DESCRIPTION: + + Returns the default startup model." + (make-model + :interface (list + (make-view :min-pxcor -5 :max-pxcor 5 :min-pycor -5 :max-pycor 5)))) + (defun read-from-nlogo (str) "READ-FROM-NLOGO STR => MODEL @@ -64,7 +78,8 @@ DESCRIPTION: (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 :inverted-boolean :boolean :choice :string :option)) (second def))) definitions))) (push (list @@ -80,6 +95,7 @@ DESCRIPTION: (: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))) + (:inverted-boolean `(or (string= "0" ,line) (string= "1" ,line))) (:choice `(find ,line ',(mapcar #'car (third def)) :test #'string=))))) definitions (loop for i to (length definitions) collect i))))) @@ -95,7 +111,9 @@ DESCRIPTION: (:int `(parse-integer ,line)) (:double `(coerce (read-from-string ,line) 'double-float)) (:boolean `(string= "1" ,line)) + (:inverted-boolean `(string= "0" ,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 @@ -130,6 +148,34 @@ DESCRIPTION: (: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)))) + +(defwidget-definition switch + (:specified "SWITCH") + (:int left) + (:int top) + (:int right) + (:int bottom) + (:string display) + (:string varname) + (:inverted-boolean on) + (:reserved) + (:reserved)) + (defun parse-interface (interface-as-strings) (let ((widgets-as-strings @@ -148,3 +194,30 @@ DESCRIPTION: ((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)))) + +;; INFORMATION ABOUT MODEL + +(defun world-dimensions (model) + "WORLD-DIMENSIONS MODEL => DIMS + + DIMS: (:xmin XMIN :xmax XMAX :ymin YMIN :ymax YMAX) + +ARGUMENTS AND VALUES: + + MODEL: A valid model containing a view + 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: + + Returns the dimensions of MODEL. MODEL must be a valid model + as parsed by CLNL, and have a valid view in it." + (let + ((view (find-if #'view-p (model-interface model)))) + (list + :xmin (view-min-pxcor view) + :xmax (view-max-pxcor view) + :ymin (view-min-pycor view) + :ymax (view-max-pycor view))))