summaryrefslogtreecommitdiff
path: root/wink-murder.el
blob: 46d2bd6470241efa201b80bb9ceed7ce5086ccde (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
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*"))