|
|
AUTORAND.BAS - Iterated function set (IFS) fractal image display
program
This program is a random Iterated Function Set fractal generator. It
assigns random values to the IFS variables, and draws the image
they define.
- When POLAR=FALSE, 2 transforms seems optimal, and 3 marginal.
With more, the designs are too random to be interesting.
- When POLAR=TRUE, 3 transforms works well. POLAR=TRUE imposes a
regularity that allows larger numbers of transforms to work better.
- When there is only 1 transformation, there's a limited number of
things that the design can do, but there are a few interesting ones
if you're patient and just keep hitting the space bar until you get
a good one.
- VIDEO MODIFICATIONS FOR IBM BASICA CONVERSION OR FOR SPECIFIC
COMPUTERS. This paragraph might contain useful clues about where to
look if you want to modify the program for a different version of
BASIC or for a different computer. As noted in the AUTORAND program
comments, you should look in your Microsoft BASIC manual for the
commands BSAVE and BLOAD. It will probably give some examples, with
some specific numeric values shown. Even if your computer is an AT
or a 386, I suspect that you can trust the memory segment shown in
the example in your book for the green plane of video memory,
because it has to be compatible with a PC. The offset to use is
almost certainly 0 (zero). You may have to play with the number of
bytes to save. My book uses &h8000 (8000 hex) as the example, which
MIGHT be correct for a PC in (low resolution?) graphics mode,
because my H100 BASIC manual was originally written for the PC, and
modified (with some errors) for the H100 computer. The H100 has 640
x 225, or 144,000 pixels in a screen. The suggested value of &h8000
only saved about half a screenful, and careful testing revealed that
exactly &hC450 would save the entire 144,000 pixels. (Plus a good
deal more, required because of the strange way video memory is
mapped in the H100.)
Other versions:
|
10 'AUTORAND.BAS 3-13-91
11 'COPYRIGHT (C)1991 STEVEN WHITNEY.
12 'Published under GNU GPL (General Public License) Version 2, with ABSOLUTELY NO WARRANTY.
13 'Initially published by http://25yearsofprogramming.com
20 'RANDOM ITERATION FRACTALS
30 'RANDOMLY GENERATES IFS VARIABLES AND DISPLAYS ASSOCIATED FRACTAL IMAGES
40 '2-1-91
50 '2-4-91 AUTOMATICALLY SETS WINDOW SIZE FOR DISPLAY AFTER 100 ITERATIONS
60 '2-4-91 MANY OTHER MAJOR MODIFICATIONS (REWRITE)
70 '2-7-91 ADDED AUTOMATIC SAVE OF ALL SCREENS TO .PIC FILES
80 '2-7-91 ERROR HANDLING CAN BE CHANGED SO ALL DISK DRIVES ARE USED FOR .PIC
90 '2-7-91 OPTION FOR USING POLAR COORDINATES AND KEEPING THETA=PHI
100 '2-8-91 MADE VIDEO ATTRIBUTES VARIABLES FOR EASE OF CHANGING
110 '2-8-91 MAKES A MATCHING .IFS FILE FOR *ALL* .PIC FILES CREATED
120 '2-8-91 POINTS GENERATED TILL 100 CONSECUTIVE POINTS ARE DUPLICATES
130 '2-8-91 IF < 1500 PIXELS TURNED ON, IMAGE WON'T BE SAVED TO .PIC (BORING)
140 '3-12-91 MIN & MAX RESET TO HUGE/SMALL NUMBERS INSTEAD OF ZERO
150 '3-13-91 FIXED RIDICULOUS ERROR IN WINDOW-SETTING CALCULATIONS
160 '------TO DO---- .IFS SHOULD BE SAVED BEFORE .PIC IN CASE DISK FILLS UP
170 'IF AUTOPIC IS ON, AN ERROR WILL BE GENERATED WHEN DISK FILLS UP
180 ON ERROR GOTO 2060
190 TRUE = (1 = 1): FALSE = NOT TRUE
200 'AUTOPIC FLAG DETERMINES WHETHER ALL SCREENS AUTOMATICALLY SAVED TO .PIC
210 AUTOPIC = FALSE 'THIS CAN *ONLY* BE TRUE IF VIDEO ATTRIBUTES ARE PROPERLY SET BELOW.
220 'POLAR DETERMINES WHETHER TO GENERATE VARIABLES WITH POLAR COORDINATES
230 'IF POLAR IS FALSE, A,B,C,D ARE UTTERLY RANDOMLY GENERATED, SO THAT
240 'FOR A TRANSFORMATION, X AND Y AXIS ROTATION MAY NOT BE EQUAL, MEANING
250 'THAT THE AXES MIGHT WIND UP NON-PERPENDICULAR (SKEWED) & IMAGE SQUISHED.
260 'IF POLAR IS TRUE, SYMMETRIC ROTATION ABOUT THE ORIGIN IS MADE POSSIBLE
270 POLAR = TRUE
280 '==>FOR AUTOPIC, VIDEO RAM ATTRIBUTES MUST BE CORRECT FOR THE COMPUTER
290 '&H SIGNIFIES HEX NOTATION, BUT NUMBERS DON'T HAVE TO BE SPECIFIED IN HEX
300 'GW-BASIC/BASICA MANUALS MIGHT HAVE USEFUL EXAMPLES UNDER BSAVE & BLOAD
310 GREENPLANE = &HE000 'STARTING ADDRESS OF H100 VIDEO RAM SEGMENT FOR GREEN
320 OFFSET = 0 'STARTING ADDRESS WITHIN GREEN SEGMENT
330 NUMBYTES = &HC450 'NUMBER OF BYTES REQUIRED FOR FULL SCREEN BSAVE
340 CLS
350 PRINT "This program randomly generates I.F.S. variables and their fractal"
360 PRINT "images. Any number of transformation equations can be used."
370 PRINT "COLOR (IF USED) IS ASSIGNED BY WHICH EQUATION GENERATED THE POINT,"
380 PRINT "but only 7 colors can be displayed. (Above 7, all points are GREEN)"
390 PRINT "It is easier to see the fractal nature in monochrome than color."
400 PRINT "A design will abort if the plotted points run off the screen."
410 PRINT "(When there is more than 1 transformation equation,"
420 PRINT "screen size is set by min/max values of 1st 100 unplotted points)"
430 PRINT "Points are plotted until 100 consecutive points have only"
440 PRINT "duplicated previously plotted ones. After 50 duplicates,"
450 PRINT "program beeps to alert you of an image possibly near completion."
460 PRINT
470 IF POLAR THEN PRINT "==> POLAR is currently set TRUE for symmetric rotation <==" ELSE PRINT "==> POLAR is currently set FALSE. Variables are completely random <=="
480 PRINT
490 PRINT "At any time, PRESS <SPACE BAR> TO ABORT & START A NEW DESIGN."
500 PRINT "At any time, PRESS 'S' TO SAVE CURRENT VARIABLE SET TO A FILE."
510 PRINT "You will be prompted for a name, and program will then continue."
520 PRINT
530 PRINT "(Pgm also automatically saves 2 generations of IFS in the files"
540 PRINT "RANDOM.IFS and RANDOM.BAK, so a lost IFS may be retrievable.)"
550 PRINT "END PROGRAM WITH <CONTROL-C> Possibly <CONTROL-BREAK> on IBM."
560 PRINT
570 INPUT "NUMBER OF TRANSFORMATION EQUATIONS"; T
580 'IF T=1, BORDERS MUST BE PREDEFINED
590 IF T = 1 THEN MINX = -300: MAXX = 300: MINY = -300: MAXY = 300: WINDOW (MINX, MINY)-(MAXX, MAXY)
600 RANDOMIZE TIMER
610 IF AUTOPIC THEN PRINT "AUTOMATIC .PIC SAVE (AUTOPIC) ENABLED. MONOCHROME MUST BE USED.": USECOL$ = "M": GOTO 660
620 PRINT "(M)ONOCHROME OR (C)OLOR? "; : USECOL$ = INPUT$(1): PRINT USECOL$
630 IF USECOL$ = "m" THEN USECOL$ = "M"
640 IF USECOL$ = "c" THEN USECOL$ = "C"
650 IF USECOL$ <> "C" AND USECOL$ <> "M" THEN 620
660 PRINT "BEEP when near completion? (Y/N) "; : BEEPON$ = INPUT$(1): PRINT BEEPON$
670 IF BEEPON$ = "y" THEN BEEPON$ = "Y"
680 'NONPTS IS NUMBER OF UNPLOTTED INITIAL POINTS TO USE
690 NONPTS = 100
700 'THROWOUT POINTS ARE NOT USED FOR ANYTHING AT ALL
710 THROWOUT = 20
720 'PICCOUNT NUMBERS .PIC FILES SEQUENTIALLY BY NUMBER
730 PICCOUNT = 0
740 'SET THE INITIAL DISK DRIVE TO USE FOR THE .PIC FILES
750 DRIVE$ = "I:"
760 'SET UP DUMMY FILES
770 OPEN "O", 1, "RANDOM.IFS": OPEN "O", 2, "RANDOM.BAK": CLOSE
780 '-----ENTRY POINT, MUST BE IN PGM
790 '-----BEGINNING OF A NEW TRANSFORM SET, IFS DATA GENERATED HERE
800 DIM A(T), B(T), C(T), D(T), E(T), F(T), P(T)
810 IF T > 1 THEN MINX = 1E+37: MAXX = -1E+37: MINY = 1E+37: MAXY = -1E+37'RESET MIN & MAX
820 P(0) = 0 'JUST TO EMPHASIZE THAT P(0) IS USED AS A DUMMY ZERO
830 FOR I = 1 TO T
840 '-----THIS SECTION USED IF POLAR=TRUE
850 IF NOT POLAR THEN 980
860 'SET DISTANCE MULTIPLIERS FOR X AND Y
870 XR = INT(RND * 201 - 100): YS = INT(RND * 201 - 100)
880 'SET THETA AND PHI (X AND Y AXIS ROTATION)
890 'WHEN EQUAL, IT GIVES ROTATION AROUND THE ORIGIN
900 THETA = (INT(RND * 36) * 10) * (3.1415926# / 180)'10-DEG.INTERVALS, IN RADIANS
910 PHI = THETA
920 A(I) = INT(XR * COS(THETA))
930 B(I) = INT(-YS * SIN(PHI))
940 C(I) = INT(XR * SIN(THETA))
950 D(I) = INT(YS * COS(PHI))
960 GOTO 1000
970 '-----THIS SECTION USED IF POLAR=FALSE
980 A(I) = INT(RND * 201 - 100): B(I) = INT(RND * 201 - 100)
990 C(I) = INT(RND * 201 - 100): D(I) = INT(RND * 201 - 100)
1000 E(I) = INT(RND * 201 - 100): F(I) = INT(RND * 201 - 100)
1010 'EQUAL PROBABILITY FOR EACH TRANSFORM, & NOT ALWAYS 1.00 TOTAL (BAD!)
1020 P(I) = 1 / T
1030 NEXT I
1040 'ARCHIVE THE RECENT IFS SETS
1050 KILL "RANDOM.BAK": NAME "RANDOM.IFS" AS "RANDOM.BAK"
1060 'AUTOMATICALLY SAVE THE CURRENT SET, JUST IN CASE (& SHOW TO SCREEN)
1070 CLS
1080 IF AUTOPIC THEN COLOR 2 ELSE COLOR 4 'GREEN OR RED
1090 PRINT T; "RANDOM TRANSFORMS:"
1100 OPEN "O", 1, "RANDOM.IFS"
1110 PRINT #1, T
1120 FOR I = 1 TO T
1130 PRINT #1, A(I); B(I); C(I); D(I); E(I); F(I); P(I)
1140 PRINT A(I); B(I); C(I); D(I); E(I); F(I);
1150 IF P(I) < 1 THEN PRINT USING ".##"; P(I) ELSE PRINT P(I)
1160 NEXT I
1170 CLOSE #1
1180 'INITIALIZE (X,Y) STARTING POINT
1190 X = 0: Y = 0
1200 'NIDENT KEEPS TRACK OF HOW MANY CONSECUTIVE POINTS HAVE BEEN DUPLICATES
1210 NIDENT = 0
1220 'PIX COUNTS THE ACTUAL NUMBER OF PIXELS TURNED ON
1230 PIX = 0
1240 'N COUNTS NUMBER OF POINTS *CALCULATED* (NOT NECESSARLY PLOTTED)
1250 '(IN OTHER WORDS, THE NUMBER OF TIMES THROUGH THE WHILE-WEND LOOP)
1260 N = 0
1270 '-----LONG LOOP GENERATES POINTS TILL 100 CONSECUTIVE ARE DUPLICATES
1280 WHILE NIDENT < 100
1290 N = N + 1
1300 'CHOOSE A RANDOM NUMBER, FRACTIONAL BETWEEN 0 AND 1
1310 R = RND
1320 'RESET TRANSFORMATION CHOICE TO ZERO (DOESN'T EXIST)
1330 K = 0
1340 'RESET CUMULATIVE PROBABILITY LEVEL COUNTER (?!)
1350 CUMPROB = 0
1360 'BUMP TRANSFORMATION CHOICE UP DEPENDING ON WHERE R FALLS IN THE
1370 'DISTRIBUTION, SEGMENTED AS IT IS ACCORDING TO PROBABILITIES
1380 '(A HIGHER PROB. OF RANDOM NUMBER FALLING IN BIGGER SEGMENT OF 0 -> 1 )
1390 'IF TOTAL PROBABILITIES <> EXACTLY 1.00, LAST TRANSFORM GETS CHEATED
1400 FOR I = 1 TO T
1410 CUMPROB = CUMPROB + P(I - 1)
1420 IF R > CUMPROB THEN K = K + 1
1430 NEXT I
1440 'APPLY AFFINE TRANSFORMATION NUMBER K TO (X,Y)
1450 NEWX = .01 * (A(K) * X + B(K) * Y) + E(K)
1460 NEWY = .01 * (C(K) * X + D(K) * Y) + F(K)
1470 'IF POINT IS IDENTICAL TO LAST, THE PROCESS IS DEAD-ENDED - SO ABORT
1480 IF X = NEWX AND Y = NEWY THEN ERASE A, B, C, D, E, F, P: GOTO 780
1490 'SET (X,Y) TO THE POINT JUST CALCULATED
1500 X = NEWX: Y = NEWY
1510 'MUST BYPASS ALL THIS IF T=1 BECAUSE ALL ACTIVITY IS IN FIRST FEW POINTS!
1520 IF T = 1 THEN 1700
1530 'BYPASS EVERYTHING IF FIRST (THROWOUT) POINTS. JUST CALC. THE NEXT ONE
1540 IF N < THROWOUT THEN 1880
1550 'THIS SECTION ONLY USED IN FIRST (NONPTS) ITERATIONS
1560 IF N > NONPTS THEN 1700
1570 'DETERMINE SCREEN WINDOW SIZE IN FIRST FEW (NONPTS) ITERATIONS
1580 IF X < MINX THEN MINX = X
1590 IF X > MAXX THEN MAXX = X
1600 IF Y < MINY THEN MINY = Y
1610 IF Y > MAXY THEN MAXY = Y
1620 'ON (NONPTS) PASS, SET WINDOW SIZE ACCORDING TO MAXIMUM VALUES SEEN SO FAR
1630 'SET RANGE IN EACH DIRECTION TO SOME MULTIPLE OF RANGE SEEN SO FAR
1640 IF N <> NONPTS THEN 1690
1650 XRANGE = ABS(MAXX - MINX): YRANGE = ABS(MAXY - MINY)
1660 MINX = MINX - .2 * XRANGE: MAXX = MAXX + .2 * XRANGE: MINY = MINY - .2 * YRANGE: MAXY = MAXY + .2 * YRANGE
1670 WINDOW (MINX, MINY)-(MAXX, MAXY)
1680 GOTO 1880
1690 IF N < NONPTS THEN 1880
1700 'ABORT IF IT IS RUNNING OFF THE SCREEN
1710 IF X < MINX OR X > MAXX OR Y < MINY OR Y > MAXY THEN ERASE A, B, C, D, E, F, P: GOTO 780
1720 'IF POINT HAS BEEN PLOTTED BEFORE, INCREMENT NIDENT
1730 'OTHERWISE, PIXEL IS BEING SET, SO INCREMENT PIX
1740 IF POINT(X, Y) > 0 THEN NIDENT = NIDENT + 1 ELSE NIDENT = 0: PIX = PIX + 1
1750 IF USECOL$ = "M" THEN COLOUR = 2: GOTO 1770
1760 IF K < 8 THEN COLOUR = K ELSE COLOUR = 2
1770 PSET (X, Y), COLOUR
1780 GOODONE$ = INKEY$
1790 'IF S WAS PRESSED, GET FILE NAME AND SAVE THE FILE
1800 IF GOODONE$ <> "S" AND GOODONE$ <> "s" THEN 1850
1810 INPUT "NAME OF FILE (OMIT .IFS)"; NEWNAM$
1820 OPEN "I", 1, "RANDOM.IFS": OPEN "O", 2, NEWNAM$ + ".IFS"
1830 WHILE NOT EOF(1): LINE INPUT #1, TEMP$: PRINT #2, TEMP$: WEND
1840 CLOSE
1850 IF GOODONE$ = " " THEN ERASE A, B, C, D, E, F, P: GOTO 780
1860 'BEEP TO ALERT USER THAT DESIGN IS ALMOST DONE
1870 IF (BEEPON$ = "Y") AND (NIDENT > 50) THEN BEEP
1880 WEND
1890 'SKIP SECTION IF AUTOPIC FLAG IS OFF
1900 'ALSO SKIP IT IF # OF PIXELS SET IS SO LOW THAT IMAGE PROBABLY BORING
1910 IF (NOT AUTOPIC) OR (PIX < 1500) THEN 2040
1920 'INCREMENT .PIC FILE COUNTER
1930 PICCOUNT = PICCOUNT + 1
1940 'SAVE GREEN PLANE TO .PIC FILE BEFORE GOING ON
1950 PICC$ = DRIVE$ + RIGHT$(STR$(PICCOUNT), LEN(STR$(PICCOUNT)) - 1)
1960 DEF SEG = GREENPLANE
1970 BSAVE PICC$ + ".PIC", OFFSET, NUMBYTES
1980 'ALSO COPY RANDOM.IFS TO AN .IFS FILE TO MATCH THE .PIC FILE
1990 OPEN "I", 1, "RANDOM.IFS"
2000 OPEN "O", 2, PICC$ + ".IFS"
2010 WHILE NOT EOF(1): LINE INPUT #1, TEMP$: PRINT #2, TEMP$: WEND
2020 CLOSE
2030 IF BEEPON$ = "Y" THEN BEEP
2040 ERASE A, B, C, D, E, F, P: GOTO 780
2050 '--------END OF REGULAR PROGRAM, FOLLOWING ARE SUBROUTINES
2060 'ERROR HANDLING - WILL BE CAUSED BY DISK FULL
2070 PRINT "ERROR: "; ERR; ERL
2080 CLOSE : END
2090 'ALTERNATIVE ERROR HANDLING, TO BE USED *ONLY* WHEN ALL DISK DRIVES
2100 'HAVE EMPTY DISKS, FOR A LONG, LONG PROGRAM RUN
2110 'DRIVES USED IN THIS ORDER: I:, D:, C:, A:, B:
2120 CLOSE
2130 KILL PICC$
2140 IF ERR <> 61 OR (ERL <> 1970 AND ERL <> 2010) THEN PRINT "ERROR: "; ERR; ERL: END
2150 IF DRIVE$ = "B:" THEN CLOSE : END
2160 IF DRIVE$ = "A:" THEN DRIVE$ = "B:"
2170 IF DRIVE$ = "C:" THEN DRIVE$ = "A:"
2180 IF DRIVE$ = "D:" THEN DRIVE$ = "C:"
2190 IF DRIVE$ = "I:" THEN DRIVE$ = "D:"
2200 PICCOUNT = 1
2210 RESUME 1950
RANDIFS.BAS
This is an early precursor of AUTORAND, with few features.
Its one strength is that it's fast. All those features bog AUTORAND down terribly.
10 'RANDIFS.BAS
11 '(C)COPYRIGHT 1991 STEVEN WHITNEY
12 'Published under GNU GPL (General Public License) Version 2, with ABSOLUTELY NO WARRANTY.
13 'Initially published by http://25yearsofprogramming.com
20 '1-17-91 TRANSFORM VARIABLES SAVED IN RANDOM.IFS FOR POSSIBLE REFERENCE
30 '2-25-91 THIS PROGRAM'S SPEED REALLY IS A GREAT ADVANTAGE.
40 '2-25-91 ADDED POLAR OPTION AND PRINT STATEMENTS, OTHER COSMETIC.
50 'FOR REAL-TIME WATCHING, THIS PROGRAM IS BETTER THAN AUTORAND.
60 TRUE = (1 = 1): FALSE = NOT TRUE
70 'POLAR DETERMINES WHETHER TO USE POLAR COORDINATES.
80 'THE PROGRAM AUTORAND.BAS HAS FULL EXPLANATION OF THIS FEATURE.
90 POLAR = FALSE
95 'SCREEN 12 : 'ENABLE FOR IBM BASICA
100 CLS
110 PRINT "Random iteration fractal program."
120 PRINT "This was a very early precursor to the AUTORAND program."
130 PRINT "Without all the extra features, this runs many times faster."
140 PRINT
150 PRINT "Press any key to abort and start new image."
160 PRINT "Program will run until <control-C> is pressed."
170 PRINT
180 PRINT "Display window not automatically set, so"
190 PRINT "image will happily run off the screen (or be too small to see)."
200 PRINT
210 PRINT "To use color, manually change indicated line near end of program."
220 PRINT
230 IF POLAR THEN PRINT "POLAR is set TRUE" ELSE PRINT "POLAR is set FALSE"
240 PRINT
250 INPUT "NUMBER OF TRANSFORMATION EQUATIONS"; T
260 RANDOMIZE TIMER
270 'GENERATE ITERATED FUNCTION SYSTEM DATA
280 DIM A(T), B(T), C(T), D(T), E(T), F(T), P(T)
290 P(0) = 0 'JUST TO EMPHASIZE THAT P(0) IS USED AS A DUMMY ZERO
300 CLS
310 PRINT T; "TRANSFORMS:"
320 FOR I = 1 TO T
330 IF NOT POLAR THEN 450
340 'SET DISTANCE MULTIPLIERS FOR X AND Y
350 XR = INT(RND * 201 - 100): YS = INT(RND * 201 - 100)
360 'SET THETA AND PHI (X AND Y AXIS ROTATION)
370 'WHEN EQUAL, IT GIVES ROTATION AROUND THE ORIGIN (OR TRANSLATED ORIGIN)
380 THETA = (INT(RND * 36) * 10) * (3.1415926# / 180)'10-DEGREE INTERVALS, IN RADIANS
390 PHI = THETA
400 A(I) = INT(XR * COS(THETA))
410 B(I) = INT(-YS * SIN(PHI))
420 C(I) = INT(XR * SIN(THETA))
430 D(I) = INT(YS * COS(PHI))
440 GOTO 470
450 A(I) = INT(RND * 201 - 100): B(I) = INT(RND * 201 - 100)
460 C(I) = INT(RND * 201 - 100): D(I) = INT(RND * 201 - 100)
470 E(I) = INT(RND * 201 - 100): F(I) = INT(RND * 201 - 100)
480 'EQUAL PROBABILITIES. FIGURE OUT HOW TO CHANGE.
490 P(I) = 1 / T
500 NEXT I
510 OPEN "O", 1, "RANDOM.IFS"
520 PRINT #1, T
530 FOR I = 1 TO T
540 PRINT #1, A(I); B(I); C(I); D(I); E(I); F(I); P(I)
550 PRINT A(I); B(I); C(I); D(I); E(I); F(I); P(I)
560 NEXT I
570 CLOSE #1
580 PRINT
590 'SET PLOTTING WINDOW
600 WINDOW (-400, -400)-(400, 400)
610 'INITIALIZE (X,Y) AND DEFINE NUMBER OF ITERATIONS = NUMITS
620 X = 0: Y = 0
630 'RANDOM ITERATION BEGINS
640 '-----ENTRY POINT, MUST BE IN PROGRAM
650 'CHOOSE A RANDOM NUMBER
660 R = RND
670 'RESET TRANSFORMATION CHOICE TO ZERO (DOESN'T EXIST)
680 K = 0
690 'RESET CUMULATIVE PROBABILITY LEVEL COUNTER (?!)
700 CUMPROB = 0
710 'BUMP TRANSFORMATION CHOICE UP DEPENDING ON WHERE R FALLS IN THE
720 'DISTRIBUTION, SEGMENTED AS IT IS ACCORDING TO PROBABILITIES
730 FOR I = 1 TO T
740 CUMPROB = CUMPROB + P(I - 1)
750 IF R > CUMPROB THEN K = K + 1
760 NEXT I
770 'APPLY AFFINE TRANSFORMATION NUMBER K TO (X,Y)
780 NEWX = .01 * (A(K) * X + B(K) * Y) + E(K)
790 NEWY = .01 * (C(K) * X + D(K) * Y) + F(K)
800 'SET (X,Y) TO THE POINT THUS OBTAINED
810 X = NEWX: Y = NEWY
820 'PRESET COLOUR TO GREEN
830 COLOUR = 2
840 'FOR COLOR, REMOVE APOSTROPHE FROM NEXT LINE, MAKING IT PART OF PROGRAM
850 'COLOUR = K
860 PSET (X, Y), COLOUR
870 IF INKEY$ > "" THEN ERASE A, B, C, D, E, F, P: GOTO 270
880 GOTO 640
890 END
SHOWIFS.BAS
This program will ask for the name of a FILE containing an IFS set.
It will then plot points and display the image.
10 'SHOWIFS.BAS 4-15-91
11 '(C)COPYRIGHT 1991 STEVEN WHITNEY
12 'Published under GNU GPL (General Public License) Version 2, with ABSOLUTELY NO WARRANTY.
13 'Initially published by http://25yearsofprogramming.com
20 'READS AN IFS FILE AND GENERATES ITS FRACTAL IMAGE.
30 '2-4-91 ORIGINAL CREATION, MODIFIED FROM THE RANDOM GENERATION PROGRAM
40 '3-12-91 MIN AND MAX RESET TO HUGE/SMALL NUMBERS INSTEAD OF ZERO
50 '3-12-91 HEADER SHOWS (N-NONPTS) POINTS INSTEAD OF (N-100)
60 '3-12-91 PROGRAM CAN BEEP IF A POINT LANDS OUTSIDE SCREEN BOUNDARY
70 '3-13-91 FIXED RIDICULOUS ERROR IN WINDOW-SETTING CALCULATIONS
71 '4-15-91 REMOVED ABSOLUTE VALUE FROM RANGE CALCULATIONS
80 '-----TO DO
90 'COUNT PIXELS SET & DUPLICATES, TOO. BEEP CONTINUOUSLY AFTER 100 DUPLICATES
100 'ALSO MAKE IT POSSIBLE TO INPUT FILE NAMES FROM A BATCH FILE,
110 'AND ALSO MAKE IT POSSIBLE TO AUTOMATICALLY SAVE .PIC AFTER 100-200 DUPS
115 'SCREEN 12 : 'ENABLE FOR IBM BASICA, ==> BUT OTHER MODS ARE REQUIRED ELSEWHERE <==
120 CLS
130 'SET LOGICAL VARIABLES
140 TRUE = (1 = 1): FALSE = NOT TRUE
150 'DETERMINE WHETHER TO SHOW EQUATIONS ON SCREEN, USUALLY TRUE
160 SHOWEQUAT = TRUE
170 'DETERMINES WHETHER TO SHOW SCREEN RIGHTSIDE UP OR UPSIDE DOWN
180 UPSDOWN = FALSE
190 'DETERMINES WHETHER TO ENABLE BSAVE (BINARY SAVE) OF IMAGE PRODUCED
200 'VERY COMPUTER SPECIFIC. SAVES Z100 GREEN PLANE **ONLY** (USE MONO)
210 ENBSAVE = FALSE 'OR TRUE
220 '===========> COMPUTER-SPECIFIC VIDEO PARAMETERS <========================
230 GREENPLANE = &HE000 'STARTING ADDRESS OF H100 VIDEO RAM SEGMENT FOR GREEN
240 OFFSET = 0 'STARTING ADDRESS WITHIN GREEN SEGMENT
250 NUMBYTES = &HC450 'NUMBER OF BYTES REQUIRED FOR FULL SCREEN BSAVE
260 PRINT "THIS PROGRAM GETS AN IFS SYSTEM FROM A FILE, AND CREATES THE IMAGE."
270 PRINT "COLOR (IF USED) IS ASSIGNED BY WHICH EQUATION GENERATED THE POINT,"
280 PRINT "BUT ONLY 7 COLORS CAN BE DISPLAYED. (ABOVE 7, ALL POINTS ARE GREEN)"
290 PRINT "IT IS EASIER TO SEE THE FRACTAL NATURE IN MONOCHROME THAN COLOR."
300 PRINT "(WHEN THERE IS MORE THAN 1 TRANSFORMATION EQUATION,"
310 PRINT "SCREEN SIZE IS SET BY MIN/MAX VALUES OF 1ST 100 UNPLOTTED POINTS)"
320 PRINT "PROGRAM WILL RUN UNTIL <CONTROL-C> IS PRESSED."
330 PRINT
340 INPUT "INPUT FILE NAME (OMIT .IFS)"; INFILE$
350 OPEN "I", 1, INFILE$ + ".IFS"
360 'GET NUMBER OF TRANSFORMATION EQUATIONS
370 INPUT #1, T
380 'IF T=1, BORDERS MUST BE PREDEFINED
390 IF T = 1 THEN MINX = -300: MAXX = 300: MINY = -300: MAXY = 300: IF NOT UPSDOWN THEN WINDOW (MINX, MINY)-(MAXX, MAXY) ELSE WINDOW SCREEN (MINX, MINY)-(MAXX, MAXY)
400 RANDOMIZE TIMER
410 IF ENBSAVE = TRUE THEN PRINT : PRINT ".PIC SAVE IS ENABLED SO MONOCHROME MUST BE USED": USECOL$ = "M": PRINT : PRINT "PRESS ANY KEY..."; : PAUSE$ = INPUT$(1): GOTO 460
420 PRINT "(M)ONOCHROME OR (C)OLOR? "; : USECOL$ = INPUT$(1): PRINT USECOL$
430 IF USECOL$ = "m" THEN USECOL$ = "M"
440 IF USECOL$ = "c" THEN USECOL$ = "C"
450 IF USECOL$ <> "C" AND USECOL$ <> "M" THEN 420
460 'NONPTS IS NUMBER OF UNPLOTTED INITIAL POINTS TO USE FOR SCREEN SIZE ONLY
470 NONPTS = 100
480 'THROWOUT POINTS JUST BRING THE IMAGE SOMEWHERE NEAR THE ATTRACTOR
490 'THROWOUT MUST BE LESS THAN NONPTS
500 THROWOUT = 20
510 '--(MAYBE) ENTRY POINT, LEAVE IN PGM // GET I.F.S. DATA
520 DIM A(T), B(T), C(T), D(T), E(T), F(T), P(T)
530 IF T > 1 THEN MINX = 1E+37: MAXX = -1E+37: MINY = 1E+37: MAXY = -1E+37'RESET MIN & MAX
540 P(0) = 0 'JUST TO EMPHASIZE THAT P(0) IS USED AS A DUMMY ZERO
550 FOR I = 1 TO T
560 INPUT #1, A(I), B(I), C(I), D(I), E(I), F(I), P(I)
570 NEXT I
580 CLOSE #1
590 CLS
600 IF ENBSAVE = TRUE THEN COLOR 2 ELSE COLOR 4: 'GREEN OR RED
610 IF NOT SHOWEQUAT THEN 680
620 PRINT T; "TRANSFORMS IN "; INFILE$
630 FOR I = 1 TO T
640 PRINT A(I); B(I); C(I); D(I); E(I); F(I);
650 IF P(I) < 1 THEN PRINT USING ".##"; P(I) ELSE PRINT P(I)
660 NEXT I
670 'INITIALIZE (X,Y)
680 x = 0: y = 0
690 'RANDOM ITERATION BEGINS
700 N = 0#
710 N = N + 1
720 'IF SHOWEQUAT THEN IF (N>=NONPTS) AND (N/100=INT(N/100)) THEN LOCATE T+2,1:PRINT N-NONPTS;"POINTS"
730 'CHOOSE A RANDOM NUMBER, FRACTIONAL BETWEEN 0 AND 1
740 R = RND
750 'RESET TRANSFORMATION CHOICE TO ZERO (DOESN'T EXIST)
760 K = 0
770 'RESET CUMULATIVE PROBABILITY LEVEL COUNTER (?!)
780 CUMPROB = 0
790 'BUMP TRANSFORMATION CHOICE UP DEPENDING ON WHERE R FALLS IN THE
800 'DISTRIBUTION, SEGMENTED AS IT IS ACCORDING TO PROBABILITIES
810 '(A HIGHER PROB. OF RANDOM NUMBER FALLING IN BIGGER SEGMENT OF 0 -> 1 )
820 FOR I = 1 TO T
830 CUMPROB = CUMPROB + P(I - 1)
840 IF R > CUMPROB THEN K = K + 1
850 NEXT I
860 'APPLY AFFINE TRANSFORMATION NUMBER K TO (X,Y)
870 NEWX = .01 * (A(K) * x + B(K) * y) + E(K)
880 NEWY = .01 * (C(K) * x + D(K) * y) + F(K)
890 'IF POINT IS IDENTICAL TO LAST, THE PROCESS IS DEAD-ENDED - SO SAVE IT
900 'EVENTUALLY THIS WILL BINARY-SAVE THE IMAGE AND GET FILE NAME FOR NEXT
910 'IF X=NEWX AND Y=NEWY THEN ERASE A,B,C,D,E,F,P : GOTO 420
920 'SET (X,Y) TO THE POINT JUST CALCULATED
930 x = NEWX: y = NEWY
935 'PRINT "x="; x; " y="; y 'for testing killer sets
940 'MUST BYPASS ALL THIS IF T=1 BECAUSE ALL ACTIVITY IS IN FIRST FEW POINTS!
950 IF T = 1 THEN 1140
960 'BYPASS EVERYTHING IF FIRST (THROWOUT) POINTS. JUST CALC. THE NEXT ONE
970 IF N < THROWOUT THEN 1240
980 'THIS SECTION ONLY USED IN FIRST (NONPTS) ITERATIONS
990 IF N > NONPTS THEN 1140
1000 'DETERMINE SCREEN WINDOW SIZE IN FIRST FEW ITERATIONS
1010 IF x < MINX THEN MINX = x
1020 IF x > MAXX THEN MAXX = x
1030 IF y < MINY THEN MINY = y
1040 IF y > MAXY THEN MAXY = y
1050 'ON (NONPTS) PASS, SET WINDOW SIZE ACCORDING TO MAXIMUM VALUES SEEN SO FAR
1060 'SET RANGE IN EACH DIRECTION TO SOME MULTIPLE OF RANGE SEEN SO FAR
1070 IF N <> NONPTS THEN 1120
1080 XRANGE = MAXX - MINX: YRANGE = MAXY - MINY
1090 MINX = MINX - .2 * XRANGE: MAXX = MAXX + .2 * XRANGE: MINY = MINY - .2 * YRANGE: MAXY = MAXY + .2 * YRANGE
1100 IF NOT UPSDOWN THEN WINDOW (MINX, MINY)-(MAXX, MAXY) ELSE WINDOW SCREEN (MINX, MINY)-(MAXX, MAXY)
1110 GOTO 1240
1120 'SKIP BOUNDARY TEST AND PLOTTING FOR INITIAL (NONPTS) POINTS
1130 IF N < NONPTS THEN 1240
1140 'IN THIS PROGRAM, JUST BEEP WHEN DOTS FALL OFF THE SCREEN
1150 'IF X<MINX OR X>MAXX OR Y<MINY OR Y>MAXY THEN BEEP
1160 IF USECOL$ = "M" THEN COLOUR = 2: GOTO 1180
1170 IF K < 8 THEN COLOUR = K ELSE COLOUR = 2
1180 PSET (x, y), COLOUR
1190 GOODONE$ = INKEY$
1200 'DEFINE GREEN VIDEO PLANE, BINARY SAVE THE IMAGE, & CONTINUE
1210 IF (GOODONE$ = "S") AND (ENBSAVE) THEN INPUT "FILE NAME (OMIT .PIC)"; OUTFILE$: DEF SEG = GREENPLANE: BSAVE OUTFILE$ + ".PIC", OFFSET, NUMBYTES: PRINT "Done. Continuing..."
1220 'THE FOLLOWING LINE IS TOO EASY TO INVOKE BY MISTAKE & RUIN A DISPLAY
1230 'IF GOODONE$ > "" AND GOODONE$<>"S" THEN RUN
1240 GOTO 710
Copyright ©2008
Steven Whitney. Last modified
02/27/2008.
