pdun007c.bas

#lang "fblite"
Option Gosub

#include once "fbgfx.bi"

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

    '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 AS INTEGER MAP(15,7)    'visible map
    DIM AS INTEGER COND(1 TO 5) 'map logic

    DIM AS INTEGER T,TT,R
    DIM AS STRING C,XM,YM
    DIM AS INTEGER X,Y,XX,YY,GS,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
    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

100

    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

1010

    ScreenCopy 2, 1

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

    MAP(T, TT) = POINT(X + (T - 8), Y + (TT - 4))

    NEXT T: NEXT TT

    LINE (0, 0)-(319, 199), 0, BF
    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

    GOSUB 5000

    ScreenCopy 1, 0

    GOTO 100

5000

    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

    RETURN