?login_element?

Subversion Repositories NedoOS

Rev

Blame | Last modification | View Log | Download

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