From dda8b325b562d957250c05a26a702f4536d5601e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Tue, 2 Aug 2022 20:19:42 +0200
Subject: Add handling of graphical chars.

---
 fmt-stack.scm | 44 ++++++++++++++++++++++++++++++++++----------
 1 file changed, 34 insertions(+), 10 deletions(-)

(limited to 'fmt-stack.scm')

diff --git a/fmt-stack.scm b/fmt-stack.scm
index e1aaca4..11c3cdd 100644
--- a/fmt-stack.scm
+++ b/fmt-stack.scm
@@ -1,7 +1,9 @@
 (define-module (fmt-stack)
   #:export (get-attr
             set-fg set-bg set-style
+            get-bg get-fg get-style
             make-fmt-frame empty-fmt-frame
+            get-frame
             fmt-frame->ansi-esc)
 
   #:use-module (monad)
@@ -20,19 +22,38 @@
 (define (empty-fmt-frame)
   (make-fmt-frame #f #f #f))
 
+;; B - blue
+;; BL - black
+;; C - cyan
+;; G - green
+;; M - magenta
+;; R - red
+;; W - white
+;; Y - yellow
+
 (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")
+     ((BL) "\x1b[0;30m")
+     ((C) "\x1b[0;96m")
+     ((G) "\x1b[0;32m")
+     ((M) "\x1b[0;35m")
+     ((R) "\x1b[0;31m")
+     ((W) "\x1b[0;97m")
+     ((Y) "\x1b[0;93m")
      (else ""))
 
    (case (get-bg frame)
      ((B) "\x1b[44m")
-     ((Y) "\x1b[43m")
-     ((C) "\x1b[46m")
+     ((BL) "\x1b[40m")
+     ((C) "\x1b[106m")
+     ((G) "\x1b[42m")
+     ((M) "\x1b[45m")
+     ((R) "\x1b[41m")
+     ((W) "\x1b[107m")
+     ((Y) "\x1b[103m")
      (else ""))
 
    (case (get-style frame)
@@ -41,13 +62,16 @@
      ((bold)      "\x1b[1m")
      (else ""))))
 
-(define (get-attr)
+(define (get-frame)
   (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)))))))
+       (make-fmt-frame
+        (get-style (find get-style stack))
+        (get-fg    (find get-fg    stack))
+        (get-bg    (find get-bg    stack))))
+      ))
+
+(define (get-attr)
+  (<$> fmt-frame->ansi-esc (get-frame)))
 
 
-- 
cgit v1.2.3