iskm/Hermes
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

clients now display received messages in the color of their origin

Browse Source
This commit is contained in:
Ibrahim Mkusa 2017-04-23 15:09:18 -04:00
parent f4060606f0
commit d65c4c634c
2 changed files with 22 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
Hermes/client.rkt
View File

@ -100,18 +100,20 @@
;(semaphore-wait hermes-gui-s)
(define input ((hermes-gui 'get-message)))
;(semaphore-post hermes-gui-s)
; TODO prompt for color as well
; TODO /quit instead of quit
; /color color is appended to input to specify the color the message should
; be displayed in
(cond ((string=? input "/quit")
(displayln (string-append date-print username " signing out. See ya!") out)
(displayln (string-append date-print username " signing out. See ya!"
" /color " ((hermes-gui 'get-color))) out)
(flush-output out)
(close-output-port error-out)
(close-output-port convs-out)
;(custodian-shutdown-all main-client-cust)
(exit)))
(displayln (string-append date-print username ": " input) out)
(displayln (string-append date-print username ": " input
" /color " ((hermes-gui 'get-color))) out)
(flush-output out))
; a wrap around to call ((hermes-gui 'send) zzz yyy) without complaints from
@ -132,10 +134,16 @@
]
[(string? evt)
(displayln-safe evt convs-out-s convs-out)
(define evt-matched
(regexp-match #px"(.*)\\s+/color\\s+(\\w+).*"
evt))
; TODO set color to current client if the message is from him
; otherwise set it to the remote
;(semaphore-wait hermes-gui-s)
(send-to-gui evt ((hermes-gui 'get-color)))
;(send-to-gui evt ((hermes-gui 'get-color)))
; extracts the message and color from received message
(send-to-gui (cadr evt-matched) (caddr evt-matched))
;(semaphore-post hermes-gui-s)
] ; could time stamp here or to send message
[else

15
Hermes/server.rkt
View File

@ -4,8 +4,9 @@
(require math/base) ;; for random number generation
(define welcome-message "Welcome to Hermes coms. Type your message below")
(define successful-connection-m "Successfully connected to a client. Sending client a welcome message.")
;; server messages in black
(define welcome-message "Welcome to Hermes coms. Type your message below /color black ")
(define successful-connection-m "Successfully connected to a client. Sending client a welcome message. /color black ")
(define sleep-t 0.1)
@ -133,7 +134,8 @@
(displayln welcome-message out)
;; print to server log and client
(define print-no-users (string-append "Number of users in chat: "
(number->string ((c-count 'current-count)))))
(number->string ((c-count 'current-count)))
" /color black"))
(displayln print-no-users out)
(displayln-safe print-no-users convs-out-s convs-out)
(flush-output out)
@ -212,7 +214,8 @@
(semaphore-wait c-count-s)
(semaphore-wait connections-s)
(define no-of-users (string-append "Number of users in chat: "
(number->string ((c-count 'current-count)))))
(number->string ((c-count 'current-count)))
" /color black"))
(displayln no-of-users out)
(flush-output out)
(semaphore-post connections-s)
@ -221,10 +224,10 @@
[list-users
(semaphore-wait connections-s)
; map over connections sending the username to the client
(displayln "Here is a list of users in chat." out)
(displayln "Here is a list of users in chat. /color black" out)
(map
(lambda (ports)
(displayln (get-username ports) out))
(displayln (string-append (get-username ports) " /color black") out))
((c-connections 'cons-list)))
(flush-output out)
(semaphore-post connections-s)]