Prima Shareware 3/DuCom_Prima-Shareware-3_cd1.bin/PROGRAMO/PASCAL/HEJB/GRAPH/UNHEJB.PAS

Pascal/Delphi Source File | 1994-04-15 | 34.1 KB | 1,189 lines

{ toto je pro tiskárnu, men¿í ⌐ádkování (30)}
unit unhejb;

interface uses crt, dos, obraz3d;
const
  l     = $10; { instrukce }
  r     = $20;
  u     = $4;
  d     = $8;
  f     = $2;
  b     = $1;
  _f    = f+d+l;{ pro kompatibilitu s p⌐edchozími verzemi }
  _b    = b+u+r;

  lu    = l+u;
  ld    = l+d;
  ru    = r+u;
  rd    = r+d;

  __vm      = $80+$10;
  __skoky   = $80+$20;
  __end     = $80+$30;
  __presuny = $80+$40;
  __rizeni  = $80+$50;

  jmpa0 = __skoky;     { skok v programu }
  jmpr  = __skoky+1;     { skok v programu }
  jmpa  = __skoky+2;

  spor  = __rizeni;    { ⌐ízení pomalosti }
  spoa  = __rizeni+1;
  sprr  = __rizeni+2;
  spra  = __rizeni+3;
  scor  = __rizeni+4;
  scoa  = __rizeni+5;
  rep   = __rizeni+6;
  scob  = __rizeni+7;
  endc  = __end;       { konec pohybu a vyçi¿tení cesty }
  endp  = __end+1;     { konec }
  xyzr  = __presuny;   { p⌐esun o sou⌐adnice }
  xyz   = __presuny+1; { p⌐esun na sou⌐adnice }

  vm0   = __vm+0;
  vm1   = __vm+1;
  vm2   = __vm+2;
  vm3   = __vm+3;
  vm4   = __vm+4;
  vm5   = __vm+5;
  vm6   = __vm+6;
  vm7   = __vm+7;
  vm8   = __vm+8;
  vm9   = __vm+9;
  vm10  = __vm+10;
  vm11  = __vm+11;
  vm12  = __vm+12;
  vm13  = __vm+13;
  vm14  = __vm+14;
  vm15  = __vm+15;
                          { pro kontrolu stavu objektu }
  __videt         = $01;  { objekt je zobrazen }
  __pohyb         = $02;  { objekt má p⌐i⌐azenu cestu }
  __zpracovava_se = $04;  { objekt se na své cestê právê zpracovává }
  __zobrazuje_se  = $08;  { objekt se právê zobrazuje }
  __existuje_tvar = $20;  { existuje tvar objektu }


type
  typ_instrukce     = byte;
  typ_instrukci  = array[0..65530] of typ_instrukce;
  typ_programu = record
                   kolik : word;     { kolik pokynû obsahuje cesta }
                   cesta : typ_instrukci { samotné instrukce }
                 end;

  typ_tvar      = record
                    pamet : word;    { kolik bodû obsahuje obraz objektu }
                    tvar  : typ_obrazu_3d; { ukazatel na pole bodû objektu }
                  end;

  ptr_typ_instrukci  = ^typ_instrukci;
  ptr_to_program  = ^typ_programu;
  ptr_typ_vproc   = ^typ_vproc;
  ptr_typ_hejbaci = ^typ_hejbaci;

  typ_vproc   = record
                gde : word;          { instrukçní ukazatel }
                kam : ptr_to_program;{ seznam pohybû objektu }
              end;

 typ_hejbaci_zaklad = object
                 poloha         : tsou_3d;
                 prodleva       : byte;
   { udava, kolikrat bude objekt jeste odstaven }
                 pomalost       : byte;
   { udava prodlevu, ktera se nastavi pri prodleve = 0 }
   { pokud pomalost = 0, neni prodleva }
   { viz krok }
                 barva          : byte;
                 stav           : byte;

   {        x x x x x x x x                                                }
   {        ^ ^ ^ ^ ^ ^ ^ ^                                                }
   {        │ │ │ │ │ │ │ │                                                }
   {        │ │ │ │ │ │ │ └─> 1 .. objekt je zobrazen na obrazovce         }
   {        │ │ │ │ │ │ └───> 1 .. objekt je v seznamu a má se hÿbat       }
   {        │ │ │ │ │ └─────> 1 .. právê se pracuje s objektem             }
   {        │ │ │ │ └───────> 1 .. právê se pracuje se zobrazením objektu  }
   {        │ │ │ └─────────> 1 ..                                         }
   {        │ │ └───────────> 1 .. uæ existuje tvar objektu                }
   {        │ └─────────────> nejsou pouæity                               }
   {        └───────────────>                                              }
                 co_delat     : typ_vproc;

                  { procedury pro pohyb objektu }
                 procedure u;
                 procedure d;
                 procedure l;
                 procedure r;
                 procedure ru;
                 procedure rd;
                 procedure lu;
                 procedure ld;
                 procedure f;
                 procedure b;
                  { pohyb v danÿch smêrech }
                 procedure presun(x, y, z : typ_souradnic);
                  { p⌐esun na absolutní sou⌐adnice }
                 procedure presun_bod(_bod : tsou_3d);
                  { p⌐esun na absolutní sou⌐adnice }
                 procedure presun_rel(x, y, z : typ_souradnic);virtual;
                  { p⌐esun na relativní sou⌐adnice }
                 procedure _presun_rel(x, y, z : typ_souradnic);virtual;
                  { p⌐esun na relativní sou⌐adnice }

                 procedure zobraz;
                  { pokud objekt neni v obrazovce, zavola _zobraz }
                 procedure _zobraz; virtual;
                  { zobrazí objekt do obrazovky }
                 procedure zhasni;
                  { zhasne objekt na obrazovce }
                 procedure _zhasni; virtual;
                  { pokud je objekt na obrazovce, zavola _zhasni }
                 procedure obnov;

                 procedure _obnov;virtual;
                  { obnoví vzhled objektu na obrazovce }

                 procedure set_pomalost(_pomalost : byte);
                  { nastaví prodlevu, se kterou se bude provadet krok }
                 procedure set_prodleva(_prodleva : byte );
                  { nastaví prodlevu, po kterou se objekt nebude hybat }
                 procedure set_barva(_c : byte); virtual;
                 procedure set_barvar(_rc : shortint); virtual;

                  { procedury pro inicialisaci a ru¿ení objektu }
                 constructor init;
                  { nastaví základní vztahy objektu nutnÅ !!!! }
{                 constructor init_poloha(kam : tsou_3d);}
                  { a navíc polohu objektu }
                 destructor zrus;
                  { uvolní ve¿kerou pamêƒ zabíranou objektem }
                 procedure standard_atrib;
                  { nastaví základní atributy objektu }

                 procedure hejbej(var cesta);
                  { zaçne hÿbat objektem po dané cestê }
                 function hejbe_se : boolean;
                  { pokud se objekt hÿbe (má p⌐i⌐azenu cestu), má hodnotu true }
                 procedure konec_pohybu;
                  { zru¿í zbytek pohybu objektu }
                 procedure anim_posun_xyz(x, y, z : typ_souradnic);
                  { vytvori a priradi cestu do [x, y, z] }
                 procedure anim_posun_bod(_bod : tsou_3d);
                  { vytvori a priradi cestu do [x, y, z] }
                 procedure dodel_anim_posun_bod(_bod : tsou_3d);
                  { vytvori a priradi cestu do [x, y, z] }

                 procedure anim_prohod(var s_kym : typ_hejbaci_zaklad);
                  { vytvo⌐í cestu mezi dvêma objekty }
                 procedure dodel_anim_prohod(var s_kym : typ_hejbaci_zaklad);
                  { vytvo⌐í cestu mezi dvêma objekty }
                  { a vymêní je }
                 procedure prirad_program(_program : ptr_to_program);
                  { danému objektu p⌐i⌐adí program }

                 procedure rozbeh;
                  { objekt se rozbêhne po své cêstê }
                  { ( s danÿm programem )            }
                 procedure stop;
                  { objekt se na své cestê zastaví  }
                 procedure dodelej_pohyb;


                 function krok : byte;
                  { objekt udêlá 1 krok na dané cestê }
                 procedure _cisti_program;
                  { uvolní pamêƒ p⌐i⌐azenou cestê }
                 procedure vm0; virtual;
                 procedure vm1; virtual;
                 procedure vm2; virtual;
                 procedure vm3; virtual;
                 procedure vm4; virtual;
                 procedure vm5; virtual;
                 procedure vm6; virtual;
                 procedure vm7; virtual;
                 procedure vm8; virtual;
                 procedure vm9; virtual;
                 procedure vm10; virtual;
                 procedure vm11; virtual;
                 procedure vm12; virtual;
                 procedure vm13; virtual;
                 procedure vm14; virtual;
                 procedure vm15; virtual;
               end;


  typ_hejbaci = object(typ_hejbaci_zaklad)
                 tvar           : ^typ_tvar;
                  { procedury pro práci se vzhledem objektu }

                 procedure _zobraz; virtual;
                  { zobrazí objekt do obrazovky }
                 procedure _zhasni; virtual;
                  { pokud je objekt na obrazovce, zavola _zhasni }

                 procedure prirad(var prvek : typ_hejbaci);
                 procedure set_barva(_c : byte);virtual;
                 procedure _cisti_tvar;
                  { uvolní pamêƒ p⌐i⌐azenou tvaru }
                 procedure _get_mem_tvar(__kolik : word);

                 function dej_bod(kterej : word) : typ_bod_3d;
                 procedure set_bod(kterej : word; co : bod_fyz_obrazu);
                 procedure set_bod_znak(kterej : word; znak : char);
                 procedure set_bod_barva(kterej : word; barvan : byte);
                 procedure set_bod_z(kterej : word; z : typ_souradnic);

                 function obsazeno : word;
                 function je_tvar : boolean;

                 procedure prirad_tvar(var _tvar : typ_tvar);

                  { procedury pro inicialisaci a ru¿ení objektu }
                 constructor init;
                  { nastaví základní vztahy objektu nutnÅ !!!! }
                 destructor zrus;
                  { uvolní ve¿kerou pamêƒ zabíranou objektem }
               end;

function  vytvor_program(var cesta) : ptr_to_program;
 { vytvo⌐í z dané cesty program, tj p⌐idá délku a ukazatel na }
 { zaçátek }

procedure konec;
 { uvolní ve¿kerou dynamickou pamêƒ zabranou jednotkou }
 { a obnoví pûvodní obsah obrazovky }

function posun_absol(var o1, o2 : typ_hejbaci_zaklad) : ptr_to_program;
 { vytvo⌐í cesty pro posun mezi vêma objekty }
function posun_absol_xyz(var o : typ_hejbaci_zaklad; x, y, z : typ_souradnic) : ptr_to_program;
 { vytvo⌐í cesty pro posun objektu na dané sou⌐adnice }
function posun_rel_xyz(x, y, z : typ_souradnic) : ptr_to_program;
 { vytvo⌐í cesty pro posun objektu o dané sou⌐adnice }
function hezky_rozmistit(k : integer) : ptr_tsou_3d;

var
  obrazovka    : typ_obrazovka_3d;

implementation
uses
  unfront;

constructor typ_hejbaci_zaklad.init;
begin
  standard_atrib;
  co_delat.kam := nil;
  co_delat.gde := 0;
  poloha         := __nula_3d;
end;

{constructor typ_hejbaci_zaklad.init_poloha;
begin
  init;
  presun_bod(kam);
end;
}
destructor typ_hejbaci_zaklad.zrus;
begin
  zhasni;
  konec_pohybu;
end;

procedure typ_hejbaci_zaklad.standard_atrib;
{ nastaví bity v poli stav na nulovou hodnotu, tj. klidovÿ stav }
begin
  asm
    les di, self
    mov byte ptr es:[di].stav, 0
    mov byte ptr es:[di].pomalost, 0
    mov byte ptr es:[di].prodleva, 0
    mov byte ptr es:[di].barva, 0
  end;
end;

procedure typ_hejbaci_zaklad.u; {bez komentare}
begin
  presun_rel(0,-1,0)
end;

procedure typ_hejbaci_zaklad.d;
begin
  presun_rel(0,1,0)
end;

procedure typ_hejbaci_zaklad.l;
begin
  presun_rel(-1,0,0)
end;

procedure typ_hejbaci_zaklad.r;
begin
  presun_rel(1,0,0)
end;

procedure typ_hejbaci_zaklad.f;
begin
  presun_rel(0,0,1)
end;

procedure typ_hejbaci_zaklad.b;
begin
  presun_rel(0,0,-1)
end;

procedure typ_hejbaci_zaklad.ru;
begin
  presun_rel(1,-1,0)
end;

procedure typ_hejbaci_zaklad.lu;
begin
  presun_rel(-1,-1,0)
end;

procedure typ_hejbaci_zaklad.rd;
begin
  presun_rel(1,1,0)
end;

procedure typ_hejbaci_zaklad.ld;
begin
  presun_rel(-1,1,0)
end;

procedure typ_hejbaci_zaklad.zobraz;
label konec;
begin
  asm          les di, self
               test es:[di].stav, __videt
               jnz konec { objekt uz je na obrazovce, deje se nic }

               test es:[di].stav, __existuje_tvar
               jz konec { objekt nema tvar, deje se nic }

               les di, self
               or  es:[di].stav, __zobrazuje_se { objekt se bude zobrazovat }
  end;
               _zobraz;
  asm
               les di, self                     { nastaveni atributû }
               or  es:[di].stav, __videt        { objekt je videt }
               and es:[di].stav, __zobrazuje_se xor 0ffh { a uz se nezobrazuje }
    konec:
  end;
end;

procedure typ_hejbaci_zaklad.zhasni;
label konec;
begin
  asm          les di, self
               test es:[di].stav, __videt or __existuje_tvar
               jz konec { objekt neni na obrazovce,
                          nebo nema tvar - deje se nic }
               les di, self
               or  es:[di].stav, __zobrazuje_se { objekt se bude zobrazovat }
  end;
               _zhasni;
  asm
               les di, self                     { nastaveni atributû }
               and es:[di].stav, (__videt or __zobrazuje_se) xor 0ffh
                 { objekt se nezobrazuje a nejni videt }
konec:
  end;
end;

procedure typ_hejbaci_zaklad.obnov;
label konec;
begin
  asm          les di, self
               test es:[di].stav, __videt
               jz konec { objekt neni na obrazovce, deje se nic }

               test es:[di].stav, __existuje_tvar
               jz konec { objekt nema tvar, deje se nic }

               les di, self
               or  es:[di].stav, __zobrazuje_se { objekt se bude zobrazovat }
  end;
               _obnov;
  asm
               les di, self                     { nastaveni atributû }
               and es:[di].stav, __zobrazuje_se xor 0ffh { a uz se nezobrazuje }
    konec:
  end;
end;

procedure typ_hejbaci_zaklad._zobraz; {zobrazi natvrdo objekt na jeho misto }
begin
end;

procedure typ_hejbaci_zaklad._zhasni;
begin
end;

procedure typ_hejbaci_zaklad._obnov;
begin
  zhasni;
  zobraz;
end;

procedure typ_hejbaci_zaklad.presun_bod(_bod : tsou_3d);
begin
  presun_rel(_bod.x - poloha.x, _bod.y - poloha.y, _bod.z - poloha.z);
end;

procedure typ_hejbaci_zaklad.presun(x, y, z : typ_souradnic);
begin
  presun_rel(x-poloha.x,y-poloha.y, z-poloha.z)
end;

procedure typ_hejbaci_zaklad.presun_rel(x, y, z : typ_souradnic);
label konec, obyc_presun;
begin
  asm
               les di, self
               test es:[di].stav, __videt
               jz obyc_presun { objekt neni zobrazen, pouze zmena souradnic }

               les di, self
               or  es:[di].stav, __zobrazuje_se { objekt se bude zobrazovat }
  end;
               _presun_rel(x, y, z);
  asm
               les di, self                     { nastaveni atributû }
               and es:[di].stav, __zobrazuje_se xor 0ffh { a uz se nezobrazuje }
               jmp konec
  end;
  obyc_presun: inc(poloha.x, x);
               inc(poloha.y, y);
               inc(poloha.z, z);
  konec:
end;

procedure typ_hejbaci_zaklad._presun_rel(x, y, z : typ_souradnic);
begin
  asm          les di, self
               and es:[di].stav, __zobrazuje_se xor 0ffh
  end;
    begin
      zhasni;
      inc(poloha.x, x);
      inc(poloha.y, y);
      inc(poloha.z, z);
      zobraz
    end;
end;
procedure typ_hejbaci_zaklad.set_barva(_c : byte);
begin
  barva := _c;
end;

procedure typ_hejbaci_zaklad.set_barvar(_rc : shortint);
begin
  set_barva(byte(barva+_rc));
end;

procedure typ_hejbaci_zaklad.set_pomalost(_pomalost : byte);
begin
  pomalost := _pomalost;
end;

procedure typ_hejbaci_zaklad.set_prodleva(_prodleva : byte );
begin
  prodleva := prodleva;
end;

procedure typ_hejbaci_zaklad.rozbeh;
begin
  stav := __pohyb or stav;
end;

procedure typ_hejbaci_zaklad.stop;
begin
  stav := (not __pohyb) and stav;
end;

procedure typ_hejbaci_zaklad.dodelej_pohyb;
begin
  repeat
  {!!  fronta.makej;}
  until (stav and __pohyb) = 0;
end;

procedure typ_hejbaci_zaklad.dodel_anim_posun_bod(_bod : tsou_3d);
var c : byte;
begin
  anim_posun_bod(_bod);
  repeat
    c:=krok;
    delay(_stand_pomalost);
  until not hejbe_se;
end;

procedure typ_hejbaci_zaklad.anim_posun_bod(_bod : tsou_3d);
begin
  prirad_program(posun_absol_xyz(self, _bod.x,_bod.y,_bod.z));
end;

procedure typ_hejbaci_zaklad.anim_posun_xyz(x, y, z : typ_souradnic);
begin
  prirad_program(posun_absol_xyz(self, x,y,z));
end;

procedure typ_hejbaci_zaklad.dodel_anim_prohod(var s_kym : typ_hejbaci_zaklad);
var c : byte;
begin
  anim_prohod(s_kym);
  repeat
    c:=krok;
    c:=s_kym.krok;
    delay(_stand_pomalost);
  until (not s_kym.hejbe_se and not hejbe_se);
end;

procedure typ_hejbaci_zaklad.anim_prohod(var s_kym : typ_hejbaci_zaklad);
begin
  if addr(self) <> addr(s_kym) then
    begin
      prirad_program(posun_absol(self, s_kym));
      s_kym.prirad_program(posun_absol(s_kym, self));
    end;
end;

procedure typ_hejbaci_zaklad.hejbej(var cesta);
begin
  repeat until (stav and __pohyb) = 0; {pokud se objekt hejbe, nelze dale}
    begin
      _cisti_program;
      prirad_program(vytvor_program(cesta));
    end;
end;

function typ_hejbaci_zaklad.hejbe_se : boolean;
begin
  hejbe_se := (stav and __pohyb) <> 0;
end;


procedure typ_hejbaci_zaklad.prirad_program(_program : ptr_to_program);
begin
  stop;
  if co_delat.kam = nil then
    begin
      co_delat.gde   := 0;
      co_delat.kam   := _program;
    end;
  rozbeh;
end;

procedure typ_hejbaci_zaklad.vm0;  begin end;
procedure typ_hejbaci_zaklad.vm1;  begin end;
procedure typ_hejbaci_zaklad.vm2;  begin end;
procedure typ_hejbaci_zaklad.vm3;  begin end;
procedure typ_hejbaci_zaklad.vm4;  begin end;
procedure typ_hejbaci_zaklad.vm5;  begin end;
procedure typ_hejbaci_zaklad.vm6;  begin end;
procedure typ_hejbaci_zaklad.vm7;  begin end;
procedure typ_hejbaci_zaklad.vm8;  begin end;
procedure typ_hejbaci_zaklad.vm9;  begin end;
procedure typ_hejbaci_zaklad.vm10; begin end;
procedure typ_hejbaci_zaklad.vm11; begin end;
procedure typ_hejbaci_zaklad.vm12; begin end;
procedure typ_hejbaci_zaklad.vm13; begin end;
procedure typ_hejbaci_zaklad.vm14; begin end;
procedure typ_hejbaci_zaklad.vm15; begin end;

function typ_hejbaci_zaklad.krok : byte;
label konec, nespro, hejbat, neni_pohyb, na_until;
const pomtab : array[0..3]of typ_souradnic = (0, -1, 1, 0);
var pom : ptr_typ_instrukci;
    rozh, _pom : byte;
    opakovat : byte;
    __x, __y, __z : typ_souradnic;
begin
  krok     := 0;
  opakovat := 1;
  asm
                  les di, self
                  test es:[di].stav, __pohyb
                  jz konec                 { objekt stoji natvrdo }

                  cmp es:[di].prodleva, 0
                  jz hejbat
                  dec es:[di].prodleva     { objekt jeste ceka na dalsi krok }
                  jmp konec

          hejbat: cmp es:[di].pomalost, 0
                  jz nespro
                  mov al, es:[di].pomalost { je nastavena pomalost }
                  mov es:[di].prodleva, al
  end;
  repeat
  asm
                  les di, self
          nespro: mov bx, es:[di].co_delat.gde
                  les di, es:[di].co_delat.kam
                  lea di, typ_programu([di]).cesta[bx]
                  inc di
                  mov word ptr pom, di
                  dec di
                  mov word ptr pom+2, es
                  mov al, es:[di]
                  mov rozh, al

                  dec opakovat

                  test al, 0c0h
                  jnz neni_pohyb
                    { tady jsou instrukce, tj _l, _r, _u, _d, .... }
  end;            inc(co_delat.gde);

                  __x := pomtab[(rozh and (unhejb.l or unhejb.r)) shr 4];
                  __y := pomtab[(rozh and (unhejb.u or unhejb.d)) shr 2];
                  __z := pomtab[rozh and (unhejb.f or unhejb.b)];
{                  if (rozh and (unhejb.l or unhejb.r)) <> 0 then
                    __x := ((rozh and (unhejb.l or unhejb.r)) shr 3 - 3);
                  if (rozh and (unhejb.u or unhejb.d)) <> 0 then
                    __y := ((rozh and (unhejb.u or unhejb.d)) shr 1 - 3);
                  if (rozh and (unhejb.f or unhejb.b)) <> 0 then
                    __z := ((rozh and (unhejb.f or unhejb.b)) shl 1 - 3);
 }
                  presun_rel(__x, __y, __z);


  asm             jmp na_until;
  end;
   neni_pohyb :
  _pom := rozh and $f0;
  rozh := rozh and $0f;
  case _pom of
    __skoky  : begin
                 inc(opakovat);
                 case rozh of
                   jmpa0 and $0f : co_delat.gde := 0;
                   jmpa  and $0f : co_delat.gde := pom^[0];
                   jmpr  and $0f : co_delat.gde := co_delat.gde+
                                         shortint(pom^[0]);

                 end;
               end;
    __end    : begin
                 krok := 255;
                 case rozh of
                   endc and $0f : begin _cisti_program end;
                   endp and $0f : konec_pohybu
                 end;
               end;
    __presuny: case rozh of
                 xyz  and $0f: begin
                          presun(byte(pom^[0]),
                                 byte(pom^[1]),
                                 byte(pom^[2]));
                          inc(co_delat.gde,3);
                      end;
                 xyzr and $0f: begin
                          presun_rel(shortint(pom^[0]),
                                     shortint(pom^[1]),
                                     shortint(pom^[2]));
                          inc(co_delat.gde,4);
                        end;
               end;
    __vm    : begin
                inc(co_delat.gde);
                case rozh of
                  unhejb.vm0  and $0f : vm0;
                  unhejb.vm1  and $0f : vm1;
                  unhejb.vm2  and $0f : vm2;
                  unhejb.vm3  and $0f : vm3;
                  unhejb.vm4  and $0f : vm4;
                  unhejb.vm5  and $0f : vm5;
                  unhejb.vm6  and $0f : vm6;
                  unhejb.vm7  and $0f : vm7;
                  unhejb.vm8  and $0f : vm8;
                  unhejb.vm9  and $0f : vm9;
                  unhejb.vm10 and $0f : vm10;
                  unhejb.vm11 and $0f : vm11;
                  unhejb.vm12 and $0f : vm12;
                  unhejb.vm13 and $0f : vm13;
                  unhejb.vm14 and $0f : vm14;
                  unhejb.vm15 and $0f : vm15;
               end;
             end;
    __rizeni : begin
{                 inc(opakovat);}
                 inc(co_delat.gde, 2);   { instrukce + parametr }
                 case rozh of
                   spor and $0f: begin _pom := byte(shortint(pom^[0])+pomalost);
                                 if _pom < 0 then _pom := 0;
                                 pomalost := _pom end;
                   spoa and $0f: pomalost := pom^[0];
                   sprr and $0f: begin _pom := byte(shortint(pom^[0])+prodleva);
                                 if _pom < 0 then _pom := 0;
                                 prodleva := _pom end;
                   spra and $0f: prodleva := pom^[0];
                   scor and $0f: set_barva(byte(shortint(pom^[0])+barva));
                   scoa and $0f: set_barva(pom^[0]);
                   rep and $0f :
                                  inc(opakovat, byte(pom^[0]));
                   scob and $0f: set_barva(byte(shortint(pom^[0])+barva) mod 15);
                 end;
               end;
   end;
   na_until:
   until opakovat = 0;
   konec:
end;

procedure typ_hejbaci_zaklad.konec_pohybu;
begin        {!!!!}
  stav := stav and (not __pohyb);
end;

procedure typ_hejbaci_zaklad._cisti_program;
begin
  if co_delat.kam <> nil then
    begin
      freemem(co_delat.kam, co_delat.kam^.kolik+4);
    end;
  stav := (not __pohyb) and stav;
  co_delat.gde := 0;
  co_delat.kam := nil
end;




{ ************************************************************************* }
{ ************************************************************************* }

constructor typ_hejbaci.init;
begin
  typ_hejbaci_zaklad.init;
  tvar := nil;
end;

destructor typ_hejbaci.zrus;
begin
  typ_hejbaci_zaklad.zrus;
  _cisti_tvar;
end;

procedure typ_hejbaci.prirad(var prvek : typ_hejbaci);
begin
  konec_pohybu;
  _cisti_tvar;
  self := prvek;
  stav := 0;
  co_delat.kam := nil;

  getmem(tvar, prvek.tvar^.pamet*sizeof(typ_ob_bodu)+2);
  move(prvek.tvar^,tvar^,prvek.tvar^.pamet*sizeof(typ_ob_bodu)+2);
  stav := stav or __existuje_tvar;
end;

procedure typ_hejbaci.set_barva(_c : byte);
var i : integer;
begin
  if tvar <> nil then
    begin
      for i := 0 to tvar^.pamet -1 do tvar^.tvar[i].obsah := _c;
      barva := _c;
      obnov;
    end;
end;

procedure typ_hejbaci._get_mem_tvar(__kolik : word);
var i : word;
begin
  _cisti_tvar;
  getmem(tvar, __kolik*sizeof(typ_ob_bodu)+2);
  tvar^.pamet := __kolik;
  __nula3d.z  := poloha.z;
  __nula3d.obsah := barva;
  for i := 0 to __kolik - 1 do tvar^.tvar[i] := __nula3d;
  stav := stav or __existuje_tvar;
end;

procedure typ_hejbaci.prirad_tvar(var _tvar : typ_tvar);
begin
  _cisti_tvar;
  getmem(tvar, _tvar.pamet*sizeof(typ_ob_bodu)+2);
  move(_tvar,tvar^,_tvar.pamet*sizeof(typ_ob_bodu)+2);
  stav := stav or __existuje_tvar;
end;

procedure typ_hejbaci._cisti_tvar;
begin
  stav := stav and (not __existuje_tvar);
  if tvar <> nil then
    begin
      zhasni;
      freemem(tvar, tvar^.pamet*sizeof(typ_ob_bodu)+2);
    end;
  tvar := nil;
end;

function typ_hejbaci.dej_bod(kterej : word) : typ_bod_3d;
begin
  if kterej < tvar^.pamet
    then dej_bod := @tvar^.tvar[kterej]
    else dej_bod := nil;
end;

procedure typ_hejbaci.set_bod(kterej : word; co : bod_fyz_obrazu);
begin
  if kterej < tvar^.pamet
    then tvar^.tvar[kterej].obsah := co;;
end;

procedure typ_hejbaci.set_bod_znak(kterej : word; znak : char);
begin
  if kterej < tvar^.pamet
    then tvar^.tvar[kterej].obsah := byte(znak);;
end;

procedure typ_hejbaci.set_bod_barva(kterej : word; barvan : byte);
begin
  if kterej < tvar^.pamet
    then tvar^.tvar[kterej].obsah := barvan;;
end;

procedure typ_hejbaci.set_bod_z(kterej : word; z : typ_souradnic);
begin
  if kterej < tvar^.pamet
    then tvar^.tvar[kterej].z := z;;
end;

function typ_hejbaci.obsazeno : word;
begin
  obsazeno := tvar^.pamet
end;

function typ_hejbaci.je_tvar : boolean;
begin
  je_tvar := tvar <> nil;
end;

procedure typ_hejbaci._zhasni; {vyrusi objekt z jeho mista }
label dalsi_bod;
var pom     : typ_bod_3d;
    x, y, k : typ_souradnic;
begin
  asm          les di, self
               les di, es:[di].tvar
               mov ax, es:typ_tvar([di]).pamet
               and ax, $7f

               lea di, es:typ_tvar([di]).tvar
               mov word ptr pom,   di
               mov word ptr pom+2, es

               les di, self
               mov ah, es:[di].poloha.x
               mov x,  ah

               add al, ah
               mov k,  al

               mov al, es:[di].poloha.y
               mov y,  al

  dalsi_bod:   les di, self
               mov al, es:[di].poloha.z
               les di, pom
               mov es:typ_ob_bodu([di]).z, al

  end;
               obrazovka.zhasni_bod_xy(x, y, pom);
  asm
               inc x
               add word ptr pom, pamet_bod_3d

               mov al, x
               cmp al, k
               jl dalsi_bod
  end;
end;

procedure typ_hejbaci._zobraz; {zobrazi natvrdo objekt na jeho misto }
label dalsi_bod;
var pom     : typ_bod_3d;
    x, y, k : typ_souradnic;
begin
  asm          les di, self
               les di, es:[di].tvar
               mov ax, es:typ_tvar([di]).pamet
               and ax, $7f

               lea di, es:typ_tvar([di]).tvar
               mov word ptr pom,   di
               mov word ptr pom+2, es

               les di, self
               mov ah, es:[di].poloha.x
               mov x,  ah

               add al, ah
               mov k,  al

               mov al, es:[di].poloha.y
               mov y,  al

  dalsi_bod:   les di, self
               mov al, es:[di].poloha.z
               les di, pom
               mov es:typ_ob_bodu([di]).z, al

  end;
               obrazovka.zobraz_bod_xy(x, y, pom);
  asm
               inc x
               add word ptr pom, pamet_bod_3d

               mov al, x
               cmp al, k
               jl dalsi_bod
  end;
end;
{ ************************************************************************* }
{ ************************************************************************* }

function posun_absol(var o1, o2 : typ_hejbaci_zaklad) : ptr_to_program;
begin
  posun_absol := posun_rel_xyz( o2.poloha.x - o1.poloha.x,
                                o2.poloha.y - o1.poloha.y,
                                o2.poloha.z - o1.poloha.z);
end;

function posun_absol_xyz(var o : typ_hejbaci_zaklad; x, y, z : typ_souradnic) : ptr_to_program;
 { vytvo⌐í cesty pro posun objektu na dané sou⌐adnice }
var x1, y1, z1, i : integer;
begin
  posun_absol_xyz := posun_rel_xyz(x - o.poloha.x, y - o.poloha.y, z - o.poloha.z);
end;

function posun_rel_xyz(x, y, z : typ_souradnic) : ptr_to_program;
 { vytvo⌐í cesty pro posun objektu o dané sou⌐adnice }
var i, pamet : integer;
    pomprog  : ptr_to_program;
    sigx, sigy, sigz : byte;
    _min, _min1 : typ_souradnic;

  function sig(hodnota : typ_souradnic) : byte;
  begin
    if hodnota > 0 then sig := 2 else sig := 1;
    if hodnota = 0 then sig := 0;
  end;


  function fmin(j, d : typ_souradnic) : typ_souradnic;
  begin
    if j < d then fmin := j else fmin := d;
  end;

begin
  pamet := abs(x)+abs(y)+abs(z)+5;
  getmem(pomprog, pamet);
  pomprog^.kolik := pamet-4;

  sigx := sig(x) shl 4;
  sigy := sig(y) shl 2;
  sigz := sig(z);
  x := abs(x);
  y := abs(y);
  z := abs(z);
  i := 0;

  _min := fmin(fmin(x, y), fmin(y, z));
  for i := 0 to _min-1 do pomprog^.cesta[i] := sigx+sigy+sigz;
  dec(x, _min);
  dec(y, _min);
  dec(z, _min);
  if x = 0 then
    begin
      _min1 := fmin(y, z);
      for i := _min to _min+_min1-1 do pomprog^.cesta[i] := sigy+sigz;
      dec(y, _min1);
      dec(z, _min1)
    end
  else
  if y = 0 then
    begin
      _min1 := fmin(x, z);
      for i := _min to _min+_min1-1 do pomprog^.cesta[i] := sigx+sigz;
      dec(x, _min1);
      dec(z, _min1)
    end
  else
  if z = 0 then
    begin
      _min1 := fmin(x, y);
      for i := _min to _min+_min1-1 do pomprog^.cesta[i] := sigx+sigy;
      dec(x, _min1);
      dec(y, _min1)
    end;

  if x <> 0 then for i := _min+_min1 to _min+_min1+x-1 do pomprog^.cesta[i] := sigx;
  if y <> 0 then for i := _min+_min1 to _min+_min1+y-1 do pomprog^.cesta[i] := sigy;
  if z <> 0 then for i := _min+_min1 to _min+_min1+z-1 do pomprog^.cesta[i] := sigz;
  if i <> 0 then inc(i);

  pomprog^.cesta[i] := endc;
  posun_rel_xyz := pomprog;
end;

function vytvor_program(var cesta) : ptr_to_program;
var a : ptr_to_program;
    i : byte;
begin
  i := 0;
  if typ_instrukci(cesta)[i] <> endc
    then repeat inc(i) until typ_instrukci(cesta)[i] = endc;
  getmem(a, i+4);
  a^.kolik := i;

  for i := 0 to a^.kolik do {prepis instrukce do dyn. pameti       }
    a^.cesta[i] := typ_instrukci(cesta)[i];
  vytvor_program := a;
end;


function hezky_rozmistit(k : integer):ptr_tsou_3d;
begin
  hezky_rozmistit := @___bod;
  ___bod.z := (k-1) div 10 * 2;
  ___bod.x := 20+((k-1) mod 10 * 6)-___bod.z;
  ___bod.y := 1+___bod.z;
end;

procedure konec;
var i : integer;
  obj : typ_co_se_hejbe;

begin
  obrazovka.skoncuj;
  (*stop_intr;
  obrazovka.skoncuj;
  while (hejbobj <> nil) do
    begin
      obj := hejbobj^.dalsi;
{      hejbobj^.pohyb^.stav := hejbobj^.pohyb^.stav
                         and ($ff xor __je_v_seznamu);}
      hejbobj^.pohyb^._cisti_program;
      dispose(hejbobj);
      hejbobj := obj
    end;
  *)
end;

begin
end.


(*procedure zapni_timer;
label makejint, _stavhejbcs, pryc, nemakat, stara_rutina;
const __pro_pre = $01;
begin

  asm
                 mov di, seg __timer
                 mov es, di
                 lea di, __timer

                 or typ_hejb_fronta_intr(es:[di]).__stav, __na_int { zapnuto }

                 lea ax, makejint
                 mov word ptr typ_hejb_fronta_intr(es:[di]).nove_intr, ax
                 mov ax, seg makejint     { addrmakejint }
                 mov word ptr typ_hejb_fronta_intr(es:[di]).nove_intr+2, ax

                  { tohle je pitomÿ, ale v tp 7.0 to nejde jinak }
                  { adresa rutiny se zapisuje p⌐ímo do instrukce }
                 mov ax, word ptr typ_hejb_fronta_intr(es:[di]).stare_intr
                 mov word ptr makejint+2, ax
                 mov ax, word ptr typ_hejb_fronta_intr(es:[di]).stare_intr+2
                 mov word ptr makejint+4, ax

                 mov byte ptr _stavhejbcs, 0

                 jmp pryc





       makejint:{ pushf
                 call cs: far [stara_rutina]
                 }
                 cli
                test byte ptr _stavhejbcs, __pro_pre
                 jnz  nemakat
                 or   byte ptr _stavhejbcs, __pro_pre

                 push ax
                 push bx
                 push cx
                 push dx

                 push si
                 push di

                 push ds
                 push es

                 push bp

                 mov ax, seg @data
                 mov ds, ax

       end;      __timer._makej;
       asm

                 pop bp

                 pop es
                 pop ds

                 pop di
                 pop si

                 pop dx
                 pop cx
                 pop bx
                 pop ax

             and byte ptr _stavhejbcs, 0ffh xor __pro_pre

{                 jmp stara_rutina}


        nemakat: sti
         iret

    _stavhejbcs:  db 0
    stara_rutina: dd 0


       end;
  pryc :
end;
*)
{procedure makejint; interrupt;
label nemakat;
begin
  asm
    test _stavhejb, __pro_pre_timer
    jnz  nemakat
    or   _stavhejb, __pro_pre_timer
  end;
    __timer._makej;
  asm
    mov al, __pro_pre_timer
    xor al, 0ffh
    and _stavhejb, al
  end;
nemakat:
end;
}