Add a bunch of terminal control modules.

3 files changed, 69 insertions, 0 deletions

diff --git a/terminal/escape.scm b/terminal/escape.scm
new file mode 100644
index 00000000..8f1b0c2b
--- /dev/null
+++ b/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/terminal/termios.scm b/terminal/termios.scm
new file mode 100644
index 00000000..b0ae585e
--- /dev/null
+++ b/terminal/termios.scm
@@ -0,0 +1,11 @@
+;;; 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" (dirname (dirname (current-filename))))
+(load-extension "libtermios" "init_termios")
diff --git a/terminal/util.scm b/terminal/util.scm
new file mode 100644
index 00000000..5b454769
--- /dev/null
+++ b/terminal/util.scm
@@ -0,0 +1,30 @@
+(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))))
+    (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))))))