\ progload

needs double
needs ids
needs events
needs zstrings
needs fields
needs datamgr
needs fieldutils
needs skins
needs listfill
needs listutil
needs 1802memory

decimal

: parse-load-addr
    ( -- start-adr true | false )
    \ parse start address
    1001 field>uhex 0= if
        ( )
        5020 FrmAlert drop
        false exit
    else
        true
    then ;

: loword  ( u. -- u )    drop ;

: recbyte@  ( addr -- byte )
    u>ud
    [ sizeof RecHdr: ] literal  m+
    db db.rec.ptr@    d+
    c@a ;    

\ db must be open before calling
: progsize@  ( -- progsize )
   db db-rec-size   ( size. )    
    [ sizeof RecHdr: u>ud ] 2literal  d-
    ( progsize. )
    loword  ;

: wontfit? 
    ( startaddr progsize -- flag )
    +    addrmax @ 1+   > ;

: loadit  ( -- flag )   
    parse-load-addr 0= if
        false exit
    then
    ( startaddr )  >r  ( )
    1000 list-sel@     ( sel )
    db db-open-rec-ro   ( )
    progsize@      ( progsize )

    r@ over
    ( progsize startaddr progsize )
    wontfit?    ( progsize flag )
    if    drop r> drop    ( )
            5100 FrmAlert drop
            db db-close-rec
            false exit
    then

    0 swap        ( byte# progsize )
    begin
        dup while
        over  dup       ( b# prgsz b# b# )
        recbyte@     ( b# prgsz b# b )
        swap  r@ +   ( b# prgsz b adr )
        byte!              ( b# prgsz )
        1- swap 1+ swap   ( strt' prgsz' )
    repeat
    2drop
    r> drop
    db db-close-rec
    true ;

: start-addr@  ( -- startaddr )
    1000 list-sel@ dup       ( sel sel )
    noListSelection = if
        drop 0
    else
        db db-open-rec
        db db.rec.ptr@     ( &rec. )
        0 rec.startaddr m+  @a   ( start )
        db db-close-rec
    then ;

: update-start-addr  ( -- )
    ['] start-addr@ catch if  0  then
    ( startaddr ) 
    u>ud  hex
    <# # # # # #>   ( str len )
    1001 string>Field drop ;    

: do-load-buttons  ( -- flag )
    event >abs itemid
    case
    \ OK pressed
    2000 of    loadit    endof
    \  Cancel pressed
    2001 of    true     endof
    \ otherwise
    false swap
    endcase ;

\ Process events for Load dialog
\ and return TRUE when it's time
\ for the dialog to close.
: do-load-event  ( ekey -- flag )
    case
    ctlSelectEvent of
        do-load-buttons    ( flag )
    endof
    lstSelectEvent of
        \ Note: I don't check the list ID
        \ because there's only one list
        \ in this dialog.
        update-start-addr  false  ( flag )
    endof
    ( otherwise )
    false swap
    endcase ;

: do-load-msg-loop  ( -- )
        begin
            ekey do-load-event
        until ;

: loadprogram  ( -- )
    db ['] db-open-ro catch if
        drop
        5080 FrmAlert drop
    else
        db db-rec-count 0= if
            5080 FrmAlert drop
        else
            2510 PopupForm
            1000 list-fill
            update-start-addr
            do-load-msg-loop
            current-form-id @
            FrmReturnToForm 
        then
        db db-close
    then ;

