home *** CD-ROM | disk | FTP | other *** search
/ Prima Shareware 3 / DuCom_Prima-Shareware-3_cd1.bin / PROGRAMO / PASCAL / HEJB / GRAPH / UNFRONT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-12-10  |  9.7 KB  |  351 lines

  1. { toto je pro tiskárnu, men¿í ⌐ádkování (30)}
  2. unit unfront;
  3.  
  4. interface uses unhejb;
  5. const
  6.   __pracuje_se    = $01;  { pracueje se s prvky seznamu ( za⌐azuje nebo vy⌐azuje ) }
  7.   __na_int        = $02;  { fronta sedi na interruptu }
  8.   __maka          = $04;  { probiha makej - fronta se zpracovava }
  9.   __volat_puvodni = $08;  { bude se volat puvodni rutina }
  10.  
  11. type
  12.   pom_uk_fronta = ^typ_co_se_hejbe;
  13.   typ_co_se_hejbe = record
  14.                       pohyb     : ptr_typ_hejbaci;
  15.                       dalsi     : pom_uk_fronta;
  16.                       predchozi : pom_uk_fronta;
  17.                     end;
  18.  
  19.  
  20.  typ_hejb_fronta = object
  21.                       constructor init;
  22.                       destructor zrus;
  23.  
  24.                       function hejbe_se : boolean;
  25.                        { zjistí, zda se nêjakÿ objekt hÿbe }
  26.                       procedure makej;
  27.                        { posune v¿echny objekty, které se  mají hÿbat po cestê o 1 krok }
  28.  
  29.                       procedure set_pomalost( _pomalost : word);
  30.                       procedure zarad_prvek(var kterej : typ_hejbaci_zaklad);
  31.                       procedure stop_vsechny;
  32.                       procedure __vyhod_prvek(kterej : pom_uk_fronta);
  33.                        { zastaví v¿echny objekty na jejich dráze }
  34.                       procedure rozbeh_vsechny;
  35.                        { rozebêhne v¿echny objekty na dané dráze }
  36.                       procedure dodelej_pohyb;
  37.                        { dokonçí pohyb v¿ech prvkû v seznamu }
  38.                        { if makat -> opakuje proceduru makej }
  39.                       procedure dodelej_pohyb_na_pocet(kolik : word);
  40.                       function pocet : word;
  41.                       procedure vypis;
  42.                     private
  43.                       seznam   : pom_uk_fronta;
  44.                       __stav   : byte;
  45.                       pomalost : word;
  46.                     end;
  47.  
  48.   typ_hejb_fronta_intr = object(typ_hejb_fronta)
  49.                            constructor init(ktere_intr : byte; volat_puvodni : boolean);
  50.                            destructor zrus;
  51.  
  52.                            procedure on;
  53.                            procedure off;
  54.                            function  je_intr : boolean;
  55.                            procedure makej;
  56.  
  57.                          private
  58.                            num_intr   : byte;
  59.                            stare_intr : pointer;
  60.                            nove_intr  : pointer;
  61.                            procedure _makej;
  62.  
  63.                          end;
  64.  
  65. const
  66.   _stand_pomalost : word = 50;
  67. procedure set_pomalost( _pomalost : word);
  68.  
  69. implementation
  70. uses crt, dos;
  71. type
  72.   typ_pole_bytu  = array[0..65534]of byte;
  73.  
  74. procedure set_pomalost( _pomalost : word);
  75. begin
  76.   _stand_pomalost := _pomalost;
  77. end;
  78.  
  79. procedure typ_hejb_fronta.zarad_prvek(var kterej : typ_hejbaci_zaklad);
  80. var x : pom_uk_fronta;
  81. begin
  82.   new(x);    {zarazeni objektu do seznamu aktivnich}
  83.   x^.pohyb  := @kterej;
  84.   if seznam <> nil then
  85.     begin
  86.       x^.dalsi  := seznam;
  87.       x^.predchozi := seznam^.predchozi;
  88.       seznam^.predchozi^.dalsi := x;
  89.       seznam^.predchozi := x;
  90.     end
  91.   else
  92.     begin
  93.       x^.dalsi := x;
  94.       x^.predchozi := x;
  95.       seznam := x;
  96.     end;
  97. end;
  98.  
  99. procedure typ_hejb_fronta.__vyhod_prvek(kterej : pom_uk_fronta);
  100. begin
  101.   if kterej = seznam then           {ru¿í se první prvek}
  102.     if kterej = kterej^.dalsi
  103.       then seznam := nil            {v seznamu byl jen jeden prvek}
  104.       else seznam := seznam^.dalsi; {v seznamu bylo vic prvku}
  105.   __stav := __stav or __pracuje_se;
  106.   kterej^.predchozi^.dalsi := kterej^.dalsi;
  107.   kterej^.dalsi^.predchozi := kterej^.predchozi;
  108.   __stav := __stav and not __pracuje_se;
  109.   dispose(kterej);
  110. end;
  111.  
  112. procedure typ_hejb_fronta.makej;
  113. { projede seznam vsech objektu, ktere se maji hybat (hejbobj)}
  114. { a se vsemi objekty provede 1 krok}
  115. var obj, objpuv, objdalsi, posledni : pom_uk_fronta;
  116.     pom_co    : ptr_typ_hejbaci;
  117. begin
  118.   __stav := __stav or __maka;
  119. {  gotoxy(40,1); write( 'avail: ', memavail, '   ');}
  120.   if (seznam <> nil) and ((__stav and __pracuje_se) = 0) then
  121.     begin
  122.       posledni := seznam^.predchozi;
  123.       objpuv   := seznam^.predchozi;
  124.       objdalsi := seznam;
  125.       repeat
  126.         obj := objdalsi;
  127.         pom_co := obj^.pohyb;
  128.         pom_co^.stav := pom_co^.stav or __zpracovava_se;
  129.  
  130.         objdalsi := obj^.dalsi;
  131.         if pom_co^.krok = 255
  132.           then __vyhod_prvek(obj);
  133.         pom_co^.stav := pom_co^.stav and (not __zpracovava_se);
  134.       until obj = posledni;
  135.     end;
  136.   __stav := __stav and not __maka;
  137. end;
  138.  
  139. procedure typ_hejb_fronta.set_pomalost( _pomalost : word);
  140. begin
  141.   pomalost := _pomalost;
  142. end;
  143.  
  144. procedure typ_hejb_fronta.dodelej_pohyb;
  145. begin
  146.   while hejbe_se do
  147.     begin
  148.       makej;
  149.       delay(pomalost);
  150.     end;
  151. end;
  152.  
  153. procedure typ_hejb_fronta.dodelej_pohyb_na_pocet(kolik : word);
  154. begin
  155.   while pocet <> kolik do
  156.     begin
  157.       makej;
  158.       delay(pomalost);
  159.     end;
  160. end;
  161.  
  162. function typ_hejb_fronta.hejbe_se : boolean;
  163. begin
  164.   hejbe_se := seznam <> nil
  165. end;
  166. { ************************************************************************* }
  167. { ************************************************************************* }
  168.  
  169. const pocinstr = 43;
  170. constructor typ_hejb_fronta_intr.init(ktere_intr : byte; volat_puvodni : boolean);
  171. type typstroj = array[0..pocinstr-1]of byte;
  172. const strojak : typstroj = ($50, $53, $51, $52, $56, $57, $1e, $06, $55, {push}
  173.                 $89, $e5,           {mov bp, sp}
  174.                 $b8, $99, $99,      {mov ax, dseg 12}
  175.                             $8e, $d8,            {mov ds, ax}
  176.                             $bf, $99, $99,      {mov di, segself 17}
  177.                             $57,                {push di}
  178.                             $bf, $99, $99,      {mov di, ofsself 21}
  179.                             $57,                {push di}
  180.                             $9a, $99, $99, $99, $99,{call far makej 25}
  181.                             $c9,                {leave}
  182.                             $07, $1f, $5f, $5e, $5a, $59, $5b, $58,{pop}
  183.                             $ea, 99, 99, 99, 99 {jmp far stare_intr 39}
  184.                             { $cf                {iret});
  185. var i : integer;
  186.     makej_ptr : pointer;
  187.  
  188. begin
  189.   typ_hejb_fronta.init;
  190.   num_intr := ktere_intr;
  191.  
  192.   makej_ptr := @typ_hejb_fronta_intr._makej;
  193.  
  194.   getmem(nove_intr, pocinstr);
  195.   for i := 0 to pocinstr-1 do
  196.     typ_pole_bytu(nove_intr^)[i] := strojak[i];
  197.  
  198.       asm
  199.         les di, self
  200.         les di, es:[di].nove_intr
  201.         mov ax, seg @data
  202.         mov es:[di+12], ax
  203.         mov ax, word ptr self+2
  204.         mov es:[di+17], ax
  205.         mov ax, word ptr self
  206.         mov es:[di+21], ax
  207.  
  208.         mov ax, word ptr makej_ptr
  209.         mov es:[di+25], ax
  210.         mov ax, word ptr makej_ptr+2
  211.         mov es:[di+27], ax
  212.       end;
  213.   if volat_puvodni
  214.     then __stav := __stav or (__volat_puvodni)
  215.     else __stav := __stav and (not __volat_puvodni)
  216. end;
  217.  
  218. procedure typ_hejb_fronta_intr.on;
  219. var stare : pointer;
  220. begin
  221. {  zapni_timer;}
  222.   if (__stav and __na_int) = 0 then
  223.     begin
  224.       getintvec(num_intr, stare_intr);
  225.       stare := stare_intr;
  226.       if (__stav and __volat_puvodni) <> 0 then
  227.         asm { stara rutina se bude volat, zapsat jeji adresu za jmp far }
  228.           les di, self
  229.           les di, es:[di].nove_intr
  230.  
  231.           mov ax, word ptr stare;
  232.           mov es:[di+39], ax
  233.           mov ax, word ptr stare+2
  234.           mov es:[di+41], ax
  235.         end
  236.       else asm  { nebude se volat stara rutina, zapise se rti místo jmp far }
  237.           les di, self
  238.           les di, es:[di].nove_intr
  239.  
  240.           mov byte ptr es:[di+38], $cf    {rti}
  241.       end;
  242.  
  243.  
  244.       __stav := __stav or __na_int;
  245.       setintvec(num_intr, nove_intr);
  246.     end;
  247. end;
  248.  
  249. destructor typ_hejb_fronta_intr.zrus;
  250. begin
  251.   freemem(nove_intr, pocinstr);
  252.   off;
  253. end;
  254.  
  255. procedure typ_hejb_fronta_intr.makej;
  256. begin
  257.   if  (__stav and __na_int) <> 0
  258.     then asm int num_intr end
  259.     else typ_hejb_fronta.makej;
  260. end;
  261.  
  262. procedure typ_hejb_fronta_intr._makej;
  263. begin
  264.   if ((__stav and __maka) = 0) and
  265.      ((__stav and __pracuje_se) = 0) then
  266.     begin
  267.       __stav := __stav or __maka;
  268.       typ_hejb_fronta.makej;
  269.       __stav := __stav and (not __maka)
  270.     end
  271. {  else begin gotoxy(1,1); writeln('znova'); end;}
  272. end;
  273.  
  274.  
  275.  
  276. procedure typ_hejb_fronta_intr.off;
  277. begin
  278.   if (__stav and __na_int) <> 0 then
  279.     begin
  280.       setintvec(num_intr, stare_intr);
  281.       __stav := __stav and (not __na_int);
  282.     end;
  283. end;
  284.  
  285. function typ_hejb_fronta_intr.je_intr : boolean;
  286. begin
  287.   je_intr := (__stav and __na_int) <> 0
  288. end;
  289.  
  290. constructor typ_hejb_fronta.init;
  291. begin
  292.   pomalost := _stand_pomalost;
  293.   __stav := 0;
  294.   seznam := nil;
  295. end;
  296.  
  297. destructor typ_hejb_fronta.zrus;
  298. begin
  299. end;
  300.  
  301. procedure typ_hejb_fronta.stop_vsechny;
  302. var obj : pom_uk_fronta;
  303. begin
  304.   obj := seznam;
  305.   if obj <> nil then
  306.     repeat
  307.       obj^.pohyb^.stav := (not __pohyb ) and obj^.pohyb^.stav;
  308.       obj := obj^.dalsi
  309.     until obj = seznam;
  310. end;
  311.  
  312. procedure typ_hejb_fronta.rozbeh_vsechny;
  313. var obj : pom_uk_fronta;
  314. begin
  315.   obj := seznam;
  316.   if obj <> nil then
  317.     repeat
  318.       obj^.pohyb^.stav := obj^.pohyb^.stav or __pohyb;
  319.       obj := obj^.dalsi
  320.     until obj = seznam;
  321. end;
  322.  
  323. function typ_hejb_fronta.pocet : word;
  324. var obj : pom_uk_fronta;
  325.     pompoc : word;
  326. begin
  327.   obj := seznam;
  328.   pompoc := 0;
  329.   if obj <> nil then
  330.     repeat
  331.       inc(pompoc);
  332.       obj := obj^.dalsi
  333.     until obj = seznam;
  334.   pocet := pompoc;
  335. end;
  336.  
  337. procedure typ_hejb_fronta.vypis;
  338. var obj : pom_uk_fronta;
  339. begin
  340.   obj := seznam;
  341.   gotoxy(1,1);
  342.   if obj <> nil then
  343.     repeat
  344.       writeln(seg(obj^):4,':',ofs(obj^):4);
  345.       obj := obj^.dalsi
  346.     until obj = seznam;
  347. end;
  348.  
  349.  
  350. end.
  351.