Dirty Rectangles logo app

asm.jrt

@@ -36,7 +36,7 @@ array oparg2 3 cells allot
 
 : byteop? ( -- f ) 
   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 ;
 
 : operror ( err -- ) lastop @ type s"  near " type lastlabel @ type s" : " type type cr ;

dirtrect.jrt

@@ -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 }
+

text.jrt

@@ -43,15 +43,14 @@
 80 const pagew
 25 const pageh
 
-0xb800 const TEXTMEM
+0xb800 const SCREENSEG
 
 { : PREP-TEXTCOPY
-  MOV ES t& TEXTMEM @+
+  MOV ES t& SCREENSEG @+
   MOV AH textpen @+
   MOV DI textpage @+ ; }
 
 :asm fill-page ( char -- )
-  INT 3 #
   POP AX
   PREP-TEXTCOPY
   MOV CX pagew pageh * #
@@ -109,13 +108,14 @@
   NEXT
 
 :asm draw-vrepeat ( count char -- )
+  INT 3 #
   POP AX
   POP CX
   JCXZ 1 @>
   PREP-TEXTCOPY-XY
 0 :>  
   STOSW
-  ADD DI pagew 1- 1 << #
+  ADD DI pagew 1- 2* #
   DEC CX
   JNZ 0 <@
   CORRECT-TEXTPOS
@@ -126,8 +126,8 @@
 var boxstyle
 : hstyle boxstyle @ 0x01 & ;
 : 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! ;
 : filled? boxstyle @ 0x04 & ;
 : filled boxstyle @ 0x04 | boxstyle ! ;
@@ -135,36 +135,33 @@ var boxstyle
 
 : hchar hstyle if 0xcd else 0xc4 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 ;
-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! ;
 : boxbottom ( w -- ) bl 2 - hline br ;
 
 : hollow-boxmiddle ( h w -- )
   textpos @ >r
-  textx + textx! dup vline
+  textx + 1- textx! dup vline
   <r textpos ! vline ;
 : filled-boxmiddle ( h w -- ) 
   textx >r
   2 - swap 
   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!
-  repeat 2drop rdrop ;
+  repeat drop drop rdrop ;
 : boxmiddle filled? if filled-boxmiddle else hollow-boxmiddle then ;
 
 : draw-box ( w h -- )
   swap dup boxtop ( h w )
-  swap over boxmiddle
+  swap 2 - over boxmiddle
   boxbottom ;