jargon

pdun007c.bas

Sep 18th, 2020
887
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. #lang "fblite"
  2. Option Gosub
  3.  
  4. #include once "fbgfx.bi"
  5.    
  6.     declare sub loadmem(fn as string,w as integer,h as integer,buffer as fb.Image Ptr)
  7.  
  8.     'Dim As fb.Image Ptr image = ImageCreate(150, 50)
  9.     'Get (1,1)-(150,50), image 
  10.  
  11.     Dim As fb.Image Ptr GA = ImageCreate(16, 16)    'brick03.mem
  12.     Dim As fb.Image Ptr GB = ImageCreate(16, 16)    'flame01.mem
  13.     Dim As fb.Image Ptr GC = ImageCreate(16, 16)    'flame02.mem
  14.     Dim As fb.Image Ptr GD = ImageCreate(16, 16)    'skull01.mem
  15.     Dim As fb.Image Ptr GR = ImageCreate(16, 16)    'dereck1.mem
  16.     Dim As fb.Image Ptr GM = ImageCreate(64, 32)    'map002.mem
  17.    
  18.     'DIM AS INTEGER GA(16, 16)  'brick03.mem
  19.     'DIM AS INTEGER GB(16, 16)  'flame01.mem
  20.     'DIM AS INTEGER GC(16, 16)  'flame02.mem
  21.     'DIM AS INTEGER GD(16, 16)  'skull01.mem
  22.     'DIM AS INTEGER GR(16, 16)  'dereck1.mem
  23.     'DIM AS INTEGER GM(64,32)   'map002.mem
  24.    
  25.     DIM AS INTEGER MAP(15,7)    'visible map
  26.     DIM AS INTEGER COND(1 TO 5) 'map logic
  27.    
  28.     DIM AS INTEGER T,TT,R
  29.     DIM AS STRING C,XM,YM
  30.     DIM AS INTEGER X,Y,XX,YY,GS,CURMAP
  31.     DIM AS SHORT START
  32.    
  33.     'KEY OFF
  34.     ScreenRes 640, 480, 4, 8
  35.     Screenset 1,0
  36.  
  37.     VIEW PRINT 1 TO 25
  38.     COLOR 15, 0
  39.     CLS
  40.     CURMAP = 2
  41.     X = 2
  42.     Y = 2
  43.  
  44. 'GOSUB 2000
  45.  
  46.  
  47. sub loadmem(fn as string,w as integer,h as integer,buffer as fb.Image Ptr)
  48.  
  49.     buffer=ImageCreate(w, h)
  50.    
  51.     dim as integer filemode
  52.     filemode=freefile
  53.    
  54.     cls
  55.  
  56.     FOR TT = 0 TO h-1
  57.         FOR T = 0 TO w-1
  58.  
  59.             INPUT #1, R
  60.             PSET (T, TT), R
  61.  
  62.         NEXT T
  63.     NEXT TT
  64.  
  65.     CLOSE filemode
  66.  
  67.     GET (0, 0)-(w-1, h-1), buffer
  68.  
  69. end sub
  70.  
  71. loadmem "brick03.mem",16,16,GA()
  72. loadmem "flame01.mem",16,16,GB()
  73. loadmem "flame02.mem",16,16,GC()
  74. loadmem "skull01.mem",16,16,GD()
  75. loadmem "dereck1.mem",16,16,GR()
  76. loadmem "map002.mem",64,32,GM()
  77.  
  78. CLS
  79. ScreenCopy 1, 2
  80.  
  81. 100
  82.    
  83.     C = INKEY
  84.    
  85.     XM = SPACE(0)
  86.     YM = SPACE(0)
  87.  
  88.     IF LEN(C) = 0 THEN
  89.        
  90.         C = SPACE(1)
  91.    
  92.     END IF
  93.    
  94.     IF C = CHR(27) THEN
  95.        
  96.         SCREEN 0, 0, 0, 0
  97.         WIDTH 80
  98.         COLOR 15, 1 ', 1
  99.         CLS
  100.         END
  101.    
  102.     END IF
  103.    
  104.     XX = X
  105.     YY = Y
  106.    
  107.     IF INSTR("123", C) > 0 THEN Y = Y + 1
  108.     IF INSTR("789", C) > 0 THEN Y = Y - 1
  109.     IF INSTR("369", C) > 0 THEN X = X + 1
  110.     IF INSTR("147", C) > 0 THEN X = X - 1
  111.    
  112.     IF X < 0 THEN X = 0 ELSE IF X > 319 THEN X = 319
  113.     IF Y < 0 THEN Y = 0 ELSE IF Y > 199 THEN Y = 199
  114.  
  115.     IF TIMER - START > .2 THEN START = TIMER: GS = GS xor 1
  116.  
  117. 1010
  118.  
  119.     ScreenCopy 2, 1
  120.    
  121.     FOR TT = 1 TO 7: FOR T = 1 TO 15
  122.    
  123.     MAP(T, TT) = POINT(X + (T - 8), Y + (TT - 4))
  124.    
  125.     NEXT T: NEXT TT
  126.  
  127.     LINE (0, 0)-(319, 199), 0, BF
  128.     FOR TT = 1 TO 7: FOR T = 1 TO 15
  129.  
  130.  
  131.     SELECT CASE MAP(T,TT)
  132.    
  133.     CASE IS = 1 'brick
  134.        
  135.         SELECT CASE GS and 1
  136.         CASE IS = 0
  137.             PUT ((T - 1) * 16, (TT - 1) * 16), GA
  138.        
  139.         CASE IS = 1
  140.             PUT ((T - 1) * 16, (TT - 1) * 16), GA
  141.        
  142.         END SELECT
  143.    
  144.     CASE IS = 2 'flame
  145.        
  146.         SELECT CASE GS and 1
  147.         CASE IS = 0
  148.             PUT ((T - 1) * 16, (TT - 1) * 16), GB
  149.        
  150.         CASE IS = 1
  151.             PUT ((T - 1) * 16, (TT - 1) * 16), GC
  152.        
  153.         END SELECT
  154.    
  155.     CASE IS = 3 'flame
  156.        
  157.         SELECT CASE GS and 1
  158.         CASE IS = 0
  159.             PUT ((T - 1) * 16, (TT - 1) * 16), GB
  160.        
  161.         CASE IS = 1
  162.             PUT ((T - 1) * 16, (TT - 1) * 16), GC
  163.        
  164.         END SELECT
  165.    
  166.     CASE IS = 4 'skull
  167.        
  168.         SELECT CASE GS and 1
  169.         CASE IS = 0
  170.             PUT ((T - 1) * 16, (TT - 1) * 16), GD
  171.        
  172.         CASE IS = 1
  173.             PUT ((T - 1) * 16, (TT - 1) * 16), GD
  174.        
  175.         END SELECT
  176.    
  177.     CASE IS > 4
  178.         LINE((T-1)*16,(TT-1)*16)-(T*16,TT*16),15,B
  179.    
  180.     END SELECT
  181.  
  182.     NEXT T: NEXT TT
  183.    
  184.     GOSUB 5000
  185.    
  186.     ScreenCopy 1, 0
  187.    
  188.     GOTO 100
  189.  
  190. 5000
  191.  
  192.     COND(1)=MAP(8,4)>=1
  193.     COND(2)=MAP(8,4)<=2
  194.     COND(3)=MAP(8,4)=-1
  195.     COND(4)=MAP(8,4)=4
  196.     COND(5)=COND(1) AND COND(2) OR COND(3) OR COND(4)
  197.    
  198.     IF COND(5) THEN
  199.         X = XX
  200.         Y = YY
  201.         RETURN 1010
  202.     END IF
  203.    
  204.     'LOCATE 20,1:PRINT X;",";Y;
  205.     'LINE((8-1)*16,(4-1)*16)-(8*16,4*16),15,B
  206.    
  207.     LINE ((1 - 1) * 16, (1 - 1) * 16)-(15 * 16, 7 * 16), 15, B
  208.    
  209.     PUT ((8 - 1) * 16, (4 - 1) * 16), GR, OR
  210.    
  211.     RETURN
  212.  
  213.  
RAW Paste Data