X-Git-Url: https://code.consxy.com/gitweb/gitweb.cgi?p=clnl;a=blobdiff_plain;f=src%2Fmain%2Fnvm%2Fbase.lisp;h=1a80dc3fa87deea9f4bed2cb8432e232b4fed5e7;hp=af87bc27e167f68c320a51009d59087bb22b60d6;hb=89cb3482de1fefc2d8e5f67e1e04a0790e8cd243;hpb=762ab38881c8870c9a61ca6857a28159f9fef9fc diff --git a/src/main/nvm/base.lisp b/src/main/nvm/base.lisp index af87bc2..1a80dc3 100644 --- a/src/main/nvm/base.lisp +++ b/src/main/nvm/base.lisp @@ -3,6 +3,8 @@ (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) @@ -13,6 +15,7 @@ (defvar *breeds* nil) (define-condition stop nil nil) +(define-condition death nil nil) (defmacro with-stop-handler (&rest forms) "MACRO WITH-STOP-HANDLER &rest FORMS => HANDLED-FORM @@ -29,20 +32,32 @@ DESCRIPTION: :stop is returned." `(handler-case (progn ,@forms) (stop (s) (declare (ignore s)) :stop))) -(defstruct turtle who color heading xcor ycor (label "") (label-color 9.9d0) (size 1d0) shape) -(defstruct patch color xcor ycor) +(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)))) @@ -53,6 +68,7 @@ DESCRIPTION: (or (eql o :turtles) (eql o :patches) + (find o *breeds* :key #'car) (and (listp o) (eql :agentset (car o))))) (defun agent-p (o)