?login_element?

Subversion Repositories NedoOS

Rev

Blame | Last modification | View Log | Download

  1. Program XLand;
  2. {Преобразует экранный файл в файл спрайтов 2х4 з.м.}
  3. uses Crt,Dos,Graph;
  4. const
  5.  Show=0;{0/1/2-не выводить/выводить/и печатать}
  6.  Nland=22;
  7.  fn:array [1..Nland] of string=('xm0',
  8.                             'xm1',
  9.                             'xm2',
  10.                             'xm3',
  11.                             'xm4',
  12.                             'xm5',
  13.                             'xm6',
  14.                             'xm7',
  15.                             'xm8',
  16.                             'xm9',
  17.                             'xm10',
  18.                             'xm11',
  19.                             'xm12','xm13','xm14','xm15','xm16','xm17',
  20.                             'xm18','xm19','xm20',
  21.                             'xmarker');
  22.  fl:array [1..Nland] of byte=(1,    {размер fl*2048 байт}
  23.                               3,
  24.                               2,
  25.                               2,
  26.                               5,
  27.                               5,
  28.                               5,
  29.                               5,
  30.                               5,
  31.                               5,
  32.                               5,
  33.                               5,
  34.                               5,5,2,2,2,2,
  35.                               2,2,2,
  36.                               1);
  37.   GrMode : byte = 5;         {0 .. 5}
  38.   Size   : integer = 256;    {1 .. 512}
  39.   Double : byte = 1;         {1 .. 2}
  40.   Ins    : boolean =false;
  41.   Column : byte = 1;         {1 .. 4}
  42.   Row    : byte = 1;         {1 ...}
  43.  
  44. var
  45.  TF,ZF:File of Char;
  46.  name,name1,name2:string;
  47.  b:array [0..(5*64-1),0..31] of byte;
  48.  c:char;
  49.  n:Longint;
  50.  aa,bb,cc,dd:byte;
  51.  gr,modd,i,j,k,m,jj:integer;
  52.  s:string;
  53.  R : registers;
  54.  
  55. {------------------------------}
  56. Procedure  Print(s : string);
  57. var
  58.   i:word;
  59.  
  60. begin
  61.   for i:=1 to length(s) do
  62.     begin
  63.       repeat
  64.       r.ah:=2;
  65.       r.dx:=0;
  66.       Intr($17,r);
  67.       until (r.ah and $90)=$90;
  68.       r.ah:=0;
  69.       r.dx:=0;
  70.       r.al:=ord(s[i]);
  71.       Intr($17,r);
  72.     end
  73. end;
  74. {---------------------}
  75. Function PrintLine(pos : integer) : boolean;
  76. var
  77.  rw,x,y,i,len :integer;
  78.  d,b : byte;
  79. begin
  80.  PrintLine:=true;
  81.  len:=Size*Column*Double;
  82.  s:=#27'*'+chr(GrMode)+chr(len mod 256)+chr(len div 256);
  83.  print(s);
  84.  y:=pos*8;
  85.  for rw:=1 to Column do
  86.  for x:=0 to Size-1 do
  87.   begin
  88.    b:=0;
  89.    for i:=0 to 7 do
  90.      b:=b shl 1 + ( (GetPixel(x,y+i) shr 1) and 1 ) xor 1;
  91.    for d:=1 to Double do  print(chr(b));
  92.    if KeyPressed then
  93.        if Readkey=#27  then
  94.         begin
  95.           PrintLine:=false;
  96.           Exit;
  97.         end;
  98.   end;
  99. end;
  100. {---------------------------------------}
  101. Procedure Pause;
  102. begin
  103.   repeat until KeyPressed;
  104.   c:=ReadKey;
  105.   if c=#0 then c:=ReadKey;
  106. end;
  107. {---------------------------------------}
  108. Procedure PrintZXscr(endline:byte);
  109. begin
  110.   SetColor(Red);
  111.   OutTextXY(20,340,'Printing ... press a key');
  112.   Pause;
  113.   print (#13#10);
  114.   print(fn[n]);
  115.   print(#13#10);
  116.   for i:=1 to Row do
  117.    begin
  118.    print(#27#51#23);
  119.    for j:=0 to endline do
  120.     if not PrintLine(j) then
  121.         begin
  122.            R.AH:=1;
  123.            R.DX:=0;
  124.            Intr($17,R);
  125.            Print(#13#10);
  126.            exit;
  127.         end
  128.       else Print(#13#10);
  129.    end
  130. end;
  131. {---------------------------------------}
  132. begin
  133.   ClrScr;
  134.   n:=0;
  135.   Writeln('Конвертация экранного файла');
  136.   Writeln('формата TR DOS');
  137.   Writeln('в файл спрайтов 2х4 для НЛО-2');
  138.   Writeln;
  139.  
  140.  for n:=1 to Nland do begin name:='d:\''UFO2''\';
  141.   name1:=Name+'images\'+fn[n]+'.tif';
  142.   name2:=Name+'ZX_DISC\'+fn[n]+'.dat';
  143.   gr:=detect;
  144.   if (Show<>0) then
  145.   InitGraph(gr,modd,'d:\tp7\bgi\')
  146.   else Writeln('Создан ',name2);
  147.  
  148.   Assign(ZF,name1);
  149.   Reset(ZF);
  150.   Assign(TF,name2);
  151.   Rewrite(TF);
  152.  
  153.   for i:=1 to 194 do begin
  154.        read(ZF,c);            {read TIF prefix}
  155.        end;
  156.  
  157.   for m:=0 to fl[n]-1 do                       {read TIF screen}
  158.     for k:=0 to 63 do
  159.         for i:=0 to 31 do
  160.           begin
  161.             read(ZF,c);
  162.             b[m*64+k,i]:=ord(c) xor $FF;
  163.             if(Show<>0) then
  164.             for gr:=0 to 7 do
  165.              putpixel(i*8+gr,m*64+k,(ord(c) shr (7-gr) and 1)*14);
  166.           end;
  167.  
  168.   Close(ZF);
  169.   if(Show=2) then printZxScr(fl[n]*8-1); {print land sprites}
  170.   for i:=0 to fl[n]-1 do  {write DATA land sprites}
  171.   begin
  172.     if(n=Nland) then jj:=3 else jj:=15;
  173.     for j:=0 to jj do
  174.     begin
  175.       for k:=0 to 31 do
  176.       begin
  177.         for m:= 0 to 1 do
  178.         begin
  179.         bb:=b[i*64+k+32,j*2+m];
  180.         aa:=b[i*64+k,j*2+m] xor bb;
  181.         c:=chr(bb);
  182.         write(TF,c);
  183.         c:=chr(aa);
  184.         write(TF,c);
  185.         end;
  186.       end;
  187.     end;
  188.   end;
  189.  
  190.   Close(TF);
  191.  
  192.   end;
  193.   repeat until KeyPressed;
  194.   CloseGraph;
  195.  
  196. end.