code.consxy.com Git - clnl/blob - src/main/nvm.lisp

   1 (in-package #:cl-nl.nvm)
   2
   3 ; This is the engine.  Yay.
   4
   5 (defvar *current-id* 0)
   6
   7 (defstruct turtle who color heading xcor ycor)
   8 (defvar *turtles* nil)
   9 (defvar *myself* nil)
  10 (defvar *self* nil)
  11
  12 (defun show (n)
  13  (format t "Showing: ~A~%" (dump-object n)))
  14
  15 (defun create-turtle ()
  16  (push
  17   (make-turtle :who *current-id*
  18                :color (coerce (+ 5 (* 10 (cl-nl.random:next-int 14))) 'double-float)
  19                :heading (coerce (cl-nl.random:next-int 360) 'double-float)
  20                :xcor 0d0
  21                :ycor 0d0)
  22   *turtles*)
  23  (incf *current-id*))
  24
  25 (defun turtles () *turtles*)
  26
  27 (defun ask (agent-set fn)
  28  (mapcar
  29   (lambda (agent)
  30    (let
  31     ((*myself* *self*)
  32      (*self* agent))
  33     (funcall fn)))
  34   (shuffle agent-set)))
  35
  36 (defun shuffle (agent-set)
  37  (let
  38   ((copy (copy-list agent-set)))
  39   (append
  40    (loop for i to (- (length copy) 2)
  41          for idx = (+ i (cl-nl.random:next-int (- (length copy) i)))
  42          for next = (nth idx copy)
  43          do (setf (nth idx copy) (nth i copy))
  44          collect next)
  45    (last copy))))
  46
  47 (defun random-float (n)
  48  (cl-nl.random:next-double n))
  49
  50 (defun fd (n)
  51  (when (not (turtle-p *self*)) (error "Gotta call fd in turtle scope, dude"))
  52  (setf (turtle-xcor *self*) (+ (turtle-xcor *self*) (sin (* pi (/ (turtle-heading *self*) 180)))))
  53  (setf (turtle-ycor *self*) (+ (turtle-ycor *self*) (cos (* pi (/ (turtle-heading *self*) 180))))))
  54
  55 (defun create-turtles (n)
  56  (loop for i from 1 to n do (create-turtle)))
  57
  58 (defun create-world ()
  59  (setf *turtles* nil)
  60  (setf *current-id* 0))
  61
  62 (defgeneric dump-object (o))
  63 (defmethod dump-object ((n double-float))
  64  (multiple-value-bind (int rem) (floor n)
  65   (if (eql 0d0 rem)
  66       (format nil "~A" int)
  67       (format nil "~F" n))))
  68 (defmethod dump-object ((o string)) o)
  69
  70 (defun export-world ()
  71  (format nil "~{~A~%~}"
  72   (list
  73    (format nil "~S" "RANDOM STATE")
  74    (format nil "~S" (cl-nl.random:export))
  75    ""
  76    (format nil "~S" "GLOBALS")
  77    "\"min-pxcor\",\"max-pxcor\",\"min-pycor\",\"max-pycor\",\"perspective\",\"subject\",\"nextIndex\",\"directed-links\",\"ticks\","
  78    (format nil "\"-1\",\"1\",\"-1\",\"1\",\"0\",\"nobody\",\"~A\",\"\"\"NEITHER\"\"\",\"-1\"" *current-id*)
  79    ""
  80    (format nil "~S" "TURTLES")
  81    "\"who\",\"color\",\"heading\",\"xcor\",\"ycor\",\"shape\",\"label\",\"label-color\",\"breed\",\"hidden?\",\"size\",\"pen-size\",\"pen-mode\""
  82    (format nil "~{~A~%~}"
  83     (mapcar
  84      (lambda (turtle)
  85       (format nil
  86        "\"~A\",\"~A\",\"~A\",\"~A\",\"~A\",\"\"\"default\"\"\",\"\"\"\"\"\",\"9.9\",\"{all-turtles}\",\"false\",\"1\",\"1\",\"\"\"up\"\"\""
  87        (turtle-who turtle)
  88        (dump-object (turtle-color turtle))
  89        (dump-object (turtle-heading turtle))
  90        (dump-object (turtle-xcor turtle))
  91        (dump-object (turtle-ycor turtle))
  92        ))
  93      (reverse *turtles*)))
  94    (format nil "~S" "PATCHES")
  95    "\"pxcor\",\"pycor\",\"pcolor\",\"plabel\",\"plabel-color\""
  96    "\"-1\",\"1\",\"0\",\"\"\"\"\"\",\"9.9\""
  97    "\"0\",\"1\",\"0\",\"\"\"\"\"\",\"9.9\""
  98    "\"1\",\"1\",\"0\",\"\"\"\"\"\",\"9.9\""
  99    "\"-1\",\"0\",\"0\",\"\"\"\"\"\",\"9.9\""
 100    "\"0\",\"0\",\"0\",\"\"\"\"\"\",\"9.9\""
 101    "\"1\",\"0\",\"0\",\"\"\"\"\"\",\"9.9\""
 102    "\"-1\",\"-1\",\"0\",\"\"\"\"\"\",\"9.9\""
 103    "\"0\",\"-1\",\"0\",\"\"\"\"\"\",\"9.9\""
 104    "\"1\",\"-1\",\"0\",\"\"\"\"\"\",\"9.9\""
 105    ""
 106    (format nil "~S" "LINKS")
 107    "\"end1\",\"end2\",\"color\",\"label\",\"label-color\",\"hidden?\",\"breed\",\"thickness\",\"shape\",\"tie-mode\""
 108    ""
 109    )))