Fixed the crashing bugs

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.
This commit is contained in:
Douglas-Richardson 2017-04-22 20:54:09 -04:00
parent aebda4ef57
commit daea63e8c5
3 changed files with 32 additions and 21 deletions

View File

@ -13,6 +13,7 @@
(define (make-gui) (define (make-gui)
(begin (begin
(displayln "Makin...");;eat this note
;;Create the frame ;;Create the frame
(define main-frame (new frame% (define main-frame (new frame%
[label "Hermes"] [label "Hermes"]
@ -88,7 +89,9 @@
(helper string start)) (helper string start))
(define (user-message onetrueinput) (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. (let();;This is kind of stupid but whatever it works.
(define username (user-message-parse onetrueinput 0)) (define username (user-message-parse onetrueinput 0))
(define user-input (user-message-parse onetrueinput (+ 1(string-length-safe username)))) (define user-input (user-message-parse onetrueinput (+ 1(string-length-safe username))))
@ -114,6 +117,7 @@
;;list of strings to the screen ;;list of strings to the screen
(define (re-draw-message username input color in-height) (define (re-draw-message username input color in-height)
(begin (begin
(displayln "Fixy!");eat this note
(send dc set-text-foreground color) (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)
)) ))
@ -144,6 +148,7 @@
;;dispatch goes below that ;;dispatch goes below that
(define (dispatch command) (define (dispatch command)
(cond ((eq? command 'show) (send main-frame show #t)) (cond ((eq? command 'show) (send main-frame show #t))
((eq? command 'close)(send main-frame show #f))
((eq? command 'send) send-message) ((eq? command 'send) send-message)
((eq? command 'set-name) (lambda (newname) (if (string? newname) ((eq? command 'set-name) (lambda (newname) (if (string? newname)
(set! name newname) (set! name newname)
@ -207,7 +212,7 @@
(define (quit-request? given-string) (define (quit-request? given-string)
(if (>= (string-length-safe given-string) 5) (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 #t
#f) #f)
#f)) #f))

View File

@ -63,21 +63,21 @@
(thread-wait t) ;; returns prompt back to drracket (thread-wait t) ;; returns prompt back to drracket
(displayln-safe "Closing client ports." error-out-s error-out) (displayln-safe "Closing client ports." error-out-s error-out)
(close-input-port in) (close-input-port in)
(close-output-port out)) (close-output-port out)
(gui 'close))
(custodian-shutdown-all main-client-cust)) (custodian-shutdown-all main-client-cust))
;; sends a message to the server ;; sends a message to the server
(define (send-messages username out) (define (send-messages username out)
; get current time ; 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 ;TODO pad the second if its only 1 character
(define date-print (string-append (number->string (date-hour date-today)) ;(define date-print (string-append (number->string (date-hour date-today))
":" ; ":"
(number->string (date-minute date-today)) ; (number->string (date-minute date-today))
":" ; ":"
(number->string (date-second date-today)) ; (number->string (date-second date-today))
" | ")) ; " | "))
;; read, quits when user types in "quit" ;; read, quits when user types in "quit"
;(define input (read-line)) ;(define input (read-line))
(define input (get-output-string (gui 'get-output-port))) (define input (get-output-string (gui 'get-output-port)))
@ -91,9 +91,11 @@
;(displayln (string-append date-print username ": " input) out) ;(displayln (string-append date-print username ": " input) out)
(if (not (null? input)) (if (not (null? input))
(begin (if (not (equal? input ""))
(display input) ((let()
(displayln input out)) (displayln input);;eat this note
(displayln input out)))
'())
'()) '())
(flush-output out)) (flush-output out))
@ -109,7 +111,9 @@
] ]
[(string? evt) [(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)] ; could time stamp here or to send message
((gui 'recieve-message) evt)] (if (not (equal? evt ""))
((gui 'recieve-message) evt)
'())]
[else [else
(displayln-safe (displayln-safe
(string-append "Nothing received from server for 2 minutes.") (string-append "Nothing received from server for 2 minutes.")

View File

@ -60,8 +60,10 @@
; Track received messages in a closure ; Track received messages in a closure
(define (make-messages messages) (define (make-messages messages)
(define (add message) (define (add message)
(set! messages (append messages (list message))) (if (string=? message "")
messages) messages
((set! messages (append messages (list message)))
messages)))
(define (mes-list) (define (mes-list)
messages) messages)
(define (remove-top) (define (remove-top)
@ -266,15 +268,15 @@
(lambda (ports) (lambda (ports)
(if (not (port-closed? (get-output-port ports))) (if (not (port-closed? (get-output-port ports)))
(begin (begin
(displayln (string-append "Server~" (displayln (first ((c-messages 'mes-list)))
(first ((c-messages 'mes-list))) (get-output-port ports))
"~red"
) (get-output-port ports))
(flush-output (get-output-port ports))) (flush-output (get-output-port ports)))
(displayln-safe "Failed to broadcast. Port not open." error-out-s error-out))) (displayln-safe "Failed to broadcast. Port not open." error-out-s error-out)))
((c-connections 'cons-list))) ((c-connections 'cons-list)))
(displayln-safe (first ((c-messages 'mes-list))) convs-out-s convs-out) (displayln-safe (first ((c-messages 'mes-list))) convs-out-s convs-out)
;; remove top message ;; remove top message
(displayln (null? ((c-messages 'mes-list))));;eat this note
(displayln ((c-messages 'mes-list)));;eat this note
((c-messages 'remove-top)) ((c-messages 'remove-top))
(displayln "Message broadcasted"))]) (displayln "Message broadcasted"))])
(semaphore-post messages-s))) (semaphore-post messages-s)))