iskm/Hermes
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merge pull request #5 from oplS17projects/mango

Browse Source 
Mango
This commit is contained in:
iskm 2017-04-23 12:57:02 -04:00 committed by GitHub
commit 044e36ff5d
5 changed files with 375 additions and 209 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

322
Hermes/GUI.rkt Normal file
View File

@ -0,0 +1,322 @@
#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
; TODO make different objects threadable send button vs text area vs canvas
; TODO gui is just a relay remember
; TODO create a dialog to ask user for his username. This should be wrapped in a
; function get-username that we can call
(provide make-gui)
; 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)
;;Create the frame/window with title "Example5", width 500 and height 700
(define main-frame (new frame%
[label "Hermes"]
[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))))
; canvas for displaying messages with horizontal and vertical scrollbar.
; on an event it calls do-stuff-paint to redraw things on the screen
; properly
(define read-canvas (new canvas%
[parent main-frame]
[paint-callback do-stuff-paint]
[style '(hscroll vscroll)]
))
; "send" is rackets way of doing object-oriented programming. It calls an
; objects functions in this case "read-canvas" object's init-auto-scrollbars
(send read-canvas init-auto-scrollbars #f #f 0 0);Start with no scrollbars
; editing area callback. Gets called when enter is pressed.
(define (text-field-callback callback-type other-thing)
(if (equal? 'text-field-enter (send other-thing get-event-type))
(button-do-stuff 'irrelevant 'not-used)
'()))
; creates the editing area as part of the parent "main-frame" define above.
; initially labelled "Username:"
; NOTE: we pad label with additional spaces so we don't have to recompute
; the window dimensions to fit the new label (the actual username)
; TODO make label setable
(define input (new text-field%
[parent main-frame]
[label "username "]
[callback text-field-callback]
))
; It's a callback function activated when the send button is pressed in the
; GUI. It is also called manually when textfield receives an enter key
(define (button-do-stuff b e);b and e do nothing :/
(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)))
(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 )
)
'()))
(send input set-value "")
)
; retrieves a message user inputed to the text field
(define (get-message)
(semaphore-wait messages-s)
(define one-message
(if (not (null? messages))
(begin
;(define msg (car messages))
(car messages)
;(set! messages (cdr messages))
)
'()))
(semaphore-post messages-s)
(if (not (string? one-message))
(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%
[parent main-frame]
[label "Send"]
[callback button-do-stuff]))
; get-dc retrieves the canvas' device context. From racket docs. A dc object
; is a drawing context for drawing graphics and text. It represents output
; devices in a generic way.
; Specifically the line below retrieves our canvas device context object.
(define dc (send read-canvas get-dc))
(send dc set-scale 1 1) ; set scaling config of output display to 1 to 1
; no scalling
(send dc set-text-foreground "black") ; color of text that gets drawn on the
; canvas with "draw-text"
; (send dc set-smoothing 'aligned)
;;messaging stuff
; could convert below to regexes
(define (user-message-parse string-i start)
(define (helper str index)
(if (eq? (string-ref str (+ start index)) #\~) ; regexes would allow us
; to avoid this #\~
(substring str start (+ start index))
(helper str (+ index 1))))
(helper string-i 0))
;; draws a user input to the screen
(define (user-message user-input)
(define username (user-message-parse user-input 0))
(define input (user-message-parse user-input (+ 1 (string-length username))))
(define color (substring user-input (+ 2 (string-length username) (string-length input))))
(send dc set-text-foreground color) ; set dc's text color to user
; provided
; (send dc draw-text (string-append username ":" input) 0 height)
(send dc draw-text input 0 height) ;; just print message to string
(set! listy (appendlist listy (list username input color height)))
(set! height (+ height 15))
; redraw overly long text on gui
(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-i and extracts elements
; actually gets called to send input to the screen. user-message is in effect
; its helper. It uses "~" to delimit the different components of message
(define (send-message input color)
(user-message (string-append name "~" input "~" color)))
;; draws messages to the screen canvas as text
(define (re-draw-message username input color in-height)
(send dc set-text-foreground color)
; (send dc draw-text (string-append username ":" input) 0 in-height)
(send dc draw-text input 0 in-height)
)
; used when redrawing the screen along with its helper.
(define (update given-list)
(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
; for interfacing with outside elements
(define gui-input-in-s '())
(define gui-input-out-s '())
(define gui-input-in '())
(define gui-input-out '())
(define name "Me")
(define min-h-size 80)
(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
;; could randomly assign a user
;; after calling get-text set it as new label of text-field
(define (get-username)
(define returned (get-text-from-user "Username set-up" "Please enter a username"
main-frame "user" (list 'disallow-invalid)
#:validate
(lambda (input)
(if (and (string? input) (<= (string-length input) 10)
(>= (string-length input) 2))
#t
#f))))
(send input set-label returned)
returned)
;;dispatch goes below that
;; TODO get username function maybe
(define (dispatch command)
; 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)
(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 should assume a message and output to screen we do not want it
; to fail
((eq? command 'get-message) get-message)
(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
; listoflist is listy here, and add-to-end is what gets appended to the end
; really expensive operation but its important for Doug to showcase some opl
; concepts
(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)))))
; did user request for color change /
(define (color-change-request? given-string)
(if (> (string-length given-string) 7)
(if (equal? (substring given-string 0 6) "/color")
#t
#f)
#f))
; we should use regexes for this.
(define (get-color-from-input given-string)
(substring given-string 7))
;(define thing1 (make-gui))
;(define thing2 (make-gui))

196
Hermes/Hermes_Gui1.3.rkt
View File

@ -1,196 +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
(provide make-gui)
(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))

2
Hermes/TODO
View File

@ -1,7 +1,7 @@
FEATURES
5. parser in the client side should do something similar (/color, /quit)
16. plain tcp -> ssl based
17. fix breaks for improper disconnects from clients
***17. fix breaks for improper disconnects from clients
18. Add topics after project completion
** regexes to parse strings for different formats -related to 5
** align code better for readability

63
Hermes/client.rkt
View File

@ -1,6 +1,6 @@
#lang racket
(require "modules/general.rkt" "Hermes_Gui1.3.rkt")
(require "modules/general.rkt" "GUI.rkt")
(require math/base) ;; for random number generation
;; TODO clean up string message output and alignment
;; TODO close ports after done
@ -10,13 +10,19 @@
;; notes: output may need to be aligned and formatted nicely
; we will prompt for these in the gui
(define hermes-gui (make-gui)) ;; our gui
((hermes-gui 'show))
;(sleep 0.25)
(define host3 "localhost")
(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 (open-output-file "./hermes_client.conf" #:exists 'append))
(define hermes-conf-s (make-semaphore 1))
(define convs-out (open-output-file "./convs_client.out" #:exists 'append))
@ -37,8 +43,16 @@
; store username to a file for later retrieval along with relevent
; info used for authentication with server
(displayln "What's your name?")
(define username (read-line))
; TODO
; semaphore for gui object
; could display a bubble and prompt for username in GUI object
; create a gui object
; (define hermes-gui (make-gui))
; ((hermes-gui 'show))
;(displayln "What's your name?")
;(define username (read-line))
(define username ((hermes-gui 'get-username)))
;send the username to the server (username in out)
(displayln username out)
@ -59,11 +73,14 @@
(sleep sleep-t)
(loop)))))
(displayln-safe "Now waiting for sender thread." error-out-s error-out)
(thread-wait t) ;; returns prompt back to drracket
; (thread-wait t) ;; returns prompt back to drracket
)
(lambda ()
(displayln-safe "Closing client ports." error-out-s error-out)
(close-input-port in)
(close-output-port out))
(custodian-shutdown-all main-client-cust))
;(close-input-port in)
;(close-output-port out)
(custodian-shutdown-all main-client-cust)))
;; sends a message to the server
@ -78,18 +95,31 @@
(number->string (date-second date-today))
" | "))
;; read, quits when user types in "quit"
(define input (read-line))
;; 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
(cond ((string=? input "quit")
(cond ((string=? input "/quit")
(displayln (string-append date-print username " signing out. See ya!") out)
(flush-output out)
(close-output-port error-out)
(close-output-port convs-out)
;(custodian-shutdown-all main-client-cust)
(exit)))
(displayln (string-append date-print username ": " input) out)
(flush-output out))
; 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)))
; receives input from server and displays it to stdout
(define (receive-messages in)
; retrieve a message from server
@ -101,9 +131,18 @@
;(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)
; 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)]))
(displayln-safe "Starting client." error-out-s error-out)
(define stop-client (client 4321))
;(define stop-client (client 4321))
; we will prompt for these in the gui

1
Hermes/server.rkt
View File

@ -186,6 +186,7 @@
(define list-count (regexp-match #px"(.*)/list\\s+count\\s*" evt-t0)) ;; is client asking for number of logged in users
(define list-users (regexp-match #px"(.*)/list\\s+users\\s*" evt-t0)) ;; user names
; do something whether it was a message, a whisper, request for number of users and so on
; TODO if user doesn't exist handle it********
(cond [whisper
(semaphore-wait connections-s)
; get output port for user