dialer/dirtrect.jrt

76 lines
2.0 KiB
Plaintext
Executable File

import text.jrt
1 boxstyle!
array shoutout-text t", DIRTY RECTANGLES"
array colors yellow b, lcyan b, lmagenta b, lgreen b, brown b,
array xborders 17 b, 32 b, 47 b, 62 b, 81 b,
: xregion 0 begin dup xborders + b@ textx <= while 1+ repeat ;
: xborder xborders + b@ ;
: choosecolor xregion colors + b@ fg! ;
: hline-to ( x -- ) textx - hline ;
: line-to-region xregion xborder hline-to ;
3 const logo-top
1 const logo-edge
13 const rect-height
2 const vgap
3 const hgap
: left-corner
textpos @ tl line-to-region textpos !
texty 1+ texty! rect-height vline ;
: bl-corner bl line-to-region ;
: left-region
choosecolor
logo-edge logo-top textxy! left-corner bl-corner
logo-edge hgap + logo-top vgap + textxy! left-corner bl-corner
logo-edge hgap 2* + logo-top vgap 2* + textxy! left-corner ;
: texty++ texty vgap + texty! ;
: bot-rect logo-top rect-height 1+ + ;
: midline textx line-to-region textx! texty++ ;
: mid-region ( i -- )
xborder logo-top textxy! choosecolor
midline midline midline
bot-rect texty!
midline midline ;
: right-edge pagew 1- logo-edge - ;
: rlineedge ( gapcount -- ) hgap * right-edge swap - 1- ;
: rline ( gapcount -- ) rlineedge textx swap hline-to textx! texty++ ;
: redge textx tr textx! texty 1+ texty! rect-height vgap - vline br ;
: right-region
3 xborder logo-top textxy! choosecolor
2 rline 1 rline 0 rline bot-rect texty!
1 rline 0 rline
1 rlineedge logo-top vgap + textxy! redge
0 rlineedge logo-top vgap 2* + textxy! redge ;
: emptych? ( ch -- f ) dup 32 = swap 0 = or ;
: drawdot? ( st -- f ) dup b@ emptych? swap 1+ b@ emptych? or not ;
: .c choosecolor draw-char ;
: dot 7 .c ;
: sp 32 .c ;
: spacer ( st -- ) sp drawdot? if dot else sp then sp ;
: shoutout shoutout-text
begin dup b@ dup while .c dup spacer 1+ repeat
drop drop ;
: logo
textmode
left-region
0 mid-region 1 mid-region 2 mid-region
right-region
12 20 textxy! shoutout ;
' logo ' main redefine
{ s" dirtrect.com" writecom }