aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDouglas-Richardson <Doug116654@gmail.com>2017-04-22 20:54:09 -0400
committerDouglas-Richardson <Doug116654@gmail.com>2017-04-22 20:54:09 -0400
commitdaea63e8c5eff7a03b32729862fff6c18a70aebb (patch)
tree0c6f646b89f9f9bb3e1b0d0aff145c4c8b270ac9
parentaebda4ef57a98f51b2da792657ea0fd204f0cc9a (diff)
Fixed the crashing bugsgrape
It technically doesn't crash, but for some reason the GUI is frozen immediately on startup and is completely unresponsive. It may have something to do with calling some function in them multiple times over and over again but I don't know. I added some debugging text with comments next to them as "eat this note". Those lines can be removed with no concequences.
-rw-r--r--Hermes/Hermes_Gui1.3.rkt9
-rw-r--r--Hermes/client.rkt30
-rw-r--r--Hermes/server.rkt14
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)))