From 7352d1932e15b6da85774853e6953c0b390fd75b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Mon, 18 Mar 2019 14:57:14 +0100
Subject: Working.

---
 fmt-stack.scm | 55 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 55 insertions(+)
 create mode 100644 fmt-stack.scm

(limited to 'fmt-stack.scm')

diff --git a/fmt-stack.scm b/fmt-stack.scm
new file mode 100644
index 0000000..ced6be3
--- /dev/null
+++ b/fmt-stack.scm
@@ -0,0 +1,55 @@
+(define-module (fmt-stack)
+  #:export (get-attr
+            set-fg set-bg set-style
+            make-fmt-frame empty-fmt-frame
+            fmt-frame->ansi-esc)
+
+  #:use-module (control monad)
+  #:use-module (control monad state)
+
+  #:use-module (data optional)
+
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9 gnu))
+
+(define-immutable-record-type fmt-frame
+  (make-fmt-frame style fg bg)
+  fmt-frame?
+  (style get-style set-style)
+  (fg    get-fg    set-fg)
+  (bg    get-bg    set-bg))
+
+(define (empty-fmt-frame)
+  (make-fmt-frame #f #f #f))
+
+(define (fmt-frame->ansi-esc frame)
+  (string-append
+   "\x1b[m"
+   (case (get-fg frame)
+     ((B) "\x1b[0;34m")
+     ((Y) "\x1b[0;33m")
+     ((C) "\x1b[0;36m")
+     (else ""))
+
+   (case (get-bg frame)
+     ((B) "\x1b[44m")
+     ((Y) "\x1b[43m")
+     ((C) "\x1b[46m")
+     (else ""))
+
+   (case (get-style frame)
+     ((underline) "\x1b[4m")
+     ((italic)    "\x1b[3m")
+     ((bold)      "\x1b[1m")
+     (else ""))))
+
+(define (get-attr)
+  (do stack <- (get)
+      (return-state
+       (fmt-frame->ansi-esc
+        (make-fmt-frame
+         (get-style (find get-style stack))
+         (get-fg    (find get-fg    stack))
+         (get-bg    (find get-bg    stack)))))))
+
+
-- 
cgit v1.2.3