Compare commits

...

6 Commits

Author SHA1 Message Date
Douglas-Richardson
daea63e8c5 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.
2017-04-22 20:54:09 -04:00
Douglas-Richardson
aebda4ef57 Fiddled around with it for a bit
I mostly added a few safties onto the string-lenght and substring
functions so they wouldn't cause a crash, but now somewhere there is
some error where string-append is trying to append to something that
isn't a string, but I have no idea where it is.
2017-04-22 14:52:46 -04:00
Douglas-Richardson
5e3bdbeeb4 Merge remote-tracking branch 'refs/remotes/origin/master' into grape 2017-04-19 18:03:24 -04:00
Doug-Richardson
fe734a8893 Fixed bug where small strings would crash 2017-04-19 16:22:47 -04:00
Doug-Richardson
240870e5d1 Updated User-message function to take one argument 2017-04-19 16:15:58 -04:00
Doug-Richardson
7707b8ec45 Added the Gui files
This isn't on the main branch because it uses the word "Commit" to describe the changes and I am afraid of commitment.
2017-04-14 19:57:07 -04:00
4 changed files with 127 additions and 63 deletions

3
.gitignore vendored
View File

@ -9,3 +9,6 @@
# ignore racket compile files
*.dep
*.zo
#ignore backup files
*.bak

View File

@ -13,9 +13,10 @@
(define (make-gui)
(begin
(displayln "Makin...");;eat this note
;;Create the frame
(define main-frame (new frame%
[label "Example5"]
[label "Hermes"]
[width 500]
[height 700]
))
@ -54,13 +55,18 @@
;;button stuff
(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 "")
))
(define given-input (send input get-value))
(if (string? given-input)
(if (color-change-request? given-input)
(set! my-color (get-color-from-input given-input))
(if (quit-request? given-input)
(write "quit" the-output-port)
(if (< 0 (string-length-safe given-input))
(send-message (send input get-value) my-color);;
'())))
'())
(send input set-value "")))
(define send-button (new button%
[parent main-frame]
[label "Send"]
@ -72,37 +78,46 @@
;;messaging stuff
(define (user-message-parse string start)
(begin
(define (helper str index)
(if (eq? (string-ref str (+ start index)) #\~)
(substring str start (+ start index))
(helper str (+ index 1))))
(helper string 0)))
(define (helper str index)
(if (string? string)
(if (>= (+ start index) (string-length-safe string))
(display string);;Something went wrong
(if (eq? (string-ref str (+ start index)) #\~)
(substring-s str start (+ start index))
(helper str (+ index 1))))
'()))
(helper string start))
(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)
(send dc draw-text (string-append username ":" input) 0 height)
(set! listy (appendlist listy (list username input color height)))
(set! height (+ height 15))
(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)
))
(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))))
(define color (substring-s onetrueinput (+ 2 (string-length-safe username) (string-length-safe user-input)) (string-length-safe onetrueinput)))
(send dc set-text-foreground color)
(send dc draw-text (string-append username ":" user-input) 0 height)
(set! listy (appendlist listy (list username user-input color height)))
(set! height (+ height 15))
(set! min-v-size (+ min-v-size 15))
(if (> (* 20 (string-length-safe user-input)) min-h-size)
(set! min-h-size (* 20 (string-length-safe user-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
(define the-output-port (open-output-string))
;;This probably won't change...
(define (send-message input color)
(user-message (string-append name "~" input "~" color)))
(write (string-append name "~" input "~" color) the-output-port))
;;Although re-draw is kind of misleading, it is just print the whole
;;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)
))
@ -133,13 +148,15 @@
;;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)
(print "Thats not good"))))
((eq? command 'recieve-message) user-message)
((eq? command 'get-list) listy)
((eq? command 'set-list) update)
;((eq? command 'get-list) listy)
;((eq? command 'set-list) update)
((eq? command 'get-output-port) the-output-port)
;;Something up with that
(else (error "Invalid Request" command))
))
@ -179,18 +196,38 @@
(define (get-height-from-list in-list)
(car (cdr (cdr (cdr in-list)))))
(define (get-color-from-input input)
(substring-s input 6 (string-length-safe input)))
;this one is a crap version of justpressing the enter key
(define (color-change-request? given-string)
(if (> (string-length given-string) 7)
(if (equal? (substring given-string 0 6) "/color")
(if (> (string-length-safe given-string) 7)
(if (equal? (substring-s given-string 0 6) "/color")
#t
#f)
#f))
(define (get-color-from-input given-string)
(substring given-string 7))
(define (quit-request? given-string)
(if (>= (string-length-safe given-string) 5)
(if (equal? (substring-s given-string 0 5) "/quit")
#t
#f)
#f))
(define (string-length-safe string)
(if (string? string)
(string-length string)
0))
(define (substring-s string start end)
(if (<= start end)
(if (<= end (string-length-safe string))
(substring string start end)
"")
""))
;(define thing1 (make-gui))
;(define thing2 (make-gui))

View File

@ -25,6 +25,7 @@
(define error-out (open-output-file "./error_client.out" #:exists 'append))
(define error-out-s (make-semaphore 1))
(define gui (make-gui))
; custodian for client connections
(define main-client-cust (make-custodian))
; make connection to server
@ -38,9 +39,10 @@
; info used for authentication with server
(displayln "What's your name?")
(define username (read-line))
((gui 'set-name) username)
(gui 'show)
;send the username to the server (username in out)
(displayln username out)
;(displayln username out)
(flush-output out)
(define a (thread
@ -61,32 +63,40 @@
(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 (read-line))
(define input (get-output-string (gui 'get-output-port)))
; TODO /quit instead of quit
(cond ((string=? input "quit")
(displayln (string-append date-print username " signing out. See ya!") out)
;(displayln (string-append date-print username " signing out. See ya!") out)
(flush-output out)
(close-output-port error-out)
(close-output-port convs-out)
(exit)))
(displayln (string-append date-print username ": " input) out)
;(displayln (string-append date-print username ": " input) out)
(if (not (null? input))
(if (not (equal? input ""))
((let()
(displayln input);;eat this note
(displayln input out)))
'())
'())
(flush-output out))
; receives input from server and displays it to stdout
@ -100,9 +110,14 @@
;(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)] ; could time stamp here or to send message
(if (not (equal? evt ""))
((gui 'recieve-message) evt)
'())]
[else
(displayln-safe (string-append "Nothing received from server for 2 minutes.") convs-out-s convs-out)]))
(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))

View File

@ -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)
@ -126,10 +128,10 @@
(semaphore-post c-count-s)
(displayln-safe successful-connection-m)
(displayln welcome-message out)
;(displayln welcome-message out)
;; print to server log and client
(define print-no-users (string-append "Number of users in chat: "
(number->string ((c-count 'current-count)))))
(define print-no-users (string-append "Server~Number of users in chat: "
(number->string ((c-count 'current-count))) "~Red"))
(displayln print-no-users out)
(displayln-safe print-no-users convs-out-s convs-out)
(flush-output out)
@ -195,7 +197,7 @@
; try to send that user the whisper
(if (port-closed? (get-output-port that-user-ports))
(begin
(displayln "User is unavailable" out)
(displayln "Server~User is unavailable~red" out)
(flush-output out))
(begin
(displayln (string-append (whisper-info whisper) (whisper-message whisper))
@ -206,8 +208,9 @@
;;should put a semaphore on connections
(semaphore-wait c-count-s)
(semaphore-wait connections-s)
(define no-of-users (string-append "Number of users in chat: "
(number->string ((c-count 'current-count)))))
(define no-of-users (string-append "Server~Number of users in chat: "
(number->string ((c-count 'current-count)))
"~red"))
(displayln no-of-users out)
(flush-output out)
(semaphore-post connections-s)
@ -216,10 +219,13 @@
[list-users
(semaphore-wait connections-s)
; map over connections sending the username to the client
(displayln "Here is a list of users in chat." out)
(displayln "Server~Here is a list of users in chat.~red" out)
(map
(lambda (ports)
(displayln (get-username ports) out))
(displayln (string-append
"Server~"
(get-username ports)
"~red")out))
((c-connections 'cons-list)))
(flush-output out)
(semaphore-post connections-s)]
@ -262,12 +268,15 @@
(lambda (ports)
(if (not (port-closed? (get-output-port ports)))
(begin
(displayln (first ((c-messages 'mes-list))) (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)))