home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / magazine / drdobbs / 1989 / 02 / tracy.asc < prev    next >
Text File  |  1989-01-04  |  11KB  |  297 lines
  1. _The Forth Column_
  2. by Martin Tracy
  3.  
  4. [LISTING ONE]
  5.  
  6.  
  7. \   MANDLZEN    9-16-88                               M.HAWLEY
  8. \
  9.    This file contains a screen for graphics words for an IBM-PC
  10. BIOS compatible. The word GRAPH puts the computer in high res.
  11. graphics mode. PIXEL-ON takes two numbers off the stack and uses
  12. them as X,Y coordinates to plot one pixel. PIXEL-OFF does the
  13. same but turns the pixel off. All other words are FORTH-83
  14. written in L&P F83.
  15.    The load screen loads screen 2 , the graphics words
  16. and screen 3 which draws a small sketch of the Mandelbrot Set
  17. in under 8 minutes.
  18.    The other screens draw bigger versions and closeups. Full
  19. blown versions take up to 4 hours to draw on my 8086 based PC.
  20. LOAD THE SCREEN YOU WANT TO RUN. You can't load them all at once
  21. because they all use the same variables and constants.
  22.  
  23. \                                                     M.HAWLEY
  24. 2 3 THRU
  25.  
  26.  
  27.  
  28.  
  29.  
  30.  
  31.  
  32.  
  33.  
  34.  
  35.  
  36.  
  37.  
  38.  
  39. \                                                     M.HAWLEY
  40. HEX
  41.  CODE VIDEO     AX POP DX POP CX POP
  42.  BP PUSH  SI PUSH  10 INT SI POP BP POP
  43.  NEXT  END-CODE
  44. : TEXT  0 0 2 VIDEO  ;
  45. : GRAPH 0 0 6 VIDEO  ;
  46. CODE PLOT    AL POP   DX POP  CX POP
  47. 0C # AH MOV
  48.  BP PUSH  SI PUSH  10 INT SI POP  BP POP
  49.  NEXT END-CODE
  50. CODE PIXEL-ON  0C01 # AX MOV   DX POP CX POP
  51.    BP PUSH SI PUSH 10 INT SI POP BP POP NEXT END-CODE
  52. CODE PIXEL-OFF 0C00 # AX MOV  DX POP CX POP
  53.    BP PUSH SI PUSH 10 INT SI POP BP POP NEXT END-CODE
  54. DECIMAL ;
  55. \   MANDLZEN  One screen Mandlbrot sketch             M.HAWLEY
  56.  
  57.       VARIABLE CX  VARIABLE CY  VARIABLE X
  58. -8192 CONSTANT CYBASE  CYBASE CY !  -12000 CX !
  59.   160 CONSTANT CXSTEP   400 CONSTANT CYSTEP
  60.  : MANDLZEN GRAPH  269 X !    370 270 DO  1 X +!
  61.     125 75 DO  0 0   X @ I PIXEL-ON
  62.  30 0 DO     2DUP DUP 8192 */  SWAP DUP 8192 */
  63.    2DUP + 0< IF X @ J PIXEL-OFF 2DROP  LEAVE THEN
  64.      SWAP - CX @ + -ROT 4096 */ CY @ + LOOP 2DROP
  65.     CYSTEP CY +!
  66.  LOOP  CYBASE CY !
  67.       CXSTEP CX +!  LOOP ." Mandelbrot by Marc Hawley "
  68. ." POB 716, Mt. Vernon, IN 47620 "    ;
  69.  
  70.  
  71. \  MANDL1    Full screen Mandelbrot portrait          M.HAWLEY
  72.  
  73.       VARIABLE CX  VARIABLE CY  VARIABLE X
  74. -8192 CONSTANT CYBASE  CYBASE CY !  -12000 CX !
  75.   33 CONSTANT CXSTEP   82 CONSTANT CYSTEP
  76.  : MANDL1 GRAPH  0 X !    500 0 DO  1 X +!
  77.     200 0 DO  0 0   X @ I PIXEL-ON
  78.  50 0 DO     2DUP DUP 8192 */  SWAP DUP 8192 */
  79.    2DUP + 0< IF X @ J PIXEL-OFF 2DROP  LEAVE THEN
  80.      SWAP - CX @ + -ROT 4096 */ CY @ + LOOP 2DROP
  81.     CYSTEP CY +!
  82.  LOOP  CYBASE CY !
  83.       CXSTEP CX +!  LOOP ." Mandelbrot by Marc Hawley "
  84. ." POB 716, Mt. Vernon, IN 47620 "    ;
  85.  
  86.  
  87. \  MANDL1    full screen                              M.HAWLEY
  88.  
  89. -200 CONSTANT CYBASE  CYBASE CY !  2000 CX !
  90.   1 CONSTANT CXSTEP   2 CONSTANT CYSTEP   0 X !
  91.  : MANDL1 GRAPH      500 0 DO  1 X +!
  92.     200 0 DO  0 0   X @ I PIXEL-ON
  93.  80 0 DO     2DUP DUP 8192 */  SWAP DUP 8192 */
  94.    2DUP + 0< IF X @ J PIXEL-OFF 2DROP  LEAVE THEN
  95.      SWAP - CX @ + -ROT 4096 */ CY @ + LOOP 2DROP
  96.     CYSTEP CY +!
  97.  LOOP  CYBASE CY !
  98.       CXSTEP CX +!  LOOP ;
  99.  
  100.  
  101.  
  102.  
  103. \  MANDL3    full screen                              M.HAWLEY
  104.  
  105. -8192 CONSTANT CYBASE  CYBASE CY !  -1024 CX !
  106.   2 CONSTANT CXSTEP   5 CONSTANT CYSTEP   0 X !
  107.  : MANDL3 GRAPH      500 0 DO  1 X +!
  108.     200 0 DO  0 0   X @ I PIXEL-ON
  109.  80 0 DO     2DUP DUP 8192 */  SWAP DUP 8192 */
  110.    2DUP + 0< IF X @ J PIXEL-OFF 2DROP  LEAVE THEN
  111.      SWAP - CX @ + -ROT 4096 */ CY @ + LOOP 2DROP
  112.     CYSTEP CY +!
  113.  LOOP  CYBASE CY !
  114.       CXSTEP CX +!  LOOP ;
  115.  
  116.  
  117.  
  118.  
  119. \  MANDL4    full screen                              M.HAWLEY
  120.  
  121. -8192 CONSTANT CYBASE  CYBASE CY !  -1024 CX !
  122.   2 CONSTANT CXSTEP   5 CONSTANT CYSTEP   0 X !
  123.  : MANDL4 GRAPH      500 0 DO  1 X +!
  124.     200 0 DO  0 0   X @ I PIXEL-ON
  125.  30 0 DO     2DUP DUP 8192 */  SWAP DUP 8192 */
  126.    2DUP + 0< IF X @ J PIXEL-OFF 2DROP  LEAVE THEN
  127.      SWAP - CX @ + -ROT 4096 */ CY @ + LOOP 2DROP
  128.     CYSTEP CY +!
  129.  LOOP  CYBASE CY !
  130.       CXSTEP CX +!  LOOP ;
  131.  
  132.  
  133.  
  134.  
  135. \  MANDL5    full screen                              M.HAWLEY
  136.  
  137. -8192 CONSTANT CYBASE  CYBASE CY !  -824 CX !
  138.   1 CONSTANT CXSTEP   2 CONSTANT CYSTEP   0 X !
  139.  : MANDL5 GRAPH      500 0 DO  1 X +!
  140.     200 0 DO  0 0   X @ I PIXEL-ON
  141.  90 0 DO     2DUP DUP 8192 */  SWAP DUP 8192 */
  142.    2DUP + 0< IF X @ J PIXEL-OFF 2DROP  LEAVE THEN
  143.      SWAP - CX @ + -ROT 4096 */ CY @ + LOOP 2DROP
  144.     CYSTEP CY +!
  145.  LOOP  CYBASE CY !
  146.       CXSTEP CX +!  LOOP ;
  147.  
  148.  
  149.  
  150.  
  151. \  MANDL6    full screen                              M.HAWLEY
  152.  
  153. -7250 CONSTANT CYBASE  CYBASE CY !  -424 CX !
  154.   1 CONSTANT CXSTEP   2 CONSTANT CYSTEP   0 X !
  155.  : MANDL6 GRAPH      500 0 DO  1 X +!
  156.     200 0 DO  0 0   X @ I PIXEL-ON
  157.  20 0 DO     2DUP DUP 8192 */  SWAP DUP 8192 */
  158.    2DUP + 0< IF X @ J PIXEL-OFF 2DROP  LEAVE THEN
  159.      SWAP - CX @ + -ROT 4096 */ CY @ + LOOP 2DROP
  160.     CYSTEP CY +!
  161.  LOOP  CYBASE CY !
  162.       CXSTEP CX +!  LOOP ;
  163.  
  164.  
  165.  
  166.  
  167. \ MANDELZEN DOCUMENTATION    9-16-88                  M.HAWLEY
  168. VARIABLES   CX and CY are the X and Y coordinates of the
  169. starting point for the graph. Everything is scaled up by a
  170. factor of 8192, so -1 is expressed as -8192, .02 is expressed
  171. as 164 and so on. The variable X is a kludge I had to use to
  172. access the outermost index of three nested loops while in the
  173. innermost. My version of L&P F83 has I and J for the first
  174. two indexes but no I' ( drat ).
  175.     To explore different parts of the Mandelbrot Set, change
  176. the starting point by editing CX and CY.
  177. CONSTANTS   CYBASE is the base value for CY. After the program
  178. scans through the range of values being tested along the Y-axis
  179. CY is reset to CYBASE for the next vertical scan.
  180.     CXSTEP and CYSTEP are the increments by which CX and CY
  181. are changed each time. To explore a large part of the Set or
  182. all of it, use large STEPs.
  183. \  DOCs cont.                                         M.HAWLEY
  184. To zoom in and magnify a small part of the Set, use small
  185. STEPs. For the best proportion, at least on my screen, CYSTEP
  186. should be 2 or 2 1/2 times as big as CXSTEP.
  187.  
  188. PIXEL-ON and PIXEL-OFF are specific to IBM-PC BIOS ROM
  189. compatibles. Given two numbers on the stack, they turn on
  190. or off the pixel at that (X,Y) location on the screen.
  191.  
  192. You will notice that the closeup screens magnify the view
  193. of screen 3 ( MANDLZEN ) up to 160 diameters just like a
  194. 160 power telescope looking at a celestial object. Yet, the
  195. program is entirely in 16 bit scaled integer math ---
  196. no floating point. I originally thought that THIS program
  197. would HAVE to be in floating point.
  198.  
  199. \ DOCs                                                M.HAWLEY
  200.     I first wrote it in floating point. It ran 6 TIMES SLOWER
  201. than present version. For my fellow intermediate programmers
  202. take notice. I now finally begin to understand why FORTH
  203. programmers scoff at floating point.
  204.  
  205. THE ALGORITHM     Two numbers are kept on the stack representing
  206. the real and imaginary components of a complex number. This
  207. number is repeatedly put through the transformation:
  208.          Z --> Z*Z + C
  209. The complex number is sqared and added to another complex
  210. number, C , which is the point being tested to determine whether
  211. it is in the Set. C is represented as CX , the real part, and
  212. CY the imaginary part. The sum is again squared and added to C.
  213. This is repeated untill the test is satisfied ( Z stays small )
  214. or failed ( Z gets too big ).
  215. \  DOCs                                               M.HAWLEY
  216.    The outer loops simply scan through the x and y coordinates
  217. of the screen or some part of the screen and update the
  218. variables.
  219.    The inner loop is the repetative test which finds Z*Z + C.
  220. The odd thing about squaring an imaginary number is that the
  221. result is always negative. ( A positive OR negative real number
  222. squared is always positive, of course. ) So what we need on the
  223. stack for the real part of Z*Z + C is ZR*ZR-ZI*ZI + CX
  224. and for the imaginary part 2*ZR*ZI + CY.
  225.     Why ? Well :
  226.  Z*Z = (ZR + ZI)*(ZR + ZI)
  227.      = ZR*ZR + 2*ZR*ZI + ZI*ZI  but ZI*ZI is negative so...
  228.      = ZR*ZR + 2*ZR*ZI - ZI*ZI
  229.  The real part is ZR*ZR - ZI*ZI , imaginary 2*ZR*ZI
  230.  Add the C :  ZR*ZR-ZI*ZI+CX    ,           2*ZR*ZI+CY    qed.
  231. \ DOCs                                                M.HAWLEY
  232. The inner loop first puts 0 0 on the stack for starters.
  233.     WORD      :     STACK
  234.              -->    0  0
  235.   X  @ I     -->    0  0  X I
  236.  PIXEL-ON    -->    0  0  plot the point being checked
  237.              -->   ZR  ZI the values being represented
  238.  2DUP        -->   ZR  ZI  ZR  ZI
  239.   DUP        -->   ZR  ZI  ZR  ZI  ZI
  240. 8192 */      -->   ZR  ZI  ZR  ZI*ZI  scaled down by 8192
  241.  SWAP        -->   ZR  ZI  ZI*ZI  ZR
  242.  DUP         -->   ZR  ZI  ZI*ZI  ZR  ZR
  243. 8192 */      -->   ZR  ZI  ZI*ZI  ZR*ZR   scaled
  244.  2DUP        -->   ZR  ZI  ZI*ZI  ZR*ZR  ZI*ZI  ZR*ZR
  245.  +           -->   ZR  ZI  ZI*ZI  ZR*ZR  ZI*ZI+ZR*ZR
  246.          this is the square of the magnitude
  247. \    DOCs                                             M.HAWLEY
  248. The magnitude of a complex number is its distance from the
  249. origin, the 0,0 point. The X and Y coordinates are two sides
  250. of a triangle and the hypotenuse is the magnitude. Using the
  251. Pythagorean Theorem, Mag*Mag = ZR*ZR + ZI*ZI
  252. If the magnitude of Z is over 2 the point will continue to
  253. grow and is not in the Set. But the square of the magnitude
  254. is easier to find, so check if it is over 4. Here is a trick.
  255. If you scale up by a factor of 1000 you will be checking for
  256. a magnitude of 4000. Fine. For more detail you might try a
  257. scale of 2000 and test for 8000. Still fine. Try a scale of
  258. 8000. Trouble. We are then testing whether a number is greater
  259. than 32000, but if it is over 32768 it will show up as a
  260. NEGATIVE number and pass the test it should fail. SO AHA !
  261. Use a scale of 8192 and test for 32768 which is similar to
  262. testing for a negative number. Mag. should not be negative.
  263. \ DOCs                                                M.HAWLEY
  264.              -->  ZR ZI  ZI*ZI ZR*ZR ZI*ZI+ZR*ZR
  265.              -->  ZR ZI  ZI*ZI ZR*ZR magnitude.squared
  266.     0<       -->  ZR ZI  ZI*ZI ZR*ZR  TF less than zero ?
  267.     IF       -->  ZR ZI  ZI*ZI ZR*ZR
  268. X @ J PIXEL-OFF      if test failed, erase pixel
  269.  2DROP               if failed, drop two numbers
  270. LEAVE THEN        ZR ZI failed, exit test
  271.              --> ZR ZI  ZI*ZI ZR*ZR  if test passed
  272.  SWAP        --> ZR ZI  ZR*ZR ZI*ZI
  273.   -          --> ZR ZI  ZR*ZR-ZI*ZI  real part of Z*Z
  274.  CX @        --> ZR ZI  ZR*ZR-ZI*ZI CX real part of C
  275.   +          --> ZR ZI  ZRnew
  276.  -ROT        --> ZRnew  ZR ZI
  277. 4096 */      --> ZRnew  2*ZR*ZI scaled ( 2/8192 = 1/4096)
  278.  
  279. \  DOCs                                               M.HAWLEY
  280.                --> ZRnew  2*ZR*ZI
  281.   CY @         --> ZRnew  2*ZR*ZI  CY   imag. part of C
  282.   +            --> ZRnew  2*ZR*ZI+CY    this is new ZI
  283.                --> ZRnew  ZInew
  284.   LOOP         -->  test again ...
  285.  2DROP         -->  clear stack when done
  286. CTSTEP CY +!   -->  increment CY , the Y axis variable
  287.  LOOP          -->  cycle through the Y axis
  288. CYBASE CY !    -->  reset CY for the next CX cycle
  289. CXSTEP CX +!   -->  increment CX, the X axis variable
  290.  LOOP          -->  cycle through the X axis
  291.   ;            -->    That's all, folks !
  292. I would like to hear your comments and improvements.
  293. Marc Hawley POB 716, Mt. Vernon, IN 47620
  294.    EXPLORE AND ENJOY THE MANDELBROT SET
  295.  
  296.  
  297.