#lang racket/base
;; Trivial demonstration of an os-big-bang style virtual machine.
;; Engages in various I/O and timer operations.

(require racket/match)
(require racket/port)
(require "os-big-bang.rkt")

(define display-driver-handler
  (message-handlers w
   [`(display ,message)
    (transition w (send-meta-message (lambda ()
				       (display message)
				       (flush-output))))]))

(define read-line-driver-handler
  (message-handlers w
   [`(request ,reply-addr read-line)
    (transition w
      (subscribe/fresh sid
	(ground-message-handler w
	  [((list 'read-line reply-addr)
	    (read-line-evt (current-input-port) 'any)
	    => l)
	   (transition w
	     (unsubscribe sid)
	     (send-message `(reply ,reply-addr ,l)))])))]))

;; This should be part of racket
(define (time-evt msecs)
  (wrap-evt (alarm-evt msecs) (lambda (_) (current-inexact-milliseconds))))

(define (tick-driver self-sid interval)
  (let loop ((last-tick-time 0) (counter 0))
    (define next-time (+ last-tick-time interval))
    (subscribe self-sid
      (ground-message-handler w
	[((list 'timer-alarm next-time)
	  (time-evt next-time)
	  => now)
	 (transition w
	   (unsubscribe self-sid)
	   (send-message `(tick ,counter ,now))
	   (loop now (+ counter 1)))]))))

(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)