From d46183860c1f3f10095e95023adcb79b1896ab0e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Fri, 22 Mar 2019 20:11:11 +0100
Subject: Move C and Scheme code into subdirs.

---
 module/terminal/escape.scm  | 28 ++++++++++++++++++++++++++++
 module/terminal/termios.scm | 13 +++++++++++++
 module/terminal/util.scm    | 37 +++++++++++++++++++++++++++++++++++++
 3 files changed, 78 insertions(+)
 create mode 100644 module/terminal/escape.scm
 create mode 100644 module/terminal/termios.scm
 create mode 100644 module/terminal/util.scm

(limited to 'module/terminal')

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))))))
+
-- 
cgit v1.2.3