dimitri/fancy
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Implement background colors

Browse source
This commit is contained in:
Dimitri Lozeve 2021-04-28 19:12:53 +02:00
parent 24f6c0552f
commit fef2c991f1
3 changed files with 22 additions and 7 deletions
Download patch file Download diff file Expand all files Collapse all files

BIN
demo.png
View file

Binary file not shown.
Side by side Swipe Overlay

Before

Width:  |  Height:  |  Size: 43 KiB

After

Width:  |  Height:  |  Size: 43 KiB

Before After
Before After

4
demo.ss
View file

@ -16,10 +16,10 @@
(displayln (parse-markup (displayln (parse-markup
"[bold red]Lorem ipsum[/bold red] dolor sit amet, [underline]consectetur[/underline] adipiscing elit, sed do "[bold red]Lorem ipsum[/bold red] dolor sit amet, [underline]consectetur[/underline] adipiscing elit, sed do
eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim ad eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim ad
minim veniam, [cyan]quis nostrud exercitation [bold]ullamco[/bold] laboris[/cyan] nisi ut minim veniam, [cyan]quis nostrud exercitation [yellow]ullamco[/yellow] laboris[/cyan] nisi ut
aliquip ex ea commodo consequat. Duis aute irure dolor in aliquip ex ea commodo consequat. Duis aute irure dolor in
reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla
pariatur. [yellow]Excepteur sint [underline]occaecat[/yellow underline] cupidatat non proident, sunt in pariatur. [black on yellow]Excepteur sint [on red]occaecat[/on red] cupidatat non proident, sunt in
culpa qui officia deserunt mollit anim id est laborum.")) culpa qui officia deserunt mollit anim id est laborum."))
(displayln) (displayln)

25
fancy/format.ss
View file

@ -31,6 +31,15 @@
(magenta . 5) (magenta . 5)
(cyan . 6) (cyan . 6)
(white . 7))) (white . 7)))
(def +basic-bg-colors+
'((on-black . 0)
(on-red . 1)
(on-green . 2)
(on-yellow . 3)
(on-blue . 4)
(on-magenta . 5)
(on-cyan . 6)
(on-white . 7)))
(def (cursor-up (n 1)) (format "~a~dA" +CSI+ n)) (def (cursor-up (n 1)) (format "~a~dA" +CSI+ n))
(def (cursor-down (n 1)) (format "~a~dB" +CSI+ n)) (def (cursor-down (n 1)) (format "~a~dB" +CSI+ n))
@ -59,7 +68,7 @@
(when italic "3") (when italic "3")
(when underline "4") (when underline "4")
(when color (format "3~d" (assgetq color +basic-colors+))) (when color (format "3~d" (assgetq color +basic-colors+)))
(when background (format "4~d" (assgetq background +basic-colors+)))])) (when background (format "4~d" (assgetq background +basic-bg-colors+)))]))
(format "~a~am" +CSI+ (string-join args #\;))) (format "~a~am" +CSI+ (string-join args #\;)))
(def (set-color (col #f)) (def (set-color (col #f))
@ -69,7 +78,8 @@
(def (parse-tag contents (style [])) (def (parse-tag contents (style []))
(def closing (eq? #\/ (string-ref contents 0))) (def closing (eq? #\/ (string-ref contents 0)))
(def tags (map string->symbol (string-split (string-trim-prefix "/" contents) #\ ))) (def clean-contents (string-subst (string-trim-prefix "/" contents) "on " "on-"))
(def tags (map string->symbol (string-split clean-contents #\ )))
(def new-style (if closing (def new-style (if closing
(lset-difference eq? style tags) (lset-difference eq? style tags)
(lset-union eq? style tags))) (lset-union eq? style tags)))
@ -79,9 +89,14 @@
(member 'italic new-style) (member 'italic new-style)
(member 'underline new-style) (member 'underline new-style)
(let ((colors (lset-intersection eq? (let ((colors (lset-intersection eq?
(map car +basic-colors+) new-style
new-style))) (map car +basic-colors+))))
(if (null? colors) #f (car colors))))) (if (null? colors) #f (car colors)))
(let ((bg-colors (lset-intersection
eq?
new-style
(map car +basic-bg-colors+))))
(if (null? bg-colors) #f (car bg-colors)))))
(values control-seq new-style)) (values control-seq new-style))
(def (parse-markup text (style [])) (def (parse-markup text (style []))