;; (interact* task [input-filter output-filter]) ;; (define (interact* task . args) (let-optionals args ((input-filter (lambda (k x) x)) (output-filter (lambda (k x) x))) (let ((ivec (make-vector 2)) (ivec0 (current-input-port)) (ivec1 (task:in task)) (out0 (current-output-port)) (out1 (task:out task))) (call-with-current-continuation (lambda (k) (with-errno-handler ((e p) ((errno/io) #f)) ;; TODO: eof in input/output (let lp () (vector-set! ivec 0 ivec0) (vector-set! ivec 1 ivec1) (select! ivec '#() '#()) (if (char-ready? ivec0) (let ((str (input-filter k (read-string/partial 256 ivec0)))) (if str (write-string str out1)))) (if (char-ready? ivec1) (let ((str (output-filter k (read-string/partial 256 ivec1)))) (if str (write-string str out0)))) (lp)))))))) (define (interact/char* task . args) (let-optionals args ((input-filter #f) (output-filter #f)) (interact* task (lambda (k str) (if input-filter ;; TODO: does this preserve correct order? (let ((chars (filter (lambda (c) (input-filter k c)) (string->list str)))) (list->string chars)) str)) (lambda (k str) (if output-filter (let ((chars (filter (lambda (c) (output-filter k c)) (string->list str)))) (list->string chars)) str))))) ;; syntax ;;;; Allow user to interact with program (sometimes there's just no other way) ;;;; (interact task) simply switches the user into interact mode with the task. ;;;; ;;;; (interact task clause ...) filters the input. The clause can either be a ;;;; character clause (character continuation-variable exp ...) or a filter ;;;; clause (filter proc). A character clause matches the character given, ;;;; links the continuation variable to the continuation out of the ;;;; interaction, and runs the expressions. A filter clause runs the given ;;;; filter-function with two arguments: the character entered and the ;;;; continuation out of the interaction. In both cases, if the filter returns ;;;; true, the expression falls through. If the expression falls through to ;;;; the bottom, the character is printed. Note that the interaction will ;;;; continue anyway, unless the continuation was explicitly called. (define-syntax interact-input-clauses (syntax-rules (filter eof) ((interact-input-clauses break char) #t) ((interact-input-clauses break char (eof k body ...) clause2 ...) (if (eof-object? char) (let ((k break)) (begin body ...)) (interact-input-clauses break char clause2 ...))) ((interact-input-clauses break char (test-char k body ...) clause2 ...) (if (eq? char test-char) (let ((k break)) (begin body ...)) (interact-input-clauses break char clause2 ...))) ((interact-input-clauses break char (filter proc) clause2 ...) (and (filter break char) (interact-input-clauses break char clause2 ...))))) (define-syntax interact-output-clauses (syntax-rules (filter eof) ((interact-output-clauses break char) #t) ((interact-output-clauses break char clause ...) #t))) (define-syntax interact (syntax-rules () ((interact task) (interact* task)) ((interact task clause ...) (interact/char* task (lambda (k c) (interact-input-clauses k c clause ...)) (lambda (k c) (interact-output-clauses k c clause ...))))))