diff options
| -rw-r--r-- | Hermes/Hermes_Gui1.3.rkt | 9 | ||||
| -rw-r--r-- | Hermes/client.rkt | 30 | ||||
| -rw-r--r-- | Hermes/server.rkt | 14 |
3 files changed, 32 insertions, 21 deletions
diff --git a/Hermes/Hermes_Gui1.3.rkt b/Hermes/Hermes_Gui1.3.rkt index 8700432..19df04b 100644 --- a/Hermes/Hermes_Gui1.3.rkt +++ b/Hermes/Hermes_Gui1.3.rkt @@ -13,6 +13,7 @@ (define (make-gui) (begin + (displayln "Makin...");;eat this note ;;Create the frame (define main-frame (new frame% [label "Hermes"] @@ -88,7 +89,9 @@ (helper string start)) (define (user-message onetrueinput) - (if (string? onetrueinput) + (display "Godit!");;eat this note + (displayln onetrueinput);;eat this note + (if (not (string=? onetrueinput "")) (let();;This is kind of stupid but whatever it works. (define username (user-message-parse onetrueinput 0)) (define user-input (user-message-parse onetrueinput (+ 1(string-length-safe username)))) @@ -114,6 +117,7 @@ ;;list of strings to the screen (define (re-draw-message username input color in-height) (begin + (displayln "Fixy!");eat this note (send dc set-text-foreground color) (send dc draw-text (string-append username ":" input) 0 in-height) )) @@ -144,6 +148,7 @@ ;;dispatch goes below that (define (dispatch command) (cond ((eq? command 'show) (send main-frame show #t)) + ((eq? command 'close)(send main-frame show #f)) ((eq? command 'send) send-message) ((eq? command 'set-name) (lambda (newname) (if (string? newname) (set! name newname) @@ -207,7 +212,7 @@ (define (quit-request? given-string) (if (>= (string-length-safe given-string) 5) - (if ((equal? substring-s given-string 0 5) "/quit") + (if (equal? (substring-s given-string 0 5) "/quit") #t #f) #f)) diff --git a/Hermes/client.rkt b/Hermes/client.rkt index 0a345e2..8746658 100644 --- a/Hermes/client.rkt +++ b/Hermes/client.rkt @@ -63,21 +63,21 @@ (thread-wait t) ;; returns prompt back to drracket (displayln-safe "Closing client ports." error-out-s error-out) (close-input-port in) - (close-output-port out)) + (close-output-port out) + (gui 'close)) (custodian-shutdown-all main-client-cust)) - ;; sends a message to the server (define (send-messages username out) ; get current time - (define date-today (seconds->date (current-seconds) #t)) + ;(define date-today (seconds->date (current-seconds) #t)) ;TODO pad the second if its only 1 character - (define date-print (string-append (number->string (date-hour date-today)) - ":" - (number->string (date-minute date-today)) - ":" - (number->string (date-second date-today)) - " | ")) + ;(define date-print (string-append (number->string (date-hour date-today)) + ; ":" + ; (number->string (date-minute date-today)) + ; ":" + ; (number->string (date-second date-today)) + ; " | ")) ;; read, quits when user types in "quit" ;(define input (read-line)) (define input (get-output-string (gui 'get-output-port))) @@ -91,9 +91,11 @@ ;(displayln (string-append date-print username ": " input) out) (if (not (null? input)) - (begin - (display input) - (displayln input out)) + (if (not (equal? input "")) + ((let() + (displayln input);;eat this note + (displayln input out))) + '()) '()) (flush-output out)) @@ -109,7 +111,9 @@ ] [(string? evt) ;(displayln-safe evt convs-out-s convs-out)] ; could time stamp here or to send message - ((gui 'recieve-message) evt)] + (if (not (equal? evt "")) + ((gui 'recieve-message) evt) + '())] [else (displayln-safe (string-append "Nothing received from server for 2 minutes.") diff --git a/Hermes/server.rkt b/Hermes/server.rkt index 25ff757..d17e72b 100644 --- a/Hermes/server.rkt +++ b/Hermes/server.rkt @@ -60,8 +60,10 @@ ; Track received messages in a closure (define (make-messages messages) (define (add message) - (set! messages (append messages (list message))) - messages) + (if (string=? message "") + messages + ((set! messages (append messages (list message))) + messages))) (define (mes-list) messages) (define (remove-top) @@ -266,15 +268,15 @@ (lambda (ports) (if (not (port-closed? (get-output-port ports))) (begin - (displayln (string-append "Server~" - (first ((c-messages 'mes-list))) - "~red" - ) (get-output-port ports)) + (displayln (first ((c-messages 'mes-list))) + (get-output-port ports)) (flush-output (get-output-port ports))) (displayln-safe "Failed to broadcast. Port not open." error-out-s error-out))) ((c-connections 'cons-list))) (displayln-safe (first ((c-messages 'mes-list))) convs-out-s convs-out) ;; remove top message + (displayln (null? ((c-messages 'mes-list))));;eat this note + (displayln ((c-messages 'mes-list)));;eat this note ((c-messages 'remove-top)) (displayln "Message broadcasted"))]) (semaphore-post messages-s))) |