Split out call to ground-vm from definition of main

This commit is contained in:
Tony Garnock-Jones 2012-01-13 16:48:43 -05:00
parent 66f74dbe63
commit a4eb28f5c5
1 changed files with 36 additions and 34 deletions

View File

@ -37,37 +37,39 @@
(send-message `(tick ,counter ,now))
(loop now (+ counter 1)))]))))
(ground-vm
(os-big-bang 'none
(subscribe 'display-driver display-driver-handler)
(subscribe 'read-line-driver read-line-driver-handler)
(tick-driver 'ticker 1000)
(send-message `(display "Hello! "))
(send-message 'greet-loop)
(subscribe 'greet-loop-handler
(message-handlers w
['greet-loop
(transition w
(send-message `(display "Enter your name:\n"))
(send-message `(request read-name read-line)))]))
(subscribe 'ticker-handler
(message-handlers w
[`(tick ,counter ,_)
(transition w
(send-message
`(display ,(string-append "TICK "
(number->string counter)
"\n"))))]))
(subscribe 'read-line-result-handler
(message-handlers w
[`(reply read-name ,(== eof))
(transition w
(send-message `(display "Goodbye!\n")))]
[`(reply read-name ,name)
(transition w
(send-message `(display "Hello, "))
(send-message `(display ,name))
(send-message `(display "!\n"))
(unsubscribe 'ticker)
(send-message 'greet-loop)
)]))))
(define main
(os-big-bang 'none
(subscribe 'display-driver display-driver-handler)
(subscribe 'read-line-driver read-line-driver-handler)
(tick-driver 'ticker 1000)
(send-message `(display "Hello! "))
(send-message 'greet-loop)
(subscribe 'greet-loop-handler
(message-handlers w
['greet-loop
(transition w
(send-message `(display "Enter your name:\n"))
(send-message `(request read-name read-line)))]))
(subscribe 'ticker-handler
(message-handlers w
[`(tick ,counter ,_)
(transition w
(send-message
`(display ,(string-append "TICK "
(number->string counter)
"\n"))))]))
(subscribe 'read-line-result-handler
(message-handlers w
[`(reply read-name ,(== eof))
(transition w
(send-message `(display "Goodbye!\n")))]
[`(reply read-name ,name)
(transition w
(send-message `(display "Hello, "))
(send-message `(display ,name))
(send-message `(display "!\n"))
(unsubscribe 'ticker)
(send-message 'greet-loop)
)]))))
(ground-vm main)