summaryrefslogtreecommitdiff
path: root/chess-irc.el
blob: 78e49a48c9a4961df6429bc411c29d5a9c77b6e1 (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
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; This transport uses an IRC bot to send/receive moves.
;;
;; $Revision$

(require 'chess-network)

(defgroup chess-irc nil
  "Use an IRC bot for sending/receiving moves."
  :group 'chess-engine)

(defcustom chess-irc-host "irc.openprojects.net"
  "The IRC host to connect your chess-irc engine to."
  :type 'string
  :group 'chess-irc)

(defcustom chess-irc-port 6667
  "The port of the IRC host specified by `chess-irc-host'."
  :type 'string
  :group 'chess-irc)

(defcustom chess-irc-nick (user-login-name)
  "The nick you wish to use for sending/receiving IRC chess moves."
  :type 'string
  :group 'chess-irc)

(defvar chess-irc-regexp-alist
  (append chess-network-regexp-alist
	  (list (cons ".+"
		      (function
		       (lambda ()
			 (message "Your opponent says: %s"
				  (match-string 0))))))))

(defvar chess-irc-process)
(defvar chess-irc-engine)
(defvar chess-irc-opponent)
(defvar chess-irc-working nil)
(defvar chess-irc-last-pos nil)

(make-variable-buffer-local 'chess-irc-process)
(make-variable-buffer-local 'chess-irc-engine)
(make-variable-buffer-local 'chess-irc-opponent)
(make-variable-buffer-local 'chess-irc-working)
(make-variable-buffer-local 'chess-irc-last-pos)

(defun chess-irc-handler (event &rest args)
  "This is an example of a generic transport engine."
  (cond
   ((eq event 'initialize)
    (message "Connecting to IRC server '%s:%d'..."
	     chess-irc-host chess-irc-port)
    (let ((engine (current-buffer)) proc)
      (with-current-buffer (generate-new-buffer " *chess-irc*")
	(setq chess-irc-engine engine
	      proc (open-network-stream "*chess-irc*" (current-buffer)
					chess-irc-host chess-irc-port))
	(message "Connected, now logging in as '%s'..." chess-irc-nick)
	(when (and proc (eq (process-status proc) 'open))
	  (process-send-string proc (format "USER %s 0 * :%s\n"
					    (user-login-name)
					    (user-full-name)))
	  (process-send-string proc (format "NICK %s\n" chess-irc-nick))
	  (set-process-filter proc 'chess-irc-filter)
	  (set-process-buffer proc (current-buffer))
	  (set-marker (process-mark proc) (point))
	  (message "Now waiting for 'name USER' via /msg, or `M-x chess-irc-engage'")))
      (setq chess-irc-process proc))
    nil)

   ((eq event 'shutdown)
    (ignore-errors
      (chess-engine-send nil "quit"))
    (ignore-errors
      (process-send-string chess-irc-process "QUIT :Goodbye\n"))
    (ignore-errors
      (kill-buffer (process-buffer chess-irc-process))))

   ((eq event 'send)
    (process-send-string chess-irc-process
			 (format "PRIVMSG %s :%s\n"
				 chess-irc-opponent (car args))))
   (t
    (apply 'chess-network-handler event args))))

(defun chess-irc-engage (nick)
  "Begin playing with another chess-irc user with the given NICK.
NOTE: This function is meant to be called from a display buffer!"
  (interactive "sYour opponent's IRC nick: ")
  (with-current-buffer
      (cdr (assq 'chess-engine-event-handler
		 (chess-game-hooks (chess-display-game nil))))
    (setq chess-irc-opponent nick)
    (chess-engine-send nil (format "name %s\n" (user-full-name)))))

;; This filter translates IRC syntax into basic chess-network protocol
(defun chess-irc-filter (proc string)
  (let ((buf (process-buffer proc)))
    (when (buffer-live-p buf)
      (with-current-buffer buf
	(let ((moving (= (point) (process-mark proc))))
	  (save-excursion
	    ;; Insert the text, advancing the marker.
	    (goto-char (process-mark proc))
	    (insert string)
	    (set-marker (process-mark proc) (point)))
	  (if moving (goto-char (process-mark proc))))
	(unless chess-irc-working
	  (setq chess-irc-working t)
	  (unwind-protect
	      (progn
		(if chess-irc-last-pos
		    (goto-char chess-irc-last-pos)
		  (goto-char (point-min)))
		(beginning-of-line)
		(while (not (eobp))
		  (cond
		   ((looking-at
		     ":\\([^ \t\n!]+\\)!\\S-+ PRIVMSG \\(\\S-+\\) :\\(.+\\)")
		    (let ((sender (match-string 1))
			  (target (match-string 2))
			  (msg (match-string 3)))
		    (with-current-buffer chess-irc-engine
		      (when (and (string= chess-irc-nick target)
				 (or (null chess-irc-opponent)
				     (string= chess-irc-opponent sender)))
			(unless chess-irc-opponent
			  (setq chess-irc-opponent sender))
			(chess-engine-submit nil (concat msg "\n")))))))
		  (forward-line)))
	    (setq chess-irc-last-pos (point)
		  chess-irc-working nil)))))))

(provide 'chess-irc)

;;; chess-irc.el ends here