'========================================================================= ' The Mandelbrot Dazibao - August 2002 - http://mandelbrot.dazibao.free.fr '========================================================================= ' Subroutines declaration DECLARE SUB Init () ' Initial Fractal : Sierpinsky Triangle DECLARE SUB Layout () ' Draws the screen zones DECLARE SUB Box (ox, oy, bw, bh, Ncr) ' Draws a rectangle DECLARE SUB Keys (Action$) ' Activate/deactivate the Fnn keys DECLARE SUB Indic (Ncol) ' Red when busy, green when idle DECLARE SUB Param () ' Refresh of the key parameters DECLARE SUB Frames () ' Draws the frames of IFS DECLARE SUB Change () ' Affine x-y tranformation DECLARE SUB UV (Nf) ' Plots an IFS Frame DECLARE SUB TraceFractal () ' Draws the Fractal DECLARE SUB TraceFrames () ' Draws the IFS frames DECLARE SUB Graph () ' Draws the new graph (frames or fractal) DECLARE SUB Changeview () ' Toggle IFS Frames / Fractal ' Function Keys definition ON KEY(1) GOSUB nFramesMin ' One less IFS frame ON KEY(2) GOSUB nFramesMaj ' One more IFS frame ON KEY(3) GOSUB CaMin ' Decrease IFS frames orientation ON KEY(4) GOSUB CaMaj ' Increase IFS frames orientation ON KEY(5) GOSUB CoMin ' Decrease IFS frames openness ON KEY(6) GOSUB CoMaj ' Increase IFS frames openness ON KEY(7) GOSUB CrMin ' Decrease reference circle radius ON KEY(8) GOSUB CrMaj ' Increase reference circle radius ON KEY(9) GOSUB ClMin ' Decrease IFS vectors length ON KEY(10) GOSUB ClMaj ' Increase IFS vectors length ' Esc key for exit KEY 15, CHR$(0) + CHR$(1) ON KEY(15) GOSUB Finish KEY(15) ON ' ==================================================== CONST Pi = 3.1415927# CONST xCenter = 210 CONST yCenter = 240 CONST Scale = 400 DIM SHARED Flag ' Toggle IFS Frames & Fractal DIM SHARED NFrames ' IFS frames number DIM SHARED Co ' IFS Frames openness DIM SHARED Ca ' IFS Frames angle from horizontal DIM SHARED Cr ' IFS Frames origins distance from (0,0) DIM SHARED Cl ' IFS Frames UV vectors length DIM SHARED Par(15, 7) ' IFS Frames definition DIM SHARED x0(2) ' An IFS origin point DIM SHARED xu(2) ' An IFS U vector DIM SHARED xv(2) ' An IFS V vector DIM SHARED xold(2) ' A point in the viewport DIM SHARED xnew(2) ' A point in an IFS frame ' ==================================================== CLS SCREEN 12 CALL Init CALL Layout CALL Indic(4) CALL Frames Flag = 1 CALL Graph CALL Keys("On") ' ==================================================== DO: LOOP WHILE INKEY$ = "" DO KeyVal$ = INKEY$ SELECT CASE KeyVal$ CASE CHR$(13) CALL Changeview CASE ELSE 'No other action END SELECT LOOP SYSTEM ' ==================================================== Finish: SYSTEM RETURN ' ==================================================== nFramesMin: NFrames = NFrames - 1 IF NFrames = 2 THEN NFrames = 3 A = (.38 - .2) / (LOG(15) - LOG(3)) B = .2 - A * LOG(3) C = 1 D = 1 / 2 - C / 3 Cr = A * LOG(NFrames) + B Cl = C / NFrames + D CALL Frames CALL Graph RETURN nFramesMaj: NFrames = NFrames + 1 IF NFrames = 16 THEN NFrames = 15 A = (.38 - .2) / (LOG(15) - LOG(3)) B = .2 - A * LOG(3) C = 1 D = 1 / 2 - C / 3 Cr = A * LOG(NFrames) + B Cl = C / NFrames + D CALL Frames CALL Graph RETURN CaMin: Ca = Ca - .05 IF Ca < -2 THEN Ca = -2 CALL Frames CALL Graph RETURN CaMaj: Ca = Ca + .05 IF Ca > 2 THEN Ca = 2 CALL Frames CALL Graph RETURN CoMin: Co = Co - .05 IF Co < -2 THEN Co = -2 CALL Frames CALL Graph RETURN CoMaj: Co = Co + .05 IF Co > 2 THEN Co = 2 CALL Frames CALL Graph RETURN CrMin: Cr = Cr - .025 IF Cr < 0 THEN Cr = 0 CALL Frames CALL Graph RETURN CrMaj: Cr = Cr + .025 IF Cr > 1 THEN Cr = 1 CALL Frames CALL Graph RETURN ClMin: Cl = Cl - .025 IF Cl < 0 THEN Cl = 0 CALL Frames CALL Graph RETURN ClMaj: Cl = Cl + .025 IF Cl > 1 THEN Cl = 1 CALL Frames CALL Graph RETURN SUB Box (Offxr, Offyr, BoxWidth, BoxHeight, Ncr) LINE (Offxr, Offyr)-(Offxr + BoxWidth + 1, Offyr + BoxHeight + 1), Ncr, B END SUB SUB Change xnew(1) = x0(1) + ((xu(1) - x0(1)) * xold(1) + (xv(1) - x0(1)) * xold(2)) / Scale xnew(2) = x0(2) + ((xu(2) - x0(2)) * xold(1) + (xv(2) - x0(2)) * xold(2)) / Scale END SUB SUB Changeview Flag = -Flag CALL Graph END SUB SUB Frames FOR Nf = 1 TO 15 FOR i = 1 TO 7 Par(Nf, i) = 0 NEXT i NEXT Nf FOR Nf = 1 TO NFrames 'Colour Par(Nf, 1) = Nf 'Angle U Par(Nf, 2) = Pi / 2 * Ca + (Nf - 1) * (2 * Pi / NFrames) - Pi / 4 * Co 'Angle V Par(Nf, 3) = Par(Nf, 2) + Pi / 2 * Co 'Offset X Par(Nf, 4) = Scale * Cr * COS(2 * Pi * (Nf - 1) / NFrames) 'Offset Y Par(Nf, 5) = Scale * Cr * SIN(2 * Pi * (Nf - 1) / NFrames) 'Length on U Par(Nf, 6) = Scale * Cl 'Length on V Par(Nf, 7) = Scale * Cl NEXT Nf FOR n = 1 TO NFrames x0(1) = Par(n, 4) x0(2) = Par(n, 5) xu(1) = x0(1) + Par(n, 6) * COS(Par(n, 2)) xu(2) = x0(2) + Par(n, 6) * SIN(Par(n, 2)) xv(1) = x0(1) + Par(n, 7) * COS(Par(n, 3)) xv(2) = x0(2) + Par(n, 7) * SIN(Par(n, 3)) Par(n, 2) = x0(1) Par(n, 3) = x0(2) Par(n, 4) = xu(1) Par(n, 5) = xu(2) Par(n, 6) = xv(1) Par(n, 7) = xv(2) NEXT n END SUB SUB Graph CLS IF Flag = -1 THEN CALL TraceFrames ELSE CALL TraceFractal END IF CALL Layout CALL Param END SUB SUB Indic (Ncol) LOCATE 15, 55 PRINT "Status" FOR m = 1 TO 10 FOR n = 1 TO 10 PSET (m + 530, n + 226), Ncol NEXT n NEXT m END SUB SUB Init NFrames = 3 'IFS Frames Number Ca = .5 'IFS Frames Angle position from horizontal Co = 1 'IFS Frames Openness Cr = .2 'IFS Frames Distance from origin. Circle radius Cl = .5 'IFS Frames vectors Length END SUB SUB Keys (Action$) SELECT CASE Action$ CASE "Off" FOR nk = 1 TO 10 KEY(nk) OFF NEXT nk CASE "On" FOR nk = 1 TO 10 KEY(nk) ON NEXT nk END SELECT END SUB SUB Layout LOCATE 4, 55 PRINT "Parameter Min Maj" LOCATE 6, 55 PRINT "Frames F1 F2" LOCATE 8, 55 PRINT "Rotation F3 F4" LOCATE 9, 55 PRINT "Openness F5 F6" LOCATE 11, 55 PRINT "Radius F7 F8" LOCATE 12, 55 PRINT "Size F9 F10" LOCATE 17, 55 PRINT "Mode Enter" LOCATE 18, 55 PRINT "End Esc" CALL Box(420, 40, 210, 160, 4) CALL Box(420, 40, 210, 30, 4) CALL Box(420, 220, 135, 70, 4) CALL Box(555, 40, 38, 160, 4) END SUB SUB Param LOCATE 6, 67 PRINT USING "##"; NFrames LOCATE 8, 65 PRINT USING "+###"; INT(Ca * 90 + .5) LOCATE 9, 65 PRINT USING "+###"; INT(Co * 90 + .5) LOCATE 11, 64 PRINT USING "#.###"; Cr LOCATE 12, 64 PRINT USING "#.###"; Cl END SUB SUB TraceFractal CALL Keys("Off") CALL Box(xCenter - Scale / 2, yCenter - Scale / 2, Scale, Scale, 4) CALL Layout CALL Param CALL Indic(4) X = xCenter Y = yCenter FOR i = 1 TO 25000 Cas = INT(RND * NFrames) + 1 Ncol = Par(Cas, 1) x0(1) = Par(Cas, 2) x0(2) = Par(Cas, 3) xu(1) = Par(Cas, 4) xu(2) = Par(Cas, 5) xv(1) = Par(Cas, 6) xv(2) = Par(Cas, 7) xold(1) = X xold(2) = Y CALL Change X = xnew(1) Y = xnew(2) IF i <= 5 THEN Ncol = 0 IF ABS(X) > (Scale / 2) OR ABS(Y) > (Scale / 2) THEN Ncol = 0 PSET (Y + xCenter, -X + yCenter), Ncol NEXT i CALL Box(xCenter - Scale / 2, yCenter - Scale / 2, Scale, Scale, 4) CALL Keys("On") CALL Indic(2) END SUB SUB TraceFrames CALL Keys("Off") CALL Box(xCenter - Scale / 2, yCenter - Scale / 2, Scale, Scale, 4) CALL Layout CALL Param CALL Indic(4) CIRCLE (xCenter, yCenter), Scale * Cr, 15 FOR n = 1 TO NFrames CALL UV(n) NEXT n CALL Indic(2) CALL Keys("On") END SUB SUB UV (n) Ncol = Par(n, 1) x0(1) = Par(n, 2) x0(2) = Par(n, 3) xu(1) = Par(n, 4) xu(2) = Par(n, 5) xv(1) = Par(n, 6) xv(2) = Par(n, 7) LINE (xCenter + x0(1), yCenter - x0(2))-(xCenter + xu(1), yCenter - xu(2)), Ncol LINE (xCenter + x0(1), yCenter - x0(2))-(xCenter + xv(1), yCenter - xv(2)), Ncol LINE (xCenter + xv(1), yCenter - xv(2))-(xCenter + xv(1) + xu(1) - x0(1), yCenter - (xu(2) + xv(2) - x0(2))), Ncol, , 2 LINE (xCenter + xu(1), yCenter - xu(2))-(xCenter + xv(1) + xu(1) - x0(1), yCenter - (xu(2) + xv(2) - x0(2))), Ncol, , 2 END SUB