Basic input and output now can be done through gui
This commit is contained in:
parent
a1798d9e3d
commit
ed5d1d7571
@ -13,6 +13,11 @@
|
|||||||
|
|
||||||
(provide make-gui)
|
(provide make-gui)
|
||||||
|
|
||||||
|
; store input into a message list
|
||||||
|
; will create closure later
|
||||||
|
(define messages '())
|
||||||
|
|
||||||
|
; (define-values (gui-in gui-out) (make-pipe #f))
|
||||||
(define (make-gui)
|
(define (make-gui)
|
||||||
;;Create the frame/window with title "Example5", width 500 and height 700
|
;;Create the frame/window with title "Example5", width 500 and height 700
|
||||||
(define main-frame (new frame%
|
(define main-frame (new frame%
|
||||||
@ -68,11 +73,28 @@
|
|||||||
(if (color-change-request? (send input get-value))
|
(if (color-change-request? (send input get-value))
|
||||||
(set! my-color (get-color-from-input (send input get-value)))
|
(set! my-color (get-color-from-input (send input get-value)))
|
||||||
(if (< 0 (string-length (send input get-value)))
|
(if (< 0 (string-length (send input get-value)))
|
||||||
(send-message (send input get-value) my-color);;
|
(begin
|
||||||
|
; (send-message (send input get-value) my-color);;
|
||||||
|
(set! messages (append messages (list (send input get-value))))
|
||||||
|
; (open-input-string )
|
||||||
|
)
|
||||||
'()))
|
'()))
|
||||||
(send input set-value "")
|
(send input set-value "")
|
||||||
)
|
)
|
||||||
|
|
||||||
|
(define (get-message)
|
||||||
|
(define one-message
|
||||||
|
(if (not (null? messages))
|
||||||
|
(begin
|
||||||
|
;(define msg (car messages))
|
||||||
|
(car messages)
|
||||||
|
;(set! messages (cdr messages))
|
||||||
|
)
|
||||||
|
'()))
|
||||||
|
(if (not (string? one-message))
|
||||||
|
(get-message)
|
||||||
|
(begin (set! messages (cdr messages))
|
||||||
|
one-message)))
|
||||||
; creates the send button
|
; creates the send button
|
||||||
(define send-button (new button%
|
(define send-button (new button%
|
||||||
[parent main-frame]
|
[parent main-frame]
|
||||||
@ -99,6 +121,7 @@
|
|||||||
(substring str start (+ start index))
|
(substring str start (+ start index))
|
||||||
(helper str (+ index 1))))
|
(helper str (+ index 1))))
|
||||||
(helper string-i 0))
|
(helper string-i 0))
|
||||||
|
|
||||||
|
|
||||||
;; draws a user input to the screen
|
;; draws a user input to the screen
|
||||||
(define (user-message user-input)
|
(define (user-message user-input)
|
||||||
@ -181,6 +204,7 @@
|
|||||||
;;Something up with that
|
;;Something up with that
|
||||||
; else should assume a message and output to screen we do not want it
|
; else should assume a message and output to screen we do not want it
|
||||||
; to fail
|
; to fail
|
||||||
|
((eq? command 'get-message) get-message)
|
||||||
(else (error "Invalid Request" command))
|
(else (error "Invalid Request" command))
|
||||||
))
|
))
|
||||||
;;dispatch goes below that
|
;;dispatch goes below that
|
||||||
|
@ -12,7 +12,7 @@
|
|||||||
|
|
||||||
(define hermes-gui (make-gui)) ;; our gui
|
(define hermes-gui (make-gui)) ;; our gui
|
||||||
((hermes-gui 'show))
|
((hermes-gui 'show))
|
||||||
(sleep 0.25)
|
;(sleep 0.25)
|
||||||
|
|
||||||
|
|
||||||
(define host3 "localhost")
|
(define host3 "localhost")
|
||||||
@ -20,7 +20,7 @@
|
|||||||
(define sleep-t 0.1)
|
(define sleep-t 0.1)
|
||||||
|
|
||||||
; we won't need this. Just me being overzealous
|
; 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 hermes-conf-s (make-semaphore 1))
|
||||||
|
|
||||||
(define convs-out (open-output-file "./convs_client.out" #:exists 'append))
|
(define convs-out (open-output-file "./convs_client.out" #:exists 'append))
|
||||||
@ -93,7 +93,8 @@
|
|||||||
" | "))
|
" | "))
|
||||||
;; read, quits when user types in "quit"
|
;; read, quits when user types in "quit"
|
||||||
;; TODO read from GUI instead
|
;; TODO read from GUI instead
|
||||||
(define input (read-line))
|
;(define input (read-line))
|
||||||
|
(define input ((hermes-gui 'get-message)))
|
||||||
; TODO /quit instead of quit
|
; TODO /quit instead of quit
|
||||||
(cond ((string=? input "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)
|
||||||
|
@ -186,7 +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-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
|
(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
|
; 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
|
; TODO if user doesn't exist handle it********
|
||||||
(cond [whisper
|
(cond [whisper
|
||||||
(semaphore-wait connections-s)
|
(semaphore-wait connections-s)
|
||||||
; get output port for user
|
; get output port for user
|
||||||
|
Loading…
Reference in New Issue
Block a user