ROSHAMBO is working!

4 files changed, 175 insertions, 36 deletions

diff --git a/examples/roshambot.lisp b/examples/roshambot.lisp
index fd6bf36..fcb3198 100644
--- a/examples/roshambot.lisp
+++ b/examples/roshambot.lisp
@@ -3,13 +3,13 @@
 (ql:quickload :cl-ppcre)
 
 (defpackage #:roshambot
-  (:use :cl)
-  (:import-from :granolin
-                :handle-event
-                :find-contact
-                :text-message-event
-                :send-text-message
-                :let-cond))
+  (:use :cl :granolin))
+  ;; (:import-from :granolin
+  ;;               :handle-event
+  ;;               :find-contact
+  ;;               :text-message-event
+  ;;               :send-text-message
+  ;;               :let-cond))
 
 (in-package :roshambot)
 
@@ -31,46 +31,170 @@
 (defstruct roshambo-match
   room
   challenger
-  challenger-state
+  challenger-room
+  challenger-move
   challenged
-  challenged-state)
+  challenged-room
+  challenged-move)
 
 (defclass roshambot ()
-  ((match-id
-   :accessor match-id
-   :initform 0)
-   (live-matches
+  ((live-matches
    :accessor live-matches
    :initform nil)))
 
 (defparameter +challenge-regex+
-  (ppcre:create-scanner "i challenge ([a-zA-Z0-9_.-]+) to roshambo"
+  (ppcre:create-scanner " ?i challenge ([a-zA-Z0-9_.-]+) to roshambo"
                         :case-insensitive-mode t))
 
 (defun you-wanna-piece-of-this!? (str)
   "If the string communicates one user's intention to challenge another to
   roshambo, returns the name of the user that has been challenged. Returns NIL otherwise."
-  (nth-value 1 (ppcre:scan-to-strings +challenge-regex+ str)))
+  (let-when (groups (nth-value 1 (ppcre:scan-to-strings +challenge-regex+ str)))
+    (aref groups 0)))
+
+(defparameter +roshambo-move-regex+
+  (ppcre:create-scanner "(rock|paper|scissors|cancel)" :case-insensitive-mode t))
+
+(defun roshambo-move!? (str)
+  (nth-value 0 (ppcre:scan-to-strings +roshambo-move-regex+ str)))
 
 (defmethod handle-event :after ((bot roshambot) (event text-message-event) &optional room-id)
-  (let ((text (msg-body event)))
+  (let ((text (granolin:msg-body event)))
     (let-cond
       (challenged (you-wanna-piece-of-this!? text)
-                  (handle-new-challenge bot room-id (sender event) challenged)))))
-
-(defun handle-new-challenge (bot room-id challenger challenged)
+                  (format t "should be challenging: ~a~%" text)
+                  (handle-new-challenge bot room-id (granolin:sender event) challenged))
+      (roshambo-match (challenger-made-move!? bot room-id (granolin::sender event) text)
+                      (handle-match-state-change bot roshambo-match))
+      (roshambo-match (challenged-made-move!? bot room-id (granolin::sender event) text)
+                      (handle-match-state-change bot roshambo-match)))))
+
+(defun challenger-made-move!? (bot room-id sender text)
+  (let-when (roshambo-match (find room-id (live-matches bot)
+                                  :key #'roshambo-match-challenger-room
+                                  :test #'equal))
+    (unless (roshambo-match-challenger-move roshambo-match)
+      (let-when (move (and (equal sender (roshambo-match-challenger roshambo-match))
+                           (roshambo-move!? text)))
+        (setf (roshambo-match-challenger-move roshambo-match) move)
+        roshambo-match))))
+
+(defun challenged-made-move!? (bot room-id sender text)
+  (let-when (roshambo-match (find room-id (live-matches bot)
+                                  :key #'roshambo-match-challenged-room
+                                  :test #'equal))
+    (unless (roshambo-match-challenged-move roshambo-match)
+      (let-when (move (and (equal sender (roshambo-match-challenged roshambo-match))
+                           (roshambo-move!? text)))
+        (setf (roshambo-match-challenged-move roshambo-match) move)
+        roshambo-match))))
+
+(defun handle-match-state-change (bot roshambo-match)
   (let-cond
-    (direct-chat (find-contact bot challenged :like t :get-direct-room t)
-                 
-
-    )
-
-
-  (let-if (full-challenged (granolin::find-contact bot challenged :like t))
-          (make-new-challenge bot room-id challenger full-challenged)
-          (send-text-message client room-id
-                             "Hey ~a, I don't know of anybody named ~a"
-                             challenger challenged)))
+    (cancelled-by (roshambo-cancelled!? roshambo-match)
+                  (send-text-message bot (roshambo-match-room roshambo-match)
+                                     "The match between ~a and ~a was canceled by ~a."
+                                     (roshambo-match-challenger roshambo-match)
+                                     (roshambo-match-challenged roshambo-match)
+                                     cancelled-by)
+                  (kill-roshambo-match bot roshambo-match))
+    (win-list (roshambo-has-winner!? roshambo-match)
+              (destructuring-bind (winner win-move loser lose-move) win-list
+                (if (eql winner :draw) ; this is a draw move
+                    (send-text-message bot (roshambo-match-room roshambo-match)
+                                       "It's a draw! Both ~a and ~a picked ~a."
+                                       win-move loser lose-move)
+                    (send-text-message bot (roshambo-match-room roshambo-match)
+                                       "~a's ~a beats ~a's ~a! ~a is the winner!~%"
+                                       winner win-move loser lose-move winner)))
+              (kill-roshambo-match bot roshambo-match))))
+
+
+(defun roshambo-cancelled!? (rmatch)
+  (cond ((and (roshambo-match-challenger-move rmatch)
+              (string-equal "cancel" (roshambo-match-challenger-move rmatch)))
+         (roshambo-match-challenger rmatch))
+
+        ((and (roshambo-match-challenged-move rmatch)
+             (string-equal "cancel" (roshambo-match-challenged-move rmatch)))
+         (roshambo-match-challenged rmatch))))
+
+(defun roshambo-has-winner!? (rsb)
+  (with-slots (challenger challenger-move challenged challenged-move) rsb
+    (when (and challenger-move challenged-move
+               (not (string-equal "cancel" challenger-move))
+               (not (string-equal "cancel" challenged-move)))
+      (cond ((string-equal challenger-move challenged-move)
+             (list :draw challenger challenged challenger-move)) ; both had same move
+            ((and (string-equal "rock" challenger-move)
+                  (string-equal "scissors" challenged-move))
+             (list challenger challenger-move challenged challenged-move))
+
+            ((and (string-equal "paper" challenger-move)
+                  (string-equal "rock" challenged-move))
+             (list challenger challenger-move challenged challenged-move))
+
+            ((and (string-equal "scissors" challenger-move)
+                  (string-equal "paper" challenged-move))
+             (list challenger challenger-move challenged challenged-move))
+
+            ((and (string-equal "rock" challenged-move)
+                  (string-equal "scissors" challenger-move))
+             (list challenged challenged-move challenger challenger-move))
+
+            ((and (string-equal "paper" challenged-move)
+                  (string-equal "rock" challenger-move))
+             (list challenged challenged-move challenger challenger-move))
+
+            ((and (string-equal "scissors" challenged-move)
+                  (string-equal "paper" challenger-move))
+             (list challenged challenged-move challenger challenger-move))))))
+
+
+(defun kill-roshambo-match (bot roshambo-match)
+  (setf (live-matches bot)
+        (delete roshambo-match (live-matches bot))))
 
+(defun handle-new-challenge (bot room-id challenger challenged)
+  (let ((challenger-room (ensure-direct-room bot challenger))
+        (challenged-room (ensure-direct-room bot challenged :like t)))
+    (if (and (send-text-message
+              bot
+              challenger-room
+              "You have challenged ~a to roshambo. Reply with Rock, Paper, Scissors or Cancel."
+              challenged)
+             (send-text-message
+              bot
+              challenged-room
+              "~a has challenged you to roshambo. Reply with Rock, Paper, Scissors, or Cancel."
+              challenger))
+        (push (make-roshambo-match :room room-id
+                                   :challenger challenger
+                                   :challenger-room challenger-room
+                                   :challenger-move nil
+                                   :challenged (find-contact bot challenged :like t)
+                                   :challenged-room challenged-room
+                                   :challenged-move nil)
+              (live-matches bot))
+
+        (send-text-message bot room-id "Some kind of problem starting a roshambo match :("))))
+
+
+(defclass roshambo-bot (granolin:client granolin:server-directory roshambot) ())
+
+;; (defmethod handle-event :after ((bot roshambot-bot) (ev timeline-event) &optional room-id)
+;;   (format t "~a - ~a:~%  ~a~%" room-id (granolin::sender ev) (granolin:msg-body ev)))
+
+(defmethod handle-event :after ((bot roshambo-bot) (ev text-message-event) &optional room-id)
+  (format t "~a - ~a:~%  ~a~%" room-id (granolin::sender ev) (granolin:msg-body ev)))
+
+(defmethod handle-event :after ((bot roshambo-bot)
+                                (ev granolin::account-data-event)
+                                &optional room-id)
+  (format t "~a ~a" (event-type ev) (event-content ev)))
+
+
+(defvar *roshambot* (make-instance 'roshambo-bot
+                                   :homeserver "https://matrix.hrlo.world"))
 
 
diff --git a/granolin.lisp b/granolin.lisp
index 96af47c..76e7441 100644
--- a/granolin.lisp
+++ b/granolin.lisp
@@ -326,7 +326,6 @@
                   *response-status* +sync-path+))))
 
 (defun handle-sync-response (client)
-  (print *response-object*)
   (setf (next-batch client)
         (next-batch *response-object*))
   (process-joined-events client)
diff --git a/utility-apps.lisp b/utility-apps.lisp
index 9ef8cde..8395805 100644
--- a/utility-apps.lisp
+++ b/utility-apps.lisp
@@ -124,6 +124,12 @@
      (update-room-aliases client room-id (room-aliases event)))))
 
 (defmethod handle-event :after ((client server-directory)
+                                (event timeline-event)
+                                &optional room-id)
+  (update-room-member client room-id (sender event)))
+
+
+(defmethod handle-event :after ((client server-directory)
                                 (event account-data-event)
                                 &optional room-id)
   (declare (ignore room-id))
@@ -131,10 +137,16 @@
     (setf (m-direct-event-content client) (event-content event))
     (loop :for (user room-ids . more) :on (event-content event) :by #'cddr :do
       (dolist (room-id room-ids)
-        (mark-as-direct client room-id)))))
+        (mark-as-direct client (symbol-name user) room-id)))))
 
-(defun mark-as-direct (client room-id)
-  (setf (direct-p (get-room client room-id)) t))
+(defun mark-as-direct (client user room-id)
+  (let-if (room (get-room client room-id))
+          (progn
+            (setf (direct-p room) t)
+            (push user (room-members room))
+            (setf (gethash room-id (directory-table client)) room))
+          (setf (gethash room-id (directory-table client))
+                (make-instance 'server-room :direct-p t :members (list user) :id room-id))))
 
 (defun name-of-room (client room-id)
   "Looks up the name of a room with ROOM-ID. Returns a string of NIL"
@@ -162,7 +174,7 @@
 (defun room-member-p (room name &key like)
   (some (lambda (memb) (or (equal name memb)
                            (and like (search name memb :test #'string-equal))))
-        (members room)))
+        (room-members room)))
 
 ;; TODO might be too nebulous.  Could be split up into two functions.
 (defun find-contact (client name &key like get-direct-room)
@@ -202,6 +214,8 @@
                (create-direct-message-room client full-name))))
 
 
+
+
 (defun create-direct-message-room (client name)
   "Attempt to create a direct message room with the given name. If successful
    the room id is returned. Returns nil and prints to *error-output* if
@@ -219,6 +233,8 @@
                 (push (getf direct user-key) room-id)
                 (setf (getf direct user-key) (list room-id)))
 
+            (setf (m-direct-event-content client) direct) ; update it here
+
             (when (update-account-data client "m.direct" direct)
               room-id))
           ;; else
diff --git a/utils.lisp b/utils.lisp
index 9dd07b5..691685f 100644
--- a/utils.lisp
+++ b/utils.lisp
@@ -1,4 +1,4 @@
 (in-package :granolin )
 
 (defun string->json-key (s)
-  (format nil ":|~a|" s))
+  (read-from-string (format nil ":|~a|" s)))