#lang scheme/base

(require
 "../tools.ss"
 "../tools/lazy-connect.ss"
 "../scat.ss"
 scheme/system)

(provide (all-defined-out))

(define current-console (make-parameter #f))

(define (with-console go [io (current-console)])
  (if io (with-io-device io go) (go)))

(define (scat-console fn . a)
  (apply with-console (lambda () (void (fn (state:stack)))) a))


;; TARGET I/O PORT UTILITIES

;; - target I/O port accessed through a parameter
;; - opened lazily
;; - close protected through dynamic wind

;; 'open' is a thunk that provides an opened port. If it's false,
;; the port is opened.


;; Construction

(define-struct io-port (in out))

(define (lazy-io-port portspec)
  (lambda ()
    (apply open-io-port portspec)))

(define (open-io-port name baud)
  (let-values
      (((i o)
        (open-input-output-file name #:exists 'append)))
    (file-stream-buffer-mode o 'none)
    (stty name baud)
    (make-io-port i o)))



(define stty
  (let ((fmt #f)
        (fmts
         '(("Linux"         . "stty -F ~a ~a raw min 1 -echo")
           ("CYGWIN_NT-5.1" . "stty -F ~a ~a min 1 -echo ixon -icanon pass8")
           ("windows"       . "mode ~a: baud=~a parity=n data=8 stop=1 xon=off dtr=off rts=off"))))
    (lambda (name baud)
      (unless fmt
        ;; Fixme: do autodetect using 'uname' or something..
        (set! fmt (cdr (assoc "Linux" fmts))))
      (system (format fmt name baud)))))


;; Destruction

(define (close-io-port io)
  (close-input-port (io-port-in io))
  (close-output-port (io-port-out io)))


;; Port access valid in 'with-lazy-connect' context.

(define (i-port) (io-port-in  (lazy-connection)))
(define (o-port) (io-port-out (lazy-connection)))

(define (with-io-device portspec thunk)
  (with-lazy-connect
   (lazy-io-port portspec)
   thunk
   close-io-port))