Frozen Fish 1: Amiga

home *** CD-ROM | disk | FTP | other *** search

/ Frozen Fish 1: Amiga / FrozenFish-Apr94.iso / bbs / alib / d0xx / d013 / basicprogs.lha / mandelbrot / Mandelbrot.bas < prev next >

Wrap

BASIC Source File | 1986-02-23 | 18.5 KB | 445 lines

1 ' 1 ' Tacky, hacky program to do Mandelbrot pretty color pictures 1 ' 1 ' Some storage declarations 1 ' XOrigin Real part Origin 1 ' YOrigin Imaginary part origin 1 ' Iterations% Maximum number of iterations for each point 1 ' DeltaX Maximum X delta 1 ' DeltaY Maximum Y delta 1 ' X% Current X coordinate 1 ' Y% Current Y coordinate 1 ' XInc% X increment 1 ' YInc% Y increment 1 ' ScreenX% Screen X coordinate 1 ' ScreenY% Screen Y coordinate 1 ' MouseX Screen X coordinate of mouse origin 1 ' MouseY Screen Y coordinate of mouse origin 1 ' MouseDX Screen delta X for mouse box 1 ' Scale%() Current scaling array 1 ' Screen% An array to save the screen into 1 ' FileName$ The filename to write the screen into 1 ' Resolution% Screen resolution (0=320, 1=640) 1 ' BitPlanes% Number of bit planes to use 1 ' Prompt$ Command prompt string 1 ' Command$ Command string 1 ' Upper$ String of upper case characters 1 ' Lower$ String of lower case characters 1 ' LowerCase% Non-zero if lower case characters are ok from the command 1 ' Valid% Non-zero if the screen data is valid 1 ' MouseValid% Non-zero if the mouse data is valid 1 ' Default Default numeric argument 1 ' Result Numeric argument from keyboard 1 ' Direction% Sign of direction for UP/DOWN/LEFT/RIGHT 1 ' Code% Array containing iteration loop code 1 ' Regs% Array containing registers for LibCall 1 ' ContourValid% Non-zero if contouring array has been built 1 ' Boot% True if we're bootstrapping 1 ' 1000 Dim Scale%(2000), Screen%(16010), Code%(150), Regs%(16) 1010 Upper$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" 1020 Lower$ = "abcdefghijklmnopqrstuvwxyz" 1030 Def FnMax(a%, b%) = a% - (a% < b%) * (b% - a%) 1035 Boot% = 0 ' Assume not booting 1 ' 1 ' Read the initial mandelbrot set: 1 ' 1040 FileName$ = "MandelSet.640" 1050 GoSub 13000 : If Success% Then GoTo 1100 1060 FileName$ = "MandelSet.320" 1070 GoSub 13000 : If Success% Then GoTo 1100 1075 XOrigin = -2.0 : YOrigin = -1.125 : DeltaX = 3.99 : DeltaY = DeltaX * 180 / 320 1076 Iterations% = 250 : Resolution% = 0 ' Default iterations and resolution 1077 BitPlanes% = 4 ' Default number of bit planes 1080 FileName$ = "MandelSet.320" ' Default bootstrap filename 1090 Boot% = -1 ' We're bootstrapping ! 1 ' 1 ' Read the iteration loop from disk: 1 ' 1100 BLoad "MandelMung", VarPtr(Code%(0)) 1 ' 1 ' Zero all the regs: 1 ' 1110 For I% = 0 to 15 1120 Regs%(I%) = 0 1130 Next I% 1140 ContourValid% = 0 ' Contour array isn't valid yet 1150 MouseValid% = 0 ' No valid mouse data yet 1 ' 1 ' Setup the screen 1 ' 2000 RGB 0, 0, 0, 0 ' Set color register zero to black 2010 RGB 1, 6, 9, 15 ' Set color register 1 to dark blue 2020 Screen Resolution%, BitPlanes%, 0 ' Setup screen resolution 2030 ScnClr ' Make sure the screen is clear 2040 If Boot% Then GoTo 6000 ' Compute set if in boot mode 2050 GShape (0, 0), Screen%() ' Restore the old screen data 2060 Valid% = 1 ' Say our data isn't valid 1 ' 1 ' Look for some commands: 1 ' 3000 GoSub 10000 ' Wait for the user to be ready 3010 GShape (0, 0), Screen% ' Restore the screen 3015 Prompt$ = "Command: " ' Get the command prompt 3020 LowerCase% = 0 ' Make sure everything's upper case 3025 GoSub 14000 ' Get the command string 3030 If Command$ = "EXIT" Then End 3035 If Command$ = "GO" Then GoTo 6000 3040 If Command$ = "SAVE" Then GoTo 3100 3045 If Command$ = "RESET" Then GoTo 1010 3050 If Command$ = "READ" Then GoTo 3200 3055 If Command$ = "CLEAR" Then GoTo 3500 3060 If Command$ = "SET" Then GoTo 3300 3065 If Command$ = "SHOW" Then GoTo 3400 3070 If Command$ = "UP" Then GoTo 3600 3075 If Command$ = "DOWN" Then GoTo 3610 3077 If Command$ = "RIGHT" Then GoTo 3700 3079 If Command$ = "LEFT" Then GoTo 3710 3080 If Command$ = "ZOOM" Then GoTo 3800 3085 If Command$ = "MOUSE" Then GoTo 4000 3090 If Command$ = "SYSTEM" Then System 3097 If Command$ = "HELP" Then GoTo 3900 3098 If Command$ = "" Then GoTo 3000 3099 Print at (0,0) "? Command error";: GoTo 3000 1 ' 1 ' He wants to save something, prompt for the filename: 1 ' 3100 If Valid% Then GoTo 3120 ' Only do this if screen active 3110 Print at (0,0) "? Data not computed";: GoTo 3000 3120 Prompt$ = "File name: " ' Ask him for a filename 3130 LowerCase% = 1 ' Say lowercase here is ok 3140 GoSub 14000 ' Go get the filename 3150 FileName$ = Command$ ' Copy the filename 3160 GoSub 12000 ' Go write the file 3165 Boot% = 0 ' We aren't booting anymore I guess 3170 If Success% Then GoTo 3010 ' Ok, go ask for another command 3180 Print at (0,0) "? File write error"; 3190 GoTo 3000 ' Wait for the mouse again 1 ' 1 ' He wants to read a file. Prompt for it: 1 ' 3200 Prompt$ = "File name: " ' Ask him for a filename 3210 LowerCase% = 1 ' Say lowercase here is ok 3220 GoSub 14000 ' Ask for the filename 3230 FileName$ = Command$ ' Copy the filename 3240 GoSub 13000 ' Go read the file 3250 If Success% Then GoTo 2000 ' Re-init the screen if happy 3260 Print at (0,0) "? File read error - Reset"; 3270 GoSub 10000 ' Wait for a mouse button 3280 GoTo 1010 ' And restart 1 ' 1 ' Prompt the user for the new values: 1 ' 3300 Prompt$ = "X Origin " : Default = XOrigin : GoSub 16000 3305 XOrigin = Result 3310 Prompt$ = "Y Origin " : Default = YOrigin : GoSub 16000 3315 YOrigin = Result 3320 Prompt$ = "Delta X " : Default = DeltaX : GoSub 16000 3325 DeltaX = Result : DeltaY = DeltaX * 180/320 3330 Prompt$ = "Iterations " : Default = Iterations% : GoSub 16000 3335 Iterations% = Result 3340 Prompt$ = "Resolution " : Default = Resolution% : GoSub 16000 3345 Resolution% = Result 3350 Prompt$ = "Bit Planes " : Default = BitPlanes% : GoSub 16000 3355 BitPlanes% = Result 3360 If ((Resolution% + BitPlanes%) < 6) And (Resolution% > -1) And (Resolution% < 2) And (BitPlanes% > 0) Then 3390 3370 Print at (0,0) "? Illegal resolution/bitplane values" : GoTo 3000 3390 GoTo 3880 ' Say the screen and mouse isn't valid 1 ' 1 ' Show the current values: 1 ' 3400 If MouseValid% = 0 Then Print at (0,0) "X Origin = "; XOrigin; " Y Origin = "; YOrigin 3405 If MouseValid% = 1 Then Print at (0,0) "X Origin = "; MouseX ; " Y Origin = "; MouseY 3410 If MouseValid% = 0 Then Print "Delta X = "; DeltaX; " Delta Y = "; DeltaY 3415 If MouseValid% = 1 Then Print "Delta X = "; MouseDX;" Delta Y = "; MouseDY 3420 Print "Iterations = "; Iterations% 3430 Print "Resolution = "; Resolution% 3450 Print " Bit Planes = "; BitPlanes%; 3460 GoTo 3000 1 ' 1 ' Here if we want to clear the data just set. About the only thing that 1 ' can be done is default back to the current screen data 1 ' 3500 GoSub 13500 ' Yank the data back from Screen% 3510 Valid% = 1 ' Say the screen's valid again 3520 GoTo 2000 ' Back to the prompt loop 1 ' 1 ' Here if we want to increment Y some fraction of the screen: 1 ' 3600 Direction% = 1 : GoTo 3620 ' Set sign of increment 1 ' 1 ' Here if we want to decrement Y some fraction of the screen: 1 ' 3610 Direction% = -1 ' Set the sign of the increment 3620 Prompt$ = "Screen fraction " ' Set the prompt 3630 Default = .5 ' Assume half the screen 3640 GoSub 16000 ' Read the screen fraction 3650 YOrigin = YOrigin + (DeltaY * Result * Direction%) 3660 GoTo 3880 ' Screen data not valid 1 ' 1 ' Here if we want to increment X some fraction of the screen: 1 ' 3700 Direction% = 1 : GoTo 3720 ' Set sign of the increment 1 ' 1 ' Here if we want to decrement X some fraction of the screen: 1 ' 3710 Direction% = -1 ' Set sign of the increment 3720 Prompt$ = "Screen fraction " ' Set the prompt 3730 Default = .5 ' Assume half the screen 3740 GoSub 16000 ' Read the screen fraction 3750 XOrigin = XOrigin + (DeltaX * Result * Direction%) 3760 GoTo 3880 ' Screen is no longer valid 1 ' 1 ' If here we want to zoom in or out. > 1 is zoom in, < 1 is zoom out 1 ' 3800 Prompt$ = "Zoom Factor " ' Set the prompt 3810 Default = 2 ' Assume twice resolution 3820 GoSub 16000 ' Get the zoom factor 3830 If Result > 0 Then GoTo 3860 ' Check range 3840 Print "? Must be greater than 0" ' Complain 3850 GoTo 3000 ' Let him think about it 3860 DeltaX = DeltaX / Result ' Scale the DeltaX 3870 DeltaY = DeltaY / Result ' Scale the DeltaY 3880 Valid% = 0 ' Screen's no longer valid 3885 MouseValid% = 0 ' No more mouse data 3890 GoTo 3010 ' Prompt again 1 ' 1 ' Give some hint as to what we're about: 1 ' 3900 Print at (0,0) "One of the following commands:" 3905 Print "Clear Clear data just set" 3910 Print "Down Reset Y origin downwards" 3915 Print "Exit Exit Mandelbrot.Bas" 3920 Print "Go Compute the new set" 3925 Print "Help Show this text" 3930 Print "Left Reset X origin left" 3933 Print "Mouse Use mouse to set origin" 3935 Print "Read Read a saved screen" 3940 Print "Reset Reset program" 3945 Print "Right Reset X origin right" 3950 Print "Save Save the screen" 3955 Print "Set Set new data" 3960 Print "Show Show current settings" 3965 Print "System Exit to CLI or workbench" 3970 Print "Up Reset Y origin upwards" 3975 Print "Zoom Zoom current settings" 3980 Print "Press left mouse button to continue" 3999 GoTo 3000 1 ' 1 ' Here to set the new coordinates using the mouse: 1 ' 4000 GoSub 20000 ' Go get the new coordinates 4010 Print at (0,0) "X = "; MouseX 4020 Print "Y = "; MouseY 4030 Print "DeltaX = "; MouseDX 4040 Print "DeltaY = "; MouseDY 4050 GoTo 3000 1 ' 1 ' Main loop here: 1' 6000 If ContourValid%= 0 Then GoSub 11000 ' Compute the contour map 6001 If MouseValid% = 0 Then GoTo 6010 ' Skip this if mouse not valid 6002 XOrigin = MouseX : YOrigin = MouseY 6003 DeltaX = MouseDX : DeltaY = MouseDY 6010 Screen Resolution%, BitPlanes%, 0 ' Setup the screen resolution 6020 ScnClr ' And start with a clean screen 6023 XInc% = (2 ^ 30 * DeltaX / 320 / (Resolution% + 1)) 6024 YInc% = (2 ^ 30 * DeltaY / 180) ' Compute increments 6030 Y% = YOrigin * (2 ^ 30) ' Set initial Y 6040 For ScreenY% = 179 to 0 Step -1 ' Outside loop is Y% 6050 X% = XOrigin * (2 ^ 30) ' Set initial X again 6060 For ScreenX% = 0 to (320 * (Resolution% + 1) - 1) Step 1 1 ' 1 ' Initialize a single point's values: 1 ' 6070 Regs%(0) = X% : Regs%(1) = Y% 6080 Regs%(2) = Iterations% 1 ' 1 ' Per point loop: 1 ' 6100 LibCall VarPtr(Code%(0)), 0, Regs%() 6110 I% = Peek_W(VarPtr(Regs%(2)) + 2) ' Get the iteration count 6120 If I% > (Iterations% - 1) Then GoTo 6300 1 ' 1 ' Here if we bummed out. Plot the point 1 ' 6200 Draw (ScreenX%, ScreenY%), Scale%(I% + 1) 1 ' 1 ' Bump to the next point 1' 6300 X% = X% + XInc% 6310 Next ScreenX% 6320 Y% = Y% + YInc% 6330 Next ScreenY% 1 ' 1 ' All done! 1 ' 6340 Valid% = 1 ' Say we're valid again 6350 MouseValid% = 0 ' Mouse data isn't valid 6360 SShape (0, 0; (320 * (Resolution% + 1)) - 1, 199), Screen% 6370 If Boot% Then Goto 3160 Else GoTo 3000 1 ' 1 ' Write the data file out and quit 1 ' 7000 GoSub 10000 ' Wait for the mouse button 7010 GoSub 12000 ' Write the file out 7020 End ' End of proggie 1 ' 1 ' Subroutine to wait for the mouse button to be pressed 1 ' 10000 Ask Mouse X%, Y%, Button% 10010 If Button% = 0 Then GoTo 10000 10020 Return 1 ' 1 ' Subroutine to fill in the scaling array given the number of bit planes 1 ' desired. 1 ' 11000 Interval% = 1 11010 Print at (0,0) "Computing contouring array"; 11020 I% = 1 11030 Color% = 1 11040 For J% = 1 to Interval% 11050 If I% <= 2000 Then Scale%(I%) = Color% 11060 I% = I% + 1 11070 Next J% 11080 If I% > 1000 Then GoTo 11130 11090 Color% = Color% + 1 11100 If Color% < (2 ^ BitPlanes%) Then 11040 11110 Interval% = Interval% + 2 11120 GoTo 11030 11130 ContourValid% = 1 ' So we don't have to do this again 11140 Return 1 ' 1 ' The disk file is created/read with BSAVE/BLOAD into array Screen%. 1 ' The first elements of this array are obtained from/fed to SShape/GShape. 1 ' We load values into this array following the screen data itself. On 1 ' write, the location in the array is determined by the resolution we're 1 ' writing. When reading the file, the offset can be obtained from the 1 ' resolution implied by the width paramter in the front of the array. 1 ' 1 ' The values appended to the screen array are: 1 ' 1 ' Byte # Contents 1 ' ==== = ======== 1 ' 0 File format version number (1) 1 ' 1 Screen resolution mode (0 or 1) 1 ' 2-3 Iteration count 1 ' 4-7 X Origin 1 ' 8-11 Y Origin 1 ' 12-15 Delta X 1 ' 16-19 Delta Y 1 ' 12000 SShape (0, 0; (320 * (Resolution% + 1) - 1), 199), Screen%() 12010 I% = (2000 * BitPlanes% * (Resolution% + 1)) + 2 12020 Poke VarPtr(Screen%(I%)), 2 12030 Poke VarPtr(Screen%(I%))+1, Resolution% 12040 Poke_W VarPtr(Screen%(I%))+2, Iterations% 12050 Screen%(I%+1) = Peek_L(VarPtr(XOrigin)) 12060 Screen%(I%+2) = Peek_L(VarPtr(YOrigin)) 12070 Screen%(I%+3) = Peek_L(VarPtr(DeltaX)) 12080 Screen%(I%+4) = Peek_L(VarPtr(DeltaY)) 12090 Success% = 0 : On Error GoTo 12130 ' In case of errors 12100 BSave FileName$, Varptr(Screen%(0)), (I% + 5) * 4 12110 Success% = 1 : On Error GoTo 0 12120 Return 12130 Resume 12120 1 ' 1 ' Converse of the previous routine, this routine restores a screen to 1 ' memory. See the previous subroutine for notes on the file format. 1 ' 13000 Success% = 0 : On Error GoTo 13660 ' In case the file lookup fails 13010 BLoad FileName$, VarPtr(Screen%(0)) 13020 On Error GoTo 0 13500 BitPlanes% = Peek_W(VarPtr(Screen%(0))) 13510 Width% = Peek_W(VarPtr(Screen%(0))+2) 13520 If Width% < 320 Then Resolution% = 0 Else Resolution% = 1 13530 I% = (2000 * BitPlanes% * (Resolution% + 1)) + 2 13540 FileVersion% = Peek(VarPtr(Screen%(I%))) 13550 If (FileVersion% > 0) And (FileVersion% < 3) Then GoTo 13580 13560 Print "? File version number error" 13570 Return 13580 If FileVersion% < 2 Then Iterations% = Peek(VarPtr(Screen%(I%))+2) 13590 If FileVersion% >= 2 Then Iterations% = Peek_W(VarPtr(Screen%(I%))+2) 13600 Poke_L VarPtr(XOrigin), Peek_L(VarPtr(Screen%(I%+1))) 13610 Poke_L VarPtr(YOrigin), Peek_L(VarPtr(Screen%(I%+2))) 13620 Poke_L VarPtr(DeltaX), Peek_L(VarPtr(Screen%(I%+3))) 13630 Poke_L VarPtr(DeltaY), Peek_L(VarPtr(Screen%(I%+4))) 13640 Success% = 1 13650 Return 13660 Resume 13650 1 ' 1 ' Subroutine to prompt for and read a command. Called with the command 1 ' prompt in Prompt$, and returns the command keyword (uppercased) in 1 ' Command$. We'll restore the screen after we're done. 1 ' 14000 Print at (0,0) Prompt$; 14010 Input "", Command$ 14020 GShape (0, 0), Screen% ' Restore the screen 14030 If LowerCase% Then Return ' Return now if lower case is ok 1 ' 1 ' Subroutine to uppercase the alpha characters in the command string. 1 ' 15000 For I% = 1 to Len(Command$) 15010 J% = InStr(1, Lower$, Mid$(Command$, I%, 1)) 15030 If J% Then Replace$(Command$, I%, 1) = Mid$(Upper$, J%, 1) 15040 Next I% 15050 Return 1 ' 1 ' Prompt for a numeric argument, preserving the old value if appropriate 1 ' 16000 Prompt$ = Prompt$ + "(" + Str$(Default) + "): " 16010 GoSub 14000 ' Go prompt and read the number 16020 If Command$ = "" Then Result = Default Else Result = Val(Command$) 16030 Return 1 ' 1 ' Routine to take new coordinates from mouse input. 1 ' User positions mouse to lower left corner of intended 1 ' area to zoom, clicks mouse button once. Position mouse 1 ' to upper left corner, click mouse button again. This 1 ' goes to great lengths to preserve the proper aspect 1 ' ratio. 1 ' 20000 PenA 1 ' Set the default writing color 20005 XoverY = 320 * (Resolution% + 1) / 180 : YoverX = 1 / XoverY 1 ' 1 ' Wait for the button to be pressed while on screen 1 ' 20010 Ask Mouse X%, Y%, Button% ' Go read the mouse 20020 If X% < 0 or Y% < 0 Then GoTo 20010 ' Ignore if not in window 20030 If X% > ((Resolution% + 1) * 320) - 1 Then GoTo 20010 20040 If Y% > 179 Then GoTo 20010 ' Ignore if too big also 20050 If Button% = 0 Then GoTo 20010 ' Wait for mouse buttom 20060 MouseX% = X% : MouseY% = Y% : NewDX% = 0 : OldDX% = 0 1 ' 1 ' Wait for the button to be released 1 ' 20070 While Button% <> 0: Ask Mouse X%, Y%, Button%: Wend 1 ' 1 ' Loop here waiting for the second pressing of the button 1 ' 20080 While Button% = 0 20090 If X% < MouseX% Then GoTo 20210 ' Don't make negative boxes 20100 If Y% > MouseY% Then GoTo 20210 20110 If X% > ((Resolution% + 1) * 320) -1 Then GoTo 20210 20120 If Y% > 179 Then GoTo 20210 ' Don't bother if too big 20130 OldDX% = NewDX% ' Copy the old delta X 20140 NewDX% = FnMax ((X% - MouseX%), int(XoverY * (MouseY% - Y%))) 20150 If NewDX% = OldDX% Then GoTo 20210 ' Don't bother if no change 20160 GShape (0, 0), Screen% ' Something moved, restore the old screen 20170 X% = MouseX% + NewDX% ' Find the corner 20180 Y% = MouseY% - int(YoverX * NewDX%) ' of the box 20190 Draw (MouseX%, MouseY% to X%, MouseY% to X%, Y%), 1 20200 Draw (X%, Y% to MouseX%, Y% to MouseX%, MouseY%), 1 20210 Ask Mouse X%, Y%, Button% ' Get the new mouse position 20220 Wend 20230 MouseValid% = 1 ' Say we have valid mouse data 20240 Gshape (0, 0), Screen% ' Restore the screen 20250 MouseX = XOrigin + DeltaX * MouseX% / (320 * (Resolution% + 1)) 20260 MouseY = YOrigin + (DeltaX * 180 / 320) * (179 - MouseY%) / 180 20270 MouseDX = DeltaX * NewDX% / (320 * (Resolution% + 1)) 20280 MouseDY = MouseDX * 180 / 320 20290 Return