jargon

pdun007c.bas

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