2013-05-14 16:38:59 +00:00
|
|
|
#lang marketplace
|
|
|
|
|
|
|
|
(require racket/port)
|
|
|
|
|
|
|
|
;; Usually it's OK to just use display and friends directly.
|
|
|
|
;; Here we have a console output driver just to show how it's done.
|
2013-06-03 18:57:42 +00:00
|
|
|
(name-process 'console-output-driver
|
|
|
|
(spawn (transition/no-state
|
2013-06-07 21:46:20 +00:00
|
|
|
(subscriber (list 'console-output ?)
|
2013-06-03 18:57:42 +00:00
|
|
|
(on-message [(list 'console-output item)
|
|
|
|
(printf "~a" item)
|
|
|
|
(void)])))))
|
2013-05-14 16:38:59 +00:00
|
|
|
|
2013-06-03 18:57:42 +00:00
|
|
|
(name-process 'console-input-driver
|
|
|
|
(spawn (transition/no-state
|
|
|
|
(name-endpoint 'input-relay
|
2013-06-07 21:46:20 +00:00
|
|
|
(publisher (list 'console-input ?)
|
2013-06-03 18:57:42 +00:00
|
|
|
(on-absence
|
|
|
|
(send-message (list 'console-output "Connection terminated.\n"))
|
|
|
|
(quit))))
|
2013-06-07 21:46:20 +00:00
|
|
|
(subscriber (cons (read-line-evt (current-input-port) 'any) ?)
|
2013-06-03 18:57:42 +00:00
|
|
|
(on-message
|
|
|
|
[(cons _ (? eof-object?))
|
|
|
|
(send-message (list 'console-output "Terminating on local EOF.\n"))
|
|
|
|
(delete-endpoint 'input-relay)]
|
|
|
|
[(cons _ (? string? line))
|
|
|
|
(send-message (list 'console-input line))])))))
|
2013-05-14 16:38:59 +00:00
|
|
|
|
2013-06-03 18:57:42 +00:00
|
|
|
(name-process 'outbound-connection
|
|
|
|
(spawn (let ((local (tcp-handle 'outbound))
|
|
|
|
(remote (tcp-address "localhost" 5999)))
|
|
|
|
(transition/no-state
|
2013-06-07 21:46:20 +00:00
|
|
|
(subscriber (list 'console-input ?)
|
2013-06-03 18:57:42 +00:00
|
|
|
(on-absence (quit))
|
|
|
|
(on-message
|
|
|
|
[(list 'console-input line)
|
|
|
|
(send-message (list 'console-output (format "> ~a \n" line)))
|
|
|
|
(send-message (tcp-channel local remote (string-append line "\n")))]))
|
2013-06-07 21:46:20 +00:00
|
|
|
(publisher (tcp-channel local remote ?))
|
|
|
|
(subscriber (tcp-channel remote local ?)
|
2013-06-03 18:57:42 +00:00
|
|
|
(on-absence (quit))
|
|
|
|
(on-message
|
|
|
|
[(tcp-channel _ _ (? eof-object?))
|
|
|
|
(quit)]
|
|
|
|
[(tcp-channel _ _ data)
|
|
|
|
(send-message (list 'console-output (format "< ~a" data)))]))))))
|