home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format 91 / af091a.adf / af91a3.lzx / prgs / Fractals / lorenz.b < prev    next >
Text File  |  2019-01-22  |  2KB  |  90 lines
  1. { The Lorenz Attractor }
  2.  
  3. const    true=-1&,false=0&
  4. const     xscreen=640,yscreen=400
  5. const     delta=0.01
  6.  
  7. single    x,y,z
  8. single    xf,yf
  9. longint    lt,rt,top,bottom
  10.  
  11. on menu gosub handle_menu
  12.  
  13. sub draw_universal_line(xw,yw)
  14. shared xf,yf
  15. shared lt,rt,top,bottom
  16.   xs = ((xw*xf-lt) * xscreen / (rt-lt)) + xscreen/2
  17.   ys = (yw*yf-bottom) * yscreen / (top-bottom)
  18.   color int(rnd*2)+1
  19.   line step (xs,ys)
  20. end sub
  21.  
  22. sub universal_x&(xw)
  23. shared xf
  24. shared lt,rt
  25.   universal_x& = ((xw*xf-lt) * xscreen / (rt-lt)) + xscreen/2
  26. end sub
  27.  
  28. sub universal_y&(yw)
  29. shared yf
  30. shared top,bottom
  31.   universal_y& = (yw*yf-bottom) * yscreen / (top-bottom)
  32. end sub
  33.  
  34. sub calc
  35. shared x,y,z
  36.   dx = 10.0*(y-x)
  37.   dy = x*(28.0-z)-y
  38.   dz = x*y - (8.0/3.0)*z
  39.   x = x + delta*dx
  40.   y = y + delta*dy
  41.   z = z + delta*dz
  42. end sub
  43.  
  44. sub LorenzAttractor
  45. shared x,y,z
  46.   x=1 : y=1 : z=1
  47.   calc
  48.   penup
  49.   setxy universal_x&(x),universal_y&(z)
  50.   repeat
  51.     calc
  52.     menu stop
  53.     draw_universal_line(x,z)
  54.     menu on
  55.   until false
  56. end sub
  57.      
  58. { ** main ** }
  59. screen 1,xscreen,yscreen,2,4
  60. window 1,"Lorenz Attractor",(0,0)-(xscreen,yscreen),0,1
  61.  
  62. palette 0,0,0,0        '..black
  63. palette 1,1,1,1        '..white
  64. palette 2,0,1,0        '..green
  65.  
  66. menu 1,0,1,"Project"
  67. menu 1,1,1,"Quit","Q"
  68.  
  69. lt=0    '..window dimensions
  70. rt=xscreen
  71. top=0
  72. bottom=yscreen
  73.  
  74. xf=14.0    '..scale up x and y
  75. yf=7.0
  76.  
  77. LorenzAttractor
  78.  
  79. END 
  80.  
  81. handle_menu:
  82.   if menu(0) = 1 and menu(1) = 1 then 
  83.     if MsgBox("Really quit?","Yes","No") then
  84.       window close 1
  85.       screen close 1
  86.       STOP
  87.     end if
  88.   end if
  89. return
  90.