home *** CD-ROM | disk | FTP | other *** search
/ CD Shareware Magazine 1996 December / CD_shareware_12-96.iso / DOS / Programa / BUBBLES.ZIP / BUBBLES.BAS < prev   
Encoding:
BASIC Source File  |  1996-05-19  |  2.4 KB  |  88 lines
  1.  CLEAR , , 2000: DEFINT A-Z: SCREEN 7: CLS
  2.   DEF FNR (X) = INT(RND * X) + 1
  3.   DIM E1(150), E2(50), E3(15), S1(500) ' dim arrays    
  4.   DIM S2(500), F1(70), F2(40), R1(200)
  5.   DIM CX(50), CY(50), CT(50)
  6.   DIM TEMP(500)
  7.   DIM SX(50), SY(50), ST(50)
  8.                                                             
  9.    
  10.    CLS : PCOPY 0, 2  'prepare our "background" page    
  11.   FOR I = 1 TO 50  'sprinkle some stars                
  12.     SX(I) = FNR(319): SY(I) = FNR(199)
  13.     ST(I) = FNR(14)
  14.   NEXT
  15.                                                             
  16.                                                             
  17.   ED = 0: ET = 0: TOG = 0
  18.   DO
  19.     PCOPY 2, 0  'copy background to template           
  20.     FOR I = 1 TO 50  'move & display stars             
  21.       SELECT CASE ST(I)
  22.       CASE 1
  23.       C = 12
  24.       CASE 2
  25.       C = 2
  26.       CASE 3
  27.       C = 3
  28.       CASE 4
  29.       C = 4
  30.       CASE 5
  31.       C = 5
  32.       CASE 6
  33.       C = 6
  34.       CASE 7
  35.       C = 7
  36.       CASE 8
  37.       CASE 9
  38.       C = 9
  39.       CASE 10
  40.       C = 10
  41.       CASE 11
  42.       C = 11
  43.       CASE 12
  44.       C = 12
  45.       CASE 13
  46.       C = 15
  47.       END SELECT
  48.      
  49.       CIRCLE (SX(I), SY(I)), 2, C
  50.     '  PAINT (SX(I), SY(I)), C
  51.       SX(I) = SX(I) - ST(I)
  52.       IF SX(I) < 0 THEN
  53.         SX(I) = 319: SY(I) = FNR(199)
  54.         ST(I) = FNR(15)
  55.       END IF
  56.     
  57.     NEXT
  58.     
  59.      PCOPY 0, 1  'copy template to viewing screen      
  60.    
  61.    
  62.    LOOP UNTIL INKEY$ <> ""
  63.   CLS : PCOPY 0, 1  'clear active page                 
  64.   END
  65.  
  66. SUB FONT (a$, X%, Y%, stepX%, stepY%, CO%, Background%, SHADOW%)
  67.  
  68. END SUB
  69.  
  70. ' PUT2P - PUT Type II:                                 
  71. ' Clipping PUT routine.                                
  72. '                                                      
  73. SUB PUT2P (X, Y, AR()) STATIC
  74.   IF X < 0 OR Y < 0 THEN EXIT SUB  'off screen         
  75.   IF X + AR(0) < 320 AND Y + AR(1) < 200 THEN
  76.     PUT (X, Y), AR, PSET: EXIT SUB
  77.   END IF  'already on screen                           
  78.   IF X > (320 - AR(0)) THEN VL = 320 - X ELSE VL = AR(0)
  79.   IF VL < 1 THEN EXIT SUB  'no need                    
  80.   IF Y > (200 - AR(1)) THEN VL2 = 200 - Y ELSE VL2 = AR(1)
  81.   IF VL2 < 1 THEN EXIT SUB  'no need                   
  82.   SAR = AR(0): SAR1 = AR(1)  'hold copy                
  83.   AR(0) = VL: AR(1) = VL2
  84.   PUT (X, Y), AR, PSET  'put modified array            
  85.   AR(0) = SAR: AR(1) = SAR1  'restore altered bytes    
  86. END SUB
  87.  
  88.