ilyakooo0/urbit
1
0
Fork 0
mirror of https://github.com/ilyakooo0/urbit.git synced 2024-11-13 08:38:43 +03:00
Code Issues Packages Projects Releases Wiki Activity

shoe: add %table and %row shoe commands

Browse Source 
For rendering a data table or just a single table row respectively.

Table data is a list of header names, a list of width restrictions, and a list
of rows, defined as lists of dimes.
Row contents are rendered as per the aura in the dime. This also determines
their alignment (left/right), and how they break to fit smaller-width columns.

%row was added because %table necessitated implementing it. Whether it's a good
fit for the shoe "protocol" remains to be seen.
This commit is contained in:
Fang 2020-09-01 20:10:38 +02:00
parent 6bf2ec28a6
commit 7658686a03
No known key found for this signature in database
GPG Key ID: EB035760C1BBA972
1 changed files with 180 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

183
pkg/arvo/lib/shoe.hoon
View File

@ -26,8 +26,15 @@
:: $shoe-effect: easier sole-effects
::
+$ shoe-effect
$% [%sole effect=sole-effect]
::TODO complex screen-draw effects
$% :: %sole: raw sole-effect
::
[%sole effect=sole-effect]
:: %table: sortable, filterable data, with suggested column char widths
::
[%table head=(list dime) wide=(list @ud) rows=(list (list dime))]
:: %row: line sections with suggested char widths
::
[%row wide=(list @ud) cols=(list dime)]
==
:: +shoe: gall agent core with extra arms
::
@ -159,6 +166,17 @@
~(tap in ~(key by soles))
|= sole-id=@ta
/sole/[sole-id]
::
%table
=; fez=(list sole-effect)
$(effect.card [%sole %mor fez])
=, +.effect.card
:- (row:draw & wide head)
%+ turn rows
(cury (cury row:draw |) wide)
::
%row
$(effect.card [%sole (row:draw | +.effect.card)])
==
--
::
@ -225,7 +243,7 @@
%+ rose (tufa buf.cli-state)
(command-parser:og sole-id)
?: ?=(%& -.res)
?. &(?=(^ p.res) run.u.p.res)
?. &(?=(^ p.res) run.u.p.res)
[[~ cli-state] shoe]
(run-command cmd.u.p.res)
:_ shoe
@ -345,4 +363,163 @@
=^ cards shoe (on-fail:og term tang)
[(deal cards) this]
--
::
++ draw
|%
++ row
|= [bold=? wide=(list @ud) cols=(list dime)]
^- sole-effect
:- %mor
^- (list sole-effect)
=/ cows=(list [wid=@ud col=dime])
%- head
%^ spin cols wide
|= [col=dime wiz=(list @ud)]
~| [%too-few-wide col]
?> ?=(^ wiz)
[[i.wiz col] t.wiz]
=/ cobs=(list [wid=@ud (list tape)])
(turn cows col-as-lines)
=+ [lin=0 any=|]
=| fez=(list sole-effect)
|- ^+ fez
=; out=tape
:: done when we're past the end of all columns
::
?: (levy out (cury test ' '))
(flop fez)
=; fec=sole-effect
$(lin +(lin), fez [fec fez])
?. bold txt+out
klr+[[`%br ~ ~]^[(crip out)]~]~
%+ roll cobs
|= [[wid=@ud lines=(list tape)] out=tape]
%+ weld out
%+ weld ?~(out "" " ")
=+ l=(swag [lin 1] lines)
?^(l i.l (reap wid ' '))
::
++ col-as-lines
|= [wid=@ud col=dime]
^- [@ud (list tape)]
:- wid
%+ turn
(break wid (col-as-text col) (break-sets -.col))
(cury (cury pad wid) (alignment -.col))
::
++ col-as-text
|= col=dime
^- tape
?+ p.col (scow col)
%t (trip q.col)
%tas ['%' (scow col)]
==
::
++ alignment
|= wut=@ta
^- ?(%left %right)
?: ?=(?(%t %ta %tas %da) wut)
%left
%right
::
++ break-sets
|= wut=@ta
:: for: may break directly before these characters
:: aft: may break directly after these characters
:: new: always break on these characters, consuming them
::
^- [for=(set @t) aft=(set @t) new=(set @t)]
?+ wut [(sy " ") (sy ".:-/") (sy "\0a")]
?(%p %q) [(sy "-") (sy "-") ~]
%ux [(sy ".") ~ ~]
==
::
++ break
|= [wid=@ud cot=tape brs=_*break-sets]
^- (list tape)
~| [wid cot]
?: =("" cot) ~
=; [lin=tape rem=tape]
[lin $(cot rem)]
:: take snip of max width+1, search for breakpoint on that.
:: we grab one char extra, to look-ahead for for.brs.
:: later on, we always transfer _at least_ the extra char.
::
=^ lin=tape cot
[(scag +(wid) cot) (slag +(wid) cot)]
=+ len=(lent lin)
:: find the first newline character
::
=/ new=(unit @ud)
=+ new=~(tap in new.brs)
=| las=(unit @ud)
|-
?~ new las
$(new t.new, las (hunt lth las (find [i.new]~ lin)))
:: if we found a newline, break on it
::
?^ new
:- (scag u.new lin)
(weld (slag +(u.new) lin) cot)
:: if it fits, we're done
::
?: (lte len wid)
[lin cot]
=+ nil=(flop lin)
:: search for latest aft match
::
=/ aft=(unit @ud)
:: exclude the look-ahead character from search
::
=. len (dec len)
=. nil (slag 1 nil)
=- ?~(- ~ `+(u.-))
^- (unit @ud)
=+ aft=~(tap in aft.brs)
=| las=(unit @ud)
|-
?~ aft (bind las (cury sub (dec len)))
$(aft t.aft, las (hunt lth las (find [i.aft]~ nil)))
:: search for latest for match
::
=/ for=(unit @ud)
=+ for=~(tap in for.brs)
=| las=(unit @ud)
|-
?~ for (bind las (cury sub (dec len)))
=- $(for t.for, las (hunt lth las -))
=+ (find [i.for]~ nil)
:: don't break before the first character
::
?:(=(`(dec len) -) ~ -)
:: if any result, break as late as possible
::
=+ brk=(hunt gth aft for)
?~ brk
:: lin can't break, produce it in its entirety
:: (after moving the look-ahead character back)
::
:- (scag wid lin)
(weld (slag wid lin) cot)
:- (scag u.brk lin)
=. cot (weld (slag u.brk lin) cot)
:: eat any leading whitespace the next line might have, "clean break"
::
|- ^+ cot
?~ cot ~
?. ?=(?(%' ' %'\09') i.cot)
cot
$(cot t.cot)
::
++ pad
|= [wid=@ud lyn=?(%left %right) lin=tape]
^+ lin
=+ l=(lent lin)
?: (gte l wid) lin
=+ p=(reap (sub wid l) ' ')
?- lyn
%left (weld lin p)
%right (weld p lin)
==
--
--