home *** CD-ROM | disk | FTP | other *** search
/ Prima Shareware 3 / DuCom_Prima-Shareware-3_cd1.bin / PROGRAMO / PASCAL / HEJB / UNITS / UNSTROM.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-11-30  |  25.6 KB  |  1,113 lines
  1. unit Unstrom;
  2. interface
  3. uses Obraz3D, Unhejb, Unobdel, Unfront;
  4.  
  5. const
  6.   __N  = 0;
  7.   __L  = 1;
  8.   __R  = 2;
  9.   __Lr = __L+__R;
  10. const Maxur = 5;
  11.  
  12. type Typ_Spoj =
  13.        object(Typ_Hejbaci)
  14.          Typ : Byte;
  15.          Velikost : Byte;
  16.          procedure Vytvor(Ur : Typ_Souradnic; _L, _R : Boolean; Nbarva : Byte);
  17.          procedure Pridej(Ur : Typ_Souradnic; _L, _R : Boolean; Nbarva : Byte);
  18.          procedure _Zobraz; virtual;
  19.          procedure _Zhasni; virtual;
  20.          procedure _Presun_Rel(X, Y, Z : Typ_Souradnic);virtual;
  21.          procedure Prazdny;
  22.          constructor Init;
  23.        end;
  24.  
  25.      Vtyp_Strom_Ptr = ^Vtyp_Strom;
  26.      Vtyp_Strom =
  27.        object(Typ_Hejbaci_Zaklad)
  28.          Klic   : Integer;
  29.  
  30.          Uroven : Byte;
  31.          Koren  : Typ_Line;
  32.          Levy, Pravy : Vtyp_Strom_Ptr;
  33.          Spoj   : Typ_Spoj;
  34.  
  35.          function Vaha : Integer;
  36.          function Hloubka : Integer;
  37.  
  38.          procedure _Neni_List;
  39.          procedure _Je_List;
  40.          procedure _Srovnat_List;
  41.  
  42.          procedure Vytvor(S : string; C1 : Byte);
  43.          procedure set_Barva(_C : Byte);virtual;
  44.  
  45.          procedure Delej_Levy(Prvek : Typ_Obdelnik; _Klic : Integer);
  46.            { vytvori levy list stromu a pripadne zobrazi }
  47.          procedure Delej_Pravy(Prvek : Typ_Obdelnik; _Klic : Integer);
  48.            { vytvori pravy list stromu a pripadne zobrazi }
  49.  
  50.          procedure Slevy(Prvek : Vtyp_Strom_Ptr);
  51.            { priradi prvek jako levy podstrom, prvek nesmi byt jinde ve stromu ! }
  52.          procedure Spravy(Prvek : Vtyp_Strom_Ptr);
  53.  
  54.          procedure Right_Rotation;
  55.          procedure Left_Rotation;
  56.  
  57.          procedure Anim_Right_Rotation;
  58.          procedure Anim_Left_Rotation;
  59.  
  60.          function Lpoloha : Ptr__Bod3D;
  61.          function Ppoloha : Ptr__Bod3D;
  62.  
  63.          procedure Anim_Insert( Prvek : Integer);
  64.  
  65.          procedure Vinsert( Prvek : Integer );
  66.          procedure Vanim_Insert( Prvek : Integer );
  67.  
  68.          procedure Anim_in_Rozmistit;
  69.          procedure Anim_Obnov;
  70.  
  71.          procedure Zrus_Levy;
  72.          procedure Zrus_Pravy;
  73.  
  74.          procedure Prohod(var Strom : Vtyp_Strom);
  75.  
  76.          procedure _Zobraz;virtual;
  77.          procedure _Zhasni;virtual;
  78.          procedure _Presun_Rel(X, Y, Z : Typ_Souradnic);virtual;
  79.          procedure _Obnov; virtual;
  80.          constructor Init;
  81.          destructor Zrus;
  82.        end;
  83.  
  84. function __Velikost(Uroven : Integer): Integer;
  85. function Lpoloha( _Bod : _Bod3D; Rozkorx, Uroven : Integer):Ptr__Bod3D;
  86. function Ppoloha( _Bod : _Bod3D; Rozkorx, Uroven : Integer):Ptr__Bod3D;
  87.  
  88. procedure set_Pocatek_Animace(X, Y, Z : Typ_Souradnic);
  89. procedure set_Velikost(Velikost : real);
  90.  
  91. implementation
  92. uses Dos;
  93. const ___Pocatek : _Bod3D = (X:0;Y:0;Z:0);
  94.       __Velikost_Stromu : real = 0.7;
  95.  
  96. procedure Vtyp_Strom.Anim_Obnov;
  97. begin
  98.   Koren.Zobraz;
  99.   Stav := Stav or __Videt;
  100.   Koren.set_Barvar(-3);
  101.   Koren.Dodel_Anim_Posun_Bod(Poloha);
  102.   _Srovnat_List;
  103.   if Levy <> nil then
  104.     begin
  105.       Levy^.Uroven := Uroven+1;
  106.       Levy^.Poloha := Lpoloha^;
  107.       Levy^.Anim_Obnov;
  108.     end;
  109.   if Pravy <> nil then
  110.     begin
  111.       Pravy^.Uroven := Uroven+1;
  112.       Pravy^.Poloha := Ppoloha^;
  113.       Pravy^.Anim_Obnov;
  114.     end;
  115.   if (Levy <> nil) or (Pravy<>nil) then
  116.     begin
  117.       Spoj.Prazdny;
  118.       Spoj.Vytvor(   Uroven,
  119.                      Levy <> nil,
  120.                      Pravy <> nil,
  121.                      Koren.Dej_Bod(0)^.Obsah.Atrib);
  122.       Spoj.Presun(Poloha.X+Koren.Rozmer.X+1,
  123.                      Poloha.Y+1,
  124.                      Poloha.Z);
  125.                   
  126.  
  127.       Spoj.Zobraz
  128.     end;
  129.   Stav := Stav or __Videt;
  130. end;
  131.  
  132.  
  133. procedure Vtyp_Strom.Anim_in_Rozmistit;
  134. var I : Integer;
  135.   procedure Rekurse(Pom : Vtyp_Strom_Ptr);
  136.   begin
  137.     if Pom^.Levy <> nil then Rekurse(Pom^.Levy);
  138.     if Pom^.Koren.Je_Tvar then
  139.       begin
  140.         if Pom^.Spoj.Je_Tvar then Pom^.Spoj.Zhasni;
  141.         Pom^._Je_List;
  142.         Pom^.Koren.set_Barvar(3);
  143.         Pom^.Koren.Dodel_Anim_Posun_Bod(Hezky_Rozmistit(I)^);
  144.         Inc(I)
  145.       end;
  146.     if Pom^.Pravy <> nil then Rekurse(Pom^.Pravy);
  147.   end;
  148. begin
  149.   I:= 1;
  150.   Rekurse(@Self);
  151. end;
  152.  
  153. procedure Vtyp_Strom.Anim_Insert( Prvek : Integer );
  154. var Obd : Typ_Line;
  155.     S : string[10];
  156.     Koncit : Boolean;
  157.     Fn : Vtyp_Strom_Ptr;
  158. begin
  159.   Obd.Init;
  160.   Obd.Presun_Bod(___Pocatek);
  161.   Str(Prvek, S);
  162.   if Klic = Maxint then
  163.     begin
  164.         Vytvor(S, 10);
  165.         Presun(0,Obrazovka.Y_Obr shr 1-1,0);
  166.         Klic := Prvek;
  167.         Zobraz
  168.     end
  169.   else
  170.     begin
  171.       Obd.Vytvor_string_Ram(S,Barva+1,Barva+2,Strom_Ram);
  172.       Obd.Zobraz;
  173.       Obd.Dodel_Anim_Posun_Bod(Poloha);
  174.  
  175.       Koncit := False;
  176.       Fn := @Self;
  177.       repeat { zatrideni }
  178.  
  179.         if Fn^.Klic > Prvek then
  180.           begin
  181.             if Fn^.Levy = nil then
  182.               begin
  183.                 Obd.Dodel_Anim_Posun_Bod(Fn^.Lpoloha^);
  184.                 Obd.set_Barva(Barva);
  185.                 Fn^.Delej_Levy(Obd,Prvek);
  186.                 Koncit := True;
  187.               end
  188.             else
  189.               begin
  190.                 Obd.Dodel_Anim_Posun_Bod(Fn^.Levy^.Poloha);
  191.                 Fn := Fn^.Levy;
  192.               end;
  193.           end
  194.         else if Fn^.Klic < Prvek then
  195.                begin
  196.                  if Fn^.Pravy = nil then
  197.                    begin
  198.                      Obd.Dodel_Anim_Posun_Bod(Fn^.Ppoloha^);
  199.                      Obd.set_Barva(Barva);
  200.                      Fn^.Delej_Pravy(Obd,Prvek);
  201.                      Koncit := True;
  202.                    end
  203.                  else
  204.                    begin
  205.                      Obd.Dodel_Anim_Posun_Bod(Fn^.Pravy^.Poloha);
  206.                      Fn := Fn^.Pravy;
  207.                    end;
  208.                end
  209.              else begin Koncit := True; end;
  210.       until Koncit;
  211.     end;
  212.   Obd.Zrus;
  213. end;
  214.  
  215. procedure Vtyp_Strom.Vanim_Insert( Prvek : Integer );
  216. var S : string;
  217.     Je : Boolean;
  218.     Tmp, Tmp1, Pom, _A, _B, Fa : Vtyp_Strom_Ptr;
  219.     Obd : Typ_Line;
  220.  
  221. begin
  222.   Obd.Init;
  223.   Obd.Presun_Bod(___Pocatek);
  224.  
  225.   Str(Prvek, S);
  226.   Obd.Vytvor_string_Ram(S,Barva+1,Barva+1,Strom_Ram);
  227.   Obd.Zobraz;
  228.  
  229.   Obd.Dodel_Anim_Posun_Bod(Poloha);
  230.   if Klic = Maxint then
  231.     begin
  232.       Vytvor(S,10);
  233.       Klic := Prvek;
  234.       Zobraz
  235.     end
  236.   else
  237.     begin
  238.  
  239.       Je   := False;
  240.       Tmp  := @Self;
  241.       Tmp1 := nil;
  242.       _A   := Tmp;
  243.       Fa   := nil;
  244.  
  245.       while not (Tmp = nil) and (not Je) do
  246.         begin
  247.           if Tmp^.Klic = Prvek then Je := True
  248.           else
  249.             begin
  250.               if Prvek < Tmp^.Klic
  251.                 then
  252.                   begin
  253.                     Obd.Dodel_Anim_Posun_Bod(Tmp^.Lpoloha^);
  254.                     Pom := Tmp^.Levy
  255.                   end
  256.                 else
  257.                   begin
  258.                     Obd.Dodel_Anim_Posun_Bod(Tmp^.Ppoloha^);
  259.                     Pom := Tmp^.Pravy;
  260.                   end;
  261.               if (not (Pom = nil)) then if (Pom^.Vaha <> 0) then
  262.                 begin _A := Pom; Fa := Tmp end;
  263.               Tmp1 := Tmp;
  264.               Tmp  := Pom
  265.             end;
  266.         end;
  267.    if not Je then
  268.       if Tmp1 = nil then
  269.         begin Tmp1 := Tmp1;
  270.         end
  271.       else
  272.         begin
  273.           Obd.set_Barva(Barva);
  274.           if Prvek < Tmp1^.Klic
  275.             then Tmp1^.Delej_Levy(Obd,Prvek)
  276.             else Tmp1^.Delej_Pravy(Obd,Prvek);
  277.           Obd.Zhasni;
  278.  
  279.           if _A^.Vaha = 2 then
  280.             begin
  281.               _B := _A^.Levy;
  282.               if _B^.Klic < Prvek then _B^.Anim_Left_Rotation;
  283.               _A^.Anim_Right_Rotation;
  284.             end
  285.           else if _A^.Vaha = -2 then
  286.             begin
  287.               _B := _A^.Pravy;
  288.               if _B^.Klic > Prvek then _B^.Anim_Right_Rotation;
  289.               _A^.Anim_Left_Rotation;
  290.             end;
  291.         end;
  292.     end;
  293.   Obd.Zrus;
  294. end;
  295.  
  296. procedure Vtyp_Strom.Vinsert(Prvek : Integer);
  297. var S : string;
  298.     Je : Boolean;
  299.     Tmp, Tmp1, Pom, _A, _B, Fa : Vtyp_Strom_Ptr;
  300.     Obd : Typ_Line;
  301.  
  302. begin
  303.   Obd.Init;
  304.   Str(Prvek, S);
  305.   if Klic = Maxint then
  306.     begin
  307.       Vytvor(S,10);
  308.       Presun(0,Obrazovka.Y_Obr shr 1-1,0);
  309.       Klic := Prvek;
  310.       Zobraz
  311.     end
  312.   else
  313.     begin
  314.       Obd.Vytvor_string_Ram(S, 10,10,Strom_Ram);
  315.  
  316.       Je   := False;
  317.       Tmp  := @Self;
  318.       Tmp1 := nil;
  319.       _A    := Tmp;
  320.       Fa   := nil;
  321.  
  322.       while not (Tmp = nil) and (not Je) do
  323.         begin
  324.           if Tmp^.Klic = Prvek then Je := True
  325.           else
  326.             begin
  327.               if Prvek < Tmp^.Klic
  328.                 then Pom := Tmp^.Levy
  329.                 else Pom := Tmp^.Pravy;
  330.               if (not (Pom = nil)) then if (Pom^.Vaha <> 0) then
  331.                 begin _A := Pom; Fa := Tmp end;
  332.               Tmp1 := Tmp;
  333.               Tmp := Pom
  334.             end;
  335.         end;
  336.    if not Je then
  337.       if Tmp1 = nil then
  338.         begin Tmp1 := Tmp1;
  339.         end
  340.       else
  341.         begin
  342.           if Prvek < Tmp1^.Klic
  343.             then Tmp1^.Delej_Levy(Obd,Prvek)
  344.             else Tmp1^.Delej_Pravy(Obd,Prvek);
  345.           if _A^.Vaha = 2 then
  346.             begin
  347.               _B := _A^.Levy;
  348.               if _B^.Klic < Prvek then _B^.Left_Rotation;
  349.               _A^.Right_Rotation;
  350.             end
  351.           else if _A^.Vaha = -2 then
  352.             begin
  353.               _B := _A^.Pravy;
  354.               if _B^.Klic > Prvek then _B^.Right_Rotation;
  355.               _A^.Left_Rotation;
  356.             end;
  357.         end;
  358.     end;
  359.   Obd.Zrus;
  360.   if (Koren.Stav and __Videt) = 0 then
  361.     Koren.Stav := Koren.Stav+1-1
  362. end;
  363.  
  364. function Lpoloha( _Bod : _Bod3D; Rozkorx, Uroven : Integer):Ptr__Bod3D;
  365. begin
  366.   Lpoloha  := @___Bod;
  367.   ___Bod.X := _Bod.X+Rozkorx+2;
  368.   ___Bod.Y := _Bod.Y-__Velikost(Uroven);
  369.   ___Bod.Z := _Bod.Z;
  370. end;
  371.  
  372. function Ppoloha( _Bod : _Bod3D; Rozkorx, Uroven : Integer):Ptr__Bod3D;
  373. begin
  374.   Ppoloha  := @___Bod;
  375.   ___Bod.X := _Bod.X+Rozkorx+2;
  376.   ___Bod.Y := _Bod.Y+__Velikost(Uroven);
  377.   ___Bod.Z := _Bod.Z;
  378. end;
  379.  
  380.  
  381. function Vtyp_Strom.Lpoloha : Ptr__Bod3D;
  382. begin
  383.   Lpoloha  := @___Bod;
  384.   ___Bod.X := Poloha.X+Koren.Rozmer.X+2;
  385.   ___Bod.Y := Poloha.Y-__Velikost(Uroven);
  386.   ___Bod.Z := Poloha.Z;
  387. end;
  388.  
  389. function Vtyp_Strom.Ppoloha : Ptr__Bod3D;
  390. begin
  391.   Ppoloha  := @___Bod;
  392.   ___Bod.X := Poloha.X+Koren.Rozmer.X+2;
  393.   ___Bod.Y := Poloha.Y+__Velikost(Uroven);
  394.   ___Bod.Z := Poloha.Z;
  395. end;
  396.  
  397. function Vtyp_Strom.Vaha : Integer;
  398. begin
  399.   if Levy = nil
  400.     then if Pravy = nil
  401.            then Vaha := 0
  402.            else Vaha := -Pravy^.Hloubka
  403.     else if Pravy = nil
  404.            then Vaha := Levy^.Hloubka
  405.            else Vaha := Levy^.Hloubka - Pravy^.Hloubka
  406. end;
  407.  
  408. function Vtyp_Strom.Hloubka : Integer;
  409.   function Max(A,B : Integer) : Integer;
  410.   begin
  411.     if A > B then Max := A else Max := B
  412.   end;
  413.  
  414. begin
  415.   if (Levy = nil) and (Pravy = nil)
  416.     then Hloubka := 1
  417.     else if Levy = nil then Hloubka := Pravy^.Hloubka+1
  418.          else if Pravy = nil then Hloubka := Levy^.Hloubka+1
  419.          else Hloubka := Max(Levy^.Hloubka,Pravy^.Hloubka)+1;
  420. end;
  421.  
  422. procedure Vtyp_Strom.Delej_Levy(Prvek : Typ_Obdelnik; _Klic : Integer);
  423. begin
  424.   if Levy = nil then
  425.     begin
  426.       New(Levy, Init);
  427.       Levy^.Presun_Bod(Lpoloha^);
  428.  
  429.       Levy^.Koren.Prirad(Prvek);
  430.       Levy^.Stav := Levy^.Stav or __Existuje_Tvar;
  431.  
  432.       Levy^.Uroven := Uroven+1;
  433.       Levy^.Klic   := _Klic;
  434.  
  435.       Spoj.Pridej(Uroven, True, False, Koren.Barva);
  436.       Spoj.Presun(Poloha.X+Koren.Rozmer.X+1, Poloha.Y+1, Poloha.Z);
  437.       if (__Videt and Stav) <> 0 then
  438.         begin
  439.           Levy^.Zobraz;
  440.           Spoj.Zobraz;
  441.         end;
  442.     end;
  443.   _Neni_List;
  444. end;
  445.  
  446. procedure Vtyp_Strom.Delej_Pravy(Prvek : Typ_Obdelnik; _Klic : Integer);
  447. begin
  448.   if Pravy = nil then
  449.     begin
  450.       New(Pravy, Init);
  451.       Pravy^.Presun_Bod(Ppoloha^);
  452.  
  453.       Pravy^.Koren.Prirad(Prvek);
  454.       Pravy^.Stav := Pravy^.Stav or __Existuje_Tvar;
  455.  
  456.       Pravy^.Uroven := Uroven+1;
  457.       Pravy^.Klic := _Klic;
  458.  
  459.       Spoj.Pridej( Uroven,
  460.                   False, True,
  461.                   Koren.Dej_Bod(0)^.Obsah.Atrib);
  462.       Spoj.Presun(Poloha.X+Koren.Rozmer.X+1, Poloha.Y+1, Poloha.Z);
  463.       if (__Videt and Stav) <> 0 then
  464.         begin
  465.           Pravy^.Zobraz;
  466.           Spoj.Zobraz;
  467.         end;
  468.     end;
  469.   _Neni_List;
  470. end;
  471.  
  472. procedure Vtyp_Strom.Slevy(Prvek : Vtyp_Strom_Ptr);
  473. begin
  474.   if Levy = nil then
  475.     begin
  476.       Levy := Prvek;
  477.  
  478.       Levy^.Uroven := Uroven+1;
  479.  
  480.       Levy^.Poloha := Lpoloha^;
  481.  
  482.       Spoj.Pridej( Uroven, True, False,
  483.                   Koren.Dej_Bod(0)^.Obsah.Atrib);
  484.       Spoj.Presun(Poloha.X+Koren.Rozmer.X+1, Poloha.Y+1, Poloha.Z);
  485.       if (__Videt and Stav) <> 0 then
  486.         begin
  487.           Levy^._Obnov;
  488.           Spoj.Zobraz;
  489.         end;
  490.     end;
  491.   _Neni_List;
  492. end;
  493.  
  494. procedure Vtyp_Strom.Spravy(Prvek : Vtyp_Strom_Ptr);
  495. begin
  496.   if Pravy = nil then
  497.     begin
  498.       Pravy := Prvek;
  499.  
  500.       Pravy^.Uroven := Uroven+1;
  501.       Pravy^.Poloha := Ppoloha^;
  502.  
  503.       Spoj.Pridej( Uroven, False, True,
  504.                   Koren.Dej_Bod(0)^.Obsah.Atrib);
  505.       Spoj.Presun(Poloha.X+Koren.Rozmer.X+1, Poloha.Y+1, Poloha.Z);
  506.       if (__Videt and Stav) <> 0 then
  507.         begin
  508.           Pravy^._Obnov;
  509.           Spoj.Zobraz;
  510.         end;
  511.     end;
  512.   _Neni_List;
  513. end;
  514.  
  515. procedure Vtyp_Strom.set_Barva(_C : Byte);
  516. begin
  517.   if Levy <> nil then Levy^.set_Barva(_C);
  518.   if Pravy <> nil then Pravy^.set_Barva(_C);
  519.   Koren.set_Barva(_C);
  520.   Spoj.set_Barva(_C);
  521.   Barva := _C;
  522. end;
  523.  
  524. procedure Vtyp_Strom.Right_Rotation;
  525. var _B, _D : Vtyp_Strom_Ptr;
  526.     Pp    : Vtyp_Strom;
  527.  
  528. begin
  529.   if Levy = nil then WriteLn('error right')
  530.   else
  531.     begin
  532.       set_Barva(Koren.Dej_Bod(0)^.Obsah.Atrib+1);
  533.       Pp.Init;
  534.       Zhasni;
  535.       _B := Levy;
  536.       _D := _B^.Pravy;
  537.  
  538.       _B^.Zrus_Pravy;    { ulozen v D }
  539.       Zrus_Levy;        { levy ulozen v B }
  540.  
  541.       Pp   := Self;
  542.       Self := _B^;
  543.       _B^  := Pp;
  544.  
  545.  
  546.       Pravy    := _B;
  547.       _B^.Levy := _D;
  548.  
  549.       Poloha := Pp.Poloha;
  550.       Uroven := Pp.Uroven;
  551.  
  552.       _Srovnat_List;
  553.       _B^._Srovnat_List;
  554.  
  555.       _Obnov;
  556.       set_Barva(Koren.Dej_Bod(0)^.Obsah.Atrib-1);
  557.     end;
  558. end;
  559.  
  560. procedure Vtyp_Strom.Left_Rotation;
  561. var  C, _D : Vtyp_Strom_Ptr;
  562.     Pp     : Vtyp_Strom;
  563.  
  564. begin
  565.   if Pravy = nil then WriteLn('error left')
  566.   else
  567.     begin
  568.       set_Barva(Koren.Dej_Bod(0)^.Obsah.Atrib-1);
  569.       Pp.Init;
  570.  
  571.       C := Pravy;
  572.       _D := C^.Levy;
  573.  
  574.       C^.Zrus_Levy;
  575.       Zrus_Pravy;
  576.  
  577.       Pp   := Self;
  578.       Self := C^;
  579.       C^   := Pp;
  580.  
  581.       Levy     := C;
  582.       C^.Pravy := _D;
  583.  
  584.       Poloha := Pp.Poloha;
  585.       Uroven := Pp.Uroven;
  586.  
  587.       _Srovnat_List;
  588.       C^._Srovnat_List;
  589.  
  590.       _Obnov;
  591.       set_Barva(Koren.Dej_Bod(0)^.Obsah.Atrib+1);
  592.     end;
  593. end;
  594.  
  595. procedure Vtyp_Strom.Anim_Right_Rotation;
  596. var _B, _D : Vtyp_Strom_Ptr;
  597.     Pp   : Vtyp_Strom;
  598. var Pom_Fronta : Typ_Hejb_Fronta;
  599. begin
  600.   if Levy = nil then WriteLn('error right')
  601.   else
  602.     begin
  603.       Pom_Fronta.Init;
  604.  
  605.       set_Barva(Koren.Dej_Bod(0)^.Obsah.Atrib+1);
  606.       Pp.Init;
  607.       Zhasni;
  608.       _B := Levy;
  609.       _D := _B^.Pravy;
  610.  
  611.       _B^.Zrus_Pravy;    { ulozen v D }
  612.       Zrus_Levy;        { levy ulozen v B }
  613.  
  614.       _B^._Obnov;
  615.       if _D <> nil then _D^._Obnov;
  616.  
  617.       if _D <> nil then
  618.         begin
  619.           _D^.Anim_Posun_Bod(Unstrom.Lpoloha(Ppoloha^,Koren.Rozmer.X,Uroven+1)^);
  620.           Pom_Fronta.Zarad_Prvek(_D^);
  621.         end;
  622.  
  623.       Dec(_B^.Uroven);
  624.       _B^._Obnov;
  625.       _B^.Anim_Posun_Bod(Poloha);
  626.       Pom_Fronta.Zarad_Prvek(_B^);
  627.  
  628.       Anim_Posun_Bod(Ppoloha^);
  629.       Pom_Fronta.Zarad_Prvek(Self);
  630.       Inc(Uroven);
  631.       _Obnov;
  632.  
  633.       Pom_Fronta.Dodelej_Pohyb;
  634.  
  635.       Pp   := Self;
  636.       Self := _B^;
  637.       _B^   := Pp;
  638.  
  639.       Pravy    := _B;
  640.       _B^.Levy := _D;
  641.  
  642.       _Srovnat_List;
  643.       _B^._Srovnat_List;
  644.  
  645.       _Obnov;
  646.       set_Barva(Koren.Dej_Bod(0)^.Obsah.Atrib-1);
  647.       Pom_Fronta.Zrus;
  648.     end;
  649. end;
  650.  
  651. procedure Vtyp_Strom.Anim_Left_Rotation;
  652. var  C, _D : Vtyp_Strom_Ptr;
  653.      Pp   : Vtyp_Strom;
  654.      Pom_Fronta : Typ_Hejb_Fronta;
  655. begin
  656.   if Pravy = nil then WriteLn('error left')
  657.   else
  658.     begin
  659.       if Uroven = 1 then
  660.        Uroven := Uroven;
  661.       Pom_Fronta.Init;
  662.       set_Barva(Koren.Dej_Bod(0)^.Obsah.Atrib-1);
  663.       Pp.Init;
  664.  
  665.       C := Pravy;
  666.       _D := C^.Levy;
  667.  
  668.       C^.Zrus_Levy;
  669.       Zrus_Pravy;
  670.  
  671.       if _D <> nil then
  672.         begin
  673.           _D^.Anim_Posun_Bod(Unstrom.Ppoloha(Lpoloha^,Koren.Rozmer.X,Uroven+1)^);
  674.           Pom_Fronta.Zarad_Prvek(_D^);
  675.         end;
  676.       Dec(C^.Uroven);
  677.       C^._Obnov;
  678.       C^.Anim_Posun_Bod(Poloha);
  679.       Pom_Fronta.Zarad_Prvek(C^);
  680.  
  681.       Anim_Posun_Bod(Lpoloha^);
  682.       Pom_Fronta.Zarad_Prvek(Self);
  683.  
  684.       Inc(Uroven);
  685.       _Obnov;
  686.  
  687.       Pom_Fronta.Dodelej_Pohyb;
  688.  
  689.       Pp   := Self;
  690.       Self := C^;
  691.       C^   := Pp;
  692.  
  693.       Levy     := C;
  694.       C^.Pravy := _D;
  695.  
  696.       _Srovnat_List;
  697.       C^._Srovnat_List;
  698.  
  699.       _Obnov;
  700.       set_Barva(Koren.Dej_Bod(0)^.Obsah.Atrib+1);
  701.       Pom_Fronta.Zrus;
  702.     end;
  703. end;
  704.  
  705. procedure Vtyp_Strom.Zrus_Levy;
  706. begin
  707.   if Levy <> nil then begin
  708.     Spoj.Prazdny;
  709.     Spoj.Vytvor(Uroven, False, Pravy <> nil, Koren.Barva);
  710.     Spoj.Presun(Poloha.X+Koren.Rozmer.X+1, Poloha.Y+1, Poloha.Z);
  711.  
  712.     if (__Videt and Stav) <> 0 then
  713.       begin
  714.         Levy^.Zhasni;
  715.         Spoj.Zobraz;
  716.       end;
  717.     Levy := nil;
  718.     if (Pravy = nil) then _Je_List;
  719.   end;
  720. end;
  721.  
  722. procedure Vtyp_Strom.Zrus_Pravy;
  723. begin
  724.   if Pravy <> nil then begin
  725.     Spoj.Prazdny;
  726.     Spoj.Vytvor(Uroven, Levy <> nil, False, Koren.Barva);
  727.     Spoj.Presun(Poloha.X+Koren.Rozmer.X+1, Poloha.Y+1, Poloha.Z);
  728.  
  729.     if (__Videt and Stav) <> 0 then
  730.       begin
  731.         Pravy^.Zhasni;
  732.         Spoj.Zobraz;
  733.       end;
  734.     Pravy := nil;
  735.     if (Levy = nil) then _Je_List;
  736.   end;
  737. end;
  738.  
  739. procedure Vtyp_Strom._Presun_Rel(X, Y, Z : Typ_Souradnic);
  740. begin
  741.   if Levy <> nil then Levy^.Presun_Rel(X,Y,Z);
  742.   if Pravy <> nil then Pravy^.Presun_Rel(X,Y,Z);
  743.   Koren.Presun_Rel(X,Y,Z);
  744.   Spoj.Presun_Rel(X,Y,Z);
  745.   Inc(Poloha.X, X);
  746.   Inc(Poloha.Y, Y);
  747.   Inc(Poloha.Z, Z);
  748. end;
  749.  
  750. procedure Vtyp_Strom._Zobraz;
  751. begin
  752.   if (Stav and __Videt) = 0 then
  753.     begin
  754.       Koren.Poloha := Poloha;
  755.       Koren.Zobraz;
  756.       if Levy <> nil then
  757.         begin
  758.           Levy^.Uroven := Uroven+1;
  759.           Levy^.Zhasni;
  760.           Levy^.Poloha := Lpoloha^;
  761.           Levy^.Zobraz;
  762.         end;
  763.       if Pravy <> nil then
  764.         begin
  765.           Pravy^.Uroven := Uroven+1;
  766.           Pravy^.Zhasni;
  767.           Pravy^.Poloha := Ppoloha^;
  768.           Pravy^.Zobraz;
  769.         end;
  770.       if (Levy <> nil) or (Pravy <> nil) then
  771.         begin
  772.           Spoj.Zhasni;
  773.           Spoj.Poloha := Lpoloha^;
  774.  
  775.           Spoj.Poloha.X := Koren.Poloha.X+Koren.Rozmer.X+1;
  776.           Spoj.Poloha.Y := Koren.Poloha.Y+1-Spoj.Velikost;
  777.           Spoj.Poloha.Z := Koren.Poloha.Z;
  778.  
  779.           Spoj.Zobraz
  780.         end;
  781.     end;
  782.   Stav := Stav or __Videt;
  783. end;
  784.  
  785. procedure Vtyp_Strom._Obnov;
  786. begin
  787.   Koren.Zhasni;
  788.   Koren.Poloha := Poloha;
  789.   Koren.Zobraz;
  790.   if Levy <> nil then
  791.     begin
  792.       Levy^.Uroven := Uroven+1;
  793.       Levy^.Zhasni;
  794.       Levy^.Poloha := Lpoloha^;
  795.       Levy^._Obnov;
  796.     end;
  797.   if Pravy <> nil then
  798.     begin
  799.       Pravy^.Uroven := Uroven+1;
  800.       Pravy^.Zhasni;
  801.       Pravy^.Poloha := Ppoloha^;
  802.       Pravy^._Obnov;
  803.     end;
  804.   if (Levy <> nil) or (Pravy <> nil) then
  805.     begin
  806.       Spoj.Prazdny;
  807.       Spoj.Vytvor(Uroven, Levy <> nil, Pravy <> nil, Koren.Barva);
  808.       Spoj.Presun(Poloha.X+Koren.Rozmer.X+1, Poloha.Y+1, Poloha.Z);
  809.       Spoj.Zobraz
  810.     end;
  811.   Stav := Stav or __Videt;
  812. end;
  813.  
  814. procedure Vtyp_Strom._Zhasni;
  815. begin
  816.   Koren.Zhasni;
  817.   if Levy <> nil then Levy^.Zhasni;
  818.   if Pravy <> nil then Pravy^.Zhasni;
  819.   if (Levy <> nil) or (Pravy <> nil) then Spoj.Zhasni
  820. end;
  821.  
  822. constructor Vtyp_Strom.Init;
  823. begin
  824.   Typ_Hejbaci_Zaklad.Init;
  825.   Koren.Init;
  826.   Spoj.Init;
  827.  
  828.   Levy   := nil;
  829.   Pravy  := nil;
  830.   Uroven := 0;
  831.   Klic   := Maxint;
  832. end;
  833.  
  834. destructor Vtyp_Strom.Zrus;
  835. begin
  836.   Typ_Hejbaci_Zaklad.Zrus;
  837.   Koren.Zrus;
  838.   Spoj.Zrus;
  839.   if Levy <> nil then Levy^.Zrus;
  840.   if Pravy <> nil then Pravy^.Zrus;
  841.   if Uroven <> 0 then Dispose(Vtyp_Strom_Ptr(@Self));
  842. end;
  843.  
  844. procedure Vtyp_Strom._Neni_List;
  845. begin
  846.   if Koren.Je_Tvar then
  847.     begin
  848.       Koren.set_Bod_Znak((Koren.Rozmer.X+1)*2-1, '╟');  {'╟'}
  849.       Koren.Obnov
  850.     end;
  851. end;
  852.  
  853. procedure Vtyp_Strom._Je_List;
  854. begin
  855.   if Koren.Je_Tvar then
  856.     begin
  857.       Koren.set_Bod_Znak((Koren.Rozmer.X+1)*2-1, '║');  {'║'}
  858.       Koren.Obnov
  859.     end;
  860. end;
  861.  
  862. procedure Vtyp_Strom._Srovnat_List;
  863. var Pp : Char;
  864. begin
  865.   if (Levy = nil) and (Pravy = nil)
  866.     then Pp := '║'
  867.     else Pp := '╟';
  868.   if Koren.Je_Tvar then
  869.     begin
  870.       Koren.set_Bod_Znak((Koren.Rozmer.X+1)*2-1, Pp);
  871.       Koren.Obnov
  872.     end;
  873. end;
  874.  
  875. procedure Vtyp_Strom.Vytvor(S : string; C1 : Byte);
  876. begin
  877.   Koren.Vytvor_string_Ram(S, C1, C1, Strom_Ram);
  878. {  Poloha := Koren.Poloha;}
  879.   Stav   := Stav or __Existuje_Tvar;
  880.   Barva  := C1;
  881. end;
  882.  
  883.  
  884. procedure Vtyp_Strom.Prohod(var Strom : Vtyp_Strom);
  885. var Pom_Bod : _Bod3D;
  886.     Pom_Ur  : Integer;
  887.  
  888. begin
  889.   Zhasni;
  890.   Strom.Zhasni;
  891.  
  892.   Pom_Bod      := Strom.Poloha;
  893.   Strom.Poloha :=       Poloha;
  894.   Poloha       := Pom_Bod;
  895.  
  896.   Pom_Ur       := Strom.Uroven;
  897.   Strom.Uroven :=       Uroven;
  898.   Uroven       := Pom_Ur;
  899.  
  900.   _Obnov;
  901.   Strom._Obnov;
  902. end;
  903.  
  904.  
  905.  
  906.  
  907.  
  908.  
  909.  
  910.  
  911.  
  912.  
  913. { ************************************************************************* }
  914. {                               typ spoj                                    }
  915. procedure Typ_Spoj.Vytvor(Ur : Typ_Souradnic; _L, _R : Boolean; Nbarva : Byte);
  916. var  I, Pomvel : Word;
  917.      Pom    : Bod_Fyz_Obrazu;
  918.  
  919. begin
  920.   if Typ = __N then
  921.     begin
  922.       Zhasni;
  923.       _Cisti_Tvar;
  924.  
  925.       Velikost := __Velikost(Ur);
  926.       if Velikost < 1 then Velikost := Velikost;
  927.       if (_L and _R) then
  928.         begin
  929.           Typ := __Lr;
  930.           Pomvel := (Velikost shl 1)+1;
  931.           _Get_Mem_Tvar(Pomvel);
  932.           set_Bod_Znak(0, '┌'); {218}
  933.  
  934.           for I := 1 to (Velikost shl 1) -1 do
  935.             set_Bod_Znak(I, '|'); {124}
  936.  
  937.           set_Bod_Znak(Velikost shl 1, '╚'); {200}
  938.  
  939.           set_Bod_Znak(Velikost, '╢'); {182}
  940.         end
  941.       else if _L then
  942.         begin
  943.           Typ := __L;
  944.           Pomvel := Velikost+1;
  945.           _Get_Mem_Tvar(Pomvel);
  946.           set_Bod_Znak(0, '┌'); {218}
  947.  
  948.           for I := 1 to Velikost - 1 do
  949.             set_Bod_Znak(I, '|'); {124}
  950.  
  951.           set_Bod_Znak(Velikost, '┘'); {}
  952.         end
  953.       else if _R then
  954.         begin
  955.           Typ := __R;
  956.           Pomvel := Velikost+1;
  957.           _Get_Mem_Tvar(Pomvel);
  958.           set_Bod_Znak(0, '┐'); {}
  959.           for I := 1 to Velikost - 1 do
  960.             set_Bod_Znak(I, '|'); {124}
  961.  
  962.           set_Bod_Znak(Velikost, '╚'); {200}
  963.         end;
  964.  
  965.       if not (_L or _R)
  966.         then Prazdny
  967.         else for I := 0 to Pomvel -1 do
  968.                set_Bod_Barva(I, Nbarva);
  969.     end;
  970. end;
  971.  
  972. procedure Typ_Spoj.Pridej(Ur : Typ_Souradnic; _L, _R : Boolean; Nbarva : Byte);
  973. var  I, Fn : Integer;
  974.      Pom : Bod_Fyz_Obrazu;
  975.  
  976. begin
  977.   Zhasni;
  978.   if Typ = __N then Vytvor(Ur,_L,_R,Nbarva)
  979.   else if (Typ = __L) and _L then begin Typ := __N; Vytvor(Ur, True,False,Nbarva) end
  980.   else if (Typ = __R) and _R then begin Typ := __N; Vytvor(Ur, False,True,Nbarva) end
  981.   else begin Typ := __N; Vytvor(Ur, True,True,Nbarva) end;
  982.   Zobraz;
  983. end;
  984.  
  985. constructor Typ_Spoj.Init;
  986. begin
  987.   Typ_Hejbaci.Init;
  988.   Typ      := __N;
  989.   Velikost := 0;
  990. end;
  991.  
  992. procedure Typ_Spoj.Prazdny;
  993. begin
  994.   Zhasni;
  995.   Konec_Pohybu;
  996.   _Cisti_Tvar;
  997.   Typ      := __N;
  998.   Velikost := 0;
  999. end;
  1000.  
  1001. procedure Typ_Spoj._Zobraz;
  1002. var Pom : Typ_Bod_3D;
  1003.     var X, Y, Z, H, S : Typ_Souradnic;
  1004.  
  1005. begin
  1006.   Pom := Dej_Bod(0);
  1007.   X   := Poloha.X{&&-Poloha.Z};
  1008.   Y   := Poloha.Y{&&+Poloha.Z};
  1009.   Z   := Poloha.Z;
  1010.   H   := Y-Velikost;
  1011.   S   := Y+Velikost;
  1012.      case Typ of
  1013.         __L : S := Y;
  1014.         __R : H := Y;
  1015.         __N : Exit
  1016.      end;
  1017.   for Y := H to S do
  1018.     begin
  1019.       Pom^.Z := Z;
  1020.       Obrazovka.Zobraz_Bod_Xy(X, Y , Pom);
  1021.       Inc(Word(Pom), Pamet_Bod_3D);
  1022.     end;
  1023. end;
  1024.  
  1025. procedure Typ_Spoj._Zhasni;
  1026. var Pom : Typ_Bod_3D;
  1027.     var X, Y, Z, H, S : Typ_Souradnic;
  1028.  
  1029. begin
  1030.   Pom := Dej_Bod(0);
  1031.   X   := Poloha.X{&&-Poloha.Z};
  1032.   Y   := Poloha.Y{&&+Poloha.Z};
  1033.   Z   := Poloha.Z;
  1034.   H   := Y-Velikost;
  1035.   S   := Y+Velikost;
  1036.      case Typ of
  1037.         __L : S := Y;
  1038.         __R : H := Y;
  1039.         __N : Exit
  1040.      end;
  1041.   for Y := H to S do
  1042.     begin
  1043.       Pom^.Z := Z;
  1044.       Obrazovka.Zhasni_Bod_Xy(X, Y , Pom);
  1045.       Inc(Word(Pom), Pamet_Bod_3D);
  1046.     end;
  1047. end;
  1048.  
  1049. procedure Typ_Spoj._Presun_Rel(X, Y, Z : Typ_Souradnic);
  1050. var Pom : Typ_Bod_3D;
  1051.     var _X, _Y, _Z, H, S, _Xn, _Yn : Typ_Souradnic;
  1052.  
  1053. begin
  1054.   Pom := Dej_Bod(0);
  1055.   _X  := Poloha.X{&&-Poloha.Z};
  1056.   _Y  := Poloha.Y{&&+Poloha.Z};
  1057.  
  1058.   _Xn := _X+X{&&-Z};
  1059.   _Yn := Y{&&+Z};
  1060.  
  1061.   _Z  := Poloha.Z{&&+Z};
  1062.   H   := _Y-Velikost;
  1063.   S   := _Y+Velikost;
  1064.      case Typ of
  1065.         __L : S := _Y;
  1066.         __R : H := _Y;
  1067.         __N : Exit
  1068.      end;
  1069.  
  1070.   for _Y := H to S do
  1071.     begin
  1072.       Pom^.Z := _Z;
  1073.       Obrazovka.Presun_Bod_Xy(_X, _Y, _Xn, _Y+_Yn, Pom);
  1074.       Inc(Word(Pom), Pamet_Bod_3D);
  1075.     end;
  1076.   Inc(Poloha.X, X);
  1077.   Inc(Poloha.Y, Y);
  1078.   Inc(Poloha.Z, Z);
  1079. end;
  1080.  
  1081.  
  1082. procedure set_Velikost(Velikost : real);
  1083. begin
  1084.   __Velikost_Stromu := Velikost;
  1085. end;
  1086.  
  1087. function __Velikost(Uroven : Integer): Integer;
  1088. var A : Integer;
  1089. begin
  1090.   Asm
  1091.     Mov Ax, 1
  1092.     Mov Cx, Maxur
  1093.     Sub Cx, Uroven
  1094.     Dec Cx
  1095.     shl Ax, Cl
  1096.  
  1097.     Mov A, Ax
  1098.   end;
  1099.   A := Round(A*__Velikost_Stromu);
  1100.   if A < 1 then A := 1;
  1101.   __Velikost := A;
  1102. end;
  1103.  
  1104. procedure set_Pocatek_Animace(X, Y, Z : Typ_Souradnic);
  1105. begin
  1106.   ___Pocatek.X := X;
  1107.   ___Pocatek.Y := Y;
  1108.   ___Pocatek.Z := Z;
  1109. end;
  1110.  
  1111. begin
  1112. end.
  1113.