DEC.BANKS@MARLBORO.DEC.COM (12/08/85)
From: Dawn Banks <DEC.BANKS@MARLBORO.DEC.COM>
Herein lies the ABasiC source for the Mandelbrot zoom program. This
distribution consists of two ABasiC programs: MandelMung.bas, which contains
the source for the assembly language subroutine, and Mandelbrot.bas, which
is the actual zoom program.
To bootstrap these programs, run ABasiC, and give the following commands:
RUN MandelMung ' which should take about 1 minute
RUN Mandelbrot ' which should take about 15 minutes
Running Mandelbrot the first time will cause it to compute the entire set
(which is the part that takes 15 minutes), and write it to disk as
MandelSet.320. This is a low resolution, 4 bit plane image in which each
point is computed to 250 iterations.
Any time Mandelbrot.bas is run after this, it will read either MandelSet.640
or MandelSet.320 and display it on the screen. Once done, it waits for the
left mouse button to be pressed. When pressed, it prompts for a command. A
complete list of available commands may be obtained by typing the "HELP"
command. When typing commands, always type the command name, followed by a
carraige return. Mandelbrot.bas will then prompt for all subsequent
arguments needed to complete the command. Some of the more interesting
commands are:
SET which prompts for the X and Y coordinates, the DeltaX (difference
between the X value at the right and left of the screen - not the
difference between single points on the screen), screen resolution
(0 or 1 as given to the basic SCREEN statement), bit plane count
and iteration count. When prompting for each of these values, the
default value will be given in parenthesis.
MOUSE Use the mouse to set the coordinates. Move the pointer to the
lower left of the desired coordinate "box", press the left mouse
button, then move the pointer to the upper right of the box and
press the mouse button again. Note that due to several bugs, this
command will not work properly if issued after a set command, nor
will the set command work properly if issued after a MOUSE command.
SHOW Show the current coordinate settings
GO Compute the set as given by the coordinates set by the SET or MOUSE
commands.
READ Read and display an existing set
SAVE Save the current set (may not be done after a SET or MOUSE command,
unless the set has been computed via the GO command). This will
also save the coordinate data with the actual picture.
EXIT Exit to ABasiC.
Program notes:
In order to speed computation of the set, an assembly language
subroutine which does the actual per point iteration. Code readers will
notice that it does not use the normal floating point representation. Since
virtually all the points being computed have an absolute value in the range
of .01 to 1.99, a floating binary representation isn't absolutely necessary.
As a result, a 32 bit fixed point representation has been chosen in which
the high order bit is the sign, the next higher bit is considered to be
"before" the decimal point, and the remaining 30 bits are considered
fraction. This yields an exclusive range of 0 to 2, and in many cases
produces a couple more bits of precision than the normal 32 bit floating
point, as well as reducing execution time. This results in low resolution
screen computation time of between 15 - 45 minutes for most regions.
As is well documented in the USENET Net.Micro.Amiga mailing list, high
resolution screens of more than 2 bit planes will steal compute cycles from
the 68000 processor. It is suggested that when computing high resolution
sets, the screen should be "hidden" under a screen of fewer bit planes.
Fortunately, the workbench screen fits this. Typing some combination of
{Amiga key} N or M will bury the ABasiC screen without affecting the run,
except to speed it up.
Two last points: you're going to need at least 512K bytes of memory,
and using 5 bit plane low resolution screens aren't going to do much for
you, as the program doesn't set the last 16 color registers, which are by
default mapped to the same colors as the first 16 registers. It wouldn't
take much work to modify the program to do this, but we didn't.
Happy hacking!
MandelMung.bas:
1000 Dim code%(71),regs%(16)
1010 Restore 10000
1020 i% = 0: Read j$
1030 While Asc(j$) <> 126
1040 If Asc(j$) = 38 Then Poke_W VarPtr(code%(0)) + i%, Val(j$): i% = i% + 2
1050 Read j$
1060 WEnd
1070 BSave "MandelMung", VarPtr(code%(0)), 282
1999 End
1 '
1 ' MANDEL - calculate Mandelbrot set membership for a point
1 '
1 ' A point C (in the complex plane) belongs to the Mandelbrot set
1 ' if, after iteratively calculating the value Zn+1 = Zn2 + C (with Zo
1 ' being 0 + 0i) the value of Z converges or stabilizes. In this
1 ' algorithm, we actually just test if the magnitude of Z reaches or
1 ' exceeds 2.
1 '
1 ' Arguments:
1 '
1 ' D0 Cr (real component) in 2's complement fixed point binary
1 ' notation with 2 bits in front, 30 behind the binary point
1 '
1 ' D1 Ci (imaginary component)
1 '
1 ' D2 maximum number of iterations, 16 bit unsigned integer
1 ' 0 means 65536
1 '
1 ' Returns:
1 '
1 ' D2 number of iterations executed
1 '
1 ' creams all data registers
1 '
1 ' Stack and register usage:
1 '
1 ' A(A7) saved maximum iteration count (integer word)
1 '
1 ' 9(A7) -1 if Cr is negative, 0 otherwise (boolean byte)
1 '
1 ' 4(A7) absolute value of Cr
1 '
1 ' (A7) absolute value of Ci
1 '
1 ' D0,D1,D3 miscellaneous temporaries
1 '
1 ' D2 -1 if sign of Zr differs from sign of Cr, 0 otherwise
1 '
1 ' D4 absolute value of Zr (usually) - an unsigned longword
1 ' fixed point number with 1 or 2 (depending on when)
1 ' bits in front of the binary point
1 '
1 ' D5 absolute value of Zi (usually)
1 '
1 ' D6 sign of Zi or 2ZrZi (depending on what calculation
1 ' is pending). 0 for positive, -1 for negative
1 '
1 ' D7 iterations are counted down here using DBF. The value
1 ' starts out one less than the maximum count input in D2,
1 ' because of the behaviour of DBF
1 '
1 ' Initialize stuff, set up stack frame
1 '
1 ' MANDEL:
10000 Data &o051502 ," SUBQ.W #1,D2 Adjust count for DBF"
10002 Data &o037402 ," MOVE.W D2,-(A7) Save count on stack"
10004 Data &o037002 ," MOVE.W D2,D7 Move count to D7"
10006 Data &o045200 ," TST.L D0 Check sign of Cr"
10010 Data &o055702 ," SMI D2 Set D2 if negative"
10012 Data &h6A06 ," BPL 10$ Positive, no worry"
10014 Data &o042200 ," NEG.L D0 Cr < 0, |Cr| = -Cr"
10016 Data &h6900,&hAA ," BVS DONE1 Cr was -2, done"
1 '
10022 Data &o045201 ," 10$: TST.L D1 Check sign of Ci"
10024 Data &h6A06 ," BPL 20$ Already positive"
10026 Data &o042201 ," NEG.L D1 Nope, make it +ive"
10030 Data &h6900,&hAC ," BVS DONE2 Ci was -2, done"
1 '
10034 Data &o037402 ," 20$: MOVE.W D2,-(A7) Stack sign of Cr"
10036 Data &o027400 ," MOVE.L D0,-(A7) Put |Cr| on stack"
10040 Data &o027401 ," MOVE.L D1.-(A7) Put |Ci| on stack"
10042 Data &o074000 ," MOVEQ #0,D4 Clear Zr"
10044 Data &o075000 ," MOVEQ #0,D5 and Zi"
10046 Data &o076000 ," MOVEQ #0,D6 and sign of Zi"
1 '
1 ' Add Ci to 2ZrZi and Cr to Zr2-Zi2 to get new Zi and Zr, respectively
1 '
1 ' MNDLUP:
10050 Data &o045006 ," TST.B D6 Check sign of 2ZrZi"
10052 Data &h660C ," BNE 10$ Go do -ive things"
10054 Data &o155227 ," ADD.L (A7),D5 Add Ci to 2ZrZi"
10056 Data &h6500,&h92 ," BCS DONE Result >= 4, done"
10062 Data &h6B00,&h8E ," BMI DONE Result >= 2, done"
10066 Data &h600E ," BRA 20$ OK, go do real part"
1 '
10070 Data &o115227 ," 10$: SUB.L (A7),D5 Add -Ci to 2ZrZi"
10072 Data &h6506 ," BCS 15$ Negative?"
10074 Data &h6B00,&h84 ," BMI DONE Result >= 2, done"
10100 Data &h6004 ," BRA 20$ OK, go do real part"
1 '
10102 Data &o042205 ," 15$: NEG.L D5 Make Zi positive"
10104 Data &o043006 ," NOT.B D6 Note change in sign"
1 '
10106 Data &o045002 ," 20$: TST.B D2 sgn(Zr2-Zi2)<>Sgn(Cr)"
10110 Data &h660A ," BNE 30$ Signs <>, subtract"
10112 Data &o154257,&h4 ," ADD.L 4(A7),D4 Add Cr to Zr2-Zi2"
10116 Data &h6572 ," BCS DONE Result >= 4, done"
10120 Data &h6B70 ," BMI DONE Result >= 2, done"
10122 Data &h600E ," BRA 40$ Go square Z"
1 '
10124 Data &o114257,&h4,"30$: SUB.L 4(A7),D4 Add -Cr to Zr2-Zi2"
10130 Data &h6504 ," BCS 35$ Negative?"
10132 Data &h6B66 ," BMI DONE Result >= 2, done"
10134 Data &h6004 ," BRA 40$ |Cr|<|Zr2-Zi2|"
1 '
10136 Data &o042204 ," 35$: NEG.L D4 Think positive"
10140 Data &o043002 ," NOT.B D2 Sign changed"
1 '
10142 Data &o132057,&h9,"40$: CMP.B 9(A7),D2 Find sign of Zr"
10146 Data &h6702 ," BEQ 45$ Positive, go on"
10150 Data &o043006 ," NOT.B D6 Note sign of 2ZrZi"
1 '
1 ' Square Z, i.e., calculate 2ZrZi and Zr2-Zi2
1 ' also, check magnitude of Z > 2 (Zr2+Zi2 > 4)
1 '
10152 Data &o161604 ," 45$: ASL.L #1,D4 Align Zr"
10154 Data &o161605 ," ASL.L #1,D5 and Zi for BIGMUL"
10156 Data &o027404 ," MOVE.L D4,-(A7) Push Zr"
10160 Data &o027405 ," MOVE.L D5,-(A7) Push Zi"
10162 Data &h6158 ," BSR BIGMUL Get ZrZi"
10164 Data &o023037 ," MOVE.L (A7)+,D3 High end into D3"
10166 Data &o160727 ," ASL.W (A7) Get top of low end"
10170 Data &o161623 ," ROXL.L #1,D3 Make 2ZrZi"
10172 Data &o045127 ," TST.W (A7) Check next bit"
10174 Data &h6A02 ," BPL 50$ Is is set?"
10176 Data &o051203 ," ADDQ.L #1,D3 Yup, round up"
1 '
10200 Data &o027204 ," 50$: MOVE.L D4,(A7) Put Zr on stack"
10202 Data &h6176 ," BSR BIGSQR Get Zr2"
10204 Data &o027405 ," MOVE.L D5,-(A7) Push Zi"
10206 Data &h6172 ," BSR BIGSQR Get Zi2"
10210 Data &o046327,&h33 ," MOVEM.L (A7),<D0,D1,D4,D5>"
10214 Data &o151205 ," ADD.L D5,D1 Add low parts"
10216 Data &o150604 ," ADDX.L D4,D0 Add high parts"
10220 Data &h6522 ," BCS DONE3 Zr2+Zi2 >= 4"
10222 Data &o46337,&h33 ," MOVEM.L (A7)+,<D0,D1,D4,D5>"
10226 Data &o012057,&h9 ," MOVE.B 9(A7),D2 Get sign of Cr"
10232 Data &o115201 ," SUB.L D1,D5 Subtract Zi2"
10234 Data &o114600 ," SUBX.L D0,D4 from Zr2"
10236 Data &h6406 ," BCC 60$ Positive?"
10240 Data &o042205 ," NEG.L D5 No, make it"
10242 Data &o040204 ," NEGX.L D4 positive"
10244 Data &o043002 ," NOT.B D2 sgn(Zr2-Zi2)<>sgn(Cr)"
1 '
10246 Data &o045205 ," 60$: TST.L D5 Check top of bottom"
10250 Data &h6A02 ," BPL 70$ If 0, don't round"
10252 Data &o051204 ," ADDQ.L #1,D4 Round up Zr"
1 '
10254 Data &o143505 ," 70$: EXG D3,D5 Move 2ZrZi to D5"
10256 Data &o050717,&hFF78 ," DBF D7,MNDLUP ReSlog"
10262 Data &h600E ," BRA DONE Out of count, done"
1 '
1 ' Various ways out
1 '
1 ' DONE3:
10264 Data &o047757,&h10 ," LEA 10(A7),A7 Pop off Zr2, Zi2"
10270 Data &H6008 ," BRA DONE Go finish up"
1 ' DONE1:
10272 Data &o045201 ," TST.L D1 Cr=-2, does Ci=0?"
10274 Data &h6608 ," BNE DONE2 No, no big deal"
10276 Data &o077377 ," MOVEQ #-1,D7 Pretend we DBFed"
10300 Data &h6004 ," BRA DONE2 Go end it all"
1 ' DONE:
10302 Data &o047757,&hA ," LEA A(A7),A7 Remove Ci, Cr, flags"
1 ' DONE2:
10306 Data &o117527 ," SUB.W D7,(A7) Figure how many"
10310 Data &o032037 ," MOVE.W (A7)+,D2 times, put in D2"
10312 Data &o047165 ," RTS POPJ"
1 '
1 ' BIGMUL - unsigned 32 bit multiply
1 '
1 ' Arguments:
1 '
1 ' 2 unsigned longwords received on the stack
1 '
1 ' Returns:
1 '
1 ' 1 unsigned quadword on the stack
1
1 ' creams D0, D1, D2 and D3
1 '
1 ' BIGMUL:
10314 Data &o046257,&hF,&h4," MOVEM.W 4(A7),<D0,D1,D2,D3>"
10322 Data &o140302 ," MULU D2,D0 Both high order parts"
10324 Data &o141303 ," MULU D3,D1 Both low order parts"
10326 Data &o142357,&h6 ," MULU 6(A7),D2 High by low"
10332 Data &o143357,&h4 ," MULU 4(A7),D3 Low by high"
10336 Data &o027500,&h4 ," MOVE.L D0,4(A7) Store high back"
10342 Data &o027501,&h8 ," MOVE.L D1,8(A7) Store low back"
10346 Data &o152203 ," ADD.L D3,D2 Combine middle parts"
1 '
10350 Data &h6404 ," BIGCMN: BCC 10$ Any carry?"
10352 Data &o051157,&h4 ," ADDQ.W #1,4(A7) Yup, incr. top word"
1 '
10356 Data &o152657,&h6,"10$: ADD.L D2,6(A7) Put middle in middle"
10362 Data &h6404 ," BCC 20$ Any carry?"
10364 Data &o051157,&h4 ," ADDQ.W #1,4(A7) Yup, incr. top word"
1 '
10370 Data &o047165 ,"20$: RTS Done, return"
1 '
1 ' BIGSQR - unsigned 32 bit square
1 '
1 ' Arguments:
1 '
1 ' 1 unsigned longword on the stack
1 '
1 ' Returns:
1 '
1 ' 1 unsigned quadword on the stack
1 '
1 ' creams D0, D1 and D2
1 '
1 ' BIGSQR:
10372 Data &o027427 ," MOVE.L (A7),-(A7) Move ret. addr. up"
10374 Data &o030057,&h8 ," MOVE.W 8(A7),D0 High order into D0"
10400 Data &o031057,&hA ," MOVE.W A(A7),D1 Low order into D1"
10404 Data &o032000 ," MOVE.W D0,D2 Copy high order to D0"
10406 Data &o140300 ," MULU D0,D0 Mpy. high by high"
10410 Data &o141301 ," MULU D1,D1 Mpy. low by low"
10412 Data &o142357,&hA ," MULU A(A7),D2 Mpy. high by low"
10416 Data &o027500,&h4 ," MOVE.L D0,4(A7) Store high back"
10422 Data &o027501,&h8 ," MOVE.L D1,8(A7) Store low back"
10426 Data &o152202 ," ADD.L D2,D2 Double the middle"
10430 Data &h60CE ," BRA BIGCMN Join up with BIGMUL"
29999 Data ~
Mandelbrot.bas:
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 Retu1 ' 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
--------