\ listfill

needs forms
needs callbacks
needs dbcosmac

: rect>width  ( &rect. -- width )
    4 m+ @a ;

: rect>yx  ( &rect. -- y x )   2@a ;

variable pn.fit
variable pn.len
variable pn.width
2variable pn.str
: draw-progname  ( &rect. &name. ) 
    2dup  pn.str 2!   StrLen pn.len !
    0 pn.fit !                ( &rect. )
    2dup rect>width pn.width !  
    ( &rect. )
    pn.fit >abs  pn.len >abs
    pn.width >abs   pn.str 2@
    FntCharsInWidth      ( &rect. )
    rect>yx            ( y x )
    pn.len @            ( y x length )
    pn.str 2@         ( y x length &name. )
    WinDrawChars ;

\ Draw an item bounded by the
\ given rectangle. The item is a zero
\ based index in the list, and as I've
\ implemented this it is also the
\ record number of the program
\ whose name we'll draw here.
: draw-item  ( &rect. item -- )
    db db-open-rec   ( &rect. )
    db db.rec.ptr@  ( &rect. ptr. )
    0 rec.name m+   ( &rect. ptr.' )
    draw-progname   ( )
    db db-close-rec ;

: list-draw-cb   
    ( &text. &rect. item )
    installCbStack callback 
    draw-item  ( &text. )
    0. 0         \ restore stack depth
    end-callback removeCbStack ;

\ Bug workaround: this systrap drops
\ two extra cells.
: LstSetListChoices
    2>r 2>r >r 0. r> 2r> 2r>
    LstSetListChoices ;

: draw-list  ( listID -- )
    GetObjectPtr 2>r        ( )
    db db-rec-count            ( #items )
    0.                           ( #items 0. )
    2r@                     ( #items 0. lstptr. )
    LstSetListChoices    ( )
    ['] list-draw-cb xt>abs    ( &cb. )
    2r@ LstSetDrawFunction    ( )
    2r> LstDrawList ;

: list-fill  ( listID -- )
        ['] draw-list catch if drop then ;
