jargon

pdun007c.bas

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