Sx Keystrokes.bas

dim shared ckey as string
ckey = space(0)

type sx_glyph_type
     As fb.Image Ptr sx_and
     As fb.Image Ptr sx_or
end type

redim shared as sx_glyph_type sx_placeholder ( 0 to 0 )

sx_placeholder(0).sx_and = imagecreate(16,16,0,8)
sx_placeholder(0).sx_or = imagecreate(16,16,0,8)

line sx_placeholder(0).sx_and,  (0,0)-(15,15),  15, bf
line sx_placeholder(0).sx_or,   (0,0)-(15,15),  0,  bf

declare sub sx_clearscreen()

declare sub sx_keywait( _
    byref c as string   =   "", _
    message as string   =   "*", _
    fg as integer       =   15, _
    bg as integer       =   9, _
    wipe as integer     =   0, _
    delay as single     =   2, _
    refresh as integer  =   1, _
    posx as integer     =   0, _
    posy as integer     =   0, _
    glyph_i as integer  =   0, _
    glyph_masked() as sx_glyph_type _
)

declare function sx_status( _
    header as string, _
    subject as string, _
    numeric as integer, _
    d as integer, _
    ext as string _
) as string

sub sx_clearscreen()
    dim as integer w=0,h=0,fg=0,bg=0,c=0

    ScreenInfo w, h '', depth, bpp, pitch, rate, driver

    fg=LoWord(color())
    bg=HiWord(color())

    line(0,0)-(w-1,h-1),HiWord(color()),bf

end sub

sub sx_keywait( _
    byref c as string   =   "", _
    message as string   =   "*", _
    fg as integer       =   15, _
    bg as integer       =   9, _
    wipe as integer     =   0, _
    delay as single     =   2, _
    refresh as integer  =   1, _
    posx as integer     =   0, _
    posy as integer     =   0, _
    glyph_i as integer  =   0, _
    glyph_masked() as sx_glyph_type _
)

    dim as single start=timer

    c=space(0)

    If not(fg=-1) then color fg
    If not(bg=-1) then color ,bg

    If not(fg=-1) then color fg
    If not(bg=-1) then color ,bg

    if not(wipe=0) then
        sx_clearscreen
    end if

    if len(message)>0 then
        print message
    end if

    if ubound(glyph_masked,0)=1 then
        if _
            glyph_i<=ubound(glyph_masked,1) _
            and _
            glyph_i>=lbound(glyph_masked,1) _
        then

            put (posx, posy), glyph_masked(glyph_i).sx_and, and
            put (posx, posy), glyph_masked(glyph_i).sx_or, or

        end if
    end if

    if not(refresh=0) then
        pcopy 1,0
    end if

    do while len(c)=0
        c=inkey

        select case delay

        case -1:
            exit do

        case 0:

        case is > 0:

            if timer-start>=delay then
                exit do
            end if

        end select
    loop

    if c=chr(27) then
        screen 0,0,0,0
        color 15,0
        width 80
        view print 1 to 25
        cls
        end
    end if

end sub

function sx_status( _
    header as string, _
    subject as string, _
    numeric as integer, _
    d as integer, _
    ext as string _
) as string

    dim as string ret
    ret=space(0)


    if len(header)>0 then
        ret += ucase(header)+":"
    end if
    if len(subject)>0 then
        ret += quot +lcase(subject) +quot
    end if
    if d>0 then
        ret += quot +nconcat(numeric,d) +quot
    end if
    if len(ext)>0 then
        ret += lcase(ext)
    end if

    sx_status = ret

end function