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) ;(semaphore-wait hermes-gui-s)
(define input ((hermes-gui 'get-message))) (define input ((hermes-gui 'get-message)))
;(semaphore-post hermes-gui-s) ;(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") (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) (flush-output out)
(close-output-port error-out) (close-output-port error-out)
(close-output-port convs-out) (close-output-port convs-out)
;(custodian-shutdown-all main-client-cust) ;(custodian-shutdown-all main-client-cust)
(exit))) (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)) (flush-output out))
; a wrap around to call ((hermes-gui 'send) zzz yyy) without complaints from ; a wrap around to call ((hermes-gui 'send) zzz yyy) without complaints from
@ -132,10 +134,16 @@
] ]
[(string? evt) [(string? evt)
(displayln-safe evt convs-out-s convs-out) (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 ; TODO set color to current client if the message is from him
; otherwise set it to the remote ; otherwise set it to the remote
;(semaphore-wait hermes-gui-s) ;(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) ;(semaphore-post hermes-gui-s)
] ; could time stamp here or to send message ] ; could time stamp here or to send message
[else [else

15
Hermes/server.rkt
View File

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