home *** CD-ROM | disk | FTP | other *** search
/ Prima Shareware 3 / DuCom_Prima-Shareware-3_cd1.bin / PROGRAMO / PASCAL / HEJB / GRAPH / UNPISMEN.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1994-04-21  |  3.2 KB  |  148 lines
  1. unit
  2.   unpismeno;
  3. interface
  4. uses
  5.   obraz3d, unhejb;
  6. type __znak  = array[0..7]of byte;
  7.      __znaky = array[char]of __znak;
  8.      __typ_sada = ^__znaky;
  9.  
  10. type typ_pismeno = object(typ_hejbaci)
  11.                     ktere : char;
  12.                     sablona : __znak;
  13.                     velikost : integer;
  14.  
  15.                     procedure vytvor(pismeno : char; _velikost : integer; _barva : bod_fyz_obrazu);
  16.                     procedure _zobraz; virtual;
  17.                     procedure _zhasni; virtual;
  18.                     procedure _presun_rel(_x, _y, _z : typ_souradnic);virtual;
  19.                   end;
  20.  
  21. implementation
  22. uses
  23.   dos;
  24.  
  25. procedure typ_pismeno.vytvor;
  26. var reg : registers;
  27.    sada : __typ_sada;
  28.    i, j, k : word;
  29.  
  30.   function bitu(b : byte) : byte;
  31.   var i, j, k : byte;
  32.   begin
  33.     j := 0;
  34.     for i := 0 to 7 do
  35.       if (b and (1 shl i)) <> 0 then inc(j);
  36.     bitu := j;
  37.   end;
  38.  
  39. begin
  40.   zhasni;
  41.  
  42.   reg.ax := $1130;
  43.   reg.bh := $03;
  44.   intr($10,reg);   {zjisteni sady 8x8}
  45.   sada := ptr(reg.es,reg.bp);
  46.  
  47.   sablona := sada^[pismeno];
  48.  
  49.   j := 0;
  50.   for i := 0 to 7 do inc(j, bitu(sablona[i]));
  51.  
  52.   barva := _barva;
  53.  
  54.   velikost := _velikost;
  55.  
  56.   _get_mem_tvar(velikost*velikost*(j+1));
  57.  
  58. end;
  59.  
  60.  
  61. procedure typ_pismeno._zobraz;
  62. var x, y, xp, yp, k : word;
  63.  
  64.   function jepix(x, y : word):boolean;
  65.   begin
  66.     jepix := (sablona[7-y] and (1 shl x)) <> 0
  67.   end;
  68.  
  69. begin
  70.   k := 0;
  71.   for y := 7 downto 0 do
  72.     for x := 0 to 7 do
  73.       if jepix(x, y) then
  74.         begin
  75.           for yp := 0 to velikost-1 do
  76.             for xp := 0 to velikost-1 do
  77.               begin
  78.                 set_bod_z(k, poloha.z);
  79.                 obrazovka.zobraz_bod_xy(poloha.x-x*velikost+xp, poloha.y-y*velikost+yp, dej_bod(k));
  80.                 inc(k);
  81.               end;
  82.         end;
  83. end;
  84.  
  85. procedure typ_pismeno._zhasni;
  86. var x, y, xp, yp, k : word;
  87.  
  88.   function jepix(x, y : word):boolean;
  89.   begin
  90.     jepix := (sablona[7-y] and (1 shl x)) <> 0
  91.   end;
  92.  
  93. begin
  94.   k := 0;
  95.   for y := 7 downto 0 do
  96.     for x := 0 to 7 do
  97.       if jepix(x, y) then
  98.         begin
  99.           for yp := 0 to velikost-1 do
  100.             for xp := 0 to velikost-1 do
  101.               begin
  102.                 obrazovka.zhasni_bod_xy(poloha.x-x*velikost+xp, poloha.y-y*velikost+yp, dej_bod(k));
  103.                 inc(k);
  104.               end;
  105.         end;
  106. end;
  107.  
  108.  
  109. procedure typ_pismeno._presun_rel;
  110. var x, y, xp, yp, k : word;
  111.     nx, ny, nz : typ_souradnic;
  112.  
  113.   function jepix(x, y : word):boolean;
  114.   begin
  115.     jepix := (sablona[y] and (1 shl x)) <> 0
  116.   end;
  117.  
  118. begin
  119.   nx := poloha.x + _x;
  120.   ny := poloha.y + _y;
  121.   nz := poloha.z + _z;
  122.   k := 0;
  123.   for y := 0 to 7 do
  124.     for x := 0 to 7 do
  125.       if jepix(x, y) then
  126.         begin
  127.           for yp := 0 to velikost-1 do
  128.             for xp := 0 to velikost-1 do
  129.               begin
  130.                 obrazovka.zhasni_bod_xy(poloha.x-x*velikost+xp, poloha.y-y*velikost+yp, dej_bod(k));
  131.  
  132.                 set_bod_z(k, nz);
  133.                 obrazovka.zobraz_bod_xy(nx-x*velikost+xp, ny-y*velikost+yp, dej_bod(k));
  134.                 inc(k);
  135.               end;
  136.         end;
  137.   poloha.x := nx;
  138.   poloha.y := ny;
  139.   poloha.z := nz;
  140.  
  141. end;
  142. end.
  143.  
  144.  
  145.  
  146.  
  147.  
  148.