API tools faq
paste
Advertisement
Guest User

Untitled

a guest
Aug 28th, 2010
243
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Pascal 10.40 KB | None | 0 0
raw download clone embed print report
  1. {Program wyswietlajacy fraktale - zbiory Julii, Mandelbrota oraz "Plonacy statek"}
  2. {kompilacja: tpc fractals -$N+ -$G+}
  3.  
  4. program Fractals;
  5.  
  6. const
  7.     MAX_X = 320;
  8.     MAX_Y = 200;
  9.     {typy fraktali}
  10.     JULIA = 0;
  11.     MANDELBROT = 1;
  12.     BURNING_SHIP = 2;
  13.  
  14. var
  15.     {parametry fraktala:}
  16.     c_re            :double; {czesc Re}
  17.     c_im            :double; {czesc Im}
  18.     fractalType     :byte; {typ fraktala}
  19.     {tablica ekranu:}
  20.     tab             :Array[0..MAX_X-1, 0..MAX_Y-1] of byte;
  21.    
  22.  
  23. {procedury zewnetrzne}
  24. procedure PutPixel(kolor :byte; x,y :word); external;
  25. procedure Init13h; external;
  26. procedure Close13h; external;
  27. function PauseKey :char; external;
  28. procedure Cls; external;
  29.  
  30. {dolacz plik OBJ odpowiedni}
  31. {$L proc.obj}
  32.  
  33.  
  34. function SprawdzPunkt(z_re, z_im :double; iter, fract :byte) :byte; assembler;
  35. var
  36.     x, y :double;
  37.     xtemp :double;
  38.    
  39. asm
  40.     finit
  41.     push    CX  
  42.     mov     CL, 0       {Julia}
  43.     cmp     CL, fract
  44.     je      @@jul
  45.     inc     CL          {Mandelbrot}
  46.     cmp     CL, fract
  47.     je      @@mand
  48.     jmp     @@burn      {Plonacy statek}
  49.  
  50.   @@jul:                {fraktal zbior Julii}
  51.     mov     CL, 0  
  52.   @@petlaj:
  53.     cmp     CL, iter
  54.     je      @@koniec
  55.     fld     z_re        {po: z_re#}
  56.     fld     z_re        {po: z_re; z_re#}
  57.     fmulp               {po: z_re*z_re#}
  58.     fld     z_im        {po: z_im; z_re*z_re#}
  59.     fld     z_im        {po: z_im; z_im; z_re*z_re#}
  60.     fmulp               {po: z_im*z_im; z_re*z_re#}
  61.     faddp               {po: z_im*z_im+z_re*z_re#}
  62.     fld1                {po: 1.0; z_im*z_im+z_re*z_re#}
  63.     fld1                {po: 1.0; 1.0; z_im*z_im+z_re*z_re#}
  64.     fld1                {po: 1.0; 1.0; 1.0; z_im*z_im+z_re*z_re#}
  65.     fld1                {po: 1.0; 1.0; 1.0; 1.0; z_im*z_im+z_re*z_re#}
  66.     faddp               {po: 2.0; 1.0; 1.0; z_im*z_im+z_re*z_re#}
  67.     faddp               {po: 3.0; 1.0; z_im*z_im+z_re*z_re#}
  68.     faddp               {po: 4.0; z_im*z_im+z_re*z_re#}
  69.     fcompp              {po: #}
  70.     fstsw   AX
  71.     sahf
  72.     jb      @@koniec
  73.     fld     z_re        {po: z_re#}
  74.     fld     z_re        {po: z_re; z_re#}
  75.     fld     z_re        {po: z_re; z_re; z_re#}
  76.     fmulp               {po: z_re*z_re; z_re#}
  77.     fld     z_im        {po: z_im; z_re*z_re; z_re#}
  78.     fld     z_im        {po: z_im; z_im; z_re*z_re; z_re#}
  79.     fmulp               {po: z_im*z_im; z_re*z_re; z_re#}
  80.     fsubp               {po: z_re*z_re - z_im*z_im; z_re#}
  81.     fld     c_re        {po: c_re; z_re*z_re - z_im*z_im; z_re#}
  82.     faddp               {po: c_re + z_re*z_re - z_im*z_im; z_re#}
  83.     fstp    z_re        {po: z_re#}
  84.     fld     z_im        {po: z_im; z_re#}
  85.     fld1                {po: 1.0; z_im; z_re#}
  86.     fld1                {po: 1.0; 1.0; z_im; z_re#}
  87.     faddp               {po: 2.0; z_im; z_re#}
  88.     fmulp               {po: 2.0*z_im; z_re#}
  89.     fmulp               {po: 2.0*z_im*z_re#}
  90.     fld     c_im        {po: c_im; 2.0*z_im*z_re#}
  91.     faddp               {po: c_im + 2.0*z_im*z_re#}
  92.     fstp    z_im        {po: #}
  93.     inc     CL
  94.     jmp     @@petlaj
  95.  
  96.   @@mand:               {fraktal zbior Mandelbrota}
  97.     mov     CL, 0
  98.     fldz                {po: 0.0#}
  99.     fstp    x           {po: #}
  100.     fldz                {po: 0.0#}
  101.     fstp    y           {po: #}
  102.   @@petlam:
  103.     cmp     CL, iter
  104.     je      @@koniec
  105.     fld     x           {po: x#}
  106.     fld     x           {po: x; x#}
  107.     fmulp               {po: x*x#}
  108.     fld     y           {po: y; x*x#}
  109.     fld     y           {po: y; y; x*x#}
  110.     fmulp               {po: y*y; x*x#}
  111.     faddp               {po: y*y + x*x#}
  112.     fld1                {po: 1.0; y*y + x*x#}
  113.     fld1                {po: 1.0; 1.0; y*y + x*x#}
  114.     fld1                {po: 1.0; 1.0; 1.0; y*y + x*x#}
  115.     fld1                {po: 1.0; 1.0; 1.0; 1.0; y*y + x*x#}
  116.     faddp               {po: 2.0; 1.0; 1.0; y*y + x*x#}
  117.     faddp               {po: 3.0; 1.0; y*y + x*x#}
  118.     faddp               {po: 4.0; y*y + x*x#}
  119.     fcompp              {po: #}
  120.     fstsw   AX
  121.     sahf
  122.     jb      @@koniec
  123.     fld     z_re        {po: z_re#}
  124.     fld     x           {po: x; z_re#}
  125.     fld     x           {po: x; x; z_re#}
  126.     fmulp               {po: x*x; z_re#}
  127.     fld     y           {po: y; x*x; z_re#}
  128.     fld     y           {po: y; y; x*x; z_re#}
  129.     fmulp               {po: y*y; x*x; z_re#}
  130.     fsubp               {po: x*x - y*y; z_re#}
  131.     faddp               {po: x*x - y*y + z_re#}
  132.     fstp    xtemp       {po: #}
  133.     fld     y           {po: y#}
  134.     fld     x           {po: x; y#}
  135.     fld1                {po: 1.0; x; y#}
  136.     fld1                {po: 1.0; 1.0; x; y#}
  137.     faddp               {po: 2.0; x; y#}
  138.     fmulp               {po: 2.0*x; y#}
  139.     fmulp               {po: 2.0*x*y#}
  140.     fld     z_im        {po: z_im; 2.0*x*y#}
  141.     faddp               {po: 2.0*x*y + z_im#}
  142.     fstp    y           {po: #}
  143.     fld     xtemp       {po: xtemp#}
  144.     fstp    x           {po: #}
  145.     inc     CL
  146.     jmp     @@petlam
  147.  
  148.  
  149.   @@burn:               {fraktal Plonacy Statek}
  150.     mov     CL, 0
  151.     fldz                {po: 0.0#}
  152.     fstp    x           {po: #}
  153.     fldz                {po: 0.0#}
  154.     fstp    y           {po: #}
  155.   @@petlab:
  156.     cmp     CL, iter
  157.     je      @@koniec
  158.     fld     x           {po: x#}
  159.     fabs                {po: |x|#}
  160.     fstp    x           {po: #}
  161.     fld     y           {po: y#}
  162.     fabs                {po: |y|#}
  163.     fstp    y           {po: #}
  164.     fld     x           {po: x#}
  165.     fld     x           {po: x; x#}
  166.     fmulp               {po: x*x#}
  167.     fld     y           {po: y; x*x#}
  168.     fld     y           {po: y; y; x*x#}
  169.     fmulp               {po: y*y; x*x#}
  170.     faddp               {po: y*y + x*x#}
  171.     fld1                {po: 1.0; y*y + x*x#}
  172.     fld1                {po: 1.0; 1.0; y*y + x*x#}
  173.     fld1                {po: 1.0; 1.0; 1.0; y*y + x*x#}
  174.     fld1                {po: 1.0; 1.0; 1.0; 1.0; y*y + x*x#}
  175.     faddp               {po: 2.0; 1.0; 1.0; y*y + x*x#}
  176.     faddp               {po: 3.0; 1.0; y*y + x*x#}
  177.     faddp               {po: 4.0; y*y + x*x#}
  178.     fcompp              {po: #}
  179.     fstsw   AX
  180.     sahf
  181.     jb      @@koniec
  182.     fld     z_re        {po: z_re#}
  183.     fld     x           {po: x; z_re#}
  184.     fld     x           {po: x; x; z_re#}
  185.     fmulp               {po: x*x; z_re#}
  186.     fld     y           {po: y; x*x; z_re#}
  187.     fld     y           {po: y; y; x*x; z_re#}
  188.     fmulp               {po: y*y; x*x; z_re#}
  189.     fsubp               {po: x*x - y*y; z_re#}
  190.     faddp               {po: x*x - y*y + z_re#}
  191.     fstp    xtemp       {po: #}
  192.     fld     y           {po: y#}
  193.     fld     x           {po: x; y#}
  194.     fld1                {po: 1.0; x; y#}
  195.     fld1                {po: 1.0; 1.0; x; y#}
  196.     faddp               {po: 2.0; x; y#}
  197.     fmulp               {po: 2.0*x; y#}
  198.     fmulp               {po: 2.0*x*y#}
  199.     fld     z_im        {po: z_im; 2.0*x*y#}
  200.     faddp               {po: 2.0*x*y + z_im#}
  201.     fstp    y           {po: #}
  202.     fld     xtemp       {po: xtemp#}
  203.     fstp    x           {po: #}
  204.     inc     CL
  205.     jmp     @@petlab
  206.  
  207.   @@koniec:
  208.     {wynik w AL}
  209.     mov     AL, CL
  210.     pop     CX
  211. end;{SprawdzPunkt}
  212.  
  213.  
  214. procedure RysujFraktal(x_min, x_max, y_min, y_max :double; iter, fract :byte);
  215. var
  216.     z_re    :double;
  217.     z_im    :double;
  218.     x       :word;
  219.     y       :word;
  220.     x_res   :double;
  221.     y_res   :double;
  222.     wynik   :byte;
  223.     maxx    :word;
  224.     maxy    :word;
  225.  
  226. begin
  227.     asm
  228.         {x_res := (x_max - x_min) / MAX_X;}
  229.         finit
  230.         fld     x_max
  231.         fsub    x_min
  232.         mov     maxx, MAX_X
  233.         fidiv   maxx
  234.         fstp    x_res
  235.         {y_res := (y_max - y_min) / MAX_Y;}
  236.         fld     y_max
  237.         fsub    y_min
  238.         mov     maxy, MAX_Y
  239.         fidiv   maxy
  240.         fstp    y_res
  241.     end;
  242.     z_re := x_min;
  243.     for x := 0 to (MAX_X - 1) do begin
  244.         z_im := y_min;
  245.         for y := 0 to (MAX_Y - 1) do begin
  246.             wynik := SprawdzPunkt(z_re, z_im, iter, fract) + 15 - iter;
  247.             if (wynik > 15) then
  248.                 wynik := 0;
  249.             tab[x, y] := wynik + 16;
  250.             z_im := z_im + y_res;
  251.         end;
  252.         z_re := z_re + x_res;
  253.     end;
  254.     for x := 0 to (MAX_X - 1) do
  255.         for y := 0 to (MAX_Y - 1) do
  256.             PutPixel(tab[x,y],x,y);
  257. end;{RysujFraktal}
  258.  
  259.  
  260. procedure Dzialaj;
  261. var
  262.     key     :char;
  263.     x       :double;
  264.     y       :double;
  265.     skala   :double;
  266.     it      :byte;  
  267.    
  268. begin
  269.     x := -2.5;
  270.     y := -1.5625;
  271.     skala := 1/64;
  272.     it := 16;
  273.     repeat
  274.         RysujFraktal(x, x + skala * MAX_X, y, y + skala * MAX_Y, it, fractalType);
  275.         key := PauseKey;
  276.         case key of
  277.             '=': {wlasciwie '+'}
  278.                 it := it + 4;
  279.             '-':
  280.                 it := it - 4;
  281.             'e':
  282.             begin
  283.                 skala := skala / 2;
  284.                 x := x + 160*skala;
  285.                 y := y + 100*skala;
  286.             end;
  287.             'q':
  288.             begin
  289.                 x := x - 160*skala;
  290.                 y := y - 100*skala;
  291.                 skala := skala * 2;
  292.             end;
  293.             'w':
  294.                 y := y - 5*skala;
  295.             's':
  296.                 y := y + 5*skala;
  297.             'a':
  298.                 x := x - 5*skala;
  299.             'd':
  300.                 x := x + 5*skala;
  301.             'u':
  302.                 c_re := c_re - 0.01;
  303.             'j':
  304.                 c_re := c_re + 0.01;
  305.             'i':
  306.                 c_im := c_im - 0.01;
  307.             'k':
  308.                 c_im := c_im + 0.01;
  309.             '1': {Julia}
  310.                 fractalType := JULIA;
  311.             '2': {Mandelbrot}
  312.                 fractalType := MANDELBROT;
  313.             '3': {Plonacy statek}
  314.                 fractalType := BURNING_SHIP;
  315.         end;
  316.         if (it < 16) then
  317.             it := 16;
  318.         if (it > 64) then
  319.             it := 64;
  320.         if (skala > 1/64) then
  321.         begin
  322.             skala := 1/64;
  323.             x := x + 160*skala;
  324.             y := y + 100*skala;
  325.         end;
  326.         if (c_re > 1) then
  327.             c_re := 1;
  328.         if (c_im > 1) then
  329.             c_im := 1;
  330.         if (c_re < -1) then
  331.             c_re := -1;
  332.         if (c_im < -1) then
  333.             c_im := -1;
  334.     until key = 'z';
  335. end;{Dzialaj}
  336.  
  337.  
  338. {glowny program}
  339. begin
  340.     c_re := 0;
  341.     c_im := 0;
  342.     fractalType := JULIA; {Julia}
  343.     Init13h;
  344.     Dzialaj;
  345.     Close13h;
  346. end.{Julia}
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!