[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: Reading characters from input



On Aug  2, David Skoupil wrote:
> I am looking for a quick (and easy) way of reading characters from
> keyboard without waiting for "Return" key, possibly including
> special characters like keyboard arrows.

If you're using Unix then one option you have is to use stty to change
the tty settings, the following piece of code is something I use that
does that.

(define (printff . args)
  (apply printf args) (flush-output))

(define (get-process-output-line exe . args)
  (let ((p (apply process*/ports #f (current-input-port) (current-error-port)
                  exe args)))
    (begin0 (read-line (car p))
      (close-input-port (car p)))))

(define (find-exe exe) (find-executable-path exe exe))
(define tty-exe  (find-exe "tty"))
(define stty-exe (find-exe "stty"))

(define yes/no?
  (if (system* tty-exe "-s")
    ;; tty -> interactive version using raw mode
    (let ((tty-settings (get-process-output-line stty-exe "-g")))
      (lambda (str . args)
        (parameterize ((current-output-port (current-error-port)))
          (printff "~a [Y/N] <?>~a~a"
                   (apply format str args) #\backspace #\backspace)
          (dynamic-wind
            (lambda () (system* stty-exe "-icanon" "-echo" "min" "1"))
            (lambda ()
              (let loop ()
                (let ((ch (char-downcase (read-char))))
                  (if (memq ch '(#\y #\n))
                    (begin (write-char ch) (flush-output) (eq? ch #\y))
                    (loop)))))
            (lambda () (system* stty-exe tty-settings) (newline))))))
    ;; not a tty -> simple version
    (lambda (str . args)
      (parameterize ((current-output-port (current-error-port)))
        (let ((msg (apply format str args)))
          (let loop ((inp #f))
            (case inp
              ((#\y) #t)
              ((#\n) #f)
              (else
               (printff "~a [Yes/No] " msg)
               (loop
                (cond ((regexp-match (format "[^ ~a]" #\tab) (read-line))
                       => (lambda (x) (char-downcase (string-ref (car x) 0))))
                      (else #f)))))))))))

-- 
          ((lambda (x) (x x)) (lambda (x) (x x)))          Eli Barzilay:
                  http://www.barzilay.org/                 Maze is Life!