diff options
author | Hugo Hörnquist <hugo@lysator.liu.se> | 2019-03-22 20:11:11 +0100 |
---|---|---|
committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2019-03-22 20:17:52 +0100 |
commit | d46183860c1f3f10095e95023adcb79b1896ab0e (patch) | |
tree | dd331a0efe9777bfe84160139da1e39df3226b71 /module/terminal | |
parent | Add stuff to test.scm. (diff) | |
download | calp-d46183860c1f3f10095e95023adcb79b1896ab0e.tar.gz calp-d46183860c1f3f10095e95023adcb79b1896ab0e.tar.xz |
Move C and Scheme code into subdirs.
Diffstat (limited to 'module/terminal')
-rw-r--r-- | module/terminal/escape.scm | 28 | ||||
-rw-r--r-- | module/terminal/termios.scm | 13 | ||||
-rw-r--r-- | module/terminal/util.scm | 37 |
3 files changed, 78 insertions, 0 deletions
diff --git a/module/terminal/escape.scm b/module/terminal/escape.scm new file mode 100644 index 00000000..8f1b0c2b --- /dev/null +++ b/module/terminal/escape.scm @@ -0,0 +1,28 @@ +;;; Module for terminal (ANSI) escape codes. + +(define-module (terminal escape) + #:use-module (srfi srfi-60) + #:use-module (terminal termios) + #:export (with-vulgar)) + +(define-public (cls) + (display "\x1b[H") ; Move cursor to the origin + (display "\x1b[J") ; Clear everything after cursor + ) + +;;; I don't curse, I'm just vulgar. + +(define-syntax with-vulgar + (syntax-rules () + ((_ thunk) + (let ((ifd (fileno (current-input-port))) + (ofd (fileno (current-output-port)))) + (dynamic-wind + (lambda () + (let ((bits (bitwise-ior ECHO ICANON))) + (c-lflags-disable! ifd bits) + (c-lflags-disable! ofd bits))) + thunk + (lambda () + (c-lflag-restore! ifd) + (c-lflag-restore! ofd)))) ))) diff --git a/module/terminal/termios.scm b/module/terminal/termios.scm new file mode 100644 index 00000000..50683f84 --- /dev/null +++ b/module/terminal/termios.scm @@ -0,0 +1,13 @@ +;;; Module for termios interaction from Guile, +;;; Since that for some reason isn't built in. + +(define-module (terminal termios) + #:export (c-lflags-disable! c-lflag-restore!)) + +(define-public ECHO #x0000010) +(define-public ICANON #x0000002) + +(setenv "LD_LIBRARY_PATH" + (string-append (dirname (dirname (dirname (current-filename)))) + "/lib")) +(load-extension "libtermios" "init_termios") diff --git a/module/terminal/util.scm b/module/terminal/util.scm new file mode 100644 index 00000000..a7435ad8 --- /dev/null +++ b/module/terminal/util.scm @@ -0,0 +1,37 @@ +(define-module (terminal util) + #:use-module (srfi srfi-19) + #:use-module (srfi srfi-60) + #:export (line ctrl color-escape)) + +(define* (line #:optional (width 64)) + (display (make-string width #\_)) + (newline)) + +(define (ctrl char) + (integer->char (bitwise-and #b00011111 (char->integer char)))) + +(define-public (display-calendar-header! date) + (let* ((day (number->string (date-day date))) + (month (number->string (date-month date))) + (year (number->string (date-year date)))) + ;; BSD cal only supports setting highlighted day explicitly for + ;; testing the functionality. This seems to at least give me + ;; an (almost) working display, albeit ugly. + (if (file-exists? "/usr/bin/ncal") + (system* "ncal" "-3" "-H" (format #f "~a-~a-~a" + year month day) + month year) + (system* "cal" "-3" day month year)))) + +(define (color-escape n) + (cond ((not n) "") + ((char=? #\# (string-ref n 0)) + (let* ((str (string-drop n 1)) + (rs (substring str 0 2)) + (gs (substring str 2 4)) + (bs (substring str 4 6))) + (format #f "\x1b[38;2;~a;~a;~am" + (string->number rs 16) + (string->number gs 16) + (string->number bs 16)))))) + |