/
client.lisp
98 lines (77 loc) · 3.02 KB
/
client.lisp
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
;; Common Lisp Script
;; Manoel Vilela
(when (not (find-package :usocket))
(ql:quickload :usocket))
(when (not (find-package :cl-readline))
(ql:quickload :cl-readline))
(when (not (find-package :lisp-chat-config))
(load "config"))
(defpackage :lisp-chat-client
(:use :usocket :cl :lisp-chat-config)
(:export :main))
(in-package :lisp-chat-client)
(defun erase-last-line ()
(format t "~C[1A~C[2K" #\Esc #\Esc))
(defun get-user-input (username)
(prog1 (cl-readline:readline :prompt (format nil "[~A]: " username)
:erase-empty-line t
:add-history t)
(erase-last-line)))
(defun send-message (message socket)
(write-line message (socket-stream socket))
(finish-output (socket-stream socket)))
;; HACK: I don't know a better way to save state of cl-readline
;; before printing messages from server, so I'm cleaning all the stuff
;; before print a new message, and restore again. Maybe there is a
;; better way for doing that.
(defun receive-message (message)
(let ((line cl-readline:*line-buffer*)
(prompt cl-readline:+prompt+))
;; erase
(cl-readline:replace-line "" nil)
(cl-readline:set-prompt "")
(cl-readline:redisplay)
;; print message from server
(write-line message)
;; restore
(cl-readline:replace-line line nil)
(setq cl-readline:*point* cl-readline:+end+)
(cl-readline:set-prompt prompt)
(cl-readline:redisplay)))
(defun client-sender (socket username)
(loop for message = (get-user-input username)
do (send-message message socket)
when (equal message "/quit")
return nil)
(sb-ext:exit))
(defun server-listener (socket)
(loop for message = (read-line (socket-stream socket))
while (not (equal message "/quit"))
do (receive-message message)))
(defun server-broadcast (socket)
(handler-case (server-listener socket)
(end-of-file () (progn (format t "Server down. ~%")
(sb-ext:exit)))))
(defun login (socket)
(princ (read-line (socket-stream socket)))
(finish-output)
(let ((username (read-line)))
(send-message username socket)
username))
(defun client-loop ()
(let* ((socket (socket-connect *host* *port*))
(username (login socket)))
(format t "Connected as ~a\@~a\:~a ~%" username *host* *port*)
(let ((sender (sb-thread:make-thread #'client-sender
:name "client sender"
:arguments (list socket username)))
(broadcast (sb-thread:make-thread #'server-broadcast
:name "server broadcast"
:arguments (list socket))))
(sb-thread:join-thread sender)
(sb-thread:join-thread broadcast))))
(defun main ()
(handler-case (client-loop)
(sb-sys:interactive-interrupt () (sb-ext:exit))
(usocket:connection-refused-error () (progn (format t "Run first the server.lisp")
(sb-ext:exit :code 1)))))