GUI no longer burns through CPU cycles.

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)]))