1 files changed, 142 insertions, 0 deletions
diff --git a/wink-murder.el b/wink-murder.el
new file mode 100644
index 0000000..46d2bd6
--- /dev/null
+++ b/wink-murder.el
@@ -0,0 +1,142 @@
+;;; wink-murder.el --- Emacs Wink-Murder game simulation  -*- lexical-binding:t -*-
+
+(require 'cl-lib)
+(require 'eieio)
+
+(defclass wink-murder () ; No superclasses
+  ((actors :initarg :actors
+           :initform (wink-murder-initialize-actors 4)
+           :type list
+           :documentation "The list of `actors' in the game.")
+   (round  :initform 1
+           :type number
+           :documentation "The current round of the game.")
+   (tick   :initform 0
+           :type number
+           :documentation "The current 'slice-of-time' the game is in.")
+   (events :initform nil
+           :type list
+           :documentation "List of events in the game's timeline."))
+  "A class representing the game state of Wink-Murder, defaults to 4 players.")
+
+(defclass wink-murder-actor ()
+  ((id
+    :initarg :id
+    :type number
+    :reader wink-murder-actor-id)
+   (target
+    :initarg :target
+    :documentation "Actor currently being observed."
+    :accessor wink-murder-actor-target)
+   (status
+    :initform 'alive
+    :documentation "'alive, 'dying, or 'dead")
+   (notes
+    :initform '()
+    :documentation "An alist containing pairs of (actor-id . target-id)"))
+  "Base class for wink-murder actors.")
+
+(defclass wink-murder-killer (wink-murder-actor)
+  ()
+  "Actor subclass to represent the killer.")
+
+(defclass wink-murder-innocent (wink-murder-actor)
+  ((death-countdown
+    :initform (1+ (random 10))
+    :documentation "The number of ticks to go from dying to dead")))
+
+(defun wink-murder-initialize-actors (players)
+  "Returns a list of `players' wink-murder-actors, where one is the killer."
+  (cl-assert (>= players 4) () "Cannot play with fewer than 4 players")
+  (let* ((killer (1+ (random players)))
+         (actors (cl-loop for i from 1 to players
+                          collect (if (eql i killer) (wink-murder-killer :id i) (wink-murder-innocent :id i)))))
+    (mapc (lambda (a)
+            (setf (wink-murder-actor-target a) (wink-murder-random-other a actors)))
+          actors)))
+
+
+
+(cl-defmethod wink-murder-observe ((actor wink-murder-actor))
+  "Base behavior for an actor. Note the ids of the observed target and who
+they are perceived to be targeting."
+  (with-slots (notes (my-target target)) actor
+    (when my-target
+      (with-slots (id (their-target target)) my-target
+        (when their-target
+          (setf notes (cons `(,id . ,(wink-murder-actor-id their-target)) notes)))))))
+
+(cl-defmethod wink-murder-observe ((actor wink-murder-innocent))
+  (when (> 5 (random 11))
+    (with-slots (id target) actor
+      (let* ((new-target (wink-murder-random-other actor (slot-value wink-murder-active-game 'actors)))
+             (new-id (wink-murder-actor-id new-target))
+             (new-status (slot-value new-target 'status)))
+        (wink-murder-add-event
+         (wink-murder-retarget-event :actor-id id :old (wink-murder-actor-id target) :new new-id
+                               :message (format "Innocent %d observes %d and sees they are %s" id
+                                                new-id new-status)))
+        (setf target new-target))))
+  (cl-call-next-method))
+
+(defun wink-murder-eye-contact? (a b)
+  "Given two `wink-murder-actor's, returns t if they are eachother's current target."
+  (and (equal (slot-value a 'target) b)
+       (equal (slot-value b 'target) a)))
+
+(defun neighbors (e lst)
+  (let* ((idx (cl-position e lst))
+         (len (length lst))
+         (left (elt lst (mod (1- idx) len)))
+         (right (elt lst (mod (1+ idx) len))))
+
+    (list left right)))
+
+  (cl-defmethod wink-murder-being-watched? ((killer wink-murder-killer))
+    "Specilized on the killer, returns true when there is a most recent memory,
+and the target is the killer themselves."
+
+    ;; (with-slots (id notes) killer
+    ;;   (let* ((most-recent-memory (car notes))
+    ;;          (their-target (cdr most-recent-memory)))
+    ;;     (and their-target (= id their-target))))
+
+    (> 5 (random 11))
+    )
+
+(cl-defmethod wink-murder-observe ((killer wink-murder-killer))
+  "Specialized behavior for the `wink-murder-killer'."
+  (with-slots (id target) killer
+    (with-slots ((old-id id)) target
+      (if (wink-murder-being-watched? killer)
+          (let* ((new-target (wink-murder-random-other killer (wink-murder-living-innocents wink-murder-active-game)))
+                 (new-id (wink-murder-actor-id new-target)))
+            (wink-murder-add-event
+             (wink-murder-retarget-event :actor-id id :old old-id :new new-id
+                                   :message (format "the killer targets %d" new-id)))
+            (setf target new-target))
+        (when (wink-murder-eye-contact? killer target)
+          (progn
+            (wink-murder-add-event
+             (wink-murder-event :actor-id id :message (format "the killer winks at %d." old-id)))
+            (wink-murder-innocent-die target)))
+      (cl-call-next-method killer)))))
+
+(defun wink-murder-alive-p (actor)
+  "Returns `t' if the actor is alive, otherwise `nil'"
+  (eql (slot-value actor 'status) 'alive))
+
+(defun wink-murder-innocent-die (actor)
+  (with-slots (id status) actor
+    (wink-murder-add-event (wink-murder-event :actor-id id :message "AIIEEEE!!"))
+    (setf status 'dead)))
+
+(defun wink-murder-play (players)
+  "Entry point to start a game of Wink-Murder."
+  (interactive "nnumber of players: ")
+  (with-current-buffer "*WINK-MURDER-LOG*" (erase-buffer))
+  (setq wink-murder-active-game (wink-murder :actors (wink-murder-initialize-actors players)))
+  (while (> (length (wink-murder-living-innocents wink-murder-active-game)) 1)
+    (wink-murder-update wink-murder-active-game))
+  (mapc #'wink-murder-log-event (reverse (slot-value wink-murder-active-game 'events)))
+  (switch-to-buffer "*WINK-MURDER-LOG*"))