X-Git-Url: https://code.consxy.com/gitweb/gitweb.cgi?p=clnl;a=blobdiff_plain;f=src%2Fmain%2Fnvm%2Fbase.lisp;h=1a80dc3fa87deea9f4bed2cb8432e232b4fed5e7;hp=9d07e9b1280ff677b51faf1e65993f924c59cc80;hb=89cb3482de1fefc2d8e5f67e1e04a0790e8cd243;hpb=9eef8ecae4fad1e01413807ebc80ae45b5990706 diff --git a/src/main/nvm/base.lisp b/src/main/nvm/base.lisp index 9d07e9b..1a80dc3 100644 --- a/src/main/nvm/base.lisp +++ b/src/main/nvm/base.lisp @@ -3,28 +3,61 @@ (defvar *current-id* 0) (defvar *turtles* nil) +(defvar *turtles-own-vars* nil) +(defvar *patches-own-vars* nil) (defvar *patches* nil) (defvar *myself* nil) (defvar *self* nil) (defvar *dimensions* nil) +(defvar *globals* nil) (defvar *topology* :torus) (defvar *ticks* nil) (defvar *breeds* nil) -(defstruct turtle who color heading xcor ycor (label "") (label-color 9.9d0) (size 1d0) shape) -(defstruct patch color xcor ycor) +(define-condition stop nil nil) +(define-condition death nil nil) + +(defmacro with-stop-handler (&rest forms) + "MACRO WITH-STOP-HANDLER &rest FORMS => HANDLED-FORM + +ARGUMENTS AND VALUES: + + FORMS: body to be handled + HANDLED-FORM: body with handling + +DESCRIPTION: + + WITH-STOP-HANDLER is a convenience macro to handle when + programs issue a stop condition. When one does, a simple + :stop is returned." + `(handler-case (progn ,@forms) (stop (s) (declare (ignore s)) :stop))) + +(defmacro with-stop-and-death-handler (&rest forms) + `(handler-case + (progn ,@forms) + (stop (s) (declare (ignore s)) :stop) + (death (d) (declare (ignore d)) :death))) + +(defmacro defcommand (name args docstring &rest body) + `(defun ,name ,args ,docstring ,@body :undefined)) + +(defstruct turtle who breed color heading xcor ycor (label "") label-color size shape own-vars) +(defstruct patch color xcor ycor own-vars turtles) (defun agentset-list (agentset) (cond ((eql agentset :turtles) *turtles*) ((eql agentset :patches) *patches*) ((and (listp agentset) (eql :agentset (car agentset))) (cddr agentset)) + ((find agentset *breeds* :key #'car) + (remove agentset *turtles* :key #'turtle-breed :test-not #'eql)) (t (error "Doesn't seem to be an agentset: ~A" agentset)))) (defun agentset-breed (agentset) (cond ((eql agentset :turtles) :turtles) ((eql agentset :patches) :patches) + ((find agentset *breeds* :key #'car) agentset) ((and (listp agentset) (eql :agentset (car agentset))) (second agentset)) (t (error "Doesn't seem to be an agentset: ~A" agentset)))) @@ -35,6 +68,7 @@ (or (eql o :turtles) (eql o :patches) + (find o *breeds* :key #'car) (and (listp o) (eql :agentset (car o))))) (defun agent-p (o)