home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / Basic / Q_BASIC.450 / BALLXOR.BAS < prev    next >
BASIC Source File  |  1987-09-23  |  2KB  |  82 lines
  1. DECLARE FUNCTION GetArraySize (WLeft, WRight, WTop, WBottom)
  2.  
  3. SCREEN 2
  4. CLS
  5. VIEW (20, 10)-(620, 190), , 1
  6.  
  7. CONST PI = 3.141592653589#
  8.  
  9. WINDOW (-3.15, -.14)-(3.56, 1.01)
  10.  
  11. ' $DYNAMIC
  12. ' The rectangle is smaller than the one in the previous
  13. ' program, which means Array is also smaller:
  14. WLeft = -.18
  15. WRight = .18
  16. WTop = .05
  17. WBottom = -.05
  18.  
  19. ArraySize% = GetArraySize(WLeft, WRight, WTop, WBottom)
  20.  
  21. DIM Array(1 TO ArraySize%) AS INTEGER
  22.  
  23. CIRCLE (0, 0), .18
  24. PAINT (0, 0)
  25.  
  26. GET (WLeft, WTop)-(WRight, WBottom), Array
  27. CLS
  28.  
  29. LINE (-3, .8)-(3.4, .2), , B
  30. Pattern$ = CHR$(126) + CHR$(0) + CHR$(126) + CHR$(126)
  31. PAINT (0, .5), Pattern$
  32.  
  33. LOCATE 21, 29
  34. PRINT "Press any key to end"
  35.  
  36. StepSize = .02
  37. StartLoop = -PI
  38. Decay = 1
  39.  
  40. DO
  41.    EndLoop = -StartLoop
  42.    FOR X = StartLoop TO EndLoop STEP StepSize
  43.       Y = ABS(COS(X)) * Decay - .14
  44.  
  45.       ' The first PUT statement places the image on
  46.       ' the screen:
  47.       PUT (X, Y), Array, XOR
  48.  
  49.       ' An empty FOR...NEXT loop to delay the program and
  50.       ' reduce image flicker:
  51.       FOR I = 1 TO 5: NEXT I
  52.  
  53.       IF Y < -.13 THEN Decay = Decay * .9
  54.       Esc$ = INKEY$
  55.       IF Esc$ <> "" OR Decay < .01 THEN EXIT FOR
  56.  
  57.       ' The second PUT statement erases the image and
  58.       ' restores the background:
  59.       PUT (X, Y), Array, XOR
  60.    NEXT X
  61.  
  62.    StepSize = -StepSize
  63.    StartLoop = -StartLoop
  64. LOOP UNTIL Esc$ <> "" OR Decay < .01
  65.  
  66. Pause$ = INPUT$(1)
  67. END
  68. REM $STATIC
  69. REM $DYNAMIC
  70. FUNCTION GetArraySize (WLeft, WRight, WTop, WBottom) STATIC
  71.    VLeft = PMAP(WLeft, 0)
  72.    VRight = PMAP(WRight, 0)
  73.    VTop = PMAP(WTop, 1)
  74.    VBottom = PMAP(WBottom, 1)
  75.  
  76.    RectHeight = ABS(VBottom - VTop) + 1
  77.    RectWidth = ABS(VRight - VLeft) + 1
  78.  
  79.    ByteSize = 4 + RectHeight * INT((RectWidth + 7) / 8)
  80.    GetArraySize = ByteSize \ 2 + 1
  81. END FUNCTION
  82.