"Roe" Graphic Put routines

Const NULL As Any Ptr = 0

declare Function bmp_load( ByRef filename As Const String ) As Any Ptr

declare sub graphic_settings(filename as string=".\roe config\graphics.cfg")

declare SUB graphicput overload (xx1_short as short=0, yy1_short as short=0, ss1_string as string="")

declare SUB graphicput overload (path as string="sprites", layer as string="a", xx1_short as short=0, yy1_short as short=0, ss1_string as string="")

dim shared as short sprites_enabled=num_enabled
dim shared as short fonts_enabled=num_enabled
dim shared as short textcolor_enabled=num_enabled

graphic_settings ".\roe config\graphics.cfg"

Function bmp_load( ByRef filename As Const String ) As Any Ptr

    Dim As Long filenum, bmpwidth, bmpheight
    Dim As Any Ptr img

'' open BMP file
    filenum = FreeFile()

    If Not(Open( filename For Binary Access Read As #filenum ) = 0 ) Then
        Return NULL
    End If

'' retrieve BMP dimensions
    Get #filenum, 19, bmpwidth
    Get #filenum, 23, bmpheight

    Close #filenum

'' create image with BMP dimensions
    img = ImageCreate( bmpwidth, Abs(bmpheight) )

    If img = NULL Then
        Return NULL
    End If

'' load BMP file into image buffer
    If Not( BLoad( filename, img ) = 0 ) Then
        ImageDestroy( img )
        Return NULL
    End If

    Return img

End Function


sub graphic_settings(filename as string=".\roe config\graphics.cfg")

    dim as long index=0
    redim as string lines(any),parts(any),prefix(any),suffix(any)
    dim as string buffer
    fastload filename, buffer

    if len(buffer)=0 then exit sub

    trk_tok buffer,crlf,lines()
    for index=1 to ubound(lines,1)
        trk_tok lines(t),colon,parts()
        trk_tok parts(1),underscore,prefix()
        trk_tok parts(2),comma,suffix()
        select case lcase(prefix(1))
        case "graphics"
            select case lcase(prefix(2))
            case "sprites"
                select case lcase(suffix(1))
                case cfg_enabled
                    sprites_enabled=num_enabled
                case cfg_disabled
                    sprites_enabled=num_disabled
                end select
            case "fonts"
                select case lcase(suffix(1))
                case cfg_enabled
                    fonts_enabled=num_enabled
                case cfg_disabled
                    fonts_enabled=num_disabled
                end select
            case "textcolor"
                select case lcase(suffix(1))
                case cfg_enabled
                    textcolor_enabled=num_enabled
                case cfg_disabled
                    textcolor_enabled=num_disabled
                end select
            end select
        end select
    next index

end sub

SUB graphicput overload (xx1_short as short=0, yy1_short as short=0, ss1_string as string="")
    graphicput "sprites", "a", xx1_short, yy1_short, ss1_string
    graphicput "sprites", "o", xx1_short, yy1_short, ss1_string
end sub

SUB graphicput overload (path as string="sprites", xx1_short as short=0, yy1_short as short=0, ss1_string as string="")

    select case lcase(path)
    case "sprites":
        select case sprites_enabled
        case num_enabled:
            graphicput path, "a", xx1_short, yy1_short, ss1_string
            graphicput path, "o", xx1_short, yy1_short, ss1_string
        case num_disabled:
            graphicput "sprites", "f", xx1_short, yy1_short, ss1_string
        end select
    case "fonts":
        select case fonts_enabled
        case num_enabled:
            graphicput path, "a", xx1_short, yy1_short, ss1_string
        case num_disabled:
            graphicput "fonts", "f", xx1_short, yy1_short, ss1_string
        end select
    end select

end sub

SUB graphicput overload (path as string="sprites", layer as string="a", xx1_short as short=0, yy1_short as short=0, ss1_string as string="")

    dim as string a_filename, o_filename
    dim as short x, y

    x=(xx1_short - 1) * 8
    y=(yy1_short - 1) * 8

    dim as string glyph
    glyph=space(0)

    ss1_string=lcase(left(ss1_string,8))

    dim as any ptr a
    dim as any ptr o

    select case lcase(path)
    case "sprites":
        select case lcase(layer)
        case "a":
            a_filename = ".\bitmaps\tiles\mask\" + ss1_string + ".bmp"

            if fileexists(a_filename) then
                a = bmp_load( a_filename )
                Bload a_filename,a
            end if
            if Imageinfo ( @a, a_colspan, a_rowspan)=0 then
                PUT (x, y), @a, and
                imagedestroy @a
            end if
        case "o":
            o_filename = ".\bitmaps\tiles\rgb\" + ss1_string + ".bmp"
            if fileexists(o_filename) then
                o=bmp_load( o_filename )
            end if
            if Imageinfo ( @o, o_colspan, o_rowspan)=0 then
                PUT (x, y), @o, or
                imagedestroy @o
            end if
        case "f":

            select case textcolor_enabled
            case num_enabled:
                color ScreenFg,ScreenBg
            case num_disabled:
                color 15,0
            end select

            LOCATE yy1_short, xx1_short
            PRINT left(ss1_string,4);
            LOCATE yy1_short+1, xx1_short
            PRINT right(ss1_string,4);

        end select
    case "fonts":
        select case lcase(layer)
        case "a":
            a_filename = ".\bitmaps\fonts\rgb\" + ss1_string + ".bmp"
            if fileexists(a_filename) then
                a=bmp_load( a_filename )
            end if
            if Imageinfo ( @a, a_colspan, a_rowspan)=0 then
                PUT (x, y), @a, and
                imagedestroy @a
            end if
        case "o":
            a_filename=space(0)
            'line(x,y)-(x+7,y+7),sc_short,bf
        case "f":

            select case textcolor_enabled
            case num_enabled:
                color ScreenFg,ScreenBg
            case num_disabled:
                color 15,0
            end select

            select case lcase(left(ss1_string,4))
            case "lttr":
                LOCATE yy1_short, xx1_short
                glyph=chr(val(mid(ss1_string,5,3)))
                PRINT glyph;
            end select
        end select
    end select

    'IF not(LEN(ss1_string)=8) THEN
    '   LOCATE yy1_short + 1, xx1_short + 1: PRINT ".";
    'END IF

END SUB


'=================


C:\Data\Roe\graphicput.bas(51) warning 13(0): Function result was not explicitly set
C:\Data\Roe\graphicput.bas() error 48: Undefined label, NULL
C:\Data\Roe\graphicput.bas() error 48: Undefined label, IMG