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~%" 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 fd (n)
  48  (when (not (turtle-p *self*)) (error "Gotta call fd in turtle scope, dude"))
  49  (setf (turtle-xcor *self*) (+ (turtle-xcor *self*) (sin (* pi (/ (turtle-heading *self*) 180)))))
  50  (setf (turtle-ycor *self*) (+ (turtle-ycor *self*) (cos (* pi (/ (turtle-heading *self*) 180))))))
  51
  52 (defun create-turtles (n)
  53  (loop for i from 1 to n do (create-turtle)))
  54
  55 (defun create-world ()
  56  (setf *turtles* nil)
  57  (setf *current-id* 0))
  58
  59 (defun format-num (n)
  60  (multiple-value-bind (int rem) (floor n)
  61   (if (eql 0d0 rem)
  62       (format nil "~A" int)
  63       (format nil "~F" n))))
  64
  65 (defun export-world ()
  66  (format nil "~{~A~%~}"
  67   (list
  68    (format nil "~S" "RANDOM STATE")
  69    (format nil "~S" (cl-nl.random:export))
  70    ""
  71    (format nil "~S" "GLOBALS")
  72    "\"min-pxcor\",\"max-pxcor\",\"min-pycor\",\"max-pycor\",\"perspective\",\"subject\",\"nextIndex\",\"directed-links\",\"ticks\","
  73    (format nil "\"-1\",\"1\",\"-1\",\"1\",\"0\",\"nobody\",\"~A\",\"\"\"NEITHER\"\"\",\"-1\"" *current-id*)
  74    ""
  75    (format nil "~S" "TURTLES")
  76    "\"who\",\"color\",\"heading\",\"xcor\",\"ycor\",\"shape\",\"label\",\"label-color\",\"breed\",\"hidden?\",\"size\",\"pen-size\",\"pen-mode\""
  77    (format nil "~{~A~%~}"
  78     (mapcar
  79      (lambda (turtle)
  80       (format nil
  81        "\"~A\",\"~A\",\"~A\",\"~A\",\"~A\",\"\"\"default\"\"\",\"\"\"\"\"\",\"9.9\",\"{all-turtles}\",\"false\",\"1\",\"1\",\"\"\"up\"\"\""
  82        (turtle-who turtle)
  83        (format-num (turtle-color turtle))
  84        (format-num (turtle-heading turtle))
  85        (format-num (turtle-xcor turtle))
  86        (format-num (turtle-ycor turtle))
  87        ))
  88      (reverse *turtles*)))
  89    (format nil "~S" "PATCHES")
  90    "\"pxcor\",\"pycor\",\"pcolor\",\"plabel\",\"plabel-color\""
  91    "\"-1\",\"1\",\"0\",\"\"\"\"\"\",\"9.9\""
  92    "\"0\",\"1\",\"0\",\"\"\"\"\"\",\"9.9\""
  93    "\"1\",\"1\",\"0\",\"\"\"\"\"\",\"9.9\""
  94    "\"-1\",\"0\",\"0\",\"\"\"\"\"\",\"9.9\""
  95    "\"0\",\"0\",\"0\",\"\"\"\"\"\",\"9.9\""
  96    "\"1\",\"0\",\"0\",\"\"\"\"\"\",\"9.9\""
  97    "\"-1\",\"-1\",\"0\",\"\"\"\"\"\",\"9.9\""
  98    "\"0\",\"-1\",\"0\",\"\"\"\"\"\",\"9.9\""
  99    "\"1\",\"-1\",\"0\",\"\"\"\"\"\",\"9.9\""
 100    ""
 101    (format nil "~S" "LINKS")
 102    "\"end1\",\"end2\",\"color\",\"label\",\"label-color\",\"hidden?\",\"breed\",\"thickness\",\"shape\",\"tie-mode\""
 103    ""
 104    )))