From ce93a60d0ed502c08410f5a4f0223e8dd620de34 Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Fri, 21 Apr 2017 18:14:16 -0400 Subject: [PATCH 01/13] removed unnecessary begin statements --- Hermes/Hermes_Gui1.3.rkt | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/Hermes/Hermes_Gui1.3.rkt b/Hermes/Hermes_Gui1.3.rkt index ba239c3..395c26e 100644 --- a/Hermes/Hermes_Gui1.3.rkt +++ b/Hermes/Hermes_Gui1.3.rkt @@ -12,8 +12,7 @@ (provide make-gui) (define (make-gui) - (begin - ;;Create the frame + ;;Create the frame/window with title "Example5", width 500 and height 700 (define main-frame (new frame% [label "Example5"] [width 500] @@ -144,7 +143,7 @@ (else (error "Invalid Request" command)) )) ;;dispatch goes below that - dispatch)) + dispatch) ;This one displays information From a9f7121695b37a0b16eeff8a121003083b670300 Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Sun, 23 Apr 2017 00:51:25 -0400 Subject: [PATCH 02/13] removed unnecessary begin statements. Added more documentation to gui code. --- Hermes/Hermes_Gui1.3.rkt | 94 ++++++++++++++++++++++++++-------------- Hermes/client.rkt | 3 ++ 2 files changed, 65 insertions(+), 32 deletions(-) diff --git a/Hermes/Hermes_Gui1.3.rkt b/Hermes/Hermes_Gui1.3.rkt index 395c26e..67597e4 100644 --- a/Hermes/Hermes_Gui1.3.rkt +++ b/Hermes/Hermes_Gui1.3.rkt @@ -32,84 +32,108 @@ (get-height-from-list (car paint-listy))) (do-more-stuff-paint (cdr paint-listy) paint-canvas paint-dc)))) + ; canvas for displaying messages with horizontal and vertical scrollbar. + ; on an event it calls do-stuff-paint to redraw things on the screen + ; properly (define read-canvas (new canvas% [parent main-frame] [paint-callback do-stuff-paint] [style '(hscroll vscroll)] )) + ; "send" is rackets way of doing object-oriented programming. It calls an + ; objects functions in this case "read-canvas" object's init-auto-scrollbars (send read-canvas init-auto-scrollbars #f #f 0 0);Start with no scrollbars - ;;text-field stuff - (define (text-feild-callback callback-type other-thing) + + ; editing area callback. Gets called when enter is pressed. + (define (text-field-callback callback-type other-thing) (if (equal? 'text-field-enter (send other-thing get-event-type)) (button-do-stuff 'irrelevant 'not-used) '())) + ; creates the editing area as part of the parent "main-frame" define above. + ; initially labelled "Username:" + ; TODO make label setable (define input (new text-field% [parent main-frame] [label "Username:"] - [callback text-feild-callback] + [callback text-field-callback] )) - ;;button stuff + + ; It's a callback function activated when the send button is pressed in the + ; GUI. It is also called manually when textfield receives an enter key (define (button-do-stuff b e);b and e do nothing :/ - (begin (if (color-change-request? (send input get-value)) (set! my-color (get-color-from-input (send input get-value))) (if (< 0 (string-length (send input get-value))) (send-message (send input get-value) my-color);; '())) (send input set-value "") - )) + ) + + ; creates the send button (define send-button (new button% [parent main-frame] [label "Send"] [callback button-do-stuff])) - ;;I forget what these do but don't move them + + ; get-dc retrieves the canvas' device context. From racket docs. A dc object + ; is a drawing context for drawing graphics and text. It represents output + ; devices in a generic way. + ; Specifically the line below retrieves our canvas device context object. (define dc (send read-canvas get-dc)) - (send dc set-scale 1 1) - (send dc set-text-foreground "black") + (send dc set-scale 1 1) ; set scaling config of output display to 1 to 1 + ; no scalling + (send dc set-text-foreground "black") ; color of text that gets drawn on the + ; canvas with "draw-text" + ; (send dc set-smoothing 'aligned) ;;messaging stuff - (define (user-message-parse string start) - (begin + ; could convert below to regexes + (define (user-message-parse string-i start) (define (helper str index) - (if (eq? (string-ref str (+ start index)) #\~) + (if (eq? (string-ref str (+ start index)) #\~) ; regexes would allow us + ; to avoid this #\~ (substring str start (+ start index)) (helper str (+ index 1)))) - (helper string 0))) + (helper string-i 0)) - (define (user-message onetrueinput) - (begin - (define username (user-message-parse onetrueinput 0)) - (define input (user-message-parse onetrueinput (+ 1(string-length username)))) - (define color (substring onetrueinput (+ 2 (string-length username) (string-length input)))) - (send dc set-text-foreground color) + ;; draws a user input to the screen + (define (user-message user-input) + (define username (user-message-parse user-input 0)) + (define input (user-message-parse user-input (+ 1 (string-length username)))) + (define color (substring user-input (+ 2 (string-length username) (string-length input)))) + (send dc set-text-foreground color) ; set dc's text color to user + ; provided (send dc draw-text (string-append username ":" input) 0 height) (set! listy (appendlist listy (list username input color height))) (set! height (+ height 15)) + ; redraw overly long text on gui (set! min-v-size (+ min-v-size 15)) (if (> (* 20 (string-length input)) min-h-size) (set! min-h-size (* 20 (string-length input))) '()) (send read-canvas init-auto-scrollbars min-h-size min-v-size 0 1) - )) - ;;Add a function that parces input from a string and extracts elements + ) + ;;Add a function that parces input from a string-i and extracts elements - ;;This probably won't change... + ; actually gets called to send input to the screen. user-message is in effect + ; its helper. It uses "~" to delimit the different components of message (define (send-message input color) (user-message (string-append name "~" input "~" color))) - ;;Although re-draw is kind of misleading, it is just print the whole - ;;list of strings to the screen + + ;; draws messages to the screen canvas as text (define (re-draw-message username input color in-height) (begin (send dc set-text-foreground color) (send dc draw-text (string-append username ":" input) 0 in-height) )) + ; used when redrawing the screen along with its helper. (define (update given-list) - (begin (set! listy '()) - (set! height 0) - (update-helper given-list))) + (set! listy '()) + (set! height 0) + (update-helper given-list)) (define (update-helper given-list) (if (null? given-list) @@ -126,9 +150,12 @@ (define name "Me") (define min-h-size 80) (define min-v-size 30) - (define listy (list (list "Server" "Connected" "Red" 0))) - (define my-color "black") - (define height 15) + (define listy (list (list "Server" "Connected" "Red" 0))) ; initializes + ; listy with first message to be drawn on screen + (define my-color "black") ; default color of the text messages if none + ; specified + (define height 15) ; height between messages drawn on the screen + ;;dispatch goes below that (define (dispatch command) (cond ((eq? command 'show) (send main-frame show #t)) @@ -160,7 +187,9 @@ ;the username the message they said and the color they used ;The the height the message should display at - +; listoflist is listy here, and add-to-end is what gets appended to the end +; really expensive operation but its important for Doug to showcase some opl +; concepts (define (appendlist listoflist add-to-end) (if (null? listoflist) (cons add-to-end '()) @@ -180,7 +209,7 @@ -;this one is a crap version of justpressing the enter key +; did user request for color change / (define (color-change-request? given-string) (if (> (string-length given-string) 7) (if (equal? (substring given-string 0 6) "/color") @@ -188,6 +217,7 @@ #f) #f)) +; we should use regexes for this. (define (get-color-from-input given-string) (substring given-string 7)) ;(define thing1 (make-gui)) diff --git a/Hermes/client.rkt b/Hermes/client.rkt index 9b4e658..91c22de 100644 --- a/Hermes/client.rkt +++ b/Hermes/client.rkt @@ -37,6 +37,9 @@ ; store username to a file for later retrieval along with relevent ; info used for authentication with server + ; TODO + ; semaphore for gui object + ; could display a bubble and prompt for username in GUI object (displayln "What's your name?") (define username (read-line)) From 63a3757f6717218d556aab7e01ceb6179ff80f29 Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Sun, 23 Apr 2017 01:36:46 -0400 Subject: [PATCH 03/13] beginning merge process --- Hermes/Hermes_Gui1.3.rkt | 26 ++++++++++++++++++++------ Hermes/client.rkt | 7 ++++++- 2 files changed, 26 insertions(+), 7 deletions(-) diff --git a/Hermes/Hermes_Gui1.3.rkt b/Hermes/Hermes_Gui1.3.rkt index 67597e4..909c51b 100644 --- a/Hermes/Hermes_Gui1.3.rkt +++ b/Hermes/Hermes_Gui1.3.rkt @@ -8,13 +8,15 @@ ;and the color as a string ;Object stuff +; TODO make different objects threadable send button vs text area vs canvas +; TODO gui is just a relay remember (provide make-gui) (define (make-gui) ;;Create the frame/window with title "Example5", width 500 and height 700 (define main-frame (new frame% - [label "Example5"] + [label "Hermes"] [width 500] [height 700] )) @@ -147,6 +149,12 @@ (update-helper (cdr given-list)))))) ;;Variables go below functions + ; for interfacing with outside elements + (define gui-input-in-s '()) + (define gui-input-out-s '()) + (define gui-input-in '()) + (define gui-input-out '()) + (define name "Me") (define min-h-size 80) (define min-v-size 30) @@ -157,16 +165,22 @@ (define height 15) ; height between messages drawn on the screen ;;dispatch goes below that + ;; TODO get username function maybe (define (dispatch command) - (cond ((eq? command 'show) (send main-frame show #t)) - ((eq? command 'send) send-message) + ; show gui should return the users the name as well as its first message + ; to be called + (cond ((eq? command 'show) (lambda () (send main-frame show #t))) + ((eq? command 'gui-input-port)) + ((eq? command 'send) send-message) ;; call to show a message in a gui ((eq? command 'set-name) (lambda (newname) (if (string? newname) (set! name newname) (print "Thats not good")))) - ((eq? command 'recieve-message) user-message) - ((eq? command 'get-list) listy) - ((eq? command 'set-list) update) + ; ((eq? command 'recieve-message) user-message) + ; ((eq? command 'get-list) listy) + ; ((eq? command 'set-list) update) ;;Something up with that + ; else should assume a message and output to screen we do not want it + ; to fail (else (error "Invalid Request" command)) )) ;;dispatch goes below that diff --git a/Hermes/client.rkt b/Hermes/client.rkt index 91c22de..f4cf137 100644 --- a/Hermes/client.rkt +++ b/Hermes/client.rkt @@ -11,6 +11,10 @@ ; we will prompt for these in the gui +(define hermes-gui (make-gui)) ;; our gui +((hermes-gui 'show)) + + (define host3 "localhost") (define port-num 4321) (define sleep-t 0.1) @@ -104,7 +108,8 @@ ;(exit) ] [(string? evt) - (displayln-safe evt convs-out-s convs-out)] ; could time stamp here or to send message + (displayln-safe evt convs-out-s convs-out) + ((hermes-gui 'send) evt "black")] ; could time stamp here or to send message [else (displayln-safe (string-append "Nothing received from server for 2 minutes.") convs-out-s convs-out)])) From 29c6708e130f4850ecfdc5ad67a2126b28789c8f Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Sun, 23 Apr 2017 01:39:06 -0400 Subject: [PATCH 04/13] renamed Hermes_Gui1.3.rkt to GUI.rkt for readability --- Hermes/{Hermes_Gui1.3.rkt => GUI.rkt} | 0 Hermes/client.rkt | 2 +- 2 files changed, 1 insertion(+), 1 deletion(-) rename Hermes/{Hermes_Gui1.3.rkt => GUI.rkt} (100%) diff --git a/Hermes/Hermes_Gui1.3.rkt b/Hermes/GUI.rkt similarity index 100% rename from Hermes/Hermes_Gui1.3.rkt rename to Hermes/GUI.rkt diff --git a/Hermes/client.rkt b/Hermes/client.rkt index f4cf137..d981cfc 100644 --- a/Hermes/client.rkt +++ b/Hermes/client.rkt @@ -1,6 +1,6 @@ #lang racket -(require "modules/general.rkt" "Hermes_Gui1.3.rkt") +(require "modules/general.rkt" "GUI.rkt") (require math/base) ;; for random number generation ;; TODO clean up string message output and alignment ;; TODO close ports after done From a1798d9e3d536c0d94cc128722ee152b4c10290d Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Sun, 23 Apr 2017 02:52:39 -0400 Subject: [PATCH 05/13] messages from other clients now display on the GUI --- Hermes/client.rkt | 31 ++++++++++++++++++++++++------- Hermes/server.rkt | 1 + 2 files changed, 25 insertions(+), 7 deletions(-) diff --git a/Hermes/client.rkt b/Hermes/client.rkt index d981cfc..827cd32 100644 --- a/Hermes/client.rkt +++ b/Hermes/client.rkt @@ -10,9 +10,9 @@ ;; notes: output may need to be aligned and formatted nicely -; we will prompt for these in the gui (define hermes-gui (make-gui)) ;; our gui ((hermes-gui 'show)) +(sleep 0.25) (define host3 "localhost") @@ -44,6 +44,10 @@ ; TODO ; semaphore for gui object ; could display a bubble and prompt for username in GUI object + + ; create a gui object + ; (define hermes-gui (make-gui)) + ; ((hermes-gui 'show)) (displayln "What's your name?") (define username (read-line)) @@ -66,11 +70,14 @@ (sleep sleep-t) (loop))))) (displayln-safe "Now waiting for sender thread." error-out-s error-out) - (thread-wait t) ;; returns prompt back to drracket + ; (thread-wait t) ;; returns prompt back to drracket + ) + + (lambda () (displayln-safe "Closing client ports." error-out-s error-out) - (close-input-port in) - (close-output-port out)) - (custodian-shutdown-all main-client-cust)) + ;(close-input-port in) + ;(close-output-port out) + (custodian-shutdown-all main-client-cust))) ;; sends a message to the server @@ -85,6 +92,7 @@ (number->string (date-second date-today)) " | ")) ;; read, quits when user types in "quit" + ;; TODO read from GUI instead (define input (read-line)) ; TODO /quit instead of quit (cond ((string=? input "quit") @@ -97,6 +105,11 @@ (displayln (string-append date-print username ": " input) out) (flush-output out)) +; sigh why you do this racket +(define send-to-gui + (lambda (message color) + ((hermes-gui 'send) message color))) + ; receives input from server and displays it to stdout (define (receive-messages in) ; retrieve a message from server @@ -108,10 +121,14 @@ ;(exit) ] [(string? evt) - (displayln-safe evt convs-out-s convs-out) - ((hermes-gui 'send) evt "black")] ; could time stamp here or to send message + (displayln-safe evt convs-out-s convs-out) + (send-to-gui evt "black") + ] ; could time stamp here or to send message [else (displayln-safe (string-append "Nothing received from server for 2 minutes.") convs-out-s convs-out)])) (displayln-safe "Starting client." error-out-s error-out) (define stop-client (client 4321)) +;(define stop-client (client 4321)) +; we will prompt for these in the gui + diff --git a/Hermes/server.rkt b/Hermes/server.rkt index 5eb634d..75cfa21 100644 --- a/Hermes/server.rkt +++ b/Hermes/server.rkt @@ -186,6 +186,7 @@ (define list-count (regexp-match #px"(.*)/list\\s+count\\s*" evt-t0)) ;; is client asking for number of logged in users (define list-users (regexp-match #px"(.*)/list\\s+users\\s*" evt-t0)) ;; user names ; do something whether it was a message, a whisper, request for number of users and so on + ; TODO if user doesn't exist handle it (cond [whisper (semaphore-wait connections-s) ; get output port for user From ed5d1d7571ce0359aa52c4bb4b401b3a1b220c7c Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Sun, 23 Apr 2017 03:50:12 -0400 Subject: [PATCH 06/13] Basic input and output now can be done through gui --- Hermes/GUI.rkt | 26 +++++++++++++++++++++++++- Hermes/client.rkt | 7 ++++--- Hermes/server.rkt | 2 +- 3 files changed, 30 insertions(+), 5 deletions(-) diff --git a/Hermes/GUI.rkt b/Hermes/GUI.rkt index 909c51b..a1d69a6 100644 --- a/Hermes/GUI.rkt +++ b/Hermes/GUI.rkt @@ -13,6 +13,11 @@ (provide make-gui) +; store input into a message list +; will create closure later +(define messages '()) + +; (define-values (gui-in gui-out) (make-pipe #f)) (define (make-gui) ;;Create the frame/window with title "Example5", width 500 and height 700 (define main-frame (new frame% @@ -68,11 +73,28 @@ (if (color-change-request? (send input get-value)) (set! my-color (get-color-from-input (send input get-value))) (if (< 0 (string-length (send input get-value))) - (send-message (send input get-value) my-color);; + (begin + ; (send-message (send input get-value) my-color);; + (set! messages (append messages (list (send input get-value)))) + ; (open-input-string ) + ) '())) (send input set-value "") ) + (define (get-message) + (define one-message + (if (not (null? messages)) + (begin + ;(define msg (car messages)) + (car messages) + ;(set! messages (cdr messages)) + ) + '())) + (if (not (string? one-message)) + (get-message) + (begin (set! messages (cdr messages)) + one-message))) ; creates the send button (define send-button (new button% [parent main-frame] @@ -99,6 +121,7 @@ (substring str start (+ start index)) (helper str (+ index 1)))) (helper string-i 0)) + ;; draws a user input to the screen (define (user-message user-input) @@ -181,6 +204,7 @@ ;;Something up with that ; else should assume a message and output to screen we do not want it ; to fail + ((eq? command 'get-message) get-message) (else (error "Invalid Request" command)) )) ;;dispatch goes below that diff --git a/Hermes/client.rkt b/Hermes/client.rkt index 827cd32..38ed60d 100644 --- a/Hermes/client.rkt +++ b/Hermes/client.rkt @@ -12,7 +12,7 @@ (define hermes-gui (make-gui)) ;; our gui ((hermes-gui 'show)) -(sleep 0.25) +;(sleep 0.25) (define host3 "localhost") @@ -20,7 +20,7 @@ (define sleep-t 0.1) ; we won't need this. Just me being overzealous -(define hermes-conf (open-output-file "./hermes_client.conf" #:exists'append)) +(define hermes-conf (open-output-file "./hermes_client.conf" #:exists 'append)) (define hermes-conf-s (make-semaphore 1)) (define convs-out (open-output-file "./convs_client.out" #:exists 'append)) @@ -93,7 +93,8 @@ " | ")) ;; read, quits when user types in "quit" ;; TODO read from GUI instead - (define input (read-line)) + ;(define input (read-line)) + (define input ((hermes-gui 'get-message))) ; TODO /quit instead of quit (cond ((string=? input "quit") (displayln (string-append date-print username " signing out. See ya!") out) diff --git a/Hermes/server.rkt b/Hermes/server.rkt index 75cfa21..de615a5 100644 --- a/Hermes/server.rkt +++ b/Hermes/server.rkt @@ -186,7 +186,7 @@ (define list-count (regexp-match #px"(.*)/list\\s+count\\s*" evt-t0)) ;; is client asking for number of logged in users (define list-users (regexp-match #px"(.*)/list\\s+users\\s*" evt-t0)) ;; user names ; do something whether it was a message, a whisper, request for number of users and so on - ; TODO if user doesn't exist handle it + ; TODO if user doesn't exist handle it******** (cond [whisper (semaphore-wait connections-s) ; get output port for user From 6b85be6490763110514702ba5587f0e3ffbc4510 Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Sun, 23 Apr 2017 04:04:45 -0400 Subject: [PATCH 07/13] bug fix: no longer attaches username to every received message. --- Hermes/GUI.rkt | 10 ++++++---- Hermes/client.rkt | 1 + 2 files changed, 7 insertions(+), 4 deletions(-) diff --git a/Hermes/GUI.rkt b/Hermes/GUI.rkt index a1d69a6..491557e 100644 --- a/Hermes/GUI.rkt +++ b/Hermes/GUI.rkt @@ -130,7 +130,9 @@ (define color (substring user-input (+ 2 (string-length username) (string-length input)))) (send dc set-text-foreground color) ; set dc's text color to user ; provided - (send dc draw-text (string-append username ":" input) 0 height) + ; (send dc draw-text (string-append username ":" input) 0 height) + (send dc draw-text input 0 height) ;; just print message to string + (set! listy (appendlist listy (list username input color height))) (set! height (+ height 15)) ; redraw overly long text on gui @@ -149,10 +151,10 @@ ;; draws messages to the screen canvas as text (define (re-draw-message username input color in-height) - (begin (send dc set-text-foreground color) - (send dc draw-text (string-append username ":" input) 0 in-height) - )) + ; (send dc draw-text (string-append username ":" input) 0 in-height) + (send dc draw-text input 0 in-height) + ) ; used when redrawing the screen along with its helper. (define (update given-list) diff --git a/Hermes/client.rkt b/Hermes/client.rkt index 38ed60d..b2ca903 100644 --- a/Hermes/client.rkt +++ b/Hermes/client.rkt @@ -101,6 +101,7 @@ (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) From 44a02c702570768b6d7a65b6153c7aa3308b2f07 Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Sun, 23 Apr 2017 04:19:45 -0400 Subject: [PATCH 08/13] updated TODO's --- Hermes/GUI.rkt | 2 ++ Hermes/TODO | 2 +- 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/Hermes/GUI.rkt b/Hermes/GUI.rkt index 491557e..30d305b 100644 --- a/Hermes/GUI.rkt +++ b/Hermes/GUI.rkt @@ -10,6 +10,8 @@ ;Object stuff ; TODO make different objects threadable send button vs text area vs canvas ; TODO gui is just a relay remember +; TODO create a dialog to ask user for his username. This should be wrapped in a +; function get-username that we can call (provide make-gui) diff --git a/Hermes/TODO b/Hermes/TODO index bbc2930..db51e46 100644 --- a/Hermes/TODO +++ b/Hermes/TODO @@ -1,7 +1,7 @@ FEATURES 5. parser in the client side should do something similar (/color, /quit) 16. plain tcp -> ssl based -17. fix breaks for improper disconnects from clients +***17. fix breaks for improper disconnects from clients 18. Add topics after project completion ** regexes to parse strings for different formats -related to 5 ** align code better for readability From 183fad9de3cd73a1a8d5b0a4706ca2654ae30358 Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Sun, 23 Apr 2017 11:15:58 -0400 Subject: [PATCH 09/13] Now prompts for user name via the GUI --- Hermes/GUI.rkt | 11 ++++++++++- Hermes/client.rkt | 7 +++++-- 2 files changed, 15 insertions(+), 3 deletions(-) diff --git a/Hermes/GUI.rkt b/Hermes/GUI.rkt index 30d305b..d3ff29a 100644 --- a/Hermes/GUI.rkt +++ b/Hermes/GUI.rkt @@ -84,6 +84,7 @@ (send input set-value "") ) + ; retrieves a message user inputed to the text field (define (get-message) (define one-message (if (not (null? messages)) @@ -191,13 +192,20 @@ ; specified (define height 15) ; height between messages drawn on the screen + ;; prompt user for username + ;; could randomly assign a user + (define (get-username) + (get-text-from-user "Username set-up" "Please enter a username" + main-frame "user" (list 'disallow-invalid) + #:validate string? )) + ;;dispatch goes below that ;; TODO get username function maybe (define (dispatch command) ; show gui should return the users the name as well as its first message ; to be called (cond ((eq? command 'show) (lambda () (send main-frame show #t))) - ((eq? command 'gui-input-port)) + ((eq? command 'get-username) get-username) ((eq? command 'send) send-message) ;; call to show a message in a gui ((eq? command 'set-name) (lambda (newname) (if (string? newname) (set! name newname) @@ -220,6 +228,7 @@ + ;Initilize scrolling ;Then we need to find out if we need them or not. diff --git a/Hermes/client.rkt b/Hermes/client.rkt index b2ca903..d94fc70 100644 --- a/Hermes/client.rkt +++ b/Hermes/client.rkt @@ -48,8 +48,9 @@ ; create a gui object ; (define hermes-gui (make-gui)) ; ((hermes-gui 'show)) - (displayln "What's your name?") - (define username (read-line)) + ;(displayln "What's your name?") + ;(define username (read-line)) + (define username ((hermes-gui 'get-username))) ;send the username to the server (username in out) (displayln username out) @@ -95,6 +96,8 @@ ;; TODO read from GUI instead ;(define input (read-line)) (define input ((hermes-gui 'get-message))) + ; TODO prompt for color as well + ; TODO /quit instead of quit (cond ((string=? input "quit") (displayln (string-append date-print username " signing out. See ya!") out) From 6bac96cfdba6be62a206b509cc532c63b9ca7a43 Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Sun, 23 Apr 2017 11:27:38 -0400 Subject: [PATCH 10/13] Now accepts "/quit" to quit instead of "quit" --- Hermes/GUI.rkt | 7 +++++-- Hermes/client.rkt | 2 +- 2 files changed, 6 insertions(+), 3 deletions(-) diff --git a/Hermes/GUI.rkt b/Hermes/GUI.rkt index d3ff29a..25a4060 100644 --- a/Hermes/GUI.rkt +++ b/Hermes/GUI.rkt @@ -65,7 +65,7 @@ ; TODO make label setable (define input (new text-field% [parent main-frame] - [label "Username:"] + [label "user"] [callback text-field-callback] )) @@ -194,10 +194,13 @@ ;; prompt user for username ;; could randomly assign a user + ;; after calling get-text set it as new label of text-field (define (get-username) - (get-text-from-user "Username set-up" "Please enter a username" + (define returned (get-text-from-user "Username set-up" "Please enter a username" main-frame "user" (list 'disallow-invalid) #:validate string? )) + (send input set-label returned) + returned) ;;dispatch goes below that ;; TODO get username function maybe diff --git a/Hermes/client.rkt b/Hermes/client.rkt index d94fc70..6752c1e 100644 --- a/Hermes/client.rkt +++ b/Hermes/client.rkt @@ -99,7 +99,7 @@ ; TODO prompt for color as well ; TODO /quit instead of quit - (cond ((string=? input "quit") + (cond ((string=? input "/quit") (displayln (string-append date-print username " signing out. See ya!") out) (flush-output out) (close-output-port error-out) From c78c2fb872413231b787eee60ea7df568bc80f1d Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Sun, 23 Apr 2017 11:43:52 -0400 Subject: [PATCH 11/13] Validate that username is at most 10 characters. Added Padding for username. --- Hermes/GUI.rkt | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/Hermes/GUI.rkt b/Hermes/GUI.rkt index 25a4060..41dbd29 100644 --- a/Hermes/GUI.rkt +++ b/Hermes/GUI.rkt @@ -61,11 +61,13 @@ '())) ; creates the editing area as part of the parent "main-frame" define above. - ; initially labelled "Username:" + ; initially labelled "Username:" + ; NOTE: we pad label with additional spaces so we don't have to recompute + ; the window dimensions to fit the new label (the actual username) ; TODO make label setable (define input (new text-field% [parent main-frame] - [label "user"] + [label "username "] [callback text-field-callback] )) @@ -198,7 +200,12 @@ (define (get-username) (define returned (get-text-from-user "Username set-up" "Please enter a username" main-frame "user" (list 'disallow-invalid) - #:validate string? )) + #:validate + (lambda (input) + (if (and (string? input) (<= (string-length input) 10) + (>= (string-length input) 2)) + #t + #f)))) (send input set-label returned) returned) From c6dd0311d43f14ce468b15f76afa0d4154f8ab8d Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Sun, 23 Apr 2017 12:48:54 -0400 Subject: [PATCH 12/13] GUI no longer burns through CPU cycles. --- Hermes/GUI.rkt | 40 ++++++++++++++++++++++++++++++++++++++-- Hermes/client.rkt | 13 +++++++++++-- 2 files changed, 49 insertions(+), 4 deletions(-) diff --git a/Hermes/GUI.rkt b/Hermes/GUI.rkt index 41dbd29..e8f3ec1 100644 --- a/Hermes/GUI.rkt +++ b/Hermes/GUI.rkt @@ -17,7 +17,9 @@ ; store input into a message list ; will create closure later +(define messages-s (make-semaphore 1)) (define messages '()) +(define sleep-t 0.1) ; (define-values (gui-in gui-out) (make-pipe #f)) (define (make-gui) @@ -79,7 +81,9 @@ (if (< 0 (string-length (send input get-value))) (begin ; (send-message (send input get-value) my-color);; + (semaphore-wait messages-s) (set! messages (append messages (list (send input get-value)))) + (semaphore-post messages-s) ; (open-input-string ) ) '())) @@ -88,6 +92,7 @@ ; retrieves a message user inputed to the text field (define (get-message) + (semaphore-wait messages-s) (define one-message (if (not (null? messages)) (begin @@ -96,9 +101,16 @@ ;(set! messages (cdr messages)) ) '())) + (semaphore-post messages-s) + (if (not (string? one-message)) - (get-message) - (begin (set! messages (cdr messages)) + (begin + (sleep sleep-t) ; so we don't burn cpu cycles + (get-message)) + (begin + (semaphore-wait messages-s) + (set! messages (cdr messages)) + (semaphore-post messages-s) one-message))) ; creates the send button (define send-button (new button% @@ -190,8 +202,29 @@ (define min-v-size 30) (define listy (list (list "Server" "Connected" "Red" 0))) ; initializes ; listy with first message to be drawn on screen + ; wrap in closure (define my-color "black") ; default color of the text messages if none ; specified + ; associated methods to prompt for color, get color and set color + (define (set-color new-color) + (set! my-color new-color)) + + (define (get-my-color) + my-color) + + ; TODO loop to make sure you get right user input + ; not really needed as user can set in window + (define (prompt-color) + (define returned (get-text-from-user "Color set-up" "Please enter color for text" + main-frame "black" (list 'disallow-invalid) + #:validate + (lambda (input) + (if (and (string? input) (<= (string-length input) 10) + (>= (string-length input) 3)) + #t + #f)))) + (set! my-color returned) + returned) (define height 15) ; height between messages drawn on the screen ;; prompt user for username @@ -215,6 +248,9 @@ ; show gui should return the users the name as well as its first message ; to be called (cond ((eq? command 'show) (lambda () (send main-frame show #t))) + ((eq? command 'get-color) get-my-color) + ((eq? command 'set-color) set-color) + ((eq? command 'prompt-color) prompt-color) ((eq? command 'get-username) get-username) ((eq? command 'send) send-message) ;; call to show a message in a gui ((eq? command 'set-name) (lambda (newname) (if (string? newname) diff --git a/Hermes/client.rkt b/Hermes/client.rkt index 6752c1e..e955027 100644 --- a/Hermes/client.rkt +++ b/Hermes/client.rkt @@ -19,6 +19,8 @@ (define port-num 4321) (define sleep-t 0.1) +(define hermes-gui-s (make-semaphore 1)) + ; we won't need this. Just me being overzealous (define hermes-conf (open-output-file "./hermes_client.conf" #:exists 'append)) (define hermes-conf-s (make-semaphore 1)) @@ -95,7 +97,9 @@ ;; read, quits when user types in "quit" ;; TODO read from GUI instead ;(define input (read-line)) + (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 @@ -110,7 +114,8 @@ (displayln (string-append date-print username ": " input) out) (flush-output out)) -; sigh why you do this racket +; a wrap around to call ((hermes-gui 'send) zzz yyy) without complaints from +; drracket (define send-to-gui (lambda (message color) ((hermes-gui 'send) message color))) @@ -127,7 +132,11 @@ ] [(string? evt) (displayln-safe evt convs-out-s convs-out) - (send-to-gui evt "black") + ; 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))) + (semaphore-post hermes-gui-s) ] ; could time stamp here or to send message [else (displayln-safe (string-append "Nothing received from server for 2 minutes.") convs-out-s convs-out)])) From 6890e2be729362ab8063acf40b19bdee64f49783 Mon Sep 17 00:00:00 2001 From: Ibrahim Mkusa Date: Sun, 23 Apr 2017 12:54:34 -0400 Subject: [PATCH 13/13] bug fix: improved responsiveness of GUI --- Hermes/client.rkt | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/Hermes/client.rkt b/Hermes/client.rkt index e955027..91e9991 100644 --- a/Hermes/client.rkt +++ b/Hermes/client.rkt @@ -97,9 +97,9 @@ ;; read, quits when user types in "quit" ;; TODO read from GUI instead ;(define input (read-line)) - (semaphore-wait hermes-gui-s) + ;(semaphore-wait hermes-gui-s) (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 @@ -134,9 +134,9 @@ (displayln-safe evt convs-out-s convs-out) ; TODO set color to current client if the message is from him ; otherwise set it to the remote - (semaphore-wait hermes-gui-s) + ;(semaphore-wait hermes-gui-s) (send-to-gui evt ((hermes-gui 'get-color))) - (semaphore-post hermes-gui-s) + ;(semaphore-post hermes-gui-s) ] ; could time stamp here or to send message [else (displayln-safe (string-append "Nothing received from server for 2 minutes.") convs-out-s convs-out)]))