; IR Chat 
(define (go)
  (set! *resdb*
    (dm-open-db "GUIdemo" 1))
  (frm-popup 100 5000 handler))

(define port (buf-get-u32 "ircm" 0))
(define baud 2400)

(define handler
  (let ((ser #f) (msgs ""))
    (define (cleanup)
	(if ser (close-serial ser))
	(set! ser #f))
    (define (redisplay)
	(fld-set-text 5001 msgs))
    (lambda (ev . args)
  (case ev
    ((frm-open) 
	(frm-set-focus 5002)
	(redisplay))
    ((timeout) 
      (if ser
       (let ((r (read (serial-input ser))))
	(if (not (eof-object? r))
	  (begin 
	    (set! msgs (string-append
		msgs "> " r "#0a"))
	    (redisplay)
	    (sound 1000 20))))))
    ((menu) 
      (cleanup)
      (frm-return 'bye))
    ((ctl-select)
      (case (car args)
	((5003) ; connect
	  (set! ser  (open-serial port 
			baud ""8n1n""))
	  (if ser (begin
	    (serial-set-timeout! ser 0)
	    (frm-show 5006 #t)
	    (frm-show 5003 #f)
	    (frm-show 5004 #t))
	    (message
		 "Can't open port.")))
	((5004) ; disconnect
	  (cleanup)
	  (frm-show 5006 #f)
	  (frm-show 5004 #f)
	  (frm-show 5003 #t))
	((5005) ; clear
	  (set! msgs "")
	  (redisplay))
	((5006) ; send
	  (let ((tx (fld-get-text 5002)))
 	    (set! msgs (string-append 
	        msgs tx "#0a"))
	    (fld-set-text 5002 "")
	    (write tx (serial-output ser)) 
	    (redisplay)))))
    ((frm-close) (cleanup))
    (else #f)))))