diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml new file mode 100644 index 0000000..63081fb --- /dev/null +++ b/.github/workflows/ci.yml @@ -0,0 +1,62 @@ +name: CI + +on: [push] + +jobs: + build: + runs-on: ubuntu-latest + steps: + - name: Install dependencies + run: | + sudo apt-get update + sudo apt-get install libssl-dev zlib1g-dev libsqlite3-dev + - name: Checkout Gambit + uses: actions/checkout@v2 + with: + repository: gambit/gambit + ref: v4.9.3 + path: gambit + - name: Install Gambit + run: | + cd gambit + ./configure --prefix=/usr/local/gambit \ + --enable-single-host \ + --enable-multiple-versions \ + --enable-openssl \ + --enable-default-runtime-options=f8,-8,t8 \ + --enable-poll + make -j + make check + sudo make install + echo "/usr/local/gambit/current/bin" >> $GITHUB_PATH + - name: Checkout Gerbil + uses: actions/checkout@v2 + with: + repository: vyzo/gerbil + path: gerbil + - name: Install Gerbil + env: + LD_LIBRARY_PATH: /usr/local/gambit/current/lib + run: | + cd gerbil/src + ./configure --prefix=/usr/local/gerbil + GERBIL_BUILD_CORES=2 ./build.sh + sudo env "PATH=$PATH" ./install + echo "GERBIL_HOME=/usr/local/gerbil" >> $GITHUB_ENV + echo "/usr/local/gerbil/bin" >> $GITHUB_PATH + - name: Checkout project + uses: actions/checkout@v2 + with: + path: repo + - name: Build + env: + LD_LIBRARY_PATH: /usr/local/gambit/current/lib + run: | + cd repo + ./build.ss + - name: Run demo + env: + LD_LIBRARY_PATH: /usr/local/gambit/current/lib + run: | + cd repo + ./demo.ss diff --git a/.gitignore b/.gitignore index e81f231..60edadc 100644 --- a/.gitignore +++ b/.gitignore @@ -1,3 +1,2 @@ *\~ -TAGS build-deps diff --git a/README.org b/README.org index 20801e5..737946d 100644 --- a/README.org +++ b/README.org @@ -8,10 +8,9 @@ Fancy pretty-printing utilities for [[https://cons.io/][Gerbil Scheme]]. ** 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]] or in Markdown syntax +- Table formatting with [[https://unicode-table.com/en/blocks/box-drawing/][Unicode box drawing characters]] - Horizontal rules - Spinners -- Progress bars ** References diff --git a/build.ss b/build.ss index c814c94..8971f3e 100755 --- a/build.ss +++ b/build.ss @@ -6,6 +6,4 @@ '("fancy/format" "fancy/table" "fancy/rule" - "fancy/progress" - "fancy/spinner") - optimize: #t debug: 'src) + "fancy/spinner")) diff --git a/demo.png b/demo.png index 7ed65bd..deb16d2 100644 Binary files a/demo.png and b/demo.png differ diff --git a/demo.ss b/demo.ss index 9bc0d18..7a228d2 100755 --- a/demo.ss +++ b/demo.ss @@ -8,11 +8,10 @@ :dlozeve/fancy/format :dlozeve/fancy/table :dlozeve/fancy/rule - :dlozeve/fancy/progress :dlozeve/fancy/spinner) (def (main) - (display (rule "[bold green]Fancy demo" style: 'simple width: 100)) + (display (rule "[bold green]Fancy demo" style: 'simple)) (displayln) (displayln (parse-markup "[bold red]Lorem ipsum[/bold red] dolor sit amet, [underline]consectetur[/underline] adipiscing elit, sed do @@ -31,11 +30,6 @@ culpa qui officia deserunt mollit anim id est laborum.")) (display (table-footer tab)) (displayln) (displayln) - (def pbar (progress-bar 100 "[green]Progress: " percent: #f style: 'line)) - (for ((i (in-range 100))) - (display (progress pbar (1+ i))) - (thread-sleep! 0.05)) - (displayln) (for ((i (in-range 20))) (display (spinner i "[yellow]Waiting:" (format "(computing ~d/20)" (1+ i)) style: 'dots)) diff --git a/fancy/format.ss b/fancy/format.ss index a27d7a2..ae83a9f 100644 --- a/fancy/format.ss +++ b/fancy/format.ss @@ -81,7 +81,7 @@ ((? (lambda (t) (assgetq t +basic-bg-colors+)) => code) (format "4~d" code)) (else #!void))) -(def (graphics-style (style [])) +(def (graphics-style style) (def colors (lset-intersection eq? style (map car +basic-colors+))) (def bg-colors (lset-intersection eq? style (map car +basic-bg-colors+))) (def style-without-colors (lset-difference eq? style diff --git a/fancy/progress.ss b/fancy/progress.ss deleted file mode 100644 index 576db8f..0000000 --- a/fancy/progress.ss +++ /dev/null @@ -1,39 +0,0 @@ -(export (struct-out progress-bar) - progress) - -(import :std/misc/string - :std/format - :dlozeve/fancy/format) - -(def +progress-styles+ - '((ascii . (#\[ #\= #\> #\ #\])) - (line . (#\┝ #\━ #\━ #\ #\┥)) - (double . (#\╞ #\═ #\═ #\ #\╡)) - (block . (#\│ #\█ #\█ #\ #\│)) - (halfblock . (#\╻ #\▄ #\▄ #\ #\╻)) - (dots . (#\⣿ #\⠶ #\⠶ #\⠀ #\⣿)))) - -(defstruct progress-bar (total description length style percent) - constructor: :init!) - -(defmethod {:init! progress-bar} - (lambda (self total (description #f) length: (length 80) style: (style 'line) percent: (percent #f)) - (struct-instance-init! self total description length style percent))) - -(def (progress pbar n) - (with ((progress-bar total description length style percent) pbar) - (let* ((n (min total (max 0 n))) - (n-done (inexact->exact (floor (* (- length 3) (/ n total))))) - (n-remaining (inexact->exact (ceiling (* (- length 3) (/ (- total n) total))))) - (progress-chars (assgetq style +progress-styles+)) - (bar (format "~c~a~c~a~c" - (list-ref progress-chars 0) - (make-string n-done (list-ref progress-chars 1)) - (list-ref progress-chars 2) - (make-string n-remaining (list-ref progress-chars 3)) - (list-ref progress-chars 4))) - (progress (if percent - (format "~3,0F%" (* 100 (/ n total))) - (format "(~d/~d)" n total)))) - (str (cursor-up 1) - (parse-markup description) bar " " progress "\n")))) diff --git a/fancy/table.ss b/fancy/table.ss index 00e2f22..1beef97 100644 --- a/fancy/table.ss +++ b/fancy/table.ss @@ -6,47 +6,25 @@ (import :std/misc/string :dlozeve/fancy/format) -(defstruct table (names widths style) - constructor: :init!) +(defstruct table (names widths)) -(defmethod {:init! table} - (lambda (self names widths (style #f)) - (set! (table-names self) names) - (set! (table-widths self) widths) - (set! (table-style self) style))) - -(def (column-text text width (style #f)) - (match style - ('markdown - (str " " (remove-markup text) (make-string (- width (string-length (remove-markup text)) 1) #\ ))) - (else - (str " " - (parse-markup text) - (make-string (- width (string-length (remove-markup text)) 1) #\ ))))) +(def (column-text text width) + (str " " + (parse-markup text) + (make-string (- width (string-length (remove-markup text)) 1) #\ ))) (def (table-header tab) - (match tab - ((table names widths 'markdown) - (str "|" (string-join (map (lambda (name width) (column-text name (+ 2 width) 'markdown)) names widths) #\|) "|\n" - "|" (string-join (map (lambda (w) (make-string (+ 2 w) #\-)) widths) #\|) "|\n")) - ((table names widths _) - (str "┌" (string-join (map (lambda (w) (make-string (+ 2 w) #\─)) widths) #\┬) "┐\n" - "│" (string-join (map (lambda (name width) (column-text name (+ 2 width))) names widths) #\│) "│\n" - "├" (string-join (map (lambda (w) (make-string (+ 2 w) #\─)) widths) #\┼) "┤\n")))) + (with ((table names widths) tab) + (str "┌" (string-join (map (lambda (w) (make-string (+ 2 w) #\─)) widths) #\┬) "┐\n" + "│" (string-join (map (lambda (name width) (column-text name (+ 2 width))) names widths) #\│) "│\n" + "├" (string-join (map (lambda (w) (make-string (+ 2 w) #\─)) widths) #\┼) "┤\n"))) (def (table-row tab . args) - (match tab - ((table names widths 'markdown) - (str "|" - (string-join (map (lambda (text width) (column-text text (+ 2 width) 'markdown)) args widths) #\|) - "|\n")) - ((table names widths _) - (str "│" - (string-join (map (lambda (text width) (column-text text (+ 2 width))) args widths) #\│) - "│\n")))) + (with ((table names widths) tab) + (str "│" + (string-join (map (lambda (text width) (column-text text (+ 2 width))) args widths) #\│) + "│\n"))) (def (table-footer tab) - (match tab - ((table names widths 'markdown) "\n") - ((table names widths _) - (str "└" (string-join (map (lambda (w) (make-string (+ 2 w) #\─)) widths) #\┴) "┘\n")))) + (with ((table names widths) tab) + (str "└" (string-join (map (lambda (w) (make-string (+ 2 w) #\─)) widths) #\┴) "┘\n")))