/
chat-client.rkt
104 lines (88 loc) · 3.48 KB
/
chat-client.rkt
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
;; The first three lines of this file were inserted by DrRacket. They record metadata
;; about the language level of this file in a form that our tools can easily process.
#reader(lib "htdp-intermediate-reader.ss" "lang")((modname chat-client) (read-case-sensitive #t) (teachpacks ((lib "image.rkt" "teachpack" "2htdp") (lib "universe.rkt" "teachpack" "2htdp"))) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ((lib "image.rkt" "teachpack" "2htdp") (lib "universe.rkt" "teachpack" "2htdp")) #f)))
(define SIZE 24)
(define COLOR 'aqua)
(define-struct client [chat-list text])
;; A ChatList is either:
;; - empty
;; - (list String empty)
;; Text is a String
;; Receiving Messages from the Universe
;; ====================================
;; receive : Client Message -> Client
;; receives an updated client state and a string message
(define (receive cl ms)
(make-client (append (client-chat-list cl) (list ms)) ""))
(check-expect (receive (make-client '() "") "foo")
(make-client (list "foo") ""))
;; Rendering the Chat
;; ==================
;; Listof String -> Image
;; helper for drawing the list of previous chats
(define (draw-chat chat)
(cond
[(empty? chat) empty-image]
[else (above (text (first chat) SIZE COLOR)
(draw-chat (rest chat)))]))
;; draw-textbox : Client -> Image
;; helper for drawing the current text
(define (draw-textbox client)
(text (client-text client) SIZE COLOR))
;; render : Client -> Image
;; function for big-bang to-draw handler
(define (render client)
(place-image/align
(above (draw-chat (client-chat-list client))
(draw-textbox client))
150 600
"middle" "bottom"
(rectangle 300 600 'solid 'black)))
(check-expect (render (make-client '() "")) (rectangle 300 600 'solid 'black))
;; Keyboard Event Handling
;; =======================
;; delete-last : String -> String
;; deletes the last character from a string - helper
(define (delete-last s)
(cond
[(string=? s "") ""]
[else (substring s 0 (sub1 (string-length s)))]))
;; add-char : String Key -> String
;; adds the string corresponding to key event to the current text
(define (add-char s k)
(local
((define non-printing
(list "\r" "cancel" "clear" "shift" "rshift" "control"
"rcontrol" "menu" "pause" "capital" "prior" "next"
"end" "home" "escape" "select" "print" "execute"
"snapshot" "insert" "help" "left" "right" "up" "down")))
(cond
[(member k non-printing) s]
[(key=? k "\b") (delete-last s)]
[else (string-append s k)])))
(check-expect (add-char "fo" "o") "foo")
(check-expect (add-char "fo" "\r") "fo")
(check-expect (add-char "foo" "\b") "fo")
;; react : Client Key -> Client or (make-package Client String)
;; big-bang on-key handler. sends a message to server on return key
(define (react client key)
(local
((define chat (client-chat-list client))
(define msg (client-text client))
(define text (add-char msg key)))
(cond
[(key=? key "\r") (make-package (make-client (append chat (list text)) "") msg)]
[else (make-client chat text)])))
;; Main Program
;; ============
;; new-client! : String -> World
;; launches a new chat client with name "user"
(define (new-client! user)
(big-bang (make-client '() "")
[on-receive receive]
[to-draw render]
[on-key react]
[name user]
[register LOCALHOST]))
(launch-many-worlds (new-client! "grant")
(new-client! "alisa"))