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.

5 files changed, 105 insertions, 246 deletions

diff --git a/.gitignore b/.gitignore
index b917769..11dd018 100644
--- a/.gitignore
+++ b/.gitignore
@@ -9,3 +9,6 @@
 # ignore racket compile files
 *.dep
 *.zo
+
+#ignore backup files
+*.bak
\ No newline at end of file
diff --git a/Hermes/Hermes_Gui1.3.rkt b/Hermes/Hermes_Gui1.3.rkt
index ba239c3..8700432 100644
--- a/Hermes/Hermes_Gui1.3.rkt
+++ b/Hermes/Hermes_Gui1.3.rkt
@@ -15,7 +15,7 @@
   (begin
     ;;Create the frame
     (define main-frame (new frame%
-                            [label "Example5"]
+                            [label "Hermes"]
                             [width 500]
                             [height 700]
                             ))
@@ -54,13 +54,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,33 +77,39 @@
     ;;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)
-        ))
+      (if (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)
@@ -138,8 +149,9 @@
                                                   (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 +191,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 (quit-request? given-string)
+  (if (>= (string-length-safe given-string) 5)
+      (if ((equal? substring-s given-string 0 5) "/quit")
           #t
           #f)
       #f))
 
-(define (get-color-from-input given-string)
-  (substring given-string 7))
+(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))
 
diff --git a/Hermes/client.rkt b/Hermes/client.rkt
index 64710bb..0a345e2 100644
--- a/Hermes/client.rkt
+++ b/Hermes/client.rkt
@@ -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
@@ -77,16 +79,22 @@
                                     (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))
+      (begin
+        (display input)
+        (displayln input out))
+      '())
   (flush-output out))
 
 ; receives input from server and displays it to stdout
@@ -100,9 +108,12 @@
          ;(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
+         ((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))
diff --git a/Hermes/server.rkt b/Hermes/server.rkt
index 9b1a171..25ff757 100644
--- a/Hermes/server.rkt
+++ b/Hermes/server.rkt
@@ -126,10 +126,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 +195,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 +206,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 +217,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,7 +266,10 @@
                 (lambda (ports)
                   (if (not (port-closed? (get-output-port ports)))
                     (begin 
-                        (displayln (first ((c-messages 'mes-list))) (get-output-port ports))
+                        (displayln (string-append "Server~"
+                                                  (first ((c-messages 'mes-list)))
+                                                  "~red"
+                                                  ) (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)))
diff --git a/Hermes_Gui1.2.rkt b/Hermes_Gui1.2.rkt
deleted file mode 100644
index a051c10..0000000
--- a/Hermes_Gui1.2.rkt
+++ /dev/null
@@ -1,194 +0,0 @@
-#lang racket
-(require racket/gui/base)
-;Author:Douglas Richardson
-;Notes:Our GUI mostly deals with lists of a list of 3 strings and a number
-;although the number is always delt with locally
-;When using user-message you need to give it a list of 3 things
-;The name of the user as a string, what they said as a string,
-;and the color as a string
-
-;Object stuff
-
-(define (make-gui)
-  (begin
-    ;;Create the frame
-    (define main-frame (new frame%
-                            [label "Example5"]
-                            [width 500]
-                            [height 700]
-                            ))
-    ;;Editing canvas
-    (define (do-stuff-paint paint-canvas paint-dc)
-      (do-more-stuff-paint listy paint-canvas paint-dc))
-
-    (define (do-more-stuff-paint paint-listy paint-canvas paint-dc)
-      (if (null? paint-listy)
-          '()
-          (begin
-            (re-draw-message (get-username-from-list (car paint-listy))
-                             (get-message-from-list (car paint-listy))
-                             (get-color-from-list (car paint-listy))
-                             (get-height-from-list (car paint-listy)))
-            (do-more-stuff-paint (cdr paint-listy) paint-canvas paint-dc))))
-
-    (define read-canvas (new canvas%
-                             [parent main-frame]
-                             [paint-callback do-stuff-paint]
-                             [style '(hscroll vscroll)]
-                             ))
-
-    (send read-canvas init-auto-scrollbars #f #f 0 0);Start with no scrollbars
-    ;;text-field stuff
-    (define (text-feild-callback callback-type other-thing)
-      (if (equal? 'text-field-enter (send other-thing get-event-type))
-          (button-do-stuff 'irrelevant 'not-used)
-          '()))
-    
-    (define input (new text-field%
-                       [parent main-frame]
-                       [label "Username:"]
-                       [callback text-feild-callback]
-                       ))
-    ;;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 send-button (new button%
-                             [parent main-frame]
-                             [label "Send"]
-                             [callback button-do-stuff]))
-    ;;I forget what these do but don't move them
-    (define dc (send read-canvas get-dc))
-    (send dc set-scale 1 1)
-    (send dc set-text-foreground "black")
-    ;;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 (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)
-        ))
-    ;;Add a function that parces input from a string and extracts elements
-
-    ;;This probably won't change...
-    (define (send-message input color)
-      (user-message (string-append name "~" input "~" color)))
-    ;;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
-        (send dc set-text-foreground color)
-        (send dc draw-text (string-append username ":" input) 0 in-height)
-        ))
-
-    (define (update given-list)
-      (begin (set! listy '())
-             (set! height 0)
-             (update-helper given-list)))
-
-    (define (update-helper given-list)
-      (if (null? given-list)
-          '()
-          (if (null? (car given-list))
-              '()
-              (begin (user-message
-                      (get-username-from-list (car given-list))
-                      (get-message-from-list (car given-list))
-                      (get-color-from-list (car given-list)))
-                     (update-helper (cdr given-list))))))
-    
-    ;;Variables go below functions
-    (define name "Me")
-    (define min-h-size 80)
-    (define min-v-size 30)
-    (define listy (list (list "Server" "Connected" "Red" 0)))
-    (define my-color "black")
-    (define height 15)
-    ;;dispatch goes below that
-    (define (dispatch command)
-      (cond ((eq? command 'show) (send main-frame show #t))
-            ((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)
-            ;;Something up with that
-            (else (error "Invalid Request" command))
-            ))
-    ;;dispatch goes below that
-    dispatch))
-
-
-;This one displays information
-
-
-
-
-;Initilize scrolling
-
-;Then we need to find out if we need them or not.
-
-;Listy is going to be a list of lists of strings
-;each element in listy will contain three strings
-;the username the message they said and the color they used
-;The the height the message should display at
-
-
-(define (appendlist listoflist add-to-end)
-  (if (null? listoflist)
-      (cons add-to-end '())
-      (cons (car listoflist) (appendlist (cdr listoflist) add-to-end))))
-
-(define (get-username-from-list in-list)
-  (car in-list))
-
-(define (get-message-from-list in-list)
-  (car (cdr in-list)))
-
-(define (get-color-from-list in-list)
-  (car (cdr (cdr in-list))))
-
-(define (get-height-from-list in-list)
-  (car (cdr (cdr (cdr in-list)))))
-
-
-
-;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")
-          #t
-          #f)
-      #f))
-
-(define (get-color-from-input given-string)
-  (substring given-string 7))
-;(define thing1 (make-gui))
-;(define thing2 (make-gui))
-