mirror of
https://github.com/ilyakooo0/urbit.git
synced 2025-01-04 13:19:48 +03:00
fang
GitHub
commit
b7df1a3f65
@ -6,7 +6,11 @@
|
||||
/+ shoe, verb, dbug, default-agent
|
||||
|%
|
||||
+$ state-0 [%0 ~]
|
||||
+$ command ~
|
||||
+$ command
|
||||
$? %demo
|
||||
%row
|
||||
%table
|
||||
==
|
||||
::
|
||||
+$ card card:shoe
|
||||
--
|
||||
@ -41,22 +45,46 @@
|
||||
++ command-parser
|
||||
|= sole-id=@ta
|
||||
^+ |~(nail *(like [? command]))
|
||||
(cold [& ~] (jest 'demo'))
|
||||
%+ stag &
|
||||
(perk %demo %row %table ~)
|
||||
::
|
||||
++ tab-list
|
||||
|= sole-id=@ta
|
||||
^- (list [@t tank])
|
||||
:~ ['demo' leaf+"run example command"]
|
||||
['row' leaf+"print a row"]
|
||||
['table' leaf+"display a table"]
|
||||
==
|
||||
::
|
||||
++ on-command
|
||||
|= [sole-id=@ta =command]
|
||||
^- (quip card _this)
|
||||
=- [[%shoe ~ %sole -]~ this]
|
||||
=/ =tape "{(scow %p src.bowl)} ran the command"
|
||||
?. =(src our):bowl
|
||||
[%txt tape]
|
||||
[%klr [[`%br ~ `%g] [(crip tape)]~]~]
|
||||
=; [to=(list _sole-id) fec=shoe-effect:shoe]
|
||||
[[%shoe to fec]~ this]
|
||||
?- command
|
||||
%demo
|
||||
:- ~
|
||||
:- %sole
|
||||
=/ =tape "{(scow %p src.bowl)} ran the command"
|
||||
?. =(src our):bowl
|
||||
[%txt tape]
|
||||
[%klr [[`%br ~ `%g] [(crip tape)]~]~]
|
||||
::
|
||||
%row
|
||||
:- [sole-id]~
|
||||
:+ %row
|
||||
~[8 27 35 5]
|
||||
~[p+src.bowl da+now.bowl t+'plenty room here!' t+'less here!']
|
||||
::
|
||||
%table
|
||||
:- [sole-id]~
|
||||
:^ %table
|
||||
~[t+'ship' t+'date' t+'long text' t+'tldr']
|
||||
~[8 27 35 5]
|
||||
:~ ~[p+src.bowl da+now.bowl t+'plenty room here!' t+'less here!']
|
||||
~[p+~marzod t+'yesterday' t+'sometimes:\0anewlines' t+'newlines']
|
||||
==
|
||||
==
|
||||
::
|
||||
++ can-connect
|
||||
|= sole-id=@ta
|
||||
|
||||
@ -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)
|
||||
==
|
||||
--
|
||||
--
|
||||
|
||||
Loading…
Reference in New Issue
Block a user