Dirty Rectangles logo app

This commit is contained in:
Jeremy Penner 2023-09-18 22:10:50 -04:00
parent 218fd0a8ef
commit ec7ab0da0d
6 changed files with 92 additions and 20 deletions

View file

@ -36,7 +36,7 @@ array oparg2 3 cells allot
: byteop? ( -- f ) : byteop? ( -- f )
oparg-breg? swap-args oparg-breg? or swap-args byteptr? or ; oparg-breg? swap-args oparg-breg? or swap-args byteptr? or ;
: byteval? ( v -- f ) 0xff00 & dup 0xff00 = swap 0 = or ; : byteval? ( v -- f ) dup 0x7f <= swap -0x80 >= and ;
: oparg-bwreg? ( -- f ) byteop? if oparg-breg? else oparg-wreg? then ; : oparg-bwreg? ( -- f ) byteop? if oparg-breg? else oparg-wreg? then ;
: operror ( err -- ) lastop @ type s" near " type lastlabel @ type s" : " type type cr ; : operror ( err -- ) lastop @ type s" near " type lastlabel @ type s" : " type type cr ;

Binary file not shown.

BIN
dirtrect.com Executable file

Binary file not shown.

75
dirtrect.jrt Executable file
View file

@ -0,0 +1,75 @@
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 }

View file

@ -43,15 +43,14 @@
80 const pagew 80 const pagew
25 const pageh 25 const pageh
0xb800 const TEXTMEM 0xb800 const SCREENSEG
{ : PREP-TEXTCOPY { : PREP-TEXTCOPY
MOV ES t& TEXTMEM @+ MOV ES t& SCREENSEG @+
MOV AH textpen @+ MOV AH textpen @+
MOV DI textpage @+ ; } MOV DI textpage @+ ; }
:asm fill-page ( char -- ) :asm fill-page ( char -- )
INT 3 #
POP AX POP AX
PREP-TEXTCOPY PREP-TEXTCOPY
MOV CX pagew pageh * # MOV CX pagew pageh * #
@ -109,13 +108,14 @@
NEXT NEXT
:asm draw-vrepeat ( count char -- ) :asm draw-vrepeat ( count char -- )
INT 3 #
POP AX POP AX
POP CX POP CX
JCXZ 1 @> JCXZ 1 @>
PREP-TEXTCOPY-XY PREP-TEXTCOPY-XY
0 :> 0 :>
STOSW STOSW
ADD DI pagew 1- 1 << # ADD DI pagew 1- 2* #
DEC CX DEC CX
JNZ 0 <@ JNZ 0 <@
CORRECT-TEXTPOS CORRECT-TEXTPOS
@ -126,8 +126,8 @@
var boxstyle var boxstyle
: hstyle boxstyle @ 0x01 & ; : hstyle boxstyle @ 0x01 & ;
: hstyle! 1 & boxstyle @ 0xfe & | boxstyle ! ; : hstyle! 1 & boxstyle @ 0xfe & | boxstyle ! ;
: vstyle boxstyle @ 0x02 & 1 >> ; : vstyle boxstyle @ 0x02 & 2/ ;
: vstyle! 1 & 1 << boxstyle @ 0xfd & | boxstyle ! ; : vstyle! 1 & 2* boxstyle @ 0xfd & | boxstyle ! ;
: boxstyle! dup hstyle! vstyle! ; : boxstyle! dup hstyle! vstyle! ;
: filled? boxstyle @ 0x04 & ; : filled? boxstyle @ 0x04 & ;
: filled boxstyle @ 0x04 | boxstyle ! ; : filled boxstyle @ 0x04 | boxstyle ! ;
@ -135,36 +135,33 @@ var boxstyle
: hchar hstyle if 0xcd else 0xc4 then ; : hchar hstyle if 0xcd else 0xc4 then ;
: vchar vstyle if 0xba else 0xb3 then ; : vchar vstyle if 0xba else 0xb3 then ;
: hline ( count -- ) hchar draw-char ; : hline ( count -- ) hchar draw-hrepeat ;
: vline ( count -- ) vchar draw-char ; : vline ( count -- ) vchar draw-vrepeat ;
dictionary .hex
{ : :corner CREATE >t >t >t >t DOES} boxstyle @ 0x03 & + b@ draw-char ; { : :corner CREATE >t >t >t >t DOES} boxstyle @ 0x03 & + b@ draw-char ;
dictionary .hex 0xc9 0xd6 0xd5 0xda :corner tl
0xda 0xd6 0xd5 0xc9 :corner tl 0xbb 0xb7 0xb8 0xbf :corner tr
dictionary .hex 0xc8 0xd3 0xd4 0xc0 :corner bl
0xbf 0xb7 0xb8 0xbb :corner tr 0xbc 0xbd 0xbe 0xd9 :corner br
0xc0 0xd4 0xd3 0xc8 :corner bl
0xd9 0xbe 0xbd 0xbc :corner br
: boxtop ( w -- ) textx swap tl 2 - hline tr nextline textx! ; : boxtop ( w -- ) textx swap tl 2 - hline tr nextline textx! ;
: boxbottom ( w -- ) bl 2 - hline br ; : boxbottom ( w -- ) bl 2 - hline br ;
: hollow-boxmiddle ( h w -- ) : hollow-boxmiddle ( h w -- )
textpos @ >r textpos @ >r
textx + textx! dup vline textx + 1- textx! dup vline
<r textpos ! vline ; <r textpos ! vline ;
: filled-boxmiddle ( h w -- ) : filled-boxmiddle ( h w -- )
textx >r textx >r
2 - swap 2 - swap
begin dup while 1- begin dup while 1-
vchar draw-char over 2 - 32 swap draw-hrepeat vchar draw-char vchar draw-char over [ key lit ] draw-hrepeat vchar draw-char
nextline r@ textx! nextline r@ textx!
repeat 2drop rdrop ; repeat drop drop rdrop ;
: boxmiddle filled? if filled-boxmiddle else hollow-boxmiddle then ; : boxmiddle filled? if filled-boxmiddle else hollow-boxmiddle then ;
: draw-box ( w h -- ) : draw-box ( w h -- )
swap dup boxtop ( h w ) swap dup boxtop ( h w )
swap over boxmiddle swap 2 - over boxmiddle
boxbottom ; boxbottom ;

Binary file not shown.