aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Hermes/GUI.rkt40
-rw-r--r--Hermes/client.rkt13
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)]))