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