\ LAUNCHER - prototyping file system interactions

\ TODO
\ 1. Add custom launchers at the top level for these apps:
\ rokky, AGICCC, space_debris.mod, cybernoid, sword, bubble_universe, BASIC, Forth, Lemmings, Elite, Starship Sentinel
\ 2. Fix up the text files code to point to docs/*.md

\ FIXME
\ The input is really unresponsive and it doesn't seem to be the fault of the display being slow.
\ There's something I am doing wrong, or the firmware is doing wrong, with the keyboard handler, making
\ it poll too slowly. It doesn't drop inputs, mercifully, but it does stutter.
\ I maxed out the key repeat rates (according to what the docs indicate)

\ FIXME
\ Right now, all of this is kind of shaky, first-iteration code.
\ If I want to reuse it for CREATION I probably should give it one more pass.
\ In particular the stringlist stuff could benefit from considering a few different use contexts.

include nibui.4th

\ TODO calculate exact sizes. Right now they are kinda padded

create fs/path^ 256 allot : fs/path! fs/path^ >asciiz ;
create fs/pattern^ 256 allot : fs/pattern! fs/pattern^ >asciiz ;
create fs/resolved^ 256 allot
create fs/fil^ 512 allot
create fs/dir^ 512 allot
variable fs/flags^ 0 fs/flags^ !
variable fs/index^ 0 fs/index^ !

: fs/fil/size@ fs/fil^ @ ; \ number of bytes
: fs/fil/str^ fs/fil^ 22 + ; \ location of the filename asciiz

CODE fs/resolvepath ( --- res)
    LD A, $38
    PUSH DE
    PUSH BC
    PUSH IX
    PUSH IY
    LD HL, fs/flags^
    LD B, (HL) \ flags
    LD HL, fs/index^
    LD C, (HL) \ index to resolve to
    LD HL, fs/path^
    LD IX, fs/resolved^
    LD DE, 256 \ max size of resolved^
    LD IY, fs/dir^
    RST .LIL $8
    LD DE, 0
    LD E, A \ status code
    LD HL, 0
    LD L, C \ index of path
    POP IY
    POP IX
    POP BC
    POP DE
    NEXT
END-CODE

\ debug - example of using paths
: examplepath1
    fs/dir^ 256 $ff fill
    fs/resolved^ 256 $ff fill
    s" *.*" fs/pattern^ >asciiz
    s" /music" fs/path^ >asciiz
    fs/resolvepath .s
;
\ examplepath1

\ debug - view fs structs
: view1 fs/path^ 600 col-dump ;
: view2 fs/fil^ 600 col-dump ;
: view3 fs/resolved^ 600 col-dump ;

CODE fs/dfindfirst ( --- res)
    LD A, $94
    PUSH IX
    PUSH IY
    LD HL, fs/dir^
    LD DE, fs/fil^
    LD BC, fs/resolved^
    LD IX, fs/pattern^
    RST .LIL $8
    EX DE, HL
    POP IY
    POP IX
    NEXT
END-CODE

CODE fs/dfindnext ( --- res)
    LD A, $95
    PUSH IX
    PUSH IY
    LD HL, fs/dir^
    LD DE, fs/fil^
    RST .LIL $8
    EX DE, HL
    POP IY
    POP IX
    NEXT
END-CODE

: fs/listfile
    fs/fil/str^ asciiz> fasttype bl emit bl emit fs/fil/size@ . cr
;
: fs/listfile?
    fs/fil/str^ c@ 0=
;

: fs/listdir/1
    fs/dfindfirst fs/listfile? if exit then fs/listfile
;

: fs/listdir/n
    fs/dfindnext fs/listfile? if exit then fs/listfile
;

: fs/listdir/all
    fs/listdir/1
    begin
        fs/listdir/n
    fs/listfile? until
;

\ ***************** File write buffer (Arena) *****************

: arena/s-fs!
\G Writes strings to the fs$ value.
  arena/len@ 0> if
    arena/buf arena/len@ fs/bytes! arena/reset
  then
;

: arena/create-fs ( size "name" -- )
  arena/create last @ name> execute ['] arena/s-fs! arena/send-xt!
;
: arena/cr. ( caddr u -- )
\G Write a line and a line ending, and send.
    arena/cmove 13 ar8! 10 ar8! arena/send-xt@ execute
;
: arena/. ( caddr u -- )
\G Write a line with no line ending, and send.
    arena/cmove arena/send-xt@ execute
;

1024 arena/create-fs writebuf.

\ ***************** Stringlist ******************
\ This is a basic string list with an 80-column (81 bytes including asciiz terminator) line capacity,
\ an execution token per line for dynamic behaviors, and a line cursor to select and manipulate each line.

0 value strlist$ \ selected list
0 value strlist/line$ \ line cursor
81 4 cells + constant strlist/line-u \ size of each line

: strlist/create ( linecount "name" -- )
\G Creates a new string list.
    create
    dup , \ number of lines capacity
    dup , \ current length allocated
    strlist/line-u * allot \ per-line string + xt + data
    does> to strlist$
;
: strlist/capacity@
\G Returns the number of lines capacity of the list. (This appears at the start of the data structure)
strlist$ @ ;
: strlist/length^
\G The number of lines length used in the list.
strlist$ cell+ ;
: strlist/line/1^
\G Returns additional data for the selected line (1st position)
    strlist$ cell+ cell+ strlist/line$ strlist/line-u * + ;
: strlist/line/2^
\G Returns additional data for the selected line (2nd position)
    strlist$ [ 3 cells literal ] + strlist/line$ strlist/line-u * + ;
;
: strlist/line/3^
\G Returns additional data for the selected line (3rd position)
    strlist$ [ 4 cells literal ] + strlist/line$ strlist/line-u * + ;
;
: strlist/line/4^
\G Returns additional data for the selected line (4th position)
    strlist$ [ 5 cells literal ] + strlist/line$ strlist/line-u * + ;
;
: strlist/line/str^ ( -- caddr )
\G Pointer to str at currently selected strlist/line$
    strlist$ [ 6 cells literal ] + strlist/line$ strlist/line-u * + ;
: strlist/line/str! ( caddr u -- )
\G Writes the string on the selected line.
    dup 80 > if drop 80 then \ trim
    strlist/line/str^ >asciiz
;
: strlist/line/str@ ( -- caddr u )
\G Reads the string on the selected line.
    strlist/line/str^ asciiz>
;
: strlist/line+
\G Advances the selected line (wraparound)
    strlist/line$ 1+
    dup strlist/length^ @ >= if drop 0 then
    to strlist/line$
;
: strlist/line+expand
\G Advances the selected line (expand length to capacity)
    strlist/line$ 1+
    dup strlist/capacity@ >= if drop 0 else
        dup strlist/length^ ! \ expand length
    then
    to strlist/line$
;
: strlist/line-
\G Decrements the selected line (wraparound)
    strlist/line$ 1-
    dup 0< if drop strlist/length^ @ 1- then
    to strlist/line$
;
: strlist/line-end?
    strlist/line$ strlist/capacity@ =
;

: strlist/listdir/1
    fs/dfindfirst fs/listfile? if 0 0 strlist/line/str! exit then fs/fil/str^ asciiz> strlist/line/str!
;
: strlist/listdir/n
    fs/dfindnext fs/listfile? if 0 0 strlist/line/str! exit then fs/fil/str^ asciiz> strlist/line/str!
;

: strlist/clear.
    strlist$ cell+ cell+ \ offset
    strlist/capacity@ strlist/line-u * \ size
    erase
    0 to strlist/line$
;
40 value strlist/pagesize$ \ page size, which may be smaller than line count to support accessory entries
: strlist/page-end?
    strlist/line$ strlist/pagesize$ =
;

true value launcher-continue

0 constant launcher-type/null
1 constant launcher-type/xt
2 constant launcher-type/next
3 constant launcher-type/restart
4 constant launcher-type/back
5 constant launcher-type/music
6 constant launcher-type/pcx
7 constant launcher-type/bin
8 constant launcher-type/bas
9 constant launcher-type/4th
10 constant launcher-type/txt
11 constant launcher-type/custom

15 value strlist/listdir/data/1^ \ used as fg color
0 value strlist/listdir/data/2^ \ used as bg color
0 value strlist/listdir/data/3^ \ used as launcher-type
0 value strlist/listdir/data/4^ \ used as xt or path based on launcher-type

: strlist/listdir/data/apply
    strlist/line/str@ swap drop 0> if \ string exists here, so populate with default for listdir
        strlist/listdir/data/1^ strlist/line/1^ !
        strlist/listdir/data/2^ strlist/line/2^ !
        strlist/listdir/data/3^ strlist/line/3^ !
        strlist/listdir/data/4^ strlist/line/4^ !
    else \ empty entry
        0 strlist/line/1^ !
        0 strlist/line/2^ !
        launcher-type/null strlist/line/3^ !
        0 strlist/line/4^ !
    then
;

: strlist/listdir/page/1
    strlist/clear.
    strlist/listdir/1 strlist/listdir/data/apply strlist/line+expand
    begin
        strlist/listdir/n strlist/listdir/data/apply strlist/line+expand
    strlist/page-end? fs/listfile? or until
;
: strlist/listdir/page/n
    strlist/clear.
    begin
        strlist/listdir/n strlist/listdir/data/apply strlist/line+expand
    strlist/page-end? fs/listfile? or until
;
: strlist/append ( d1 d2 d3 d4 caddr u -- )
    strlist/line/str! strlist/line/4^ ! strlist/line/3^ ! strlist/line/2^ ! strlist/line/1^ ! strlist/line+expand
;

44 strlist/create mystrlist
mystrlist
0 strlist/length^ !

0 value launcherui/strlist/next$
0 value launcherui/strlist/restart$
0 value launcherui/strlist/back$

: launcherui/on-next
    strlist/listdir/page/n
    fs/listfile? 0= if
        launcherui/strlist/next$ execute
    then
    launcherui/strlist/restart$ execute
    launcherui/strlist/back$ execute
;
: launcherui/strlist/next
    14 0 launcher-type/xt ['] launcherui/on-next s" Next page" strlist/append
;
' launcherui/strlist/next to launcherui/strlist/next$
: launcherui/on-restart
    strlist/listdir/page/1 \ build the listing prepared by assigning pattern and path
    fs/listfile? 0= if
        launcherui/strlist/next$ execute
        launcherui/strlist/restart$ execute
    then
    launcherui/strlist/back$ execute
;
: launcherui/strlist/restart
    14 0 launcher-type/xt ['] launcherui/on-restart s" Start Over" strlist/append
;
' launcherui/strlist/restart to launcherui/strlist/restart$

0 value launcherui/strlist/1$

: launcherui/on-back
    launcherui/strlist/1$ execute
;
: launcherui/strlist/back
    14 0 launcher-type/xt ['] launcherui/on-back s" Back" strlist/append
;
' launcherui/strlist/back to launcherui/strlist/back$

: launcherui/obey/run
    s" /run_src.obey" fs/mode/create-new fs/mode/write or fs/open
;
: launcherui/obey/run/close
    writebuf. s"  " arena/cr.
    fs/truncate
    fs/close
    fs/fsync
;

: launcherui/exit/obey
    writebuf.
    s" UnSet kiosk" arena/cr.
    s" echo Exiting to MOS Prompt" arena/cr.
    launcherui/obey/run/close
;

: launcherui/music/obey
    writebuf.
    s" Try playmod /music/" arena/. strlist/line/str@ arena/cr.
    s" cd /" arena/cr.
    s" launcher" arena/cr.
    launcherui/obey/run/close
;

: launcherui/pcx/obey
    writebuf.
    s" Try pcxview /pcx/" arena/. strlist/line/str@ arena/cr.
    s" cd /" arena/cr.
    s" launcher" arena/cr.
    launcherui/obey/run/close
;

: launcherui/txt/obey
    writebuf.
    s" Try more " arena/. strlist/line/4^ @ asciiz> arena/. s" /" arena/. strlist/line/str@ arena/cr.
    s" pause" arena/cr.
    s" cd /" arena/cr.
    s" launcher" arena/cr.
    launcherui/obey/run/close
;

: launcherui/bin/obey
    writebuf.
    s" Try " arena/. strlist/line/4^ @ asciiz> arena/. s" /" arena/. strlist/line/str@ arena/cr.
    s" cd /" arena/cr.
    s" launcher" arena/cr.
    launcherui/obey/run/close
;

: launcherui/bas/obey
    writebuf.
    s" Try bbcbasic " arena/. strlist/line/4^ @ asciiz> arena/. s" /" arena/. strlist/line/str@ arena/cr.
    s" cd /" arena/cr.
    s" launcher" arena/cr.
    launcherui/obey/run/close
;

: launcherui/4th/obey
    writebuf.
    s" Try forth24 " arena/. strlist/line/4^ @ asciiz> arena/. s" /" arena/. strlist/line/str@ arena/cr.
    s" cd /" arena/cr.
    s" launcher" arena/cr.
    launcherui/obey/run/close
;

: launcherui/strlist/games/1
    strlist/clear.
    s" *.bin" fs/pattern^ >asciiz                   \ filename filter
    launcher-type/bin to strlist/listdir/data/3^  \ on-select
    s" /games" fs/path^ >asciiz                     \ path
    fs/path^ to strlist/listdir/data/4^             \ path (restated)
    fs/resolvepath
    launcherui/on-restart
;

: launcherui/strlist/basdemos/1
    strlist/clear.
    s" *.bas" fs/pattern^ >asciiz                   \ filename filter
    launcher-type/bas to strlist/listdir/data/3^  \ on-select
    s" /demos" fs/path^ >asciiz                     \ path
    fs/path^ to strlist/listdir/data/4^             \ path (restated)
    fs/resolvepath
    launcherui/on-restart
;

: launcherui/strlist/music/1
    strlist/clear.
    s" *.mod" fs/pattern^ >asciiz                   \ filename filter
    launcher-type/music to strlist/listdir/data/3^  \ on-select
    s" /music" fs/path^ >asciiz                     \ path
    fs/path^ to strlist/listdir/data/4^             \ path (restated)
    fs/resolvepath
    launcherui/on-restart
;

: launcherui/strlist/pcx/1
    strlist/clear.
    s" *.pcx" fs/pattern^ >asciiz                   \ filename filter
    launcher-type/pcx to strlist/listdir/data/3^  \ on-select
    s" /pcx" fs/path^ >asciiz                     \ path
    fs/path^ to strlist/listdir/data/4^             \ path (restated)
    fs/resolvepath
    launcherui/on-restart
;

: launcherui/strlist/txt/1
    strlist/clear.
    s" *.md" fs/pattern^ >asciiz                   \ filename filter
    launcher-type/txt to strlist/listdir/data/3^  \ on-select
    s" /docs" fs/path^ >asciiz                     \ path
    fs/path^ to strlist/listdir/data/4^             \ path (restated)
    fs/resolvepath
    launcherui/on-restart
;

: launcherui/strlist/4th/1
    strlist/clear.
    s" *.4th" fs/pattern^ >asciiz                   \ filename filter
    launcher-type/4th to strlist/listdir/data/3^  \ on-select
    s" /forth/examples_agon" fs/path^ >asciiz                     \ path
    fs/path^ to strlist/listdir/data/4^             \ path (restated)
    fs/resolvepath
    launcherui/on-restart
;

: launcherui/sword
    s" Try games/sword.bin" arena/cr.
;

: launcherui/rokky
    s" Try games/rokky.bin" arena/cr.
;

: launcherui/cyber
    s" Try games/cybernoid.bin" arena/cr.
;

: launcherui/pacma
    s" Try games/PAC-MAN.BIN" arena/cr.
;

: launcherui/space
    s" playmod music/space_debris.mod" arena/cr.
;

: launcherui/bna
    s" pcxview pcx/bna-2bpp.pcx" arena/cr.
;

: launcherui/stars
    s" Try games/starship_sentinel.bin" arena/cr.
;

: launcherui/bubbl
    s" Try demos/bubbleuniverse.bin" arena/cr.
;

: launcherui/elite
    s" cd /games" arena/cr.
    s" Load elite.bin" arena/cr.
    s" Run" arena/cr.
;

: launcherui/agoni
    s" cd /demos/agoniccc_v01" arena/cr.
    s" Load agoniccc_hd_270.bin" arena/cr.
    s" Run" arena/cr.
;

: launcherui/strlist/1
    strlist/clear.
    13 16 launcher-type/null 0 s"   TOP PICKS  " strlist/append
    0  0 launcher-type/null 0 s"  " strlist/append
    10 0 launcher-type/custom ['] launcherui/sword s" Sword Work - Arcade Action By Inufuto" strlist/append
    11 0 launcher-type/custom ['] launcherui/rokky s" Rokky - Boulder-Dash Style Diamond Digging" strlist/append
    2 0 launcher-type/custom ['] launcherui/cyber s" Cybernoid - Ported From ZX Spectrum" strlist/append
    3 0 launcher-type/custom ['] launcherui/pacma s" Pac-Man - WIP Arcade Port" strlist/append
    10 0 launcher-type/custom ['] launcherui/stars s" Starship Sentinel - Asteroids Style Vector Graphics" strlist/append
    11 0 launcher-type/custom ['] launcherui/space s" space_debris.mod - Music Demo" strlist/append
    2 0 launcher-type/custom ['] launcherui/bna s" bna-2bpp.pcx - High-Res Pictures" strlist/append
    3 0 launcher-type/custom ['] launcherui/bubbl s" Bubble Universe - 2D Graphics Demo" strlist/append
    10 0 launcher-type/custom ['] launcherui/elite s" Elite - 3D Graphics Demo" strlist/append
    11 0 launcher-type/custom ['] launcherui/agoni s" AGONICCC - 3D Demoscene Effect" strlist/append
    0  0 launcher-type/null 0 s"  " strlist/append
    13 16 launcher-type/null 0 s"   ADDITIONAL PROGRAMS  " strlist/append
    0  0 launcher-type/null 0 s"  " strlist/append
    14 0 launcher-type/xt ['] launcherui/strlist/games/1 s" Games" strlist/append
    14 0 launcher-type/xt ['] launcherui/strlist/pcx/1 s" Pictures" strlist/append
    14 0 launcher-type/xt ['] launcherui/strlist/music/1 s" Music" strlist/append
    14 0 launcher-type/xt ['] launcherui/strlist/txt/1 s" Text Files" strlist/append
    14 0 launcher-type/xt ['] launcherui/strlist/basdemos/1 s" Basic" strlist/append
    14 0 launcher-type/xt ['] launcherui/strlist/4th/1 s" Forth" strlist/append
;
' launcherui/strlist/1 to launcherui/strlist/1$

201 constant wevent:strlist/page \ String list: new page

: widget/strlist/cursor^ widget/2^ ; \ cursor index
: widget/strlist/x^ widget/3^ ; \ origin x
: widget/strlist/y^ widget/4^ ; \ origin y
: widget/strlist/data^ widget/6^ ; \ strlist buffer
: widget/strlist/sprite^ widget/7^ ; \ sprite index
: widget/strlist/cursor-asset^ widget/8^ ;
: widget/strlist/bitmapw^ widget/9^ ;
: widget/strlist/bitmaph^ widget/10^ ;
: widget/strlist/bitmapvbuf^ widget/11^ ;
: widget/strlist/cursor.
    \ cursor is displayed offset left of the origin
    widget/strlist/y^ @ widget/strlist/cursor^ @ +
    widget/strlist/x^ @ 2 -
    widget/strlist/sprite^ @ vdp/spr/select.
    8 *  4 + swap 8 * vdp/spr/move-abs. \ multiply text->pixel, then move
;

: widget/strlist.
    widget/strlist/data^ @ to strlist$

    1 vdp/bg.

    \ blank the displayed area of our stringlist
    25 vdp/e.  \ PLOT
    $04 vdp/e. \ move absolute
    widget/strlist/x^ @ 8 * split vdp/e. vdp/e. \ left
    widget/strlist/y^ @ 8 * split vdp/e. vdp/e. \ top
    25 vdp/e.  \ PLOT
    $63 vdp/e. \ rectangle fill (relative, bg color)
    80 8 * split vdp/e. vdp/e. \ right
    strlist/capacity@ 8 * split vdp/e. vdp/e. \ bottom

    \ strlist is displayed flush with origin
    0 to strlist/line$
    strlist/length^ @ 0 do
        widget/strlist/y^ @ strlist/line$ +
        widget/strlist/x^ @ vdp/textcursor-abs.
        strlist/line/1^ @ vdp/fg.
        strlist/line/2^ @ vdp/bg.
        strlist/line/str@ fasttype
        strlist/line+
    loop

;

: on-select
    widget/strlist/cursor^ @ to strlist/line$
    \ 0 0 vdp/textcursor-abs.
    \ s" selected: " fasttype
    \ strlist/line/str^ asciiz> fasttype
    \ 32 emit
    \ strlist/line/1^ @ .
    \ strlist/line/2^ @ .
    \ strlist/line/3^ @ .
    \ strlist/line/4^ @ .

    strlist/line/3^ @
    case
        launcher-type/xt of
            strlist/line/4^ @ execute
            launcher-continue if
                wevent:strlist/page widget/iterate
            then
        endof
        launcher-type/bin of
            vdp/cls.
            ." Running " strlist/line/str@ fasttype
            32 emit ." at path " strlist/line/4^ @ asciiz> fasttype
            launcherui/obey/run launcherui/bin/obey
            false to launcher-continue
        endof
        launcher-type/bas of
            vdp/cls.
            ." Running " strlist/line/str@ fasttype
            32 emit ." at path " strlist/line/4^ @ asciiz> fasttype
            launcherui/obey/run launcherui/bin/obey
            false to launcher-continue
        endof
        launcher-type/4th of
            vdp/cls.
            ." Running " strlist/line/str@ fasttype
            32 emit ." at path " strlist/line/4^ @ asciiz> fasttype
            launcherui/obey/run launcherui/4th/obey
            false to launcher-continue
        endof
        launcher-type/txt of
            vdp/cls.
            ." Running " strlist/line/str@ fasttype
            32 emit ." at path " strlist/line/4^ @ asciiz> fasttype
            launcherui/obey/run launcherui/txt/obey
            false to launcher-continue
        endof
        launcher-type/music of
            vdp/cls.
            ." Running " strlist/line/str@ fasttype
            32 emit ." at path " strlist/line/4^ @ asciiz> fasttype
            launcherui/obey/run launcherui/music/obey
            false to launcher-continue
        endof
        launcher-type/pcx of
            vdp/cls.
            ." Running " strlist/line/str@ fasttype
            32 emit ." at path " strlist/line/4^ @ asciiz> fasttype
            launcherui/obey/run launcherui/pcx/obey
            false to launcher-continue
        endof
        launcher-type/custom of
            vdp/cls.
            ." Running " strlist/line/str@ fasttype
            32 emit ." at path " strlist/line/4^ @ asciiz> fasttype
            launcherui/obey/run
            writebuf.
            strlist/line/4^ @ execute
            s" cd /" arena/cr.
            s" launcher" arena/cr.
            launcherui/obey/run/close
            false to launcher-continue
        endof
    endcase

;

: widget/strlist/init
    2 1 vdp/sys/set-var. \ set hardware test flag

    widget/strlist/cursor-asset^ @
    widget/strlist/bitmapw^ @
    widget/strlist/bitmaph^ @
    widget/strlist/bitmapvbuf^ @ vdp/argb2222-upload.

    widget/strlist/sprite^ @ vdp/spr/select.
    vdp/spr/clear.
    vdp/spr/hw.
    widget/strlist/bitmapvbuf^ @ vdp/spr/add-frame.

    widget/strlist.
    vdp/spr/show.
    widget/strlist/cursor.
;
: widget/strlist/key
    kb/is-down@ if
        kb/fabgl@ case
            k/up of
                \ TODO: there is perhaps overly complicated sync code here where I move the value of the cursor into the strlist selection
                \ and then i sync it back to the widget. Blah.
                widget/strlist/data^ @ to strlist$
                widget/strlist/cursor^ @ to strlist/line$
                strlist/line-
                kb/mods@ 2 = if strlist/line- strlist/line- strlist/line- strlist/line- then \ shift accel
                strlist/line$ widget/strlist/cursor^ !
            endof
            k/down of
                widget/strlist/data^ @ to strlist$
                widget/strlist/cursor^ @ to strlist/line$
                strlist/line+
                kb/mods@ 2 = if strlist/line+ strlist/line+ strlist/line+ strlist/line+ then \ shift accel
                strlist/line$ widget/strlist/cursor^ !
            endof
            k/space of
                on-select
            endof
            k/enter of
                on-select
            endof
        endcase
    then
;

: widget/strlist
    case
        wevent:init of widget/strlist/init endof
        wevent:tick of widget/strlist/cursor. endof
        wevent:key of widget/strlist/key endof
        wevent:strlist/page of
            0 widget/strlist/cursor^ !
            widget/strlist.
        endof
    endcase
;
: widget/strlist! ['] widget/strlist widget/xt! ;

: launcherui/start
    widget/strlist!
    0 widget/strlist/cursor^ !
    2 widget/strlist/x^ !
    2 widget/strlist/y^ !
    strlist$ widget/strlist/data^ !

    launcherui/strlist/1
    vdp/cls.
    widget/strlist.

    13 vdp/fg.
    0 20 vdp/textcursor-abs.
    ." Agon Software Launcher"

    47 0 vdp/textcursor-abs.
    ." Up Arrow and Down Arrow move / Enter selects"
;

: launcherui/loop
    begin
        dbg/enter
        kb/done? 0= if
            begin
                kb/read+
                kb/fabgl@ k/esc = kb/is-down@ and if
                    launcherui/obey/run launcherui/exit/obey
                    false to launcher-continue
                else
                    wevent:key widget/iterate
                then
            kb/done? until
        then
        wevent:tick widget/iterate
        vdp/spr/update.
        vdp/sys/vsync.
        vdp/sys/flush.
        0 dbg/leave
        launcher-continue 0= if exit then
    false until
;

create menu-cursor/asset

0   c, 0   c, 192 c, 192 c, 192 c, 192 c, 0   c, 0   c,
0   c, 192 c, 255 c, 255 c, 255 c, 255 c, 192 c, 0   c,
192 c, 255 c, 255 c, 255 c, 255 c, 255 c, 255 c, 192 c,
192 c, 255 c, 255 c, 255 c, 255 c, 255 c, 255 c, 192 c,
192 c, 255 c, 255 c, 255 c, 255 c, 255 c, 255 c, 192 c,
192 c, 255 c, 255 c, 255 c, 255 c, 255 c, 255 c, 192 c,
0   c, 192 c, 255 c, 255 c, 255 c, 255 c, 192 c, 0   c,
0   c, 0   c, 192 c, 192 c, 192 c, 192 c, 0   c, 0   c,

15000 constant menu-cursor/bmp

\ TODO we should invent a bitmap animation data structure that the menu can point to
\ the menu doesn't need to hold all of this data for itself, really
\ make that something to work on with the next iteration of a-nib

menu-cursor/asset widget/strlist/cursor-asset^ !
menu-cursor/bmp widget/strlist/bitmapvbuf^ !
0 widget/strlist/sprite^ !
8 widget/strlist/bitmapw^ !
8 widget/strlist/bitmaph^ !

: vdp/aud/channel-reset. ( ch -- )
    23 vdp/e. 0 vdp/e. $85 vdp/e. ( ch ) vdp/e. 10 vdp/e.
;

: main/init
    0 vdp/aud/channel-reset.
    1 vdp/aud/channel-reset.
    2 vdp/aud/channel-reset.
    3 vdp/aud/channel-reset.
    4 vdp/aud/channel-reset.
    5 vdp/aud/channel-reset.
    6 vdp/aud/channel-reset.
    7 vdp/aud/channel-reset.
    20 screen/init. \ 512x384 mode ( note: this resets a bunch of stuff )
    vdp/text-at-text. \ text cursor
    255 16 - 16 vdp/cursor-movement. \ wrap, don't scroll
    0 vdp/cursor-ctrl. \ turn off the cursor
    launcherui/start
    wevent:init widget/iterate \ initialize screen and upload assets to VDP
    1 vdp/spr/activate. \ activate space for the cursor sprite
    mos/setkbvector \ custom keyboard
    30 0 do vdp/sys/vsync. vdp/sys/flush. loop \ wait before taking input
    kb/flush \ clear out whatever presses are there before we enter loop
    23 vdp/e. 0 vdp/e. $88 vdp/e. \ keyboard control
        ( delay ) 250 split vdp/e. vdp/e.
        ( rate ) 33 split vdp/e. vdp/e.
        ( led ) 0 vdp/e.
    launcherui/loop
;

: main/bye
    mos/clearkbvector
    screen/finish.
    255 16 - 0 vdp/cursor-movement. \ scroll
    1 vdp/cursor-ctrl. \ turn on the cursor
    vdp/sys/flush.
    bye
;

: main
    main/init
    main/bye
;

: launcher-turnkey
    ['] main turnkey
;

.( Type "launcher-turnkey /launcher.bin" to update the launcher)
