X-Git-Url: https://code.consxy.com/gitweb/gitweb.cgi?p=clnl;a=blobdiff_plain;f=src%2Fmain%2Fmodel.lisp;h=7ff6efb5b20152573d6bac0ffe6cfcd13999ff69;hp=f054d4c62b0d7f144be7d9e9f07dc5c8866c6052;hb=bc0c65622016066a82bc03b065f7138118c5b3cd;hpb=bb7b48443976f5cea04f5dd1c9bac64659d0a2c7 diff --git a/src/main/model.lisp b/src/main/model.lisp index f054d4c..7ff6efb 100644 --- a/src/main/model.lisp +++ b/src/main/model.lisp @@ -75,7 +75,7 @@ DESCRIPTION: (make-model :code "" :interface (list - (make-view :min-pxcor -5 :max-pxcor 5 :min-pycor -5 :max-pycor 5 :patch-size 13d0)))) + (make-view :left 10 :top 10 :min-pxcor -5 :max-pxcor 5 :min-pycor -5 :max-pycor 5 :patch-size 13d0)))) (defun read-from-nlogo (str) "READ-FROM-NLOGO STR => MODEL @@ -349,6 +349,57 @@ DESCRIPTION: (switch (list (intern (string-upcase (switch-varname widget)) :keyword) (switch-on widget))))) (model-interface model)))) +(defun buttons (model) + "BUTTONS MODEL => BUTTON-DEFS + + BUTTON-DEFS: BUTTON-DEF* + BUTTON-DEF: (:left LEFT :top TOP :height HEIGHT :width WIDTH :display DISPLAY) + +ARGUMENTS AND VALUES: + + MODEL: A valid model + LEFT: An integer representing the left position + TOP: An integer representing the top position + HEIGHT: An integer representing height + WIDTH: An integer representing width + DISPLAY: A string representing display name + +DESCRIPTION: + + Returns button definitions that get declared in the buttons of the + MODEL. This is used to initialize the interface." + (remove nil + (mapcar + (lambda (widget) + (typecase widget + (button + (list + :left (button-left widget) + :top (button-top widget) + :width (- (button-right widget) (button-left widget)) + :height (- (button-bottom widget) (button-top widget)) + :display (button-display-name widget))))) + (model-interface model)))) + +(defun view (model) + "BUTTONS MODEL => VIEW-DEF + + VIEW-DEF: (:left LEFT :top TOP) + +ARGUMENTS AND VALUES: + + MODEL: A valid model + LEFT: An integer representing the left position + TOP: An integer representing the top position + +DESCRIPTION: + + Returns the view definition that get declared in the view of the + MODEL. This is used to initialize the interface." + (let + ((view (find-if #'view-p (model-interface model)))) + (list :left (view-left view) :top (view-top view)))) + (defun code (model) "CODE MODEL => CODE