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

Initial commit

Browse source
This commit is contained in:
Dimitri Lozeve 2021-11-21 22:13:35 +01:00
commit 51f5e862a3
8 changed files with 467 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

7
.gitignore vendored Normal file
View file

@ -0,0 +1,7 @@
*\~
*.so
*.link
*.static.o
*.import.scm
*.build.sh
*.install.sh

21
LICENSE Normal file
View file

@ -0,0 +1,21 @@
MIT License
Copyright (c) 2021 Dimitri Lozeve
Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in all
copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
SOFTWARE.

18
README.org Normal file
View file

@ -0,0 +1,18 @@
* Fancy
Fancy pretty-printing utilities for [[http://call-cc.org/][CHICKEN Scheme]].
#+ATTR_HTML: :width 100% :style margin-left: auto; margin-right: auto;
[[./demo.png]]
** Features
- [[https://en.wikipedia.org/wiki/ANSI_escape_code#CSI_(Control_Sequence_Introducer)_sequences][ANSI control codes]] for styling and cursor movement
- Table formatting with [[https://unicode-table.com/en/blocks/box-drawing/][Unicode box drawing characters]]
- Horizontal rules
- Spinners
** References
- [[https://notes.burke.libbey.me/ansi-escape-codes/][Everything you never wanted to know about ANSI escape codes]]
- [[https://github.com/willmcgugan/rich][Rich]] for Python, especially for their [[https://rich.readthedocs.io/en/latest/markup.html][console markup]] language

272
colors.scm Normal file
View file

@ -0,0 +1,272 @@
(define +colors+
;; Basic palette
'((black . "0")
(red . "1")
(green . "2")
(yellow . "3")
(blue . "4")
(magenta . "5")
(cyan . "6")
(white . "7")
;; 256-color palette
(Black . "8;5;0")
(Maroon . "8;5;1")
(Green . "8;5;2")
(Olive . "8;5;3")
(Navy . "8;5;4")
(Purple . "8;5;5")
(Teal . "8;5;6")
(Silver . "8;5;7")
(Grey . "8;5;8")
(Red . "8;5;9")
(Lime . "8;5;10")
(Yellow . "8;5;11")
(Blue . "8;5;12")
(Fuchsia . "8;5;13")
(Aqua . "8;5;14")
(White . "8;5;15")
(Grey0 . "8;5;16")
(NavyBlue . "8;5;17")
(DarkBlue . "8;5;18")
(Blue3 . "8;5;19")
(Blue3 . "8;5;20")
(Blue1 . "8;5;21")
(DarkGreen . "8;5;22")
(DeepSkyBlue4 . "8;5;23")
(DeepSkyBlue4 . "8;5;24")
(DeepSkyBlue4 . "8;5;25")
(DodgerBlue3 . "8;5;26")
(DodgerBlue2 . "8;5;27")
(Green4 . "8;5;28")
(SpringGreen4 . "8;5;29")
(Turquoise4 . "8;5;30")
(DeepSkyBlue3 . "8;5;31")
(DeepSkyBlue3 . "8;5;32")
(DodgerBlue1 . "8;5;33")
(Green3 . "8;5;34")
(SpringGreen3 . "8;5;35")
(DarkCyan . "8;5;36")
(LightSeaGreen . "8;5;37")
(DeepSkyBlue2 . "8;5;38")
(DeepSkyBlue1 . "8;5;39")
(Green3 . "8;5;40")
(SpringGreen3 . "8;5;41")
(SpringGreen2 . "8;5;42")
(Cyan3 . "8;5;43")
(DarkTurquoise . "8;5;44")
(Turquoise2 . "8;5;45")
(Green1 . "8;5;46")
(SpringGreen2 . "8;5;47")
(SpringGreen1 . "8;5;48")
(MediumSpringGreen . "8;5;49")
(Cyan2 . "8;5;50")
(Cyan1 . "8;5;51")
(DarkRed . "8;5;52")
(DeepPink4 . "8;5;53")
(Purple4 . "8;5;54")
(Purple4 . "8;5;55")
(Purple3 . "8;5;56")
(BlueViolet . "8;5;57")
(Orange4 . "8;5;58")
(Grey37 . "8;5;59")
(MediumPurple4 . "8;5;60")
(SlateBlue3 . "8;5;61")
(SlateBlue3 . "8;5;62")
(RoyalBlue1 . "8;5;63")
(Chartreuse4 . "8;5;64")
(DarkSeaGreen4 . "8;5;65")
(PaleTurquoise4 . "8;5;66")
(SteelBlue . "8;5;67")
(SteelBlue3 . "8;5;68")
(CornflowerBlue . "8;5;69")
(Chartreuse3 . "8;5;70")
(DarkSeaGreen4 . "8;5;71")
(CadetBlue . "8;5;72")
(CadetBlue . "8;5;73")
(SkyBlue3 . "8;5;74")
(SteelBlue1 . "8;5;75")
(Chartreuse3 . "8;5;76")
(PaleGreen3 . "8;5;77")
(SeaGreen3 . "8;5;78")
(Aquamarine3 . "8;5;79")
(MediumTurquoise . "8;5;80")
(SteelBlue1 . "8;5;81")
(Chartreuse2 . "8;5;82")
(SeaGreen2 . "8;5;83")
(SeaGreen1 . "8;5;84")
(SeaGreen1 . "8;5;85")
(Aquamarine1 . "8;5;86")
(DarkSlateGray2 . "8;5;87")
(DarkRed . "8;5;88")
(DeepPink4 . "8;5;89")
(DarkMagenta . "8;5;90")
(DarkMagenta . "8;5;91")
(DarkViolet . "8;5;92")
(Purple . "8;5;93")
(Orange4 . "8;5;94")
(LightPink4 . "8;5;95")
(Plum4 . "8;5;96")
(MediumPurple3 . "8;5;97")
(MediumPurple3 . "8;5;98")
(SlateBlue1 . "8;5;99")
(Yellow4 . "8;5;100")
(Wheat4 . "8;5;101")
(Grey53 . "8;5;102")
(LightSlateGrey . "8;5;103")
(MediumPurple . "8;5;104")
(LightSlateBlue . "8;5;105")
(Yellow4 . "8;5;106")
(DarkOliveGreen3 . "8;5;107")
(DarkSeaGreen . "8;5;108")
(LightSkyBlue3 . "8;5;109")
(LightSkyBlue3 . "8;5;110")
(SkyBlue2 . "8;5;111")
(Chartreuse2 . "8;5;112")
(DarkOliveGreen3 . "8;5;113")
(PaleGreen3 . "8;5;114")
(DarkSeaGreen3 . "8;5;115")
(DarkSlateGray3 . "8;5;116")
(SkyBlue1 . "8;5;117")
(Chartreuse1 . "8;5;118")
(LightGreen . "8;5;119")
(LightGreen . "8;5;120")
(PaleGreen1 . "8;5;121")
(Aquamarine1 . "8;5;122")
(DarkSlateGray1 . "8;5;123")
(Red3 . "8;5;124")
(DeepPink4 . "8;5;125")
(MediumVioletRed . "8;5;126")
(Magenta3 . "8;5;127")
(DarkViolet . "8;5;128")
(Purple . "8;5;129")
(DarkOrange3 . "8;5;130")
(IndianRed . "8;5;131")
(HotPink3 . "8;5;132")
(MediumOrchid3 . "8;5;133")
(MediumOrchid . "8;5;134")
(MediumPurple2 . "8;5;135")
(DarkGoldenrod . "8;5;136")
(LightSalmon3 . "8;5;137")
(RosyBrown . "8;5;138")
(Grey63 . "8;5;139")
(MediumPurple2 . "8;5;140")
(MediumPurple1 . "8;5;141")
(Gold3 . "8;5;142")
(DarkKhaki . "8;5;143")
(NavajoWhite3 . "8;5;144")
(Grey69 . "8;5;145")
(LightSteelBlue3 . "8;5;146")
(LightSteelBlue . "8;5;147")
(Yellow3 . "8;5;148")
(DarkOliveGreen3 . "8;5;149")
(DarkSeaGreen3 . "8;5;150")
(DarkSeaGreen2 . "8;5;151")
(LightCyan3 . "8;5;152")
(LightSkyBlue1 . "8;5;153")
(GreenYellow . "8;5;154")
(DarkOliveGreen2 . "8;5;155")
(PaleGreen1 . "8;5;156")
(DarkSeaGreen2 . "8;5;157")
(DarkSeaGreen1 . "8;5;158")
(PaleTurquoise1 . "8;5;159")
(Red3 . "8;5;160")
(DeepPink3 . "8;5;161")
(DeepPink3 . "8;5;162")
(Magenta3 . "8;5;163")
(Magenta3 . "8;5;164")
(Magenta2 . "8;5;165")
(DarkOrange3 . "8;5;166")
(IndianRed . "8;5;167")
(HotPink3 . "8;5;168")
(HotPink2 . "8;5;169")
(Orchid . "8;5;170")
(MediumOrchid1 . "8;5;171")
(Orange3 . "8;5;172")
(LightSalmon3 . "8;5;173")
(LightPink3 . "8;5;174")
(Pink3 . "8;5;175")
(Plum3 . "8;5;176")
(Violet . "8;5;177")
(Gold3 . "8;5;178")
(LightGoldenrod3 . "8;5;179")
(Tan . "8;5;180")
(MistyRose3 . "8;5;181")
(Thistle3 . "8;5;182")
(Plum2 . "8;5;183")
(Yellow3 . "8;5;184")
(Khaki3 . "8;5;185")
(LightGoldenrod2 . "8;5;186")
(LightYellow3 . "8;5;187")
(Grey84 . "8;5;188")
(LightSteelBlue1 . "8;5;189")
(Yellow2 . "8;5;190")
(DarkOliveGreen1 . "8;5;191")
(DarkOliveGreen1 . "8;5;192")
(DarkSeaGreen1 . "8;5;193")
(Honeydew2 . "8;5;194")
(LightCyan1 . "8;5;195")
(Red1 . "8;5;196")
(DeepPink2 . "8;5;197")
(DeepPink1 . "8;5;198")
(DeepPink1 . "8;5;199")
(Magenta2 . "8;5;200")
(Magenta1 . "8;5;201")
(OrangeRed1 . "8;5;202")
(IndianRed1 . "8;5;203")
(IndianRed1 . "8;5;204")
(HotPink . "8;5;205")
(HotPink . "8;5;206")
(MediumOrchid1 . "8;5;207")
(DarkOrange . "8;5;208")
(Salmon1 . "8;5;209")
(LightCoral . "8;5;210")
(PaleVioletRed1 . "8;5;211")
(Orchid2 . "8;5;212")
(Orchid1 . "8;5;213")
(Orange1 . "8;5;214")
(SandyBrown . "8;5;215")
(LightSalmon1 . "8;5;216")
(LightPink1 . "8;5;217")
(Pink1 . "8;5;218")
(Plum1 . "8;5;219")
(Gold1 . "8;5;220")
(LightGoldenrod2 . "8;5;221")
(LightGoldenrod2 . "8;5;222")
(NavajoWhite1 . "8;5;223")
(MistyRose1 . "8;5;224")
(Thistle1 . "8;5;225")
(Yellow1 . "8;5;226")
(LightGoldenrod1 . "8;5;227")
(Khaki1 . "8;5;228")
(Wheat1 . "8;5;229")
(Cornsilk1 . "8;5;230")
(Grey100 . "8;5;231")
(Grey3 . "8;5;232")
(Grey7 . "8;5;233")
(Grey11 . "8;5;234")
(Grey15 . "8;5;235")
(Grey19 . "8;5;236")
(Grey23 . "8;5;237")
(Grey27 . "8;5;238")
(Grey30 . "8;5;239")
(Grey35 . "8;5;240")
(Grey39 . "8;5;241")
(Grey42 . "8;5;242")
(Grey46 . "8;5;243")
(Grey50 . "8;5;244")
(Grey54 . "8;5;245")
(Grey58 . "8;5;246")
(Grey62 . "8;5;247")
(Grey66 . "8;5;248")
(Grey70 . "8;5;249")
(Grey74 . "8;5;250")
(Grey78 . "8;5;251")
(Grey82 . "8;5;252")
(Grey85 . "8;5;253")
(Grey89 . "8;5;254")
(Grey93 . "8;5;255")))
(define +bg-colors+
(map (lambda (c) `(,(string->symbol (string-append "on-" (symbol->string (car c))))
. ,(cdr c)))
+colors+))

5
fancy.egg Normal file
View file

@ -0,0 +1,5 @@
((author "Dimitri Lozeve")
(synopsis "Fancy pretty-printing utilities for CHICKEN Scheme")
(license "MIT")
(dependencies srfi-1 utf8 srfi-152)
(components (extension fancy)))

35
fancy.scm Normal file
View file

@ -0,0 +1,35 @@
(module fancy
(cursor-up
cursor-down
cursor-forward
cursor-back
cursor-next
cursor-previous
cursor-hor
cursor-pos
erase-in-display
erase-in-line
scroll-up
scroll-down
save-pos
restore-pos
graphics-rendition-code
graphics-style
parse-tag
parse-markup
remove-markup
rule)
(import scheme
(chicken base)
(chicken format)
(chicken irregex)
srfi-1
utf8
srfi-152)
(include "colors.scm")
(include "format.scm")
(include "rule.scm")
)

93
format.scm Normal file
View file

@ -0,0 +1,93 @@
;; ========================= Constants =========================
(define +CSI+ "\033[")
(define +basic-colors+
'((black . 0)
(red . 1)
(green . 2)
(yellow . 3)
(blue . 4)
(magenta . 5)
(cyan . 6)
(white . 7)))
(define +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)))
(define +re-tags+ (irregex "\\[(/?[a-z ]*?)\\]"))
;; ========================= Control sequences =========================
(define (cursor-up #!optional (n 1)) (format "~a~aA" +CSI+ n))
(define (cursor-down #!optional (n 1)) (format "~a~aB" +CSI+ n))
(define (cursor-forward #!optional (n 1)) (format "~a~aC" +CSI+ n))
(define (cursor-back #!optional (n 1)) (format "~a~aD" +CSI+ n))
(define (cursor-next #!optional (n 1)) (format "~a~aE" +CSI+ n))
(define (cursor-previous #!optional (n 1)) (format "~a~aF" +CSI+ n))
(define (cursor-hor #!optional (n 1)) (format "~a~aG" +CSI+ n))
(define (cursor-pos #!optional (n 1) (m 1)) (format "~a~a;~aH" +CSI+ n m))
(define (erase-in-display #!optional (n 0)) (format "~a~aJ" +CSI+ n))
(define (erase-in-line #!optional (n 0)) (format "~a~aK" +CSI+ n))
(define (scroll-up #!optional (n 1)) (format "~a~aS" +CSI+ n))
(define (scroll-down #!optional (n 1)) (format "~a~aT" +CSI+ n))
(define (save-pos) (format "~as" +CSI+))
(define (restore-pos) (format "~au" +CSI+))
;; ========================= Graphics rendition parameters =========================
(define (graphics-rendition-code tag)
(define basic-color (assoc tag +basic-colors+))
(define basic-bg-color (assoc tag +basic-bg-colors+))
(cond
((eq? tag 'bold) "2")
((eq? tag 'italic) "3")
((eq? tag 'underline) "4")
(basic-color (format "3~a" (cdr basic-color)))
(basic-bg-color (format "4~a" (cdr basic-bg-color)))))
(define (graphics-style #!optional (style '()))
(define colors (lset-intersection eq? style (map car +basic-colors+)))
(define bg-colors (lset-intersection eq? style (map car +basic-bg-colors+)))
(define style-without-colors (lset-difference eq? style
(map car +basic-colors+)
(map car +basic-bg-colors+)))
(define final-style (cons* (unless (null? colors) (car colors))
(unless (null? bg-colors) (car bg-colors))
style-without-colors))
(format "~a~am" +CSI+
(string-join (filter string? (map graphics-rendition-code final-style)) ";")))
;; ========================= Console markup =========================
(define (parse-tag contents #!optional (style '()))
(define closing (eq? #\/ (string-ref contents 0)))
(define clean-contents (if closing (string-drop contents 1) contents))
(define clean-contents (irregex-replace/all "on " clean-contents "on-"))
(define tags (map string->symbol (string-split clean-contents " ")))
(define new-style (if closing
(lset-difference eq? style tags)
(lset-union eq? style tags)))
(define control-seq (graphics-style new-style))
(values control-seq new-style))
(define (parse-markup text #!optional (style '()))
(define match (irregex-search +re-tags+ text))
(if match
(let-values (((control-seq new-style) (parse-tag (irregex-match-substring match 1) style)))
(parse-markup (irregex-replace +re-tags+ text control-seq) new-style))
(string-join (list text (graphics-style '())))))
(define (remove-markup text)
(irregex-replace/all +re-tags+ text ""))

16
rule.scm Normal file
View file

@ -0,0 +1,16 @@
(define (rule text #!key (width 80) (style 'simple))
(define rule-len (- width (+ 2 (string-length (remove-markup text)))))
(define left-len (sub1 (quotient rule-len 2)))
(define right-len (sub1 (+ (remainder rule-len 2) (quotient rule-len 2))))
(define c (cond
((eq? style 'simple) #\━)
((eq? style 'double) #\═)
((eq? style 'dashed) #\╌)))
(string-join
(list (make-string left-len c)
" "
(parse-markup text)
" "
(make-string right-len c)
"\n")))