home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 5 / FreshFish_July-August1994.bin / bbs / dev / ace-2.0.lha / ACE-2.0 / prgs / Fractals / henon.b next >
Encoding:
Text File  |  1994-01-10  |  2.0 KB  |  103 lines
  1. { Henon Attractors -- cf Becker & Dorfler, pp 62-64,68 }
  2.  
  3. const     xscreen=640,yscreen=400
  4.  
  5. const    maxReal = 1E+18    
  6. const    maxInt = 2147483647
  7.  
  8. '..planetary Henon attractor data
  9. const    lt = -1.2
  10. const    rt = 1.2
  11. const    top = 1.2
  12. const    bottom = -1.2
  13. const     phaseAngle = 1.111
  14. const    x0 = 0.098
  15. const    y0 = 0.061
  16. const    dx0 = 0.04
  17. const    dy0 = 0.03
  18. const    orbitnumber = 40
  19. const    pointnumber = 700
  20.   
  21. sub set_universal_point(xw,yw)
  22.   xs = ((xw-lt) * xscreen / (rt-lt)) 
  23.   ys = (yw-bottom) * yscreen / (top-bottom)
  24.   pset (xs,ys)
  25. end sub
  26.  
  27. on mouse gosub finish
  28. mouse on
  29.  
  30. sub HenonAttractor
  31. single    cosA,sinA
  32. single    xNew,yNew,xOld,yOld
  33. single    deltaxperpixel,deltayperpixel
  34. longint    i,j
  35. longint    ok1,ok2
  36. shortint pcolr
  37.  
  38.   cosA = cos(phaseAngle) : sinA = sin(phaseAngle)
  39.   xOld = x0 : yOld = y0    '..starting point of first orbit
  40.   deltaxperpixel = xscreen/(rt-lt)
  41.   deltayperpixel = yscreen/(top-bottom)
  42.  
  43.   for j=1 to orbitnumber 
  44.     i=1
  45.     '..set foreground pen color
  46.     pcolr = (pcolr + 1) mod 3 
  47.     color pcolr+1
  48.     while i <= pointnumber 
  49.       if (abs(xOld) <= maxReal) and (abs(yOld) <= maxReal) then
  50.       xNew = xOld*cosA - (yOld - xOld*xOld)*sinA
  51.     yNew = xOld*sinA + (yOld - xOld*xOld)*cosA
  52.     ok1 = (abs(xNew-lt) < maxInt/deltaxperpixel)
  53.     ok2 = (abs(top-yNew) < maxInt/deltayperpixel)
  54.     if ok1 and ok2 then
  55.       set_universal_point(xNew,yNew)
  56.     end if    
  57.     xOld = xNew
  58.     yOld = yNew
  59.       end if  
  60.       i = i + 1
  61.     wend
  62.     xOld = x0 + j * dx0
  63.     yOld = y0 + j * dy0
  64.   next    
  65.     
  66. end sub
  67.  
  68. mouse off
  69.  
  70. { ** main ** }
  71. screen 1,xscreen,yscreen,3,4
  72.  
  73. palette 0,0,0,0        '..black
  74. palette 1,1,1,1        '..white
  75. palette 2,0,1,0        '..green
  76. palette 3,1,0,0        '..red
  77. palette 4,1,1,0.13    '..yellow
  78. palette 5,1,0.13,0.93    '..violet
  79.  
  80. '..border and title
  81. line (0,0)-(xscreen-5,yscreen-5),5,b
  82. title$ = "Planetary Henon Attractor"
  83. color 4
  84. locate 2,40-len(title$)\2
  85. prints title$
  86.  
  87. color 2
  88. locate 47,50
  89. prints "press left mouse button..."
  90.  
  91. HenonAttractor
  92.  
  93. finish:
  94.  color 3
  95.  locate 47,50
  96.  prints "              hit a key..."
  97.  
  98.  while inkey$="":wend
  99.  
  100.  screen close 1
  101.  
  102.  STOP
  103.