\ ************* Fast TYPE *************

CODE FASTTYPE ( c-addr1 u --- )
\G Use MOS v1.03 RST 18h to rapidly print the string at c-addr1 and length u.
    LD C, E
    LD B, D
    POP DE
    EX DE, HL
    LD A, 0 \ required to trigger length mode
    RST .LIS $18
    POP DE
    NEXT
END-CODE

\ ************* Colorized memory dumps *************

10 value debug-col0-v
2 value debug-col1-v
15 value debug-col2-v

: debug-col0 17 emit debug-col0-v emit ;
: debug-col1 17 emit debug-col1-v emit ;
: debug-col2 17 emit debug-col2-v emit ;

: COL-DL ( addr1 --- addr2 )
\G hex/ascii dump in one line of 16 bytes at addr1 addr2 is addr1+16
  debug-col2
  BASE @ >R 16 BASE ! CR
  DUP 0 <# # # # # # # #> TYPE ." : "
  debug-col1
  8 0 DO
   DUP I 2*     + C@ 0 <# # # #> TYPE debug-col0
   DUP I 2* 1+  + C@ 0 <# # # #> TYPE debug-col1 ."  "
  LOOP
  debug-col2
  16 0 DO
   DUP I + C@ DUP 32 < OVER 127 = OR IF DROP ." ." ELSE EMIT THEN
  LOOP
  16 + R> BASE ! ;

: COL-DUMP ( addr len --- )
\G Show a hex/ascii dump of the memory block of len bytes at addr
  7 + 4 RSHIFT 0 DO
   col-dl ?TERMINAL IF LEAVE THEN
  LOOP DROP ;

\ ************* Memory arenas *************

0 value cur-arena \ selected
0 value arena? \ error

: arena-len
  cur-arena @
;
: arena-max
  cur-arena cell+ @
;
: arena-bounds? ( offset -- t )
  dup arena-max <= swap 0< 0= + -2 =
;
: arena-len!
  dup arena-bounds? dup to arena? if
    cur-arena !
  else drop then
;
: arena-buf
  cur-arena cell+ cell+ 
;
: arena-here
  arena-buf arena-len +
;
: arena-dump
  cur-arena arena-max cell+ cell+ col-dump
;
: arena-type
  arena-len 0> if
    arena-buf arena-len fasttype
  then
;
: arena-reset
  0 arena-len!
  0 arena-buf arena-max rot fill
;
: arena-push24
  arena-len cell+ arena-bounds? dup to arena? if
    arena-here ! arena-len cell+ cur-arena !
  else drop then
;
: arena-push16
  arena-len 1+ 1+ arena-bounds? dup to arena? if
    arena-here h! arena-len 1+ 1+ cur-arena !
  else drop then
;
: arena-push8
  arena-len 1+ arena-bounds? dup to arena? if
    arena-here c! arena-len 1+ cur-arena !
  else drop then
;
: arena-cmove ( c-addr1 u -- )
  dup -rot dup arena-len + arena-bounds? dup to arena? if
    arena-here swap cmove 
    arena-len + arena-len!
  else drop drop drop then
;
: create-arena ( max-size "name" -- )
  create 0 , dup , allot
  does>
  to cur-arena
;

\ TODO: write to arena directly from open file

\ create-arena myarena 
\ myarena 48 arena-push8 \ "0"
\ arena-dump
\ : hello s" hello" ;
\ hello arena-cmove
\ arena-dump
\ arena-type \ "0hello"

\ ************* Linear Interpolation *************

100 value lerp-pct-range \ lerp inputs range between 0 and this value. Outputs are provided at call time
: lerp-pct \ ( x1 x0 input-pct -- interpolated-x0x1 )
  -rot dup -rot - \ compute difference
  rot lerp-pct-range */ + \ multiply divide interpolation
;

\ lerp-pct will exhibit biasing towards one end of the output range since it uses truncated division.
\ in highly granular situations this doesn't matter,
\ but for scenarios like line-drawing it's nice to add a half-step counterbalance.
\ the way to do this is to set lerp-pct-range to ( larger-distance 2* ) and add 1 to input-pct.
\ : lerp100demo
\   200 100 50 lerp-pct .
\   0 100 50 lerp-pct .
\   0 100 -1 lerp-pct .
\   0 100 101 lerp-pct .
\ ;

\ ************* Drawing *************

0 value _lerpx0
0 value _lerpx1
0 value _lerpy0
0 value _lerpy1
0 value _lerpdistx
0 value _lerpdisty
0 value _lerpbase
0 value _lerpinc

: debug-lerpxt
  swap ." x" . ." y" . cr
;

' debug-lerpxt value _lerpxt \ ( y x -- )

: lerp2d \ DDA line algorithm

  \ find dist
  _lerpx1 _lerpx0 - abs to _lerpdistx
  _lerpy1 _lerpy0 - abs to _lerpdisty

  _lerpdistx _lerpdisty - 0= if
    _lerpx0 _lerpy0 _lerpxt execute
  else
    _lerpdistx _lerpdisty > if
      \ ." branch1 distx is greater than disty "
      \ find base, inc, range
      _lerpx0 to _lerpbase 1 to _lerpinc
      _lerpx0 _lerpx1 > if _lerpx0 to _lerpbase -1 to _lerpinc then
      _lerpdistx 2* to lerp-pct-range
      \ inner loop
      _lerpdistx 1+ 0 do
        _lerpbase 
        _lerpy1 _lerpy0 i 2* 1+ lerp-pct 
        _lerpxt execute
        _lerpbase _lerpinc + to _lerpbase
      loop
    else
      \ ." branch2 disty is greater than distx "
      \ find base, inc, range
      _lerpy0 to _lerpbase 1 to _lerpinc
      _lerpy0 _lerpy1 > if _lerpy0 to _lerpbase -1 to _lerpinc then
      _lerpdisty 2* to lerp-pct-range
      \ inner loop
      _lerpdisty 1+ 0 do
        _lerpx1 _lerpx0 i 2* 1+ lerp-pct
        _lerpbase
        _lerpxt execute
        _lerpbase _lerpinc + to _lerpbase
      loop
    then
  then
;

: rect2d \ outline box

  _lerpx0 _lerpx1 > if _lerpx0 _lerpx1 to _lerpx0 to _lerpx1 then

  _lerpx1 _lerpx0 do
    i _lerpy0 _lerpxt execute
    i _lerpy1 _lerpxt execute
  loop

  _lerpy0 _lerpy1 > if _lerpy0 _lerpy1 to _lerpy0 to _lerpy1 then
  _lerpy1 _lerpy0 - to _lerpdisty

  _lerpdisty > 1 if 
    _lerpy1 _lerpy0 1+ do
      _lerpx0 i _lerpxt execute
      _lerpx1 i _lerpxt execute
    loop
  then

;

: fillrect2d \ filled box

  _lerpx0 _lerpx1 > if _lerpx0 _lerpx1 to _lerpx0 to _lerpx1 then
  _lerpy0 _lerpy1 > if _lerpy0 _lerpy1 to _lerpy0 to _lerpy1 then

  _lerpy1 1+ _lerpy0 do
    _lerpx1 1+ _lerpx0 do
      i j _lerpxt execute
    loop
  loop

;

\ ************* 2D Cursor *************

0 value cur-2dc                     \ selected object address
: create-2dc ( "name" -- )
  create 0 , 0 , 0 , 0 , 0 ,
does>
  to cur-2dc ;
: 2dc-x0@ cur-2dc @ ;
: 2dc-x0! ( v -- ) cur-2dc ! ;
: 2dc-y0@ cur-2dc cell+ @ ;
: 2dc-y0! ( v -- ) cur-2dc cell+ ! ;
: 2dc-x1@ cur-2dc cell+ cell+ @ ;
: 2dc-x1! ( v -- ) cur-2dc cell+ cell+ ! ;
: 2dc-y1@ cur-2dc 3 cells + @ ;
: 2dc-y1! ( v -- ) cur-2dc 3 cells + ! ;
: 2dc-stroke@ cur-2dc 4 cells + @ ;
: 2dc-stroke! ( xt -- ) cur-2dc 4 cells + ! ;
: 2dc-dot
  2dc-x0@ 2dc-y0@ 2dc-stroke@ execute
;

: _2dc-setup
  2dc-stroke@ to _lerpxt
  2dc-x0@ to _lerpx0
  2dc-x1@ to _lerpx1
  2dc-y0@ to _lerpy0
  2dc-y1@ to _lerpy1
;

: 2dc-line
  _2dc-setup
  lerp2d
;

: 2dc-rect
  _2dc-setup
  rect2d
;

: 2dc-fillrect
  _2dc-setup
  fillrect2d
;

\ create-2dc mycursor
\ mycursor ' debug-lerpxt 2dc-stroke!
\ mycursor 10 2dc-x0!
\ mycursor 5 2dc-y1!
\ 2dc-line

\ ************* Array 2D, 8-bit *************

0 value cur-a2d8      \ header address
0 value cur-a2d8!     \ data address
0 value a2d8?         \ last operation error flag
: create-a2d8 ( width height "name" -- )
  create 2dup * -rot swap , , allot
does>
  dup 2 cells + to cur-a2d8!
  to cur-a2d8 ;
: a2d8-width cur-a2d8 @ ;
: a2d8-height cur-a2d8 cell+ @ ;
: a2d8-1d ( x y -- idx ) \ Convert (x,y) to 1-dimensional index
  a2d8-width * + ;
: a2d8! cur-a2d8! + c! ;
: a2d8@ cur-a2d8! + c@ ;
: a2d8-dump cur-a2d8 a2d8-width a2d8-height * cell+ cell+ col-dump ;

: a2d8-in-bounds? ( x y -- t )
  2dup 0 >= swap 0 >= + -rot a2d8-height < swap a2d8-width < + + -4 =
;

: a2d8-plot2d ( v x y -- )
  2dup a2d8-in-bounds? dup to a2d8?
  if a2d8-1d a2d8!
  else 2drop drop then
;

: a2d8-fill ( v -- )
  cur-a2d8! a2d8-width a2d8-height * rot fill ;
;

\ Type lines ( can be repurposed to write to buffers etc. )

: debug-a2d8-writeln fasttype cr ;
' debug-a2d8-writeln value a2d8-writeln-xt \ ( caddr1 u -- )
: debug-a2d8-iter . . . cr ;
' debug-a2d8-iter value a2d8-iter-xt \ ( x y v -- )

0 value _a2d8-i
: a2d8-type
  cur-a2d8! to _a2d8-i
  a2d8-height 0 do 
    _a2d8-i a2d8-width a2d8-writeln-xt execute
    _a2d8-i a2d8-width + to _a2d8-i 
  loop
;

: a2d8-iter
  cur-a2d8! to _a2d8-i
  a2d8-width 0 do
    a2d8-height 0 do
      i j _a2d8-i a2d8-iter-xt execute
      _a2d8-i 1+ to _a2d8-i 
    loop
  loop
;


\ x0 y0 x1 y1 c2d-xy!     \ set the point positions for cursor2d
\ : my-stroke ( x y -- )
\   1 rot- a2d8-plot2d    \ plot "1" to the selected array2d
\ ;
\ 
\ ' my-stroke to c2d-stroke \ set the cursor stroke to the xt of my-stroke

\ 5 4 create-a2d8 myarray myarray a2d8-dump


\ TODOs to actually finish the port:
\ Render my first bitmap
\   The form in which I write VDP programs basically always assumes:
\   we write a whole stored program...
\   and we either upload it to a particular buffer in append or replace mode, then execute
\   or we execute immediately
\   i can probably make a new VDP program writer that makes better use of arenas etc.
\   in a lot of instances we want to stream off of sdcard and for that we end up with this idiom:
\     begin a buffer with a few commands to setup the buffer
\     seek to the file position we want
\     copy some number of bytes
\     upload the buffer
\     for stock commands like setting up bitmaps and such, we may end up doing this:
\     create a load/store wordset for "configure this vdp command"
\     define that command through random access
\     then execute to append it to a buffer. or inverting that idea, the word appends itself to the buffer,
\     and they use, in turn, words for incremental buffer-append and blit-to-buffer
\     that gives us the arena feature "for free" everywhere.

\ we are now in the stage where I should start including VDU codes to do some engine things.

\ what codes do i need?
\ well, i want to primarily do things with the charset rewriting thingy
\ i need a thing for "hey turn this buffer into a VDP bitmap with an index"

\ so, i have a potentially viable basis
\ i have a a2d8-type and the debug print will basically do what i need with the rewritten charsets, if i
\ position it beforehand
\ if i can add to this the aspect of interactivity with a cursor, we have the start of the bitmap editor
\ and the tilemap editor
\ this editor system won't work with really large maps...
\ i do need variations that crop out rectangles and pad or wrap at the edges so that we can have scrolling camera

\ anyway, the first FIXME is to figure out how to connect together a2d8 and 2dc properly.
\ what i want to do is make some code that constructs a 32x32 bitmap,
\ a pen for it, and ways of configuring the pen.
\ then add "upload the bitmap" and such.
\ once we have some of that going, accumulate features until we have something that can edit graphics, save to disk
\ then plan out how we want to make the larger interactive system for adventure creation


\ Bitmap editor bringup
\ File save/load (design file format)
\ Render my first tilemap
\ Tilemap editor bringup
\ Item editor bringup
\ Monster editor bringup
\ Game loop
\ SFX editor bringup
\ Integrate SFX

\ If we do all of that we have such a nice basis for more game ports.
\ Do all the magazine games and keep polishing - things will Start To Happen.
\ If things get slow in Forth, we can always write some assembly
