home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / Basic / Q_BASIC.450 / MANDEL.BAS < prev    next >
BASIC Source File  |  1987-09-23  |  6KB  |  181 lines
  1. DEFINT A-Z         ' Default variable type is integer
  2.  
  3. DECLARE SUB ShiftPalette ()
  4. DECLARE SUB WindowVals (WL%, WR%, WT%, WB%)
  5. DECLARE SUB ScreenTest (EM%, CR%, VL%, VR%, VT%, VB%)
  6.  
  7. CONST FALSE = 0, TRUE = NOT FALSE       ' Boolean constants
  8.  
  9. ' Set maximum number of iterations per point:
  10. CONST MAXLOOP = 30, MAXSIZE = 1000000
  11.  
  12. DIM PaletteArray(15)
  13. FOR I = 0 TO 15 : PaletteArray(I) = I : NEXT I
  14.  
  15. ' Call WindowVals to get coordinates of window corners:
  16. WindowVals WLeft, WRight, WTop, WBottom
  17.  
  18. ' Call ScreenTest to find out if this is an EGA machine,
  19. ' and get coordinates of viewport corners:
  20. ScreenTest EgaMode, ColorRange, VLeft, VRight, VTop, VBottom
  21.  
  22. ' Define viewport and corresponding window:
  23. VIEW (VLeft, VTop)-(VRight, VBottom), 0, ColorRange
  24. WINDOW (WLeft, WTop)-(WRight, WBottom)
  25.  
  26. LOCATE 24, 10 : PRINT "Press any key to quit.";
  27.  
  28. XLength = VRight - VLeft
  29. YLength = VBottom - VTop
  30. ColorWidth = MAXLOOP \ ColorRange
  31.  
  32. ' Loop through each pixel in viewport and calculate
  33. ' whether or not it is in the Mandelbrot Set:
  34. FOR Y = 0 TO YLength       ' Loop through every line in
  35.                            ' the viewport.
  36.    LogicY = PMAP(Y, 3)     ' Get the pixel's logical y
  37.                            ' coordinate.
  38.    PSET (WLeft, LogicY)    ' Plot leftmost pixel in the line.
  39.    OldColor = 0            ' Start with background color.
  40.  
  41.    FOR X = 0 TO XLength    ' Loop through every pixel in
  42.                            ' the line.
  43.       LogicX = PMAP(X, 2)  ' Get the pixel's logical x
  44.                            ' coordinate .
  45.       MandelX& = LogicX
  46.       MandelY& = LogicY
  47.  
  48.       ' Do the calculations to see if this point is in
  49.       ' the Mandelbrot Set:
  50.       FOR I = 1 TO MAXLOOP
  51.          RealNum& = MandelX& * MandelX&
  52.          ImagNum& = MandelY& * MandelY&
  53.          IF (RealNum& + ImagNum&) >= MAXSIZE THEN EXIT  FOR
  54.          MandelY& = (MandelX& * MandelY&) \ 250 + LogicY
  55.          MandelX& = (RealNum& - ImagNum&) \ 500 + LogicX
  56.       NEXT I
  57.  
  58.       ' Assign a color to the point:
  59.       PColor = I \ ColorWidth
  60.  
  61.       ' If color has changed, draw a line from the
  62.       ' last point referenced to the new point,
  63.       ' using the old color:
  64.       IF PColor <> OldColor THEN
  65.          LINE -(LogicX, LogicY), (ColorRange - OldColor)
  66.          OldColor = PColor
  67.       END IF
  68.  
  69.       IF INKEY$ <> "" THEN END
  70.    NEXT X
  71.  
  72.    ' Draw the last line segment to the right edge of
  73.    ' the viewport:
  74.    LINE -(LogicX, LogicY), (ColorRange - OldColor)
  75.  
  76.    ' If this is an EGA machine, shift the palette after
  77.    ' drawing each line:
  78.    IF EgaMode THEN ShiftPalette
  79. NEXT Y
  80.  
  81. DO
  82.    ' Continue shifting the palette until the user
  83.    ' presses a key:
  84.    IF EgaMode THEN ShiftPalette
  85. LOOP WHILE INKEY$ = ""
  86.  
  87. SCREEN 0, 0             ' Restore the screen to text mode,
  88. WIDTH 80                ' 80 columns.
  89. END
  90.  
  91. BadScreen:              ' Error handler that is invoked if
  92.    EgaMode = FALSE      ' there is no EGA graphics card
  93.    RESUME NEXT
  94. '
  95. ' ======================= ShiftPalette =======================
  96. ' Rotates the palette by one each time it is called.
  97. ' ============================================================
  98. '
  99. SUB ShiftPalette STATIC
  100.    SHARED PaletteArray(), ColorRange
  101.  
  102.    FOR I = 1 TO ColorRange
  103.       PaletteArray(I) = (PaletteArray(I) MOD ColorRange) + 1
  104.    NEXT I
  105.    PALETTE USING PaletteArray(0)
  106.  
  107. END SUB
  108. '
  109. ' ======================== ScreenTest ========================
  110. '    Tests to see if user has EGA hardware with SCREEN 8.
  111. '    If this causes an error, the EM flag is set to FALSE,
  112. '    and the screen is set with SCREEN 1.
  113. '
  114. '    Also sets values for corners of viewport (VL = left,
  115. '    VR = right, VT = top, VB = bottom), scaled with the
  116. '    correct aspect ratio so viewport is a perfect square.
  117. ' ============================================================
  118. '
  119. SUB ScreenTest (EM, CR, VL, VR, VT, VB) STATIC
  120.    EM = TRUE
  121.    ON ERROR GOTO BadScreen
  122.    SCREEN 8, 1
  123.    ON ERROR GOTO 0
  124.  
  125.    IF EM THEN           ' No error, so SCREEN 8 is OK
  126.       VL = 110  : VR = 529
  127.       VT = 5    : VB = 179
  128.       CR = 15           ' 16 colors (0 - 15)
  129.  
  130.    ELSE                 ' Error, so use SCREEN 1
  131.       SCREEN 1, 1
  132.       VL = 55   : VR = 264
  133.       VT = 5    : VB = 179
  134.       CR = 3            ' 4 colors (0 - 3)
  135.    END IF
  136.  
  137. END SUB
  138. '
  139. ' ======================== WindowVals ========================
  140. '     Gets window corners as input from the user, or sets
  141. '     values for the corners if there is no input.
  142. ' ============================================================
  143. '
  144. SUB WindowVals (WL, WR, WT, WB) STATIC
  145.    CLS
  146.    PRINT "This program prints the graphic representation of"
  147.    PRINT "the complete Mandelbrot Set. The default window is"
  148.    PRINT "from (-1000,625) to (250,-625). To zoom in on part"
  149.    PRINT "of the figure, input coordinates inside this window."
  150.    PRINT
  151.    PRINT "Press <ENTER> to see the default window. Press any"
  152.    PRINT "other key to input your own window coordinates: ";
  153.    LOCATE , , 1
  154.    Resp$ = INPUT$(1)
  155.  
  156.    ' User didn't press ENTER, so input window corners:
  157.    IF Resp$ <> CHR$(13) THEN
  158.       PRINT
  159.       INPUT "X coordinate of upper left corner: ", WL
  160.       DO
  161.          INPUT "X coordinate of lower right corner: ", WR
  162.          IF WR <= WL THEN
  163.          PRINT "Right corner must be greater than left corner."
  164.          END IF
  165.       LOOP WHILE WR <= WL
  166.       INPUT "Y coordinate of upper left corner: ", WT
  167.       DO
  168.          INPUT "Y coordinate of lower right corner: ", WB
  169.          IF WB >= WT THEN
  170.          PRINT "Bottom corner must be less than top corner."
  171.          END IF
  172.       LOOP WHILE WB >= WT
  173.  
  174.    ELSE         ' Pressed ENTER, so set default values.
  175.       WL = -1000
  176.       WR = 250
  177.       WT = 625
  178.       WB = -625
  179.    END IF
  180. END SUB
  181.