diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..d6d6e5b
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,3 @@
+# ignore generated files
+*.lib
+*.fas
diff --git a/AdvancedDatatypesAndGenericProgramming.lisp b/AdvancedDatatypesAndGenericProgramming.lisp
new file mode 100644
index 0000000..e69de29
diff --git a/DiceOfDoom.lisp b/DiceOfDoom.lisp
new file mode 100644
index 0000000..5f47b02
--- /dev/null
+++ b/DiceOfDoom.lisp
@@ -0,0 +1,220 @@
+(defparameter *num-players* 2)
+(defparameter *max-dice* 3)
+(defparameter *board-size* 5)
+(defparameter *board-hexnum* (* *board-size* *board-size*))
+(defparameter *ai-level* 4)
+
+; DIRTY IMPERATIVE
+
+(defun gen-board()
+ ; Randomize board when game begins
+ (board-array (loop for n below *board-hexnum*
+ collect (list (random *num-players*)
+ (1+ (random *max-dice*))))))
+
+(defun draw-board (board)
+ (loop for y below *board-size*
+ do (progn (fresh-line)
+ (loop repeat (- *board-size* y)
+ do (princ " "))
+ (loop for x below *board-size*
+ for hex = (aref board (+ x (* *board-size* y)))
+ do (format t "~a-~a " (player-letter (first hex))
+ (second hex))))))
+
+; CLEAN FUNCTIONAL
+
+(defun board-array (lst)
+ ; Convert board list to array
+ (make-array *board-hexnum* :initial-contents lst))
+
+(defun player-letter (n)
+ (code-char (+ 97 n)))
+
+(defun game-tree-v1 (board player spare-dice first-move)
+ (list player
+ board
+ (add-passing-move board
+ player
+ spare-dice
+ first-move
+ (attacking-moves board player spare-dice))))
+
+(let ((previous (make-hash-table :test #'equalp)))
+ (defun game-tree (&rest rest)
+ (or (gethash rest previous)
+ (setf (gethash rest previous) (apply #'game-tree-v1 rest)))))
+
+(defun add-passing-move (board player spare-dice first-move moves)
+ (if first-move
+ moves
+ (lazy-cons (list nil
+ (game-tree (add-new-dice board player (1- spare-dice))
+ (mod (1+ player) *num-players*)
+ 0
+ t))
+ moves)))
+
+(defun attacking-moves (board cur-player spare-dice)
+ (labels ((player (pos)
+ (first (aref board pos)))
+ (dice (pos)
+ (second (aref board pos))))
+ (lazy-mapcan (lambda (src)
+ (if (eq (player src) cur-player)
+ (lazy-mapcan (lambda (dst)
+ (if (and (not (eq (player dst) cur-player))
+ (> (dice src) (dice dst)))
+ (make-lazy (list (list (list src dst)
+ (game-tree (board-attack board
+ cur-player
+ src
+ dst
+ (dice src))
+ cur-player
+ (+ spare-dice (dice dst))
+ nil))))
+ (lazy-nil)))
+ (make-lazy (neighbors src)))
+ (lazy-nil)))
+ (make-lazy (loop for n below *board-hexnum* collect n)))))
+
+(defun neighbors-v1 (pos)
+ (let ((up (- pos *board-size*))
+ (down (+ pos *board-size*)))
+ (loop for p in (append (list up down)
+ (unless (zerop (mod pos *board-size*))
+ (list (1- up) (1- pos)))
+ (unless (zerop (mod (1+ pos) *board-size*))
+ (list (1+ pos) (1+ down))))
+ when (and (>= p 0) (< p *board-hexnum*))
+ collect p)))
+
+(let ((previous (make-hash-table)))
+ (defun neighbors (pos)
+ (or (gethash pos previous)
+ (setf (gethash pos previous) (neighbors-v1 pos)))))
+
+(defun board-attack (board player src dst dice)
+ (board-array (loop for pos from 0
+ for hex across board
+ collect (cond ((eq pos src) (list player 1))
+ ((eq pos dst) (list player (1- dice)))
+ (t hex)))))
+
+(defun add-new-dice (board player spare-dice)
+ (labels ((f (lst n)
+ (cond ((zerop n) lst)
+ ((null lst) nil)
+ (t (let ((cur-player (caar lst))
+ (cur-dice (cadar lst)))
+ (if (and (eq cur-player player)
+ (< cur-dice *max-dice*))
+ (cons (list cur-player (1+ cur-dice))
+ (f (cdr lst) (1- n)))
+ (cons (car lst) (f (rest lst) n))))))))
+ (board-array (f (coerce board 'list)
+ (largest-cluster-size board player)))))
+
+(defun play-vs-human (tree)
+ (print-info tree)
+ (if (not (lazy-null (caddr tree)))
+ (play-vs-human (handle-human tree))
+ (announce-winner (cadr tree))))
+
+(defun print-info (tree)
+ (fresh-line)
+ (format t "current player = ~a" (player-letter (first tree)))
+ (draw-board (first (rest tree))))
+
+(defun handle-human (tree)
+ (fresh-line)
+ (princ "choose your move:")
+ (let ((moves (caddr tree)))
+ (labels ((print-moves (moves n)
+ (unless (lazy-null moves)
+ (let* ((move (lazy-first moves))
+ (action (first move)))
+ (fresh-line)
+ (format t "~a. " n)
+ (if action
+ (format t "~a -> ~a" (first action) (first (last action)))
+ (princ "end turn.")))
+ (print-moves (lazy-rest moves) (1+ n)))))
+ (print-moves moves 1))
+ (fresh-line)
+ (first (last (lazy-nth (1- (read)) moves)))))
+
+(defun winners (board)
+ (let* ((tally (loop for hex across board
+ collect (first hex)))
+ (totals (mapcar (lambda (player)
+ (cons player (count player tally)))
+ (remove-duplicates tally)))
+ (best (apply #'max (mapcar #'cdr totals))))
+ (mapcar #'first
+ (remove-if (lambda (x)
+ (not (eq (rest x) best)))
+ totals))))
+
+(defun announce-winner (board)
+ (fresh-line)
+ (let ((w (winners board)))
+ (if (> (length w) 1)
+ (format t "The game is a tie between ~a" (mapcar #'player-letter w))
+ (format t "The winner is ~a" (player-letter (first w))))))
+
+ ; The MINIMAX Algorithm
+(defun rate-position (tree player)
+ (let ((moves (third tree)))
+ (if (not (lazy-null moves))
+ (apply (if (eq (first tree) player)
+ #'max
+ #'min)
+ (get-ratings tree player))
+ (score-board (second tree) player))))
+
+(defun get-ratings (tree player)
+ (take-all (lazy-mapcar (lambda (move)
+ (rate-position (second move) player))
+ (third tree))))
+
+;(defun handle-computer (tree)
+; (let ((ratings (ab-get-ratings-max (limit-tree-depth tree *ai-level*)
+; (first tree)
+; most-positive-fixnum
+; most-negative-fixnum)))
+; (cadr (lazy-nth (position (apply #'max ratings) ratings)
+ ; (caddr tree)))))
+
+(defun handle-computer (tree)
+ (let ((ratings (get-ratings (limit-tree-depth tree *ai-level*) (first tree))))
+ (pick-chance-branch
+ (second tree)
+ (lazy-nth (position (apply #'max ratings) ratings) (third tree)))))
+
+(defun play-vs-computer (tree)
+ (print-info tree)
+ (cond ((lazy-null (third tree)) (announce-winner (second tree)))
+ ((zerop (first tree)) (play-vs-computer (handle-human tree)))
+ (t (play-vs-computer (handle-computer tree)))))
+
+(defun score-board (board player)
+ (loop for hex across board
+ for pos from 0
+ sum (if (eq (first hex) player)
+ (if (threatened pos board)
+ 1
+ 2)
+ -1)))
+
+(defun threatened (pos board)
+ (let* ((hex (aref board pos))
+ (player (first hex))
+ (dice (second hex)))
+ (loop for n in (neighbors pos)
+ do (let* ((nhex (aref board n))
+ (nplayer (first nhex))
+ (ndice (second nhex)))
+ (when (and (not (eq player nplayer)) (> ndice dice))
+ (return t))))))
diff --git a/DiceOfDoom_V2.lisp b/DiceOfDoom_V2.lisp
new file mode 100644
index 0000000..5fa5672
--- /dev/null
+++ b/DiceOfDoom_V2.lisp
@@ -0,0 +1,55 @@
+(load "~/Development/CLISP/LOL/DiceOfDoom.lisp")
+(load "~/Development/CLISP/LOL/lazy.lisp")
+
+(defparameter *board-size* 5)
+(defparameter *board-hexnum* (* *board-size* *board-size*))
+
+(defun limit-tree-depth (tree depth)
+ (list (first tree)
+ (first (rest tree))
+ (if (zerop depth)
+ (lazy-nil)
+ (lazy-mapcar (lambda (move)
+ (cons (first move)
+ (mapcar (lambda (x)
+ (limit-tree-depth x (1- depth)))
+ (rest move))))
+ (caddr tree)))))
+
+(defun ab-get-ratings-max (tree player upper-limit lower-limit)
+ (labels ((f (moves lower-limit)
+ (unless (lazy-null moves)
+ (let ((x (ab-rate-position (second (lazy-first moves))
+ player
+ upper-limit
+ lower-limit)))
+ (if (>= x upper-limit)
+ (list x)
+ (cons x (f (lazy-rest moves) (max x lower-limit))))))))
+ (f (third tree) lower-limit)))
+
+(defun ab-get-ratings-min (tree player upper-limit lower-limit)
+ (labels ((f (moves upper-limit)
+ (unless (lazy-null moves)
+ (let ((x (ab-rate-position (second (lazy-first moves))
+ player
+ upper-limit
+ lower-limit)))
+ (if (<= x lower-limit)
+ (list x)
+ (cons x (f (lazy-rest moves) (min x upper-limit))))))))
+ (f (third tree) upper-limit)))
+
+(defun ab-rate-position (tree player upper-limit lower-limit)
+ (let ((moves (third tree)))
+ (if (not (lazy-null moves))
+ (if (eq (first tree) player)
+ (apply #'max (ab-get-ratings-max tree
+ player
+ upper-limit
+ lower-limit))
+ (apply #'min (ab-get-ratings-min tree
+ player
+ upper-limit
+ lower-limit)))
+ (score-board (second tree) player))))
diff --git a/LoopMacroEvolution.lisp b/LoopMacroEvolution.lisp
new file mode 100644
index 0000000..09d2cae
--- /dev/null
+++ b/LoopMacroEvolution.lisp
@@ -0,0 +1,111 @@
+(defparameter *width* 93)
+(defparameter *height* 30)
+(defparameter *jungle* '(45 10 10 10))
+(defparameter *plant-energy* 80)
+(defparameter *plants* (make-hash-table :test #'equal))
+(defparameter *reproduction-energy* 200)
+
+(defun random-plant (left top width height)
+ (let ((pos (cons (+ left (random width)) (+ top (random height)))))
+ (setf (gethash pos *plants*) t)))
+
+(defun add-plants ()
+ (apply #'random-plant *jungle*)
+ (random-plant 0 0 *width* *height*))
+
+(defstruct animal x y energy dir genes)
+
+(defparameter *animals*
+ (list (make-animal :x (ash *width* -1)
+ :y (ash *height* -1)
+ :energy 1000
+ :dir 0
+ :genes (loop repeat 8
+ collecting (1+ (random 10))))))
+(defun move (animal)
+ (let ((dir (animal-dir animal))
+ (x (animal-x animal))
+ (y (animal-y animal)))
+ (setf (animal-x animal) (mod (+ x
+ (cond ((and (>= dir 2) (< dir 5)) 1)
+ ((or (= dir 1) (= dir 5)) 0)
+ (t - 1)))
+ *width*))
+ (setf (animal-y animal) (mod (+ y
+ (cond ((and (>= dir 0) (< dir 3)) -1)
+ ((and (>= dir 4) (< dir 7)) 1)
+ (t 0)))
+ *height*))
+ (decf (animal-energy animal))))
+
+(defun turn (animal)
+ (let ((x (random (apply #'+ (animal-genes animal)))))
+ (labels ((angle (genes x)
+ (let ((xnu (- x (first genes))))
+ (if (< xnu 0)
+ 0
+ (1+ (angle (rest genes) xnu))))))
+ (setf (animal-dir animal)
+ (mod (+ (animal-dir animal) (angle (animal-genes animal) x))
+ 8)))))
+
+(defun eat (animal)
+ (let ((pos (cons (animal-x animal) (animal-y animal))))
+ (when (gethash pos *plants*)
+ (incf (animal-energy animal) *plant-energy*)
+ (remhash pos *plants*))))
+
+(defun reproduce (animal)
+ (let ((e (animal-energy animal)))
+ (when (>= e *reproduction-energy*)
+ (setf (animal-energy animal) (ash e -1))
+ (let ((animal-nu (copy-structure animal))
+ (genes (copy-list (animal-genes animal)))
+ (mutation (random 8)))
+ (setf (nth mutation genes)
+ (max 1 (+ (nth mutation genes) (random 3) -1)))
+ (setf (animal-genes animal-nu) genes)
+ (push animal-nu *animals*)))))
+
+(defun update-world ()
+ (setf *animals* (remove-if (lambda (animal)
+ (<= (animal-energy animal) 0))
+ *animals*))
+ (mapc (lambda (animal)
+ (turn animal)
+ (move animal)
+ (eat animal)
+ (reproduce animal))
+ *animals*)
+ (add-plants))
+
+(defun draw-world ()
+ (loop for y
+ below *height*
+ do (progn (fresh-line)
+ (princ "|")
+ (loop for x
+ below *width*
+ do (princ (cond ((some (lambda (animal)
+ (and (= (animal-x animal) x)
+ (= (animal-y animal) y)))
+ *animals*)
+ #\M)
+ ((gethash (cons x y) *plants*) #\*)
+ (t #\space))))
+ (princ "|"))))
+
+(defun evolution ()
+ (draw-world)
+ (fresh-line)
+ (let ((str (read-line)))
+ (cond ((equal str "quit") ())
+ (t (let ((x (parse-integer str :junk-allowed t)))
+ (if x
+ (loop for i
+ below x
+ do (update-world)
+ if (zerop (mod i 1000))
+ do (princ #\.))
+ (update-world))
+ (evolution))))))
diff --git a/OrcBattle.lisp b/OrcBattle.lisp
new file mode 100644
index 0000000..0b4e041
--- /dev/null
+++ b/OrcBattle.lisp
@@ -0,0 +1,209 @@
+(defparameter *player-health* nil)
+(defparameter *player-agility* nil)
+(defparameter *player-strength* nil)
+
+(defparameter *monsters* nil)
+(defparameter *monster-builders* nil)
+(defparameter *monster-num* 12)
+
+(defun orc-battle ()
+ (init-monsters)
+ (init-player)
+ (game-loop)
+ (when (player-dead)
+ (princ "You have been killed. Game over."))
+ (when (monsters-dead)
+ (princ "Congratulations! You have vanquished allo f your foes.")))
+
+(defun game-loop ()
+ (unless (or (player-dead) (monsters-dead))
+ (show-player)
+ (dotimes (k (1+ (truncate (/ (max 0 *player-agility*) 15))))
+ (unless (monsters-dead)
+ (show-monsters)
+ (player-attack)))
+ (fresh-line)
+ (map 'list
+ (lambda(m)
+ (or (monster-dead m) (monster-attack m)))
+ *monsters*)
+ (game-loop)))
+
+(defun init-player ()
+ (setf *player-health* 30)
+ (setf *player-agility* 30)
+ (setf *player-strength* 30))
+
+(defun player-dead ()
+ (<= *player-health* 0))
+
+(defun show-player ()
+ (fresh-line)
+ (princ "You are a valiant knight with a health of ")
+ (princ *player-health*)
+ (princ ", and agility of ")
+ (princ *player-agility*)
+ (princ ", and a strength of ")
+ (princ *player-strength*))
+
+(defun player-attack ()
+ (fresh-line)
+ (princ "Attack style: [s]tab [d]ouble swing [r]oundhouse:")
+ (case (read)
+ (s (monster-hit (pick-monster)
+ (+ 2 (randval (ash *player-strength* -1)))))
+ (d (let ((x (randval (truncate (/ *player-strength* 6)))))
+ (princ "Your double swing has a strength of ")
+ (princ x)
+ (fresh-line)
+ (monster-hit (pick-monster) x)
+ (unless (monsters-dead)
+ (monster-hit (pick-monster) x))))
+ (otherwise (dotimes (x (1+ (randval (truncate (/ *player-strength* 3)))))
+ (unless (monsters-dead)
+ (monster-hit (random-monster) 1))))))
+
+(defun randval (n)
+ (1+ (random (max 1 n))))
+
+(defun random-monster ()
+ (let ((m (aref *monsters* (random (length *monsters*)))))
+ (if (monster-dead m)
+ (random-monster)
+ m)))
+
+(defun pick-monster ()
+ (fresh-line)
+ (princ "Monster #:")
+ (let ((x (read)))
+ (if (not (and (integerp x) (>= x 1) (<= x *monster-num*)))
+ (progn (princ "That is not a valid monster number.")
+ (pick-monster))
+ (let ((m (aref *monsters* (1- x))))
+ (if (monster-dead m)
+ (progn (princ "That monster is already dead.")
+ (pick-monster))
+ m)))))
+
+(defun init-monsters ()
+ (setf *monsters*
+ (map 'vector
+ (lambda (x)
+ (funcall (nth (random (length *monster-builders*))
+ *monster-builders*)))
+ (make-array *monster-num*))))
+
+(defun monster-dead (m)
+ (<= (monster-health m) 0))
+
+(defun monsters-dead ()
+ (every #'monster-dead *monsters*))
+
+(defun show-monsters ()
+ (fresh-line)
+ (princ "Your foes:")
+ (let ((x 0))
+ (map 'list
+ (lambda (m)
+ (fresh-line)
+ (princ " ")
+ (princ (incf x))
+ (princ ". ")
+ (if (monster-dead m)
+ (princ "**dead**")
+ (progn (princ "-Health:")
+ (princ (monster-health m))
+ (princ "- ")
+ (monster-show m))))
+ *monsters*)))
+
+(defstruct monster (health (randval 10)))
+
+(defmethod monster-hit (m x)
+ (decf (monster-health m) x)
+ (if (monster-dead m)
+ (progn (princ "You killed the ")
+ (princ (type-of m))
+ (princ "! "))
+ (progn (princ "You hit the ")
+ (princ (type-of m))
+ (princ ", knocking off ")
+ (princ x)
+ (princ " health points! "))))
+
+(defmethod monster-show (m)
+ (princ "> fierce ")
+ (princ (type-of m)))
+
+(defmethod monster-attack (m))
+
+(defstruct (orc (:include monster)) (club-level (randval 8)))
+(push #'make-orc *monster-builders*)
+
+(defmethod monster-show ((m orc))
+ (princ "A wicked orc with a level ")
+ (princ (orc-club-level m))
+ (princ " club"))
+
+(defmethod monster-attack ((m orc))
+ (let ((x (randval (orc-club-level m))))
+ (princ "An orc swings his club at you and knocks off ")
+ (princ x)
+ (princ " of your health points. ")
+ (decf *player-health* x)))
+
+(defstruct (hydra (:include monster)))
+(push #'make-hydra *monster-builders*)
+
+(defmethod monster-show ((m hydra))
+ (princ "A malicious hydra with ")
+ (princ (monster-health m))
+ (princ " heads."))
+
+(defmethod monster-hit ((m hydra) x)
+ (decf (monster-health m) x)
+ (if (monster-dead m)
+ (princ "The corpse of the fully decapitated and decapacitated hydra falls to the floor!")
+ (progn (princ "You lop off ")
+ (princ x)
+ (princ " of the hydra's heads! "))))
+
+(defmethod monster-attack ((m hydra))
+ (let ((x (randval (ash (monster-health m) -1))))
+ (princ "A hydra attacks you with ")
+ (princ x)
+ (princ " of its heads! It also grows back one more head! ")
+ (incf (monster-health m))
+ (decf *player-health* x)))
+
+(defstruct (slime-mold (:include monster)) (sliminess (randval 5)))
+(push #'make-slime-mold *monster-builders*)
+
+(defmethod monster-show ((m slime-mold))
+ (princ "A slime mold with a sliminess of ")
+ (princ (slime-mold-sliminess m)))
+
+(defmethod monster-attack ((m slime-mold))
+ (let ((x (randval (slime-mold-sliminess m))))
+ (princ "A slime mold wraps around your legs and decreases your agility by ")
+ (princ x)
+ (princ "! ")
+ (decf *player-agility* x)
+ (when (zerop (random 2))
+ (princ "It also squirts in your face, taking away a health point! ")
+ (decf *player-health*))))
+
+(defstruct (brigand (:include monster)))
+(push #'make-brigand *monster-builders*)
+
+(defmethod monster-attack ((m brigand))
+ (let ((x (max *player-health* *player-agility* *player-strength*)))
+ (cond ((= x *player-health*)
+ (princ "A brigand hits you with his slingshot, taking off 2 health points! ")
+ (decf *player-health* 2))
+ ((= x *player-agility*)
+ (princ "A brigand catches your leg with his whip, taking off 2 agility points! ")
+ (decf *player-agility* 2))
+ ((= x *player-strength*)
+ (princ "A brigand cuts your arm with his whip, taking off 2 strength points!" )
+ (decf *player-strength* 2)))))
diff --git a/WebServer.lisp b/WebServer.lisp
new file mode 100644
index 0000000..bef37d8
--- /dev/null
+++ b/WebServer.lisp
@@ -0,0 +1,73 @@
+(defun http-char (c1 c2 &optional (default #\Space))
+ (let ((code (parse-integer
+ (coerce (list c1 c2) 'string)
+ :radix 16
+ :junk-allowed t)))
+ (if code
+ (code-char code)
+ default)))
+
+(defun decode-param (s)
+ (labels ((f (lst)
+ (when lst
+ (case (first lst)
+ (#\% (cons (http-char (second lst) (third lst))
+ (f (cdddr lst))))
+ (#\+ (cons #\space (f (rest lst))))
+ (otherwise (cons (first lst) (f (rest lst))))))))
+ (coerce (f (coerce s 'list)) 'string)))
+
+(defun parse-params (s)
+ (let ((i1 (position #\= s))
+ (i2 (position #\& s)))
+ (cond (i1 (cons (cons (intern (string-upcase (subseq s 0 i1)))
+ (decode-param (subseq s (1+ i1) i2)))
+ (and i2 (parse-params (subseq s (1+ i2))))))
+ ((equal s "") nil)
+ (t s))))
+
+(defun parse-url (s)
+ (let* ((url (subseq s
+ (+ 2 (position #\space s))
+ (position #\space s :from-end t)))
+ (x (position #\? url)))
+ (if x
+ (cons (subseq url 0 x) (parse-params (subseq url (1+ x))))
+ (cons url '()))))
+
+(defun get-header (stream)
+ (let* ((s (read-line stream))
+ (h (let ((i (position #\: s)))
+ (when i
+ (cons (intern (string-upcase (subseq s 0 i)))
+ (subseq s (+ i 2)))))))
+ (when h
+ (cons h (get-header stream)))))
+
+(defun get-content-params (stream header)
+ (let ((length (rest (assoc 'content-length header))))
+ (when length
+ (let ((content (make-string (parse-integer length))))
+ (read-sequence content stream)
+ (parse-params content)))))
+
+(defun serve (request-handler)
+ (let ((socket (socket-server 8080)))
+ (unwind-protect
+ (loop (with-open-stream (stream (socket-accept socket))
+ (let* ((url (parse-url (read-line stream)))
+ (path (first url))
+ (header (get-header stream))
+ (params (append (rest url)
+ (get-content-params stream header)))
+ (*standard-output* stream))
+ (funcall request-handler path header params))))
+ (socket-server-close socket))))
+
+(defun hello-request-handler (path header params)
+ (if (equal path "greeting")
+ (let ((name (assoc 'name params)))
+ (if (not name)
+ (princ "")
+ (format t "Nice to meet you, ~a!" (rest name))))
+ (princ "Sorry... I don't know that page.")))
diff --git a/Wumpus.lisp b/Wumpus.lisp
new file mode 100644
index 0000000..c71ddf5
--- /dev/null
+++ b/Wumpus.lisp
@@ -0,0 +1,78 @@
+(defparameter *worm-num* 10)
+(defparameter *edge-num* 1000)
+(defparameter *node-num* 1000)
+
+(defun neighbors (node edge-alist)
+ (mapcar #'first (rest (assoc node edge-alist))))
+
+(defun within-one (a b edge-alist)
+ (member b (neighbors a edge-alist)))
+
+(defun within-two (a b edge-alist)
+ (or (within-one a b edge-alist)
+ (some (lambda(x)
+ (within-one x b edge-alist))
+ (neighbors a edge-alist))))
+
+(defun make-city-nodes (edge-alist)
+ (let ((wumpus (random-node))
+ (glow-worms (loop for i below *worm-num*
+ collect (random-node))))
+ (loop for n from 1 to *node-num*
+ collect (append (list n)
+ (cond ((eql n wumpus) '(wumpus))
+ ((within-two n wumpus edge-alist) '(blood!)))
+ (cond ((member n glow-worms)
+ '(glow-worm))
+ ((some (lambda (worm)
+ (within-one n worm edge-alist))
+ glow-worms)
+ '(lights!)))
+ (when (some #'rest (rest (assoc n edge-alist)))
+ '(sirens!))))))
+
+(defun get-connected (node edge-list)
+ (let ((visited nil))
+ (labels ((traverse (node)
+ (unless (member node visited)
+ (push node visited)
+ (mapc (lambda (edge)
+ (traverse (rest edge)))
+ (direct-edges node edge-list)))))
+ (traverse node))
+ visited))
+
+(defun direct-edges (node edge-list)
+ (remove-if-not (lambda (x)
+ (eql (first x) node))
+ edge-list))
+
+(defun make-edge-list ()
+ (apply #'append (loop repeat *edge-num*
+ collect (edge-pair (random-node) (random-node)))))
+
+(defun edge-pair (a b)
+ (unless (eql a b)
+ (list (cons a b) (cons b a))))
+
+(defun random-node ()
+ (1+ (random *node-num*)))
+
+(defun hash-edges (edge-list)
+ (let ((tab (make-hash-table :size (length edge-list))))
+ (mapc (lambda (x)
+ (let ((node (first x)))
+ (push (rest x) (gethash node tab))))
+ edge-list)
+ tab))
+
+(defun get-connected-hash (node edge-tab)
+ (let ((visited (make-hash-table)))
+ (labels ((traverse (node)
+ (unless (gethash node visited)
+ (setf (gethash node visited) t)
+ (mapc (lambda (edge)
+ (traverse edge))
+ (gethash node edge-tab)))))
+ (traverse node))
+ visited))
diff --git a/animal-noises.txt b/animal-noises.txt
new file mode 100644
index 0000000..11f66c7
--- /dev/null
+++ b/animal-noises.txt
@@ -0,0 +1,2 @@
+
+"my data2"
\ No newline at end of file
diff --git a/data.txt b/data.txt
new file mode 100644
index 0000000..b99df57
--- /dev/null
+++ b/data.txt
@@ -0,0 +1 @@
+my data
\ No newline at end of file
diff --git a/dice_of_doom_v3.lisp b/dice_of_doom_v3.lisp
new file mode 100644
index 0000000..d6fe788
--- /dev/null
+++ b/dice_of_doom_v3.lisp
@@ -0,0 +1,152 @@
+(load "~/Development/CLISP/LOL/DiceOfDoom_V2.lisp")
+(load "~/Development/CLISP/LOL/WebServer.lisp")
+(load "~/Development/CLISP/LOL/svg.lisp")
+
+(defparameter *board-width* 900)
+(defparameter *board-height* 500)
+(defparameter *board-scale* 64)
+(defparameter *top-offset* 3)
+(defparameter *dice-scale* 40)
+(defparameter *dot-size* 0.05)
+
+(defun draw-die-svg (x y col)
+ (labels ((calc-pt (pt)
+ (cons (+ x (* *dice-scale* (first pt)))
+ (+ y (* *dice-scale* (rest pt)))))
+ (f (pol col)
+ (polygon (mapcar #'calc-pt pol) col)))
+ (f '((0 . -1) (-0.6 . -0.75) (0 . -0.5) (0.6 . -0.75))
+ (brightness col 40))
+ (f '((0 . -0.5) (-0.6 . -0.75) (-0.6 . 0) (0 . 0.25))
+ col)
+ (f '((0 . -0.5) (0.6 . -0.75) (0.6 . 0) (0 . 0.25))
+ (brightness col -40))
+ (mapc (lambda (x y)
+ (polygon (mapcar (lambda (xx yy)
+ (calc-pt (cons (+ x (* xx *dot-size*))
+ (+ y (* yy *dot-size*)))))
+ '(-1 -1 1 1)
+ '(-1 1 1 -1))
+ '(255 255 255)))
+ '(-0.05 0.125 0.3 -0.3 -0.125 0.05 0.2 0.2 0.45 0.45 -0.45 -0.2)
+ '(-0.875 -0.80 -0.725 -0.775 -0.7 -0.625
+ -0.35 -0.05 -0.45 -0.15 -0.45 -0.05))))
+
+(defun draw-tile-svg (x y pos hex xx yy col chosen-tile)
+ (loop for z below 2
+ do (polygon (mapcar (lambda (pt)
+ (cons (+ xx (* *board-scale* (first pt)))
+ (+ yy (* *board-scale* (+ (rest pt) (* (- 1 z) 0.1))))))
+ '((-1 . -0.2) (0 . -0.5) (1 . -0.2)
+ (1 . 0.2) (0 . 0.5) (-1 . 0.2)))
+ (if (eql pos chosen-tile)
+ (brightness col 100)
+ col)))
+ (loop for z below (second hex)
+ do (draw-die-svg (+ xx
+ (* *dice-scale*
+ 0.3
+ (if (oddp (+ x y z))
+ -0.3
+ 0.3)))
+ (- yy (* *dice-scale* z 0.8)) col)))
+
+(defparameter *die-colors* '((255 63 63) (63 63 255)))
+
+(defun draw-board-svg (board chosen-tile legal-tiles)
+ (loop for y below *board-size*
+ do (loop for x below *board-size*
+ for pos = (+ x (* *board-size* y))
+ for hex = (aref board pos)
+ for xx = (* *board-scale* (+ (* 2 x) (- *board-size* y)))
+ for yy = (* *board-scale* (+ (* y 0.7) *top-offset*))
+ for col = (brightness (nth (first hex) *die-colors*)
+ (* -15 (- *board-size* y)))
+ do (if (or (member pos legal-tiles) (eql pos chosen-tile))
+ (tag g () (tag a ("xlink:href" (make-game-link pos))
+ (draw-tile-svg x y pos hex xx yy col chosen-tile)))
+ (draw-tile-svg x y pos hex xx yy col chosen-tile)))))
+
+(defun make-game-link (pos)
+ (format nil "/game.html?chosen=~a" pos))
+
+(defparameter *cur-game-tree* nil)
+(defparameter *from-tile* nil)
+
+(defun dod-request-handler (path header params)
+ (if (equal path "game.html")
+ (progn (princ "")
+ (tag center ()
+ (princ "Welcome to DICE OF DOOM")
+ (tag br ())
+ (let ((chosen (assoc 'chosen params)))
+ (when (or (not *cur-game-tree*) (not chosen))
+ (setf chosen nil)
+ (web-initialize))
+ (cond ((lazy-null (caddr *cur-game-tree*))
+ (web-announce-winner (rest *cur-game-tree*)))
+ ((zerop (first *cur-game-tree*))
+ (web-handle-human
+ (when chosen
+ (read-from-string (rest chosen)))))
+ (t (web-handle-computer))))
+ (tag br ())
+ (draw-dod-page *cur-game-tree* *from-tile*)))
+ (princ "Sorry... I don't know that page.")))
+
+(defun web-initialize ()
+ (setf *from-tile* nil)
+ (setf *cur-game-tree* (game-tree (gen-board) 0 0 t)))
+
+(defun web-announce-winner (board)
+ (fresh-line)
+ (let ((w (winners board)))
+ (if (> (length w) 1)
+ (format t "The game is a tie between ~a" (mapcar #'player-letter w))
+ (format t "The winner is ~a" (player-letter (first w)))))
+ (tag a (href "game.html")
+ (princ " play again")))
+
+(defun web-handle-human (pos)
+ (cond ((not pos) (princ "Please choose a hex to move from:"))
+ ((eq pos 'pass) (setf *cur-game-tree* (second (lazy-first (third *cur-game-tree*))))
+ (princ "Your reinforcements have been placed.")
+ (tag a (href (make-game-link nil))
+ (princ "confinue")))
+ ((not *from-tile*) (setf *from-tile* pos)
+ (princ "Now choose a destination:"))
+ ((eq pos *from-tile*) (setf *from-tile* nil)
+ (princ "Move cancelled."))
+ (t (setf *cur-game-tree*
+ (pick-chance-branch
+ (second *cur-game-tree*)
+ (lazy-find-if (lambda (move)
+ (equal (first move)
+ (list *from-tile* pos)))
+ (third *cur-game-tree*))))
+ (setf *from-tile* nil)
+ (princ "You may now ")
+ (tag a (href (make-game-link 'pass))
+ (princ "pass"))
+ (princ " or make another move:"))))
+
+(defun web-handle-computer ()
+ (setf *cur-game-tree* (handle-computer *cur-game-tree*))
+ (princ "The computer has moved. ")
+ (tag script ()
+ (princ "window.setTimeout('window.location=\"game.html?chosen=NIL\"',5000)")))
+
+
+(defun draw-dod-page (tree selected-tile)
+ (svg 900
+ 500
+ (draw-board-svg (second tree)
+ selected-tile
+ (take-all (if selected-tile
+ (lazy-mapcar
+ (lambda (move)
+ (when (eql (caar move)
+ selected-tile)
+ (cadar move)))
+ (third tree))
+ (lazy-mapcar #'caar (third tree)))))))
diff --git a/dice_of_doom_v4.lisp b/dice_of_doom_v4.lisp
new file mode 100644
index 0000000..90f0ad8
--- /dev/null
+++ b/dice_of_doom_v4.lisp
@@ -0,0 +1,108 @@
+(load "~/Development/CLISP/LOL/dice_of_doom_v3.lisp")
+
+(defparameter *num-players* 4)
+(defparameter *die-colors* '((255 63 63) (63 63 255) (63 255 63) (255 63 255)))
+(defparameter *dice-probability* #(#(0.84 0.97 1.0 1.0)
+ #(0.44 0.78 0.94 0.99)
+ #(0.15 0.45 0.74 0.91)
+ #(0.04 0.19 0.46 0.72)
+ #(0.01 0.06 0.22 0.46)))
+
+(defparameter *max-dice* 5)
+(defparameter *ai-level* 2)
+
+(defun attacking-moves (board cur-player spare-dice)
+ (labels ((player (pos)
+ (first (aref board pos)))
+ (dice (pos)
+ (second (aref board pos))))
+ (lazy-mapcan (lambda (src)
+ (if (eq (player src) cur-player)
+ (lazy-mapcan
+ (lambda (dst)
+ (if (and (not (eq (player dst) cur-player))
+ (> (dice src) 1))
+ (make-lazy (list (list (list src dst)
+ (game-tree (board-attack board cur-player src dst (dice src))
+ cur-player
+ (+ spare-dice (dice dst))
+ nil)
+ (game-tree (board-attack-fail board cur-player src dst (dice src))
+ cur-player
+ (+ spare-dice (dice dst))
+ nil))))
+ (lazy-nil)))
+ (make-lazy (neighbors src)))
+ (lazy-nil)))
+ (make-lazy (loop for n below *board-hexnum*
+ collect n)))))
+
+(defun board-attack-fail (board player src dst dice)
+ (board-array (loop for pos from 0
+ for hex across board
+ collect (if (eq pos src)
+ (list player 1)
+ hex))))
+
+(defun roll-dice (dice-num)
+ (let ((total (loop repeat dice-num
+ sum (1+ (random 6)))))
+ (fresh-line)
+ (format t "On ~a dice rolled ~a." dice-num total)
+ total))
+
+(defun roll-against (src-dice dst-dice)
+ (> (roll-dice src-dice) (roll-dice dst-dice)))
+
+(defun pick-chance-branch (board move)
+ (labels ((dice (pos)
+ (second (aref board pos))))
+ (let ((path (first move)))
+ (if (or (null path) (roll-against (dice (first path))
+ (dice (second path))))
+ (second move)
+ (third move)))))
+
+(defun get-ratings (tree player)
+ (let ((board (second tree)))
+ (labels ((dice (pos)
+ (second (aref board pos))))
+ (take-all (lazy-mapcar
+ (lambda (move)
+ (let ((path (first move)))
+ (if path
+ (let* ((src (first path))
+ (dst (second path))
+ (probability (aref (aref *dice-probability*
+ (1- (dice dst)))
+ (- (dice src) 2))))
+ (+ (* probability (rate-position (second move) player))
+ (* (- 1 probability) (rate-position (third move) player))))
+ (rate-position (second move) player))))
+ (third tree))))))
+
+(defun get-connected (board player pos)
+ (labels ((check-pos (pos visited)
+ (if (and (eq (first (aref board pos)) player)
+ (not (member pos visited)))
+ (check-neighbors (neighbors pos) (cons pos visited))
+ visited))
+ (check-neighbors (lst visited)
+ (if lst
+ (check-neighbors (rest lst) (check-pos (first lst) visited))
+ visited)))
+ (check-pos pos '())))
+
+(defun largest-cluster-size (board player)
+ (labels ((f (pos visited best)
+ (if (< pos *board-hexnum*)
+ (if (and (eq (first (aref board pos)) player)
+ (not (member pos visited)))
+ (let* ((cluster (get-connected board player pos))
+ (size (length cluster)))
+ (if (> size best)
+ (f (1+ pos) (append cluster visited) size)
+ (f (1+ pos) (append cluster visited) best)))
+ (f (1+ pos) visited best))
+ best)))
+ (f 0 '() 0)))
diff --git a/die.svg b/die.svg
new file mode 100644
index 0000000..fa7b901
--- /dev/null
+++ b/die.svg
@@ -0,0 +1 @@
+
diff --git a/example.svg b/example.svg
new file mode 100644
index 0000000..4cf6fc4
--- /dev/null
+++ b/example.svg
@@ -0,0 +1 @@
+
diff --git a/lazy.lisp b/lazy.lisp
new file mode 100644
index 0000000..c5ff964
--- /dev/null
+++ b/lazy.lisp
@@ -0,0 +1,65 @@
+(defmacro lazy (&body body)
+ (let ((forced (gensym))
+ (value (gensym)))
+ `(let ((,forced nil)
+ (,value nil))
+ (lambda ()
+ (unless ,forced
+ (setf ,value (progn ,@body))
+ (setf ,forced t))
+ ,value))))
+
+(defun force (lazy-value)
+ (funcall lazy-value))
+
+(defmacro lazy-cons (a d)
+ `(lazy (cons ,a ,d)))
+
+(defun lazy-first (x)
+ (first (force x)))
+
+(defun lazy-rest (x)
+ (rest (force x)))
+
+(defun lazy-nil ()
+ (lazy nil))
+
+(defun lazy-null (x)
+ (not (force x)))
+
+(defun make-lazy (lst)
+ (lazy (when lst
+ (cons (first lst) (make-lazy (rest lst))))))
+
+(defun take (n lst)
+ (unless (or (zerop n) (lazy-null lst))
+ (cons (lazy-first lst) (take (1- n) (lazy-rest lst)))))
+
+(defun take-all (lst)
+ (unless (lazy-null lst)
+ (cons (lazy-first lst) (take-all (lazy-rest lst)))))
+
+(defun lazy-mapcar (fun lst)
+ (lazy (unless (lazy-null lst)
+ (cons (funcall fun (lazy-first lst))
+ (lazy-mapcar fun (lazy-rest lst))))))
+
+(defun lazy-mapcan (fun lst)
+ (labels ((f (lst-cur)
+ (if (lazy-null lst-cur)
+ (force (lazy-mapcan fun (lazy-rest lst)))
+ (cons (lazy-first lst-cur) (lazy (f (lazy-rest lst-cur)))))))
+ (lazy (unless (lazy-null lst)
+ (f (funcall fun (lazy-first lst)))))))
+
+(defun lazy-find-if (fun lst)
+ (unless (lazy-null lst)
+ (let ((x (lazy-first lst)))
+ (if (funcall fun x)
+ x
+ (lazy-find-if fun (lazy-rest lst))))))
+
+(defun lazy-nth (n lst)
+ (if (zerop n)
+ (lazy-first lst)
+ (lazy-nth (1- n) (lazy-rest lst))))
diff --git a/random_walk.svg b/random_walk.svg
new file mode 100644
index 0000000..ead0b77
--- /dev/null
+++ b/random_walk.svg
@@ -0,0 +1 @@
+
\ No newline at end of file
diff --git a/random_walk1.svg b/random_walk1.svg
new file mode 100644
index 0000000..c2587f6
--- /dev/null
+++ b/random_walk1.svg
@@ -0,0 +1 @@
+