Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- #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
- 'brick03.mem
- Dim shared As fb.Image Ptr GA = ImageCreate(16, 16)
- 'flame01.mem
- Dim shared As fb.Image Ptr GB = ImageCreate(16, 16)
- 'flame02.mem
- Dim shared As fb.Image Ptr GC = ImageCreate(16, 16)
- 'skull01.mem
- Dim shared As fb.Image Ptr GD = ImageCreate(16, 16)
- 'dereck1.mem
- Dim shared As fb.Image Ptr GR = ImageCreate(16, 16)
- 'map002.mem
- Dim shared As fb.Image Ptr GM = ImageCreate(64, 32)
- '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
- exit sub
- 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
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement