76 lines
2 KiB
Plaintext
Executable file
76 lines
2 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 }
|
|
|