Skip to content

Instantly share code, notes, and snippets.

Last active August 11, 2022 18:13
Show Gist options
  • Save clartaq/d7ff89a3fa150e1b281e8b83e8489a8b to your computer and use it in GitHub Desktop.
Save clartaq/d7ff89a3fa150e1b281e8b83e8489a8b to your computer and use it in GitHub Desktop.
Raw Terminal Input in Chez Scheme
;; This is a demonstration program using some of the Chez Scheme FFI
;; to put the terminal into "raw" mode, read a line of characters,
;; possibly containing control characters that would normally
;; terminate input, without echoing the characters typed. Once the
;; user presses the line termination character, (user defined, see the
;; `quit?` procedure), the program displays the line.
;; The program shows how to obtain character-by-character input with
;; immediate examination of each character. Such a procedure is useful
;; when writing things like text editors where you want the program to
;; respond immediately to keyboard commands without waiting for the
;; entire line to be entered.
;; Procedures for convenient printing.
;; Return #t if the character is an ASCII control character, false
;; otherwise.
(define (char-control? c)
(let ((char-num (char->integer c)))
(or (= char-num 127)
(< char-num 32))))
;; If c is a control character, it is converted into a two-character
;; string that indicates its special status by preceding it with a
;; "^".
(define (char->readable c)
(if (char-control? c)
(string #\^ (integer->char (+ 64 (char->integer c))))
(string c)))
;; Return a transform of the input string with embedded control chars
;; converted to human-readable form showing a "^" prepended to it.
(define (string->readable s)
(let loop ((lst (string->list s))
(acc ""))
(if (null? lst)
(loop (cdr lst) (string-append acc (char->readable (car lst)))))))
;; Display a series of arguments followed by a newline.
(define (println . args)
(for-each display args)
;; When in raw mode, lines need to be ended with CR/LF pairs to act
;; like normal printing.
(define (println-in-raw . args)
(for-each display args)
(display (string #\return #\newline)))
;; Foreign fuction stuff. Assure we have access to the needed
;; functions from the C runtime and import them.
;; Load the C runtime on macOS. Other OSs will require something
;; different.
(load-shared-object "libc.dylib")
;; Assure that we have access to all of the functions we require.
(if (and (foreign-entry? "isatty")
(foreign-entry? "tcgetattr")
(foreign-entry? "tcsetattr")
(foreign-entry? "cfmakeraw"))
(println "We have access to needed functions from the C standard library.")
(println "Can't find needed functions in the C standard library"))
(if (and (foreign-entry? "(cs)s_errno")
(foreign-entry? "(cs)s_strerror"))
(println "We have access to needed functions from the Chez C runtime.")
(println "Can't find needed functions in the Chez C runtime.")
(exit 1)))
;; termios-related stuff.
;; Explanation of `termios` and `cfmakeraw`. This is from the
;; `cfmakeraw(3)` Linux man page. Descriptions reflect the result of
;; related flags settings.
;; termios_p->c_iflag &= ~(IGNBRK | // Do not ignore a BREAK
;; BRKINT | // BREAK will produce a null byte
;; PARMRK | // Ignore parity errors
;; ISTRIP | // Do not strip the eigth bit
;; INCLCR | // Do not translate NL to CR on input
;; IGNCR | // Do not ignore carriage return on input
;; ICRNL | // Do not translate a carriage return to newline
;; IXON ); // Disable XON/XOFF flow control on output
;; termios_p->c_oflag &= ~OPOST; // Disable implementation-defined output processing
;; termios_p->c_lflag &= ~(ECHO | // Do not echo characters
;; ECHONL | // Do not echo newline characters
;; ICANON | // Disable canonical mode ("cooked") processing
;; ISIG | // Do not generate INTR, QUIT, SUSP or DSUSP signals
;; IEXTEN ); // Disable implemenation-defined input processing
;; termios_p->c_cflag &= ~(CSIZE | // No character size mask
;; PARENB ); // Turn off parity generation
;; termios_p->c_cflag |= CS8; // 8-bit characters
;; NOTE: The use of 8-bit characters makes this a bit incompatible with the `read-char`
;; procedure, which works with UTF-8 characters. Needs more work.
;; The following definitions and structure are from the file
;; /Library/Developer/CommandLineTools/SDKs/MacOSX10.15.sdk/System/Library/Frameworks/Kernel.framework/Headers/sys/termios.h
;; on an iMac.
;; #define NCCS 20
;; typedef unsigned long tcflag_t;
;; typedef unsigned char cc_t;
;; typedef unsigned long speed_t;
(define NCCS 20)
(define-ftype termios
[c_iflag unsigned-long] ; input flags
[c_oflag unsigned-long] ; output flags
[c_cflag unsigned-long] ; control flags
[c_lflag unsigned-long] ; local flags
;; It seems like Chez will not let me use the defined constant
;; NCCS above for the size of the array. Gotta use the literal 20.
[c_cc (array 20 char)] ; special control chars
[c_ispeed unsigned-long] ; input speed
[c_ospeed unsigned-long] ; output speed
;; Give ourselves access to a bunch of foreign function interfaces.
;; int isatty(int fildes); Returns 1 if the file descriptor represents
;; a terminal, 0 otherwise.
(define isatty (foreign-procedure "isatty" (int) int))
;; int tcgetattr(int fd, struct termios *termios_p); Copy the current
;; attributes into the buffer (termios struct) pointed to. Returns 0
;; on success, -1 on failure in which case errno will contain the
;; error code.
(define tcgetattr (foreign-procedure "tcgetattr" (int (* termios)) int))
;; int tcsetattr(inf fd, int optional_atcions, const struct termios
;; *termios_p); Copy the buffer (termios struct) pointed to into the
;; terminal associated the the integer file descriptor. Returns 0 on
;; success, -1 on failure code is copied into errno.
(define tcsetattr (foreign-procedure "tcsetattr" (int int (* termios)) int))
;; void cfmakeraw(struct termios *termio_p);
(define cfmakeraw (foreign-procedure "cfmakeraw" ((* termios)) void))
;; Don't actually use these anymore. Left them here as a reminder
;; about using the "(cs)" calling scheme to reference functions in the
;; Chez Scheme run time.
(define errno (foreign-procedure "(cs)s_errno" () int))
(define strerror (foreign-procedure "(cs)s_strerror" (int) scheme-object))
;; Define some file descriptors for stdin/out. Couldn't find this
;; documented anywhere. These values are from Chez expediter.c.
(define STDIN_FD 0)
(define STDOUT_FD 1)
(if (= 1 (isatty STDIN_FD))
(println "We have a terminal.")
(println "Output is not a terminal."))
;; Allocate a buffer large enough to hold a termios struct and return
;; a pointer to it. Don't forget to release it manually when finished
;; with it.
(define (alloc-termios-buf)
(make-ftype-pointer termios
(foreign-alloc (ftype-sizeof termios))))
;; Reading lines from a terminal.
;; Return #t if a program terminating condition is observed; #f
;; otherwise.
(define (quit? c)
(if (or (eof-object? c)
(char=? c #\q)
(char=? c #\newline)
(char=? c #\return))
(println "Finished because c = " (char->readable c))
;; Read a line of characters from the terminal. Since we assume raw
;; mode, there is no echo. Return a string composed of the typed
;; characters. This procedure is not much different from the standard
;; `get-line` procedure in R5Rs, but examines individual characters
;; for special actions that can be activated in raw mode.
(define (inner-read-line)
(let loop ((acc "")
(c (read-char)))
(if (quit? c)
(loop (string-append acc (string c)) (read-char)))))
;; Return a pointer to a termios structure for the given file
;; descriptor. Assumes the device is already set up in cooked mode.
(define (cooked-termios fd)
(let ((my-termios (alloc-termios-buf)))
(tcgetattr fd my-termios)
;; Return a pointer to a termios structure for the given file
;; descriptor. Assumes the device is already set up in cooked mode and
;; creates a version of the termios structure initialized to set it up
;; in raw mode.
(define (raw-termios fd)
(let ((my-termios (cooked-termios fd)))
(cfmakeraw my-termios)
;; Arguments passed to tcsetattr() describing how to switch to the new
;; termios settings. From termios.h.
(define TCSA 0) ; Make change immediately.
(define TCSADRAIN 1) ; Drain output, then change.
(define TCSAFLUSH 2) ; Drain output, flush input.
;; Read a line from the standard input in raw mode and return it. The
;; existing terminal attributes are read and restored before exiting.
(define (read-raw-line)
(let* ((cooked-attrs (cooked-termios STDIN_FD))
(raw-attrs (raw-termios STDIN_FD))
(get-raw! (lambda ()
(tcsetattr STDIN_FD TCSAFLUSH raw-attrs)))
(get-cooked! (lambda ()
(tcsetattr STDIN_FD TCSAFLUSH cooked-attrs)
;; Don't forget to handle foreign memory.
(foreign-free (ftype-pointer-address cooked-attrs))
(foreign-free (ftype-pointer-address raw-attrs))))
(a-line (dynamic-wind
(println "Enter an invisible line of text:")
(println-in-raw "\rResult of reading line in raw mode: "
(string->readable (read-raw-line)))
Copy link

clartaq commented Aug 10, 2022

2022-08-10: Update with simplifications.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment