pdun007c.bas

#lang "fb"

#include once "fbgfx.bi"

    declare sub loadmem(fn as string,w as integer,h as integer,buffer as fb.Image Ptr)
    declare sub readmap(MAP() as integer,X as integer,Y as integer)
    declare sub drawmap(MAP() as integer)
    declare sub fivethou(byref x as integer,byref y as integer,xx as integer,yy as integer, COND() as integer)

    'Dim As fb.Image Ptr image = ImageCreate(150, 50)
    'Get (1,1)-(150,50), image

    Dim As fb.Image Ptr GA = ImageCreate(16, 16)    'brick03.mem
    Dim As fb.Image Ptr GB = ImageCreate(16, 16)    'flame01.mem
    Dim As fb.Image Ptr GC = ImageCreate(16, 16)    'flame02.mem
    Dim As fb.Image Ptr GD = ImageCreate(16, 16)    'skull01.mem
    Dim As fb.Image Ptr GR = ImageCreate(16, 16)    'dereck1.mem
    Dim As fb.Image Ptr GM = ImageCreate(64, 32)    'map002.mem

    'DIM AS INTEGER GA(16, 16)  'brick03.mem
    'DIM AS INTEGER GB(16, 16)  'flame01.mem
    'DIM AS INTEGER GC(16, 16)  'flame02.mem
    'DIM AS INTEGER GD(16, 16)  'skull01.mem
    'DIM AS INTEGER GR(16, 16)  'dereck1.mem
    'DIM AS INTEGER GM(64,32)   'map002.mem

    DIM SHARED AS INTEGER MAP(15,7) 'visible map
    DIM SHARED AS INTEGER COND(1 TO 5)  'map logic

    dim shared as integer GS
    DIM AS INTEGER T,TT,R
    DIM AS STRING C,XM,YM
    DIM AS INTEGER X,Y,XX,YY,CURMAP
    DIM AS SHORT START

    'KEY OFF
    ScreenRes 640, 480, 4, 8
    Screenset 1,0

    VIEW PRINT 1 TO 25
    COLOR 15, 0
    CLS
    CURMAP = 2
    X = 2
    Y = 2

'GOSUB 2000


sub loadmem(fn as string,w as integer,h as integer,buffer as fb.Image Ptr)

    buffer=ImageCreate(w, h)

    dim as integer filemode,T,TT,R
    filemode=freefile

    cls

    FOR TT = 0 TO h-1
        FOR T = 0 TO w-1

            INPUT #1, R
            PSET (T, TT), R

        NEXT T
    NEXT TT

    CLOSE filemode

    GET (0, 0)-(w-1, h-1), buffer

end sub

loadmem "brick03.mem",16,16,GA
loadmem "flame01.mem",16,16,GB
loadmem "flame02.mem",16,16,GC
loadmem "skull01.mem",16,16,GD
loadmem "dereck1.mem",16,16,GR
loadmem "map002.mem",64,32,GM

CLS
ScreenCopy 1, 2

do

    C = INKEY

    XM = SPACE(0)
    YM = SPACE(0)

    IF LEN(C) = 0 THEN

        C = SPACE(1)

    END IF

    IF C = CHR(27) THEN

        SCREEN 0, 0, 0, 0
        WIDTH 80
        COLOR 15, 1 ', 1
        CLS
        END

    END IF

    XX = X
    YY = Y

    IF INSTR("123", C) > 0 THEN Y = Y + 1
    IF INSTR("789", C) > 0 THEN Y = Y - 1
    IF INSTR("369", C) > 0 THEN X = X + 1
    IF INSTR("147", C) > 0 THEN X = X - 1

    IF X < 0 THEN X = 0 ELSE IF X > 319 THEN X = 319
    IF Y < 0 THEN Y = 0 ELSE IF Y > 199 THEN Y = 199

    IF TIMER - START > .2 THEN START = TIMER: GS = GS xor 1

    COND(5)=0
    do while COND(5)=0

        ScreenCopy 2, 1

        readmap MAP(),X,Y

        LINE (0, 0)-(319, 199), 0, BF

        drawmap MAP()
        fivethou x,y,x,yy,COND()

        ScreenCopy 1, 0

    loop
loop

sub readmap(MAP() as integer,X as integer,Y as integer)
    dim as integer T,TT

    FOR TT = 1 TO 7
        FOR T = 1 TO 15
            MAP(T, TT) = POINT(X + (T - 8), Y + (TT - 4))
        NEXT T
    NEXT TT

end sub

sub drawmap(MAP() as integer)
    dim as integer T,TT

    FOR TT = 1 TO 7
    FOR T = 1 TO 15


    SELECT CASE MAP(T,TT)

    CASE IS = 1 'brick

        SELECT CASE GS and 1
        CASE IS = 0
            PUT ((T - 1) * 16, (TT - 1) * 16), GA

        CASE IS = 1
            PUT ((T - 1) * 16, (TT - 1) * 16), GA

        END SELECT

    CASE IS = 2 'flame

        SELECT CASE GS and 1
        CASE IS = 0
            PUT ((T - 1) * 16, (TT - 1) * 16), GB

        CASE IS = 1
            PUT ((T - 1) * 16, (TT - 1) * 16), GC

        END SELECT

    CASE IS = 3 'flame

        SELECT CASE GS and 1
        CASE IS = 0
            PUT ((T - 1) * 16, (TT - 1) * 16), GB

        CASE IS = 1
            PUT ((T - 1) * 16, (TT - 1) * 16), GC

        END SELECT

    CASE IS = 4 'skull

        SELECT CASE GS and 1
        CASE IS = 0
            PUT ((T - 1) * 16, (TT - 1) * 16), GD

        CASE IS = 1
            PUT ((T - 1) * 16, (TT - 1) * 16), GD

        END SELECT

    CASE IS > 4
        LINE((T-1)*16,(TT-1)*16)-(T*16,TT*16),15,B

    END SELECT

    NEXT T
    NEXT TT

end sub


sub fivethou(byref x as integer,byref y as integer,xx as integer,yy as integer, COND() as integer)

    COND(1)=MAP(8,4)>=1
    COND(2)=MAP(8,4)<=2
    COND(3)=MAP(8,4)=-1
    COND(4)=MAP(8,4)=4
    COND(5)=COND(1) AND COND(2) OR COND(3) OR COND(4)

    IF COND(5) THEN
        X = XX
        Y = YY
        RETURN 1010
    END IF

    'LOCATE 20,1:PRINT X;",";Y;
    'LINE((8-1)*16,(4-1)*16)-(8*16,4*16),15,B

    LINE ((1 - 1) * 16, (1 - 1) * 16)-(15 * 16, 7 * 16), 15, B

    PUT ((8 - 1) * 16, (4 - 1) * 16), GR, OR

end sub