{B-,D+,L+,I+,Q+,R+,S+,T+,V+,Y+ ladici}
{$D-,E-,G+,I-,L-,N-,P+,Q-,R-,S-,T-,V-,Y- exe}
{$G+,N+,E- !!!}
{$M 4500, 64640, 64640}
Uses Dos;
Type
   PointType= Record
      x,y:integer;
   End;
   TypPaleta=Array[0..767] Of Byte; {RGB}
Const
   Color13:Byte=7;
Var
   AdrA000:Pointer;  {Adresa $A0000}
   Adresa13:Pointer; {Aktualni adresa grafiky}
   Pal13:TypPaleta;  {RGB}
Const VelikostObrazu=320*202;
Const
   Hleda:String[12]='';
   Zvyrazni:array[1..3] of String[12] =('','','');
   NortonX:Integer= 40; {levy horni roh}
   NortonY:Integer= 52;
   Cz:boolean=False;
   Esc:Boolean=False;
   NormAttr:Word = 64*256; {nezvyraznena barva}
   KurzAttr:Word = 64;     {kurzor}
   ZvyrAttr:Word = 44*256; {zvyraznena,Name}
Var
   Cesta:String[67];

Type
	_Sour = record
		x,y:Single;
	end;
   Vektor = Array [1..3] of Single;
   TypBaze=Array[1..3] of Vektor;
   Sour2D = Record
      Sour:PointType;
      JeVidet:Boolean;
   End;
Const
      Tab:array[1..7] of string[40]=
{       0        1         2         3         4}
{       123456789012345678901234567890123456789012345678}
     (('ÉÍÍÍÍÍÍÍÍÍÍÍÍÑÍÍÍÍÍÍÍÍÍÍÍÍÑÍÍÍÍÍÍÍÍÍÍÍÍ»'),
      ('º            ³            ³            º'),
      ('ÇÄR[ ]H[ ]S[ ]V[ ]D[ ]A[ ]ÁÄÄÄÄÄÄÄÄÄÄÄĶ'),
      ('º                                      º'),
      ('ÈÍ[F1: Help]ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ[Esc]ͼ'),
      ('ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»'),
      ('ºÄR[ ]H[ ]S[ ]V[ ]D[ ]A[ ]ÁÄÄÄÄÄÄÄÄÄÄÄĺ'));
Var
Bit:array[1..8] of Boolean;
Pred,Max,Min,Tet:Integer;
{Tet=0..20 relativni adresa v okne,Max= souboru v adresari,Min= abs. adresa 1. souboru v okne}
S:SearchRec;
Jmeno:array[0..20] of String[12];
  Typ:array[0..20] of Byte;
  Cas:array[0..20] of Longint;
  Vel:array[0..20] of Longint;
Konec:Boolean;

Const
	SirZn=6;
   VysZn=8;

   FontFlags  :Byte=0; { $1=prepis,$2=stred}
   LocateFont :PointType=(x:0;y:0);
   ColorFont  :Byte = 64;
   ColorPozadi:Byte = 0;

Font68:Array[0..255,0..5] of Byte = (
(0,0,0,0,0,0),
(126,169,141,141,169,126),
(126,215,243,243,215,126),
(0,24,60,30,60,24),
(0,8,28,62,28,8),
(0,6,54,60,54,6),
(0,12,30,60,30,12),
(0,0,16,56,16,0),
(255,231,195,195,231,255),
(0,24,36,36,24,0),
(255,231,219,219,231,255),
(12,18,18,92,96,112),
(0,48,74,79,74,48),
(0,3,3,126,32,24),
(0,3,127,80,86,126),
(219,60,231,231,60,219),
(0,62,28,28,8,8),
(0,8,8,28,28,62),
(0,20,54,127,54,20),
(0,122,0,0,122,0),
(0,56,68,127,64,127),
(0,34,89,85,77,34),
(0,6,6,6,6,0),
(1,41,109,255,109,41),
(0,16,48,126,48,16),
(0,8,12,126,12,8),
(0,8,8,62,28,8),
(0,8,28,62,8,8),
(0,28,4,4,4,4),
(0,8,28,8,28,8),
(0,2,14,62,14,2),
(0,32,56,62,56,32),
(0,0,0,0,0,0),
(0,0,0,122,0,0),
(0,0,96,0,96,0),
(0,20,62,20,62,20),
(0,58,42,127,42,46),
(0,98,100,24,38,70),
(0,44,82,42,4,10),
(0,0,80,96,0,0),
(0,0,24,36,66,0),
(0,0,66,36,24,0),
(0,8,42,28,42,8),
(0,8,8,62,8,8),
(0,0,1,6,0,0),
(0,8,8,8,8,8),
(0,0,6,6,0,0),
(0,2,4,8,16,32),
(0,60,70,90,98,60),
(0,34,66,126,2,2),
(0,34,70,74,82,34),
(0,36,66,82,82,44),
(0,12,20,36,126,4),
(0,116,82,82,82,76),
(0,60,82,82,82,12),
(0,96,64,78,80,96),
(0,44,82,82,82,44),
(0,48,74,74,74,60),
(0,0,0,36,0,0),
(0,0,1,22,0,0),
(0,0,8,20,34,0),
(0,20,20,20,20,20),
(0,0,34,20,8,0),
(0,32,64,74,80,32),
(0,56,68,82,106,56),
(0,62,72,72,72,62),
(0,126,82,82,82,44),
(0,60,66,66,66,36),
(0,126,66,66,66,60),
(0,126,82,82,66,66),
(0,126,80,80,64,64),
(0,60,66,66,82,92),
(0,126,16,16,16,126),
(0,66,66,126,66,66),
(0,68,66,66,66,124),
(0,126,8,16,40,70),
(0,126,2,2,2,2),
(0,126,32,16,32,126),
(0,126,32,16,8,126),
(0,60,66,66,66,60),
(0,126,72,72,72,48),
(0,60,66,74,70,60),
(0,126,72,76,74,50),
(0,36,82,82,82,12),
(0,64,64,126,64,64),
(0,124,2,2,2,124),
(0,120,4,2,4,120),
(0,124,2,4,2,124),
(0,70,40,16,40,70),
(0,96,16,14,16,96),
(0,66,70,90,98,66),
(0,0,126,66,66,0),
(0,32,16,8,4,2),
(0,0,66,66,126,0),
(0,16,32,64,32,16),
(1,1,1,1,1,1),
(0,0,96,80,0,0),
(0,4,42,42,42,30),
(0,126,18,18,18,12),
(0,28,34,34,34,0),
(0,12,18,18,18,126),
(0,28,42,42,42,24),
(0,0,16,62,80,64),
(0,24,37,37,37,62),
(0,126,16,16,16,14),
(0,0,18,94,2,0),
(0,2,1,1,94,0),
(0,126,8,20,34,2),
(0,0,66,126,2,0),
(0,62,32,30,32,30),
(0,62,32,32,32,30),
(0,28,34,34,34,28),
(0,63,36,36,36,24),
(0,24,36,36,37,63),
(0,0,30,32,32,32),
(0,18,42,42,42,4),
(0,32,124,34,2,0),
(0,60,2,2,2,62),
(0,48,12,2,12,48),
(0,60,2,28,2,60),
(0,34,20,8,20,34),
(0,56,5,5,5,62),
(0,34,38,42,50,34),
(0,16,108,130,130,0),
(0,0,0,102,0,0),
(0,130,130,124,16,0),
(0,32,64,32,64,0),
(0,14,18,34,18,14),
(0,56,69,69,69,42),
(0,28,66,2,66,30),
(0,28,42,106,170,24),
(0,12,82,146,82,30),
(0,12,82,18,82,30),
(0,12,146,82,18,30),
(0,12,82,178,82,30),
(0,24,36,37,37,2),
(0,12,90,154,90,8),
(0,28,170,42,170,24),
(0,28,170,106,42,24),
(0,64,18,30,66,0),
(0,0,82,158,66,0),
(0,0,146,94,2,0),
(0,30,168,40,168,30),
(0,14,84,180,84,14),
(0,62,42,106,162,34),
(0,36,42,28,42,26),
(0,62,72,126,82,66),
(0,12,82,146,82,12),
(0,12,82,18,82,12),
(0,12,146,82,18,12),
(0,28,66,130,66,30),
(0,28,130,66,2,30),
(0,24,69,5,69,30),
(0,28,162,34,162,28),
(0,60,130,2,130,60),
(0,24,36,102,36,36),
(0,18,62,82,66,34),
(0,74,42,31,42,74),
(0,126,80,84,47,5),
(0,2,9,62,72,32),
(0,4,42,106,170,30),
(0,0,18,94,130,0),
(0,28,34,98,162,28),
(0,60,2,66,130,62),
(0,94,144,144,80,142),
(0,94,136,132,66,158),
(0,72,168,168,232,0),
(0,72,168,168,72,0),
(0,4,10,82,2,4),
(0,28,16,16,16,16),
(0,16,16,16,16,28),
(64,114,12,57,75,5),
(64,114,12,54,75,2),
(0,0,0,94,0,0),
(8,20,34,8,20,34),
(34,20,8,34,20,8),
(85,0,170,0,85,0),
(85,170,85,170,85,170),
(170,255,85,255,170,255),
(0,0,0,255,0,0),
(8,8,8,255,0,0),
(20,20,20,255,0,0),
(8,8,255,0,255,0),
(8,8,15,8,15,0),
(20,20,20,31,0,0),
(20,20,247,0,255,0),
(0,0,255,0,255,0),
(20,20,23,16,31,0),
(20,20,244,4,252,0),
(8,8,248,8,248,0),
(20,20,20,252,0,0),
(8,8,8,15,0,0),
(0,0,0,248,8,8),
(8,8,8,248,8,8),
(8,8,8,15,8,8),
(0,0,0,255,8,8),
(8,8,8,8,8,8),
(8,8,8,255,8,8),
(0,0,0,255,20,20),
(0,0,255,0,255,8),
(0,0,252,4,244,20),
(0,0,31,16,23,20),
(20,20,244,4,244,20),
(20,20,23,16,23,20),
(0,0,255,0,247,20),
(20,20,20,20,20,20),
(20,20,247,0,247,20),
(20,20,20,244,20,20),
(8,8,248,8,248,8),
(20,20,20,23,20,20),
(8,8,15,8,15,8),
(0,0,248,8,248,8),
(0,0,0,252,20,20),
(0,0,0,31,20,20),
(0,0,15,8,15,8),
(8,8,255,8,255,8),
(20,20,20,255,20,20),
(8,8,8,248,0,0),
(0,0,0,15,8,8),
(255,255,255,255,255,255),
(15,15,15,15,15,15),
(255,255,255,0,0,0),
(0,0,0,255,255,255),
(240,240,240,240,240,240),
(0,28,34,34,28,34),
(0,30,32,42,42,20),
(0,127,64,64,64,96),
(0,16,34,60,32,62),
(0,99,85,73,65,99),
(0,28,34,34,60,32),
(0,1,62,2,2,60),
(0,96,64,127,64,96),
(0,8,85,127,85,8),
(0,28,42,73,42,28),
(0,25,38,64,38,25),
(0,12,50,82,74,68),
(0,8,20,8,20,8),
(0,29,34,62,34,92),
(0,28,42,42,34,0),
(0,63,64,64,64,63),
(0,42,42,42,42,42),
(0,34,34,250,34,34),
(0,2,138,82,34,2),
(0,2,34,82,138,2),
(0,0,0,63,64,48),
(0,12,2,252,0,0),
(0,8,8,42,8,8),
(0,18,36,18,36,0),
(0,96,144,144,96,0),
(0,0,24,24,0,0),
(0,0,8,8,0,0),
(0,8,4,2,127,64),
(0,240,128,128,112,0),
(0,0,144,176,80,0),
(0,60,60,60,60,0),
(0,0,0,0,0,0));

   ScanCode:Byte=0;
	MaByt=25509;
   Je:Word=0;

	Xpul= 159;
   Ypul= 99;
   MeritkoX = 300;
   MeritkoY = 240;
   TvrdyMaxBod  = 300;
   TvrdyMaxPol  = 200;
   TvrdyMaxHran =  15; {v polygonu}
   TvrdyMaxObj  =  64;
   TvrdyMaxPloch=  30; {v objektu}
   TvrdyMaxZBodPolObj = TvrdyMaxBod;
	ctab:Array[1..9] of Single=
(0.99987663248, {Cos(Uhel)}
 0.99950656036,
 0.99888987496,
 0.99802672842,
 0.99691733373,
 0.99556196460,
 0.99396095545,
 0.99211470131,
 0.99002365772);
   stab:Array[1..9] of Single=
(0.015707317312, {Sin(Uhel)}
 0.031410759078,
 0.047106450710,
 0.062790519529,
 0.078459095728,
 0.094108313319,
 0.10973431109,
 0.12533323356,
 0.14090123194);
   c5:Single = {3grad=}0.99888987496;
   s5:Single = {3grad=}0.04710645071;
   Posun:Byte = 3;
   MaxPol:Word=0;
   MaxBod:Word=0;
   MaxObj:Word=0;
   Cekej:Byte=1;
   Ohen:Boolean=True;
   Rotace:Boolean=True;
   Vypln:Boolean=False;
   Pohyb:Boolean=False;
   Stin:Boolean=True;
   BazeOka:TypBaze=((1,0,0),(0,1,0),(0,0,1));
   BazeObj:TypBaze=((1,0,0),(0,1,0),(0,0,1));
   BazeStr:TypBaze=((1,0,0),(0,1,0),(0,0,1));
   StredLokal:Vektor=(110,0,0);
   Red:Byte=60;
   Green:Byte=30;
   Blue:Byte=0;
Var
   LokalBody  :array[1..TvrdyMaxBod] of Vektor;
   LokalStrObj:array[1..TvrdyMaxObj] of Vektor;
   LokalStrPol:array[1..TvrdyMaxPol] of Vektor;
   Body       :array[1..TvrdyMaxBod] of Vektor;
   StredObj   :array[1..TvrdyMaxObj] of Vektor;
   StredPol   :array[1..TvrdyMaxPol] of Vektor;
   Kolmy      :array[1..TvrdyMaxPol] of Vektor;  {smeruje dovnitr (od viditelne strany k neviditelne)}
   SezHran    :array[1..TvrdyMaxPol,0..TvrdyMaxHran] of Integer;  {[?,0] ...hran v ? plose/polygonu}
   SezPloch   :array[1..TvrdyMaxObj,0..TvrdyMaxPloch] of Integer; {[?,0] ...ploch v ? podcasti}
   SerazeneTez:array[1..TvrdyMaxObj] of Integer; {serazene podcasti od nejvzdalenejsiho}

   Roz  :String[2];
   Oko  :Vektor;
   Obr  :Array [1..TvrdyMaxBod] of Sour2D;
   Polygon:Array[1..TvrdyMaxHran] of PointType;
   AdrOkna:Pointer;
   PTime:^LongInt;

Procedure InitGraph;
Var
b:Byte;
Begin
   Asm  {cteni kombinace monitoru}
		push ds
		push bp
		Mov ax,$1a00
		Int 10h
		Mov B,al
		pop bp
		pop ds
   End;
   IF b <> $1a Then Begin Write('Nedetekovana karta VGA.'#13); Halt(2); End;
   Asm  {sluzba 0;ah=0,al=13h; nastaveni modu 13h}
		push ds
		push bp
		mov ax,13h
		int 10h
		pop bp
		pop ds
   End;
End;


Procedure CloseGraph; Assembler;
Asm
   push ds
	push bp
	mov ax,3h
	int 10h
	pop bp
	pop ds
End;


Function  Orez(var x1,y1,x2,y2:Integer):Boolean;
Const
MaxX = 319;
MaxY = 199;
MinX = 0;
MinY = 0;
Var
    P:array[0..9] of LongInt;
    W,O,N,M:Byte;
    D:LongInt;
Begin
   Orez := False;
   IF (x1 < MinX) and (x2 < MinX) Then Exit;
   IF (x1 > MaxX) and (x2 > MaxX) Then Exit;
   IF (y1 < MinY) and (y2 < MinY) Then Exit;
   IF (y1 > MaxY) and (y2 > MaxY) Then Exit;
   {zbavili jsme se tecek u neprotinajicich primek na okraji}
   Orez := True;
   P[0] := x1;
   P[1] := x2;
   P[2] := P[1] - P[0]; {dx}
   P[3] := MinX;
   P[4] := MaxX;
   P[5] := y1;
   P[6] := y2;
   P[7] := P[6] - P[5]; {dy}
   P[8] := MinY;
   P[9] := MaxY;
   For W := 0 to 1 do
   For O := 0 to 1 do
   For N := 0 to 1 do
   Begin
      M := (w shl 2) + w; {0,0,0,0,5,5,5,5}
      D := P[M + 3 + O] - P[M + N]; {3-0,3-1,4-0,4-1,8-5,8-6,9-5,9-6}
      IF (D * (1 - (O shl 1))) <= 0 THEN Continue;
      {bod je vne ohrady}
      IF P[M + 2] = 0 THEN
      Begin
         {rovnobezka mimo obdelnik}
         Orez := False;
         Exit;
      End;
      {(3-0)/2, (3-1)/2, (4-0)/2, (4-1)/2, (8-5)/7, (8-6)/7, (9-5)/7, (9-6)/7}
      P[5 - M + N] := P[5 - M + N] + (D * P[5 - M + 2]) div P[M + 2];
      P[M + N] := P[M + 3 + O];
      P[2] := P[1] - P[0];
      P[7] := P[6] - P[5];
   End;
   x1 := P[0];
   x2 := P[1];
   y1 := P[5];
   y2 := P[6];
   IF (x1 < MinX) Or (x1 > MaxX) Then Orez := False;
   IF (x2 < MinX) Or (x2 > MaxX) Then Orez := False;
   IF (y1 < MinY) Or (y1 > MaxY) Then Orez := False;
   IF (y2 < MinY) Or (y2 > MaxY) Then Orez := False;
End;

Function  AlokujPole13:Pointer;
Var P:Pointer;
Begin
	IF MaxAvail < VelikostObrazu Then
	Begin
		Write('Chyb¡ ',VelikostObrazu-MaxAvail,' bytu souvisl‚ho bloku.'#13);
	   Halt;
	End;
	GetMem(P,VelikostObrazu);
   FillChar(P^,VelikostObrazu,0);
   AlokujPole13 := P;
End;


Procedure PutPixel(X,Y:Integer;Barva:Byte); Assembler;
ASM
	MOV	AX,X
	TEST	AX,$8000
	JNZ	@Exit
	CMP	AX,319
	JA 	@Exit
	MOV	BX,Y
	TEST	BX,$8000
	JNZ	@Exit
	CMP	BX,199
	JA 	@Exit
	XCHG	BH,BL      {Zameni BH a BL, jako * 256}
	LES   DI,Adresa13
	ADD   DI,BX
	SHR   BX,2
	ADD	BX,AX
	ADD   DI,BX
	MOV   AL,Barva
	MOV   ES:[DI],AL
@Exit:
End;


Function  GetPixel(X,Y:Integer):Byte; Assembler;
ASM
   LES   DI,Adresa13
	MOV	BX,Y
	XCHG	BH,BL      {Zameni BH a BL, jako * 256}
	ADD   DI,BX
	SHR   BX,2
	ADD	BX,X
	ADD   DI,BX
	MOV   AL,ES:[DI]
End;


Procedure Line(X1,Y1,X2,Y2:Integer);
Var
DeltaS:Integer;	{Zmena za 1 ds}
Dskok,XRoz,XRoz2,YRoz,i:Integer;
Begin
	IF NOT Orez(x1,y1,x2,y2) Then Exit;
	XRoz := x2-x1;
	YRoz := y2-y1;
   IF XRoz < 0 Then	{1 reseni zacatku}
   Begin
   	x1 := x2;
      y1 := y2;
      XRoz := - XRoz;
      YRoz := - YRoz;
   End;
	IF XRoz >= Abs(YRoz) Then
	Begin
		DeltaS:= 1;
		IF YRoz >= 0 Then DSkok := 320 Else Begin DSkok := -320; YRoz := -YRoz; End;
	End Else Begin
		IF YRoz >= 0 Then DeltaS:= 320 Else Begin DeltaS:= -320; YRoz := -YRoz; End;
		DSkok := 1;
      i := XRoz; XRoz := YRoz; YRoz := i;
	End;
   XRoz2 := -(XRoz Shl 1);
	ASM
		MOV	BX,y1
		XCHG	BH,BL      {Zameni BH a BL, jako * 256}
		LES	DI,Adresa13
		ADD	DI,BX
		SHR	BX,2
		ADD	BX,x1
		ADD	DI,BX			{cil ES:DI}
		MOV	AL,Color13	{AL := Color13}
		MOV	ES:[DI],AL
		MOV	CX,XRoz		{CX := XRoz na Smycku}
		OR 	CX,CX
		JZ 	@Exit
		MOV	DX,YRoz
		SHL	DX,1			{DX := 2*YRoz}
		MOV	SI,dx
		SUB	SI,CX			{SI := P}
		MOV	BX,DeltaS	{BX := DeltaS}
@Smycka:
		ADD	DI,BX
		TEST	SI,$8000
		JNZ	@1
		ADD	DI,DSkok
		ADD	SI,XRoz2
@1:
		MOV	ES:[DI],AL
		ADD	SI,DX
		LOOP	@Smycka
@Exit:
	End;
End;


Procedure DrawPoly(Pocet:Byte;var Seznam);
Var
   Sez:Array[1..TvrdyMaxHran] of PointType absolute Seznam;
   a:Word;
Begin
   For a := Pocet DownTo 2 do Line(Sez[a].x,Sez[a].y,Sez[a-1].x,Sez[a-1].y);
   Line(Sez[Pocet].x,Sez[Pocet].y,Sez[1].x,Sez[1].y);
End;


Procedure FillPoly(Pocet:Byte;var Seznam);
Var
  S:Array[1..TvrdyMaxHran] of PointType absolute Seznam;
  DeltaX,DeltaY:Array[1..TvrdyMaxHran] of Integer;
  Pomocny:Array[1..TvrdyMaxHran] of Integer Absolute DeltaY;
  MinY,MaxY,Y,x1,x2:Integer;
  a,a2,Sum:Word;
  PrusecikX:Array[1..TvrdyMaxHran] of Integer;
  ZmenaStoupani:Boolean;
  L:LongInt;
  OfsBodu:Word;

  Procedure Serad(Pocet:Word;Var IntegerBuffer);
  Var
	 S:Array[1..TvrdyMaxHran] of Integer absolute IntegerBuffer;
	 a,b:Word;
	 i:Integer;
  Begin
	 For a := 2 to Pocet do
	 Begin
		For b := a downto 2 do
		Begin
		  IF S[b] < S[b-1] Then
		  Begin
			 i      := S[b-1];
			 S[b-1] := S[b];
			 S[b]   := i;
        End
        Else Break;
		End;
    End;
  End;

Begin
  For a := 1 To Pocet do Pomocny[a] := S[a].Y;
  Serad(Pocet,Pomocny);
  MinY := Pomocny[1];
  MaxY := Pomocny[Pocet];
  If MinY < 0 then MinY := 0;
  If MinY>199 then Exit;
  If MaxY>199 then MaxY := 199;
  If MaxY < 0 then Exit;

  DeltaX[1] := S[1].X - S[Pocet].X;
  DeltaY[1] := S[1].Y - S[Pocet].Y;
  For a := 2 to Pocet do DeltaX[a] := S[a].X - S[a-1].X;
  For a := 2 to Pocet do DeltaY[a] := S[a].Y - S[a-1].Y;
  DeltaX[Pocet+1] := DeltaX[1];
  DeltaY[Pocet+1] := DeltaY[1];

  For Y := MinY to MaxY do
  Begin
    Sum := 0;
    For a := 1 to Pocet do
    Begin
      IF a = 1 Then a2 := Pocet Else a2 := a - 1;
      ZmenaStoupani := Not (((DeltaY[a]>0) And (DeltaY[a+1]>0)) Or ((DeltaY[a]<0) And (DeltaY[a+1]<0)));
      {Test zda y protina usecku d(a,a2)}
      IF (S[a].y >= y) or (S[a2].y >= y)
      Then IF (S[a].y <= y) or (S[a2].y <= y)
		Then IF Not (S[a].y = S[a2].y) {vod primka, DeltaY = 0}
      Then IF ZmenaStoupani OR (S[a].y <> y)
		Then Begin
        Sum := Sum + 1;
        L := y - S[a2].y; {jinak to obcas pretece}
{        PrusecikX[Sum] := L*DeltaX[a] div DeltaY[a] + S[a2].x;}
        L := L*DeltaX[a];
        IF ((L > 0) And (DeltaY[a] > 0)) Or ((L < 0) And (DeltaY[a] < 0)) Then
		  PrusecikX[Sum] := (L + DeltaY[a] Div 2) div DeltaY[a] + S[a2].x
        Else
        PrusecikX[Sum] := (L - DeltaY[a] Div 2) div DeltaY[a] + S[a2].x;
      End;
    End;
    If Sum = 0 Then Continue;
    If Odd(Sum) Then Write('Chyba pri vybarvovani n-uhelniku'#13); {nastane nekdy pokud jsou 2 totozne body(1= posledni)}
    Serad(Sum,PrusecikX);
	 Asm
       xor ax,ax
       mov bx,y
       mov ah,bl
       shl bx,6
       add ax,bx
       mov OfsBodu,ax
    End;
    For a := 1 To Sum SHR 1 do
    Begin
      x1 := PrusecikX[(a SHL 1)-1];
      x2 := PrusecikX[(a SHL 1)];
      IF (x2 < 0) OR (x1 > 319) Then Continue;
      IF x1 < 0 then x1 := 0;
      IF x2 > 319 then x2 := 319;
      FillChar(Mem[Seg(Adresa13^):Ofs(Adresa13^) + OfsBodu + x1],x2-x1+1,Color13);
{      FillChar(Ptr(Seg(Adresa13^),Ofs(Adresa13^) + OfsBodu + x1)^,x2-x1+1,Color13);}
    End;
  End;
End;


Procedure Elipsa(Sx,Sy:Integer;a,b:Single;Vypln:Boolean);
Var
   x,y,MinX,MaxX:Integer;
   OfsBodu:Word;
Begin
   IF (a>0) And (b>0) Then
   Begin
      For y := Trunc(-b) to Trunc(b) do
      IF (Sy + y >= 0) And (Sy + y <= 199) Then
		Begin
         x := Trunc(SQRT(SQR(a)*(1-y*y/SQR(b))));
         IF Vypln Then
         Begin
	         MinX := SX - x;
         	MaxX := SX + x;
            IF MinX < 0   Then MinX := 0;
            IF MaxX > 319 Then MaxX := 319;
            IF MaxX >= MinX Then
            Begin
	            OfsBodu := (Sy+y) Shl 8 + (Sy+y) Shl 6;
               FillChar(Mem[Seg(Adresa13^):Ofs(Adresa13^) + OfsBodu + MinX],MaxX-MinX + 1,Color13);
{	            FillChar(Ptr(Seg(Adresa13^),Ofs(Adresa13^) + OfsBodu + MinX)^,MaxX-MinX + 1,Color13);}
            End;
         End Else
         Begin
	         PutPixel(Sx + x, Sy + y,Color13);
	         PutPixel(Sx - x, Sy + y,Color13);
         End;
      End;
      IF Not Vypln Then
      For x := Trunc(-a) to Trunc(a) do
      IF (Sx + x >= 0) And (Sx + x <= 319) Then
      Begin
         y := Trunc(SQRT(SQR(b)*(1-x*x/SQR(a))));
         PutPixel(Sx + x,Sy + y,Color13);
         PutPixel(Sx + x,Sy - y,Color13);
      End;
   End;
End;


Procedure Circle(X,Y:Integer;Polomer:Word;Vypln:Boolean);
Begin
   Elipsa(X,Y,Polomer*1.212,Polomer,Vypln);
End;


Procedure ZpetnyBehPaprsku; Assembler;
Asm
   mov dx,3dah
@1:in  al,dx
   and al,8
   jz @1
@2:in  al,dx
   and al,8
   jnz @2
End;


Procedure CopyPole13(AdrZdroj,AdrCil:Pointer);
Begin
	ZpetnyBehPaprsku;
	Asm  {0..199}
		PUSH	DS
      LES	DI,AdrCil      {nastaven segment a offset cile   ES:DI}
		LDS	SI,AdrZdroj 	{nastaven segment a offset startu DS:SI}
		MOV	CX,16000			{kolikrat se bude opakovat rep}
		DB 	66h				{32 bit instrukce?}
		REP	MOVSW				{rep = IF cx>0 then cx := cx - 1}
		POP	DS
   End;
End;




Procedure ClearDevice; Assembler;
ASM
	LES	DI,Adresa13
	MOV	BX,320*200
	XOR	AX,AX
@1:
	MOV	ES:[DI+BX-2],AX
	SUB	BX,2
	JNZ	@1
End;


Procedure SetDAC13(Index,Red,Green,Blue:Byte); Assembler;
Asm
   push ds
   push bp
   mov ax,$1010
   xor bh,bh
   mov bl,Index
   mov ch,green
   mov cl,blue
   mov dh,red
   int 10h
   pop bp
   pop ds
End;


Procedure LoadPal13(var Buffer); Assembler;
Asm
   push ds
   push bp
   mov ax,$1012
   xor bx,bx
   mov cx,256
   Les dx,Buffer
   int 10h
   pop bp
   pop ds
End;


Procedure InitPrechod(Od,Kam:Byte;OldR,OldG,OldB,NewR,NewG,NewB:ShortInt);
{provede prechod od OLD temer k NEW}
{Od,Kam 0..255}
{Old 0..63}
{New 0..64}
Var
a,b:Byte;
w:Word;
Begin
   w := Od*3;
   b := (Kam - Od) + 1;
   NewR := NewR - OldR;
   NewG := NewG - OldG;
   NewB := NewB - OldB;
	For a := 0 To b - 1 Do
   Begin
   	Pal13[w]  := OldR + NewR * a Div b;
      Pal13[w+1]:= OldG + NewG * a Div b;
      Pal13[w+2]:= OldB + NewB * a Div b;
		Inc(w,3);
   End;
End;


Procedure InitPalOhen;
Begin
   {cerna}
   InitPrechod(  0, 15, 0, 0, 0, 0, 0,16); {16}
   {ctvrtmodra}
   InitPrechod( 16, 31, 0, 0,16,16, 0,32); {16}
   {pulfialova}
   InitPrechod( 32, 63,16, 0,32,48, 0, 0); {32}
   {cervena}
   InitPrechod( 64, 79,48, 0, 0,64, 0, 0); {16}
   {syte cervena}
   InitPrechod( 80, 95,63, 0, 0,63, 0, 0); {16, bez prechodu}
   {syte cervena}
   InitPrechod( 96,159,63, 0, 0,63,64, 0); {64, v puli oranzova}
   {zluta}
   InitPrechod(160,223,63,63, 0,63,63,64); {64}
   {bila}
   InitPrechod(224,255,63,63,63, 0, 0, 0); {32}
   {cerna}
   ZpetnyBehPaprsku;
   LoadPal13(Pal13);
End;


Procedure InitPalSpektrum;
Begin
   {cerna}
   InitPrechod(  0, 31, 0, 0, 0,64, 0, 0); {32}
   {cervena}
   InitPrechod( 32, 95,63, 0, 0,63,64, 0); {64 v puli oranzova}
   {zluta}
   InitPrechod( 96,127,63,63, 0, 0,63, 0); {32}
   {zelena}
   InitPrechod(128,191, 0,63, 0, 0, 0,64); {64 v puli azurova}
   {modra}
   InitPrechod(192,223, 0, 0,63,64, 0,63); {32, bez prechodu}
   {fialova}
   InitPrechod(224,255,63, 0,63, 0, 0, 0); {32}
   {cerna}
   ZpetnyBehPaprsku;
   LoadPal13(Pal13);
End;



Procedure InitPalRGB(Red,Green,Blue:Byte);
Begin
	{cerna..barevna/cerna}
   InitPrechod(  0, 31,  0,    0,   0,Red,Green,Blue);
   {barevna/cerna..bila}
   InitPrechod( 32, 63,Red,Green,Blue, 63,   63,  63);
   {bila..barevna/cerna}
   InitPrechod( 64,159, 63,   63,  63,Red,Green,Blue);
   {barevna/cerna..cerna}
   InitPrechod(160,255,Red,Green,Blue,  0,    0,   0);
   ZpetnyBehPaprsku;
   LoadPal13(Pal13);
End;


Procedure Vybarvi(a:Byte); Assembler;
ASM
	LES	DI,Adresa13
	MOV	BX,320*202
	MOV	AL,a
	MOV	AH,AL
@1:
	MOV	ES:[DI+BX-2],AX
	SUB	BX,2
	JNZ	@1
End;


Procedure Rozmazni; Assembler;
ASM
	LES	DI,Adresa13
	ADD	DI,320			{ES:DI adresa meneneho bodu zvetsena o radek}

	XOR	BH,BH
	XOR	AH,AH
	MOV	CX,64000;      {320*200 = pocita se i z radku 200 a 201, posledni meneny je 199}
@1:
	MOV	AL,ES:[DI-1]   {   +----+}
	MOV	BL,ES:[DI]     {   |-320| =meneny bod}
	ADD	AX,BX          {+--+----+--+}
	MOV	BL,ES:[DI+1]   {|-1| DI |+1|}
	ADD	AX,BX          {+--+----+--+}
	MOV	BL,ES:[DI+320] {   |+320|}
	ADD	AX,BX          {   +----+}
	SHR	AX,2				{AX := (Bod(DI-1)+Bod(DI)+Bod(DI+1)+Bod(DI+320)) div 4}
	JZ 	@2
	DEC	AX					{IF AX > 0 Then AX := Ax -1}
@2:
	MOV	BYTE PTR ES:[DI-320],AL  {nastavena barva}
	INC	DI
	LOOP	@1
END;



Procedure PisXYCode(x,y:Integer;code:Byte);
Var
a,b,z:integer;
Begin
	For b := 0 to 5 do
	Begin
		z := 128;
	   For a := 0 to 7 do
	   Begin
	   	IF (z and Font68[Code,b]) > 0 Then PutPixel(x+b,y+a,ColorFont)
         Else IF FontFlags And 1 <> 0 Then PutPixel(x+b,y+a,ColorPozadi);
	      z := z Shr 1;
	   End;
	End;
   Inc(LocateFont.x,6);
End;


Procedure OutTextXY(X,Y:Integer;Retezec:String);
Var
	p,delka:byte;
Begin
   LocateFont.x := x;
   LocateFont.y := y;
	For Delka := 1 To Length(Retezec) do
   Begin
      p := Ord(Retezec[Delka]);
      IF (LocateFont.x > 319-6) or (p = 13) Then
      Begin
         LocateFont.x := 0;
         LocateFont.y := LocateFont.y + 8;
         IF LocateFont.y > 199 - 8 Then LocateFont.y := 0;
         If p = 13 Then Continue;
      End;
      PisXYCode(LocateFont.x,LocateFont.y,p);
   End;
End;


Procedure OutInteger(Cislo:LongInt);
var Slovo:string[11];
Begin
   Str(Cislo,Slovo);
   OutTextXY(LocateFont.x,LocateFont.y,Slovo);
End;


Procedure OutText(Retezec:String);
Begin
   OutTextXY(LocateFont.x,LocateFont.y,Retezec);
End;

Function KeyPressed:Boolean; Assembler;
Asm
	CMP	ScanCode,0     {ZF := ((ScanCode AND 0) = 0)}
	JNE	@@1            {IF Not ZF 0 Then GOTO 1}
	MOV	AH,1           {AH := 1, INT 16h cte ale nevyjme z bufferu}
   INT	16H				{AL := ASCII kod znaku; AH := SCAN kod znaku; ZF = NeniStisk}
	MOV	AL,0           {AL := 0}
	JE		@@2				{IF ZF THEN GOTO 2}
@@1:MOV	AL,1				{AL := 1}
@@2:							{KeyPressed := AL}
End;


Function ReadKey:Char; Assembler;
Asm
	MOV	AL,ScanCode		{AL := ScanCode}
	MOV	ScanCode,0		{ScanCode := 0}
	OR		AL,AL				{ZF := ((AL OR AL) = 0)}
	JNE	@@1				{IF Not ZF THEN GOTO 1 Byla stisknuta klavesa s kodem 0, napr. F1}
	XOR	AH,AH				{AH := 0, INT 16h pak cte znak z klavesnice}
	INT	16H				{AL := ASCII kod znaku; AH := SCAN kod znaku}
	OR		AL,AL				{ZF := ((AL OR AL) = 0)}
	JNE	@@1				{IF Not ZF Then GOTO 1}
	MOV	ScanCode,AH		{ScanCode := AH ulozeno pro pristi pouziti}
	OR		AH,AH				{ZF := ((AH OR AH) = 0)}
	JNE	@@1				{IF Not ZF Then GOTO 1}
	MOV	AL,'C'-64		{AL := 3}
@@1:							{ReadKey := AL}
End;

Procedure Pause;
Begin
   Repeat Until KeyPressed;
   While KeyPressed do ReadKey;
End;

Procedure RozlozByt(a:Byte);
Var b,c:Byte;
Begin
	b := 1;
   For c := 1 To 8 Do
   Begin
   	Bit[c] := (a And b) <> 0;
      b := b Shl 1;
   End;
End;


Procedure OutTextXYW(X,Y:Integer;Atribut:Word;Retezec:String);
Begin
	ColorFont  := Hi(Atribut);
   ColorPozadi:= Lo(Atribut);
   OutTextXY(NortonX+X*SirZn,NortonY+Y*VysZn,Retezec);
End;

Function UCase(S:String):String;
Var a:Byte;
Begin
   For a := 1 to Length(S) do if (Ord(S[a]) > 96) and (Ord(S[a])<123) then S[a] := Chr(Ord(S[a]) - 32);
   UCase := S;
End;


Function LCase(S:String):String;
Var a: Byte;
Begin
   For a := 1 to Length(S) Do IF (Ord(S[a]) > 64) and (Ord(S[a])<91) then S[a] := Chr(Ord(S[a]) + 32);
   LCase := S;
End;


Function RTrim(Veta:String):String;
Var
   A:Byte Absolute Veta;
Begin
   For A := A DownTo 0 Do IF Veta[A] <> ' ' Then Break;
   RTrim := Veta;
End;



PROCEDURE DosChyba;
Var
S:string;
Begin
   Case DosError of
      0: S := 'Nedoslo k chybe';
      2: S := 'Soubor nebyl nalezen';
      3: S := 'Cesta nebyla nalezena';
      5: S := 'Nepovoleny pristup';
      6: S := 'Neplatne cislo komunikacniho kanalu se souborem';
      8: S := 'Nedostatek pameti';
      10: S := 'Chyba systemoveho prostredi';
      11: S := 'Nepripustny format';
      18: S := 'Zadne dalsi soubory';
   Else S := 'Neznama chyba';
   End;
   OutTextXY(0,0,S);
   Halt;
End;



Function Souboru(c:string):integer;
Var a:integer;
Begin
   a := 0;
   Repeat
      a := a + 1;
      if a = 1 then FindFirst(C + '*.*',AnyFile,S)
      Else FindNext(S);
   Until DosError <> 0;
   Souboru :=  a-1;
End;


PROCEDURE Zapis(a:byte);
Begin
   {Zarovnani Jmena na 12 pismen}
   Jmeno[a] := S.Name + '            ';
   Typ[a] := S.Attr;
   Cas[a] := S.Time;
   Vel[a] := S.Size;
   IF S.Attr And $10 = 0 Then Jmeno[a] := LCase(Jmeno[a]);
end;


PROCEDURE Dohledej(Odkud:Byte);
Var a:Byte;
Begin
   For a := Odkud to 20 do
   Begin
      FindNext(S);
      IF DosError = 18 then Jmeno[a] := '            '
      Else IF DosError <> 0 then DosChyba
      Else Zapis(a);
   end;
   Pred := Min;
End;



PROCEDURE Prohledej(c:string);
Var a,b:integer;
Begin
   b := Min - Pred;
   IF b < 0 then   {posun nazpet (proti srsti->prohledava se znovu od zacatku)}
   Begin
      For a := 1 to Min do
      Begin
         IF a = 1 Then FindFirst(C+'*.*',Anyfile,S)
         Else FindNext(S);
         IF DosError <> 0 Then DosChyba;
      End;
      Zapis(0);
      a := 1;
   End
   Else  {posun dopredu (pokracuje se v prohledavani)}
   Begin
      IF b < 21 Then
      Begin
         For a := 0 to 20 - b do
         Begin
            Jmeno[a] := Jmeno[b+a];
            Typ[a]   := Typ[b+a];
            Cas[a]   := Cas[b+a];
            Vel[a]   := Vel[b+a];
         End;
         a := 21 - b;
      End
      Else
      Begin
         For a := 1 to b - 21 do FindNext(S);
         a := 0;
      End;
   End;
   Dohledej(a);
End;




PROCEDURE Zobraz;
Var
a:integer;
dt:datetime;
S1,S2:String;
W:Word;
Begin
   For a := 0 to 20 do
   Begin
      IF Tet = a then W := KurzAttr
      Else IF Not ((Pos(Zvyrazni[1],Jmeno[a]) = 0) and
			(Pos(Zvyrazni[2],Jmeno[a]) = 0) and
			(Pos(Zvyrazni[3],Jmeno[a]) = 0)) then W := ZvyrAttr
      Else W := NormAttr;
      OutTextXYW(1+(a Div 7)*13,2+(a Mod 7),W,Jmeno[a])
   End;

   RozlozByt(Typ[Tet]);
   For a := 1 to 6 Do OutTextXYW(4*a,9,NormAttr,Chr(45-Ord(Bit[a]) Shl 1));

   {Aktjmeno}
   S2 := Jmeno[Tet];
   {Aktsize}
   Str(Vel[Tet],S1);
   For a:= Length(S1) to 8 do S2 := S2 + ' ';
   S2 := S2 + S1 + ' ';
   {Aktdate}
   UnpackTime(Cas[Tet],DT);
   Str(DT.Day,S1);
   IF Length(S1) = 1 then S1 := ' ' + S1;
   S2 := S2 + S1 + '-';
   Str(DT.month,S1);
   IF Length(S1) = 1 then S1 := '0' + S1;
   S2 := S2 + S1 + '/';
   Str(DT.Year,S1);
   S2 := S2 + S1 + ' ';
   {Aktcas}
   Str(DT.Hour,S1);
   IF Length(S1) = 1 then S1 := ' ' + S1;
   S2 := S2 + S1 + ':';
   Str(DT.Min,S1);
   if Length(S1) = 1 then S1 := '0' + S1;
   S2 := S2 + S1;
   OutTextXYW(1,10,NormAttr,S2);
   {Hleda}
   If Length(Hleda)>0 then OutTextXYW(13,11,NormAttr,'[            ]')
   Else OutTextXYW(13,11,NormAttr,'ÍÍÍÍÍÍÍÍÍÍÍÍÍÍ');
   OutTextXYW(14,11,NormAttr,Hleda);
End;



PROCEDURE Tabulka;
Var a: byte;
Begin
   IF cz Then OutTextXYW(0,0,NormAttr,Tab[6])
	Else OutTextXYW(0,0,NormAttr,Tab[1]);
   OutTextXYW(0,1,NormAttr,Tab[2]);
   For a := 0 to 2 do OutTextXYW(1+a*13,1,ZvyrAttr,'Name');
   For a := 2 to 8 do OutTextXYW(0,a,NormAttr,Tab[2]);
   IF cz Then OutTextXYW(0,9,NormAttr,Tab[7])
	Else OutTextXYW(0,9,NormAttr,Tab[3]);
   OutTextXYW(0,10,NormAttr,Tab[4]);
   OutTextXYW(0,11,NormAttr,Tab[5]);
End;



PROCEDURE Novy;
Var a:byte;
Begin
   Tet := 0;
   Min := 1;
   Pred := 2;
   Max := Souboru(Cesta);
   Prohledej(Cesta);
   {hornipath}
   IF cz Then OutTextXYW(0,0,NormAttr,Tab[6])
	Else OutTextXYW(0,0,NormAttr,Tab[1]);
   a := Length(Cesta);
   if a > 34 then OutTextXYW(2,0,Normattr,' '+Copy(Cesta,1,3)+'..'+Copy(Cesta,a-28,29)+' ')
   Else OutTextXYW(19-(Length(Cesta)div 2),0,NormAttr,' '+Cesta+' ');
End;




PROCEDURE Sipky(P:char);
Begin
   {vpravo}
   IF P = 'M' then
   Begin
      IF (Tet < 14) and (Min + Tet + 6 < Max) Then Tet := Tet + 7
      ElSE IF Tet + Min + 6 < Max Then
      Begin
         Min := Min + 7;
         Prohledej(Cesta);
      end
      Else IF Min + 20 < Max Then
      Begin
         Tet := 20;
         Min := Max - 20;
         Prohledej(Cesta);
      end
      ELSE Tet := Max - Min
   end
   {vlevo}
   Else if P = 'K' then
   Begin
      IF Tet > 6 Then Tet := Tet - 7
      Else IF Min > 7 Then
      Begin
         Min := Min - 7;
         Prohledej(Cesta);
      end
      Else IF Min > 1 Then
      Begin
         Tet := 0;
         Min := 1;
         Prohledej(Cesta);
      end
      Else Tet := 0;
   End
   {nahoru}
   Else if P = 'H' then
   Begin
      IF Tet > 0 then Tet := Tet - 1
      Else IF Min > 1 then
      Begin
         Min := Min - 1;
         Prohledej(Cesta);
      end;
   End
   {dolu}
   Else if P = 'P' then
   Begin
      IF (Tet < 20) and (Tet + Min < Max) Then Tet := Tet + 1
      Else IF Min + 20  < Max then
      Begin
         Min := Min + 1;
         Prohledej(Cesta);
      end;
   end;
End;




PROCEDURE Hledej;
Label 1;
Var a:integer;
Slovo:string[12];
Begin
   Tet := 0;
   Min := 1;
   Pred:= 1;
   For a := 1 to Max do
   Begin
      IF a = 1 then FindFirst(Cesta + '*.*',AnyFile,S)
      Else FindNext(S);
      IF DosError <> 0 then DosChyba;
      Slovo := Copy(S.Name,1,Length(Hleda));
      IF ((Slovo)) = (Hleda) Then
      Begin
         Min := a;
         Zapis(0);
         Dohledej(1);
         Goto 1;
      End;
   End;
   Novy;
1:
End;




Function Norton:String;
Var
P:char;
a:byte;
Begin
While KeyPressed do ReadKey;
Esc := False;
Konec := False;
Tabulka;
Novy;
IF Length(Hleda)>0 Then Hledej;
Repeat

   Zobraz;

   repeat until keypressed;
   P := upcase(readkey);

   {esc}
   IF P = #27 then
   Begin
      Norton := Cesta;
      Esc := True;
      Konec := True;
   End
   {enter}
   Else IF (P = #13) Then
   Begin
      IF (Typ[Tet] And $10) <> 0 Then
      Begin
         If Jmeno[Tet] = '..          ' then
         Begin
            a := Length(Cesta);
            Delete(Cesta,a,1);
            Repeat
               a := a - 1;
               Delete(Cesta,a,1)
            Until Cesta[a-1] = '\';
         End
         Else if Jmeno[Tet] <> '.           ' Then
         Begin
            Cesta := Cesta + RTrim(Jmeno[Tet]) + '\';
         End;
         Novy;
         Hledej;
      End
      Else
      Begin
         Norton := Cesta + UCase(RTrim(Jmeno[Tet]));
         Konec := True;
      End;
   End
   {del}
   Else IF (P = #8) and (Length(Hleda) > 0) then Delete(Hleda,Length(Hleda),1)
   Else if P = #0 then
   Begin
      P := readkey;
{F1}  If P = ';' then
      Begin
         OutTextXYW(1,2,NormAttr,' F2         = Cz[On|Off]              ');
         OutTextXYW(1,3,NormAttr,' Alt + A..Z = Novy disk               ');
         OutTextXYW(1,4,NormAttr,' Home & End = Prvni a posledni soubor ');
         OutTextXYW(1,5,NormAttr,' Text & Del = vyhledani souboru       ');
         OutTextXYW(1,6,NormAttr,' R = ReadOnly, H = Hidden             ');
         OutTextXYW(1,7,NormAttr,' S = SysFile,  V = VolumeID           ');
         OutTextXYW(1,8,NormAttr,' D = Directory,A = Archive            ');
         Pause;
         For a := 2 to 8 do OutTextXYW(0,a,NormAttr,Tab[2]);
      End;
{F2}  If P = '<' then
      Begin
         Cz := Not (Cz);
         Tabulka;
         OutTextXYW(19-(Length(Cesta)div 2),0,NormAttr,' '+Cesta+' ');
      End;
{Alt + A..Z}
      a := 0;
      Case Ord(P) Of
         30:  a := 1;  {alt+a}
         48:  a := 2;
         46:  a := 3;  {alt+c}
         32:  a := 4;
         18:  a := 5;  {alt+e}
         33:  a := 6;
         34:  a := 7;  {alt+g}
         35:  a := 8;
         23:  a := 9;  {alt+i}
         36:  a := 10;
         37:  a := 11; {alt+k}
         38:  a := 12;
         50:  a := 13; {alt+m}
         49:  a := 14;
         24:  a := 15; {alt+o}
         25:  a := 16;
         16:  a := 17; {alt+q}
         19:  a := 18;
         31:  a := 19; {alt+s}
         20:  a := 20;
         22:  a := 21; {alt+u}
         47:  a := 22;
         17:  a := 23; {alt+w}
         45:  a := 24;
         21:  a := 25;
         44:  a := 26; {alt+z}
      End;
      IF a <> 0 Then
      Begin
         IF DiskFree(a) <> -1 Then
         Begin
            Cesta := CHR(64 + a)+':\';
            Novy;
         End;
      End;
      IF (P = 'M') or (P = 'K') or (P = 'H') or (P = 'P') then Sipky(P);
      {home}
      IF P = 'G' then
      Begin
         Tet := 0;
         Min := 1;
         Prohledej(Cesta);
      end;
      {end}
      IF P = 'O' then
      Begin
         Tet := 20;
         Min := Max - 20;
         IF Min < 1 then
         Begin
            Min := 1;
            Tet := Max - 1;
         end;
         Prohledej(Cesta);
      End;
   End
   Else if (Length(Hleda)<12) and (ord(p)>32) then
   Begin
      Hleda := Hleda + P;
      Hledej;
   End;

Until Konec;

End;


Procedure Secti(S:String);
Var a:Byte;
Begin
	For a := 1 to Length(S) do Je := Je + Ord(S[a]);
End;



Function SkalSouc(Var Vek1,Vek2:Vektor):Single;
Begin
  SkalSouc := Vek1[1] * Vek2[1] + Vek1[2] * Vek2[2] + Vek1[3] * Vek2[3];
End;


Procedure NasobVek(Var Vek:Vektor; n: Single);
Begin
  Vek[1] := Vek[1] * n;
  Vek[2] := Vek[2] * n;
  Vek[3] := Vek[3] * n;
End;


Procedure NovyVek(Var Vek,A,B:Vektor);
Begin
  Vek[1] := A[1] - B[1];
  Vek[2] := A[2] - B[2];
  Vek[3] := A[3] - B[3];
End;


Procedure Jednotkovy(var Vek:Vektor);
Var
	r:Single;
Begin
  r := Sqrt(SkalSouc(Vek, Vek));
  NasobVek(Vek, 1 / r);
End;



Procedure VektSouc(Var Vek1,Vek2,Vek3:Vektor);
Begin
  Vek1[1] := Vek2[2] * Vek3[3] - Vek2[3] * Vek3[2];
  Vek1[2] := Vek2[3] * Vek3[1] - Vek2[1] * Vek3[3];
  Vek1[3] := Vek2[1] * Vek3[2] - Vek2[2] * Vek3[1];
  Jednotkovy(Vek1);
end;



Procedure VypocetKolmychVektoru;
var
a:Word;
x,y:Vektor;
Begin
   For a := 1 to MaxPol do
   Begin
      NovyVek(x,Body[SezHran[a,3]], Body[SezHran[a,2]]);
      NovyVek(y,Body[SezHran[a,1]], Body[SezHran[a,2]]);
      VektSouc(Kolmy[a],x,y);
      Jednotkovy(Kolmy[a]);
   End;
End;


Procedure SectiBody(Var Vek,A,B:Vektor);
Begin
  Vek[1] := A[1] + B[1];
  Vek[2] := A[2] + B[2];
  Vek[3] := A[3] + B[3];
End;


Procedure LokalDoAbs;
Var
	Vek:Vektor;

   Procedure Preved(var Absolutni,Lokalni;Kolik:Word);
   Var
		a,b:Word;
      Lok:Array[1..TvrdyMaxZBodPolObj] of Vektor Absolute Lokalni;
      Abs:Array[1..TvrdyMaxZBodPolObj] of Vektor Absolute Absolutni;
   Begin
   	For a := 1 to Kolik do
	   For b := 1 to 3 do Abs[a,b] := Vek[b] +
		Lok[a,1]*BazeObj[1,b] +
		Lok[a,2]*BazeObj[2,b] +
		Lok[a,3]*BazeObj[3,b];
   End;
Begin
	Vek := BazeStr[1];
	NasobVek(Vek,20);
	SectiBody(Vek,StredLokal,Vek);

	Preved(Body,LokalBody,MaxBod);
   VypocetKolmychVektoru;
   Preved(StredPol,LokalStrPol,MaxPol);
   Preved(StredObj,LokalStrObj,MaxObj);
End;



Procedure InitLokalTeziste;
Var
	a,b,c:Word;
Begin
   FillChar(LokalStrPol,SizeOf(LokalStrPol),0);
	For a := 1 To MaxPol Do
   Begin
   	For b := 1 to SezHran[a,0] Do
      For c := 1 to 3 Do LokalStrPol[a,c] := LokalStrPol[a,c] + LokalBody[SezHran[a,b],c];
      NasobVek(LokalStrPol[a], 1 / SezHran[a,0]);
   End;
   FillChar(LokalStrObj,SizeOf(LokalStrObj),0);
	For a := 1 To MaxObj Do
   Begin
   	For b := 1 to SezPloch[a,0] Do
      For c := 1 to 3 Do LokalStrObj[a,c] := LokalStrObj[a,c] + LokalStrPol[SezPloch[a,b],c];
      NasobVek(LokalStrObj[a], 1 / SezPloch[a,0]);
   End;
End;



Procedure SeradTeziste; {od nejvzdalenejsiho k nejblizsimu}
Var
	a,b,c:Byte;
	Vzd:Array[1..TvrdyMaxObj] of Single;
	r:Single;
   Vek:Vektor;
Begin
	For a := 1 to MaxObj do
   Begin
   	NovyVek(Vek,StredObj[a],Oko);
		Vzd[a] := SkalSouc(Vek, Vek);
      SerazeneTez[a] := a;
	End;

   For a := 2 To MaxObj Do
	For b := a DownTo 2 do
	IF Vzd[b] > Vzd[b-1] Then
   Begin
   	r := Vzd[b-1];
      Vzd[b-1]:= Vzd[b];
      Vzd[b]  := r;
      c := SerazeneTez[b-1];
      SerazeneTez[b-1] := SerazeneTez[b];
      SerazeneTez[b] := c;
   End Else	Break;
End;



Procedure SmazObjekt;
Begin
	MaxPol := 0;
   MaxObj := 0;
   MaxBod := 0;
End;



Procedure NovePismeno(Ch:Char;dxyz,dy:Byte);
Var
	Pole:Array[0..5,0..7] of Boolean;
   Cisla:Array[0..8,0..8] of Byte;
   Pol,a,x,y:Byte;

	Procedure NoveCislo(x,y:Integer);
	Begin
   	IF Cisla[x,y] <> 0 Then Exit;
      Inc(MaxBod);
      Cisla[x,y] := MaxBod;
      LokalBody[MaxBod, 1] := -Dxyz;
      LokalBody[MaxBod, 2] := (Dy + 4 - x)*Dxyz;
      LokalBody[MaxBod, 3] := (3 - y)*Dxyz;

      Inc(MaxBod);
      LokalBody[MaxBod] := LokalBody[MaxBod-1];
      LokalBody[MaxBod, 1] := Dxyz;
	End;

	Procedure NastavPolygon(x1,x2,x3,x4:Byte);
	Begin
   	Inc(MaxPol);
      SezHran[MaxPol,0] := 4;
      SezHran[MaxPol,1] := x1;
      SezHran[MaxPol,2] := x2;
      SezHran[MaxPol,3] := x3;
      SezHran[MaxPol,4] := x4;
      Inc(Pol);
      SezPloch[MaxObj,Pol] := MaxPol;
	End;
Begin
   For x := 0 To 5 Do
   Begin
   	a := Font68[Ord(Ch),x];
   	For y := 7 DownTo 0 Do
		Begin
	   	IF a And 1 = 1 Then Pole[x,y] := True Else Pole[x,y] := False;
	      a := a Shr 1;
      End;
	End;
	FillChar(Cisla,SizeOf(Cisla),0);
   For x := 0 To 5 Do
   For y := 0 To 7 Do
   Begin
   	IF Pole[x,y] Then
      Begin
      	Pol := 0;
         NoveCislo(x  ,y);
         NoveCislo(x  ,y+1);
         NoveCislo(x+1,y+1);
         NoveCislo(x+1,y);
         Inc(MaxObj);
         NastavPolygon(Cisla[x,y],Cisla[x+1,y],Cisla[x+1,y+1],Cisla[x,y+1]);
         NastavPolygon(Cisla[x,y]+1,Cisla[x,y+1]+1,Cisla[x+1,y+1]+1,Cisla[x+1,y]+1);
         {nahore}
         IF (y = 0) Or Not Pole[x,y-1] Then NastavPolygon(Cisla[x,y],Cisla[x,y]+1,Cisla[x+1,y]+1,Cisla[x+1,y]);
         {dole}
         IF (y = 7) Or Not Pole[x,y+1] Then NastavPolygon(Cisla[x,y+1],Cisla[x+1,y+1],Cisla[x+1,y+1]+1,Cisla[x,y+1]+1);
         {vlevo}
         IF (x = 0) Or Not Pole[x-1,y] Then NastavPolygon(Cisla[x,y],Cisla[x,y+1],Cisla[x,y+1]+1,Cisla[x,y]+1);
         {vpravo}
         IF (x = 5) Or Not Pole[x+1,y] Then NastavPolygon(Cisla[x+1,y],Cisla[x+1,y]+1,Cisla[x+1,y+1]+1,Cisla[x+1,y+1]);
         SezPloch[MaxObj,0] := Pol;
      End;
   End;
   InitLokalTeziste;
   LokalDoABS;
   SeradTeziste; {init}
End;



Procedure LoadObjekt;
Label Konec,ObnovGrafiku;
Var
	Radek,ErrorRadek:String;
	CisloRadku:LongInt;

	Procedure Chyba;
	Begin
	   OutTextXY(0,16,'Chyba pri cteni souboru na radku: ');
		OutInteger(CisloRadku);
      OutText(#13+ErrorRadek);
	   Halt(5);
	End;

	Function Cislo(Ch:Char):Boolean;
	Begin
		Case Ch Of
		   '0','1','2','3','4','5','6','7','8','9','+','-','.',' ','E': Cislo := True;
		   Else Cislo := False;
	   End;
	End;

	Function OrezCislo:String;
	Label Konec;
	Var
		S:String;
	   Ch:Char;
		a:Byte;
	Begin
		S := '';
		For a := 1 To Length(Radek) Do
	   Begin
         Ch := Radek[1];
	      Delete(Radek,1,1);
	   	IF Not Cislo(Ch) Then Begin IF Length(S) > 0 Then Goto Konec; End
	      Else IF Ch <> ' ' Then S := S + Ch;
	   End;
	Konec:
	   OrezCislo := S;
	End;

	Function CtiSingle:Single;
	Var
		Code:Integer;
		R:Single;
	Begin
	   Val(OrezCislo,R,Code);
	   If Code <> 0 then Chyba;
	   CtiSingle := R;
	End;
Type
	TypFaze=(Baze,Body,Polygony,Objekty);
Var
	F:Text;
	a,Sum,b:Byte;
	Jmeno:String;
   Faze:TypFaze;
Begin
   Adresa13 := AdrA000;
   FontFlags := 1;
	OutTextXY(0,0,'Otevri soubor s priponou 3do!');
   Jmeno := Norton;
   IF Esc Then Goto ObnovGrafiku;
   Assign(F, Jmeno);
   FileMode := 0;
   Reset(F);
   Faze := Baze;
   CisloRadku := 1;
   MaxObj := 0;
   While Not Eof(F) Do
   Begin
      ReadLn(F, Radek);
      ErrorRadek := Radek;
      For a := 1 to Length(Radek) do Radek[a] := UpCase(Radek[a]);
      While Pos('{',Radek) <> 0 Do
      Begin
         IF Pos('}',Radek) = 0 then Chyba;
         Delete(Radek,Pos('{',Radek),Pos('}',Radek) - Pos('{',Radek) + 1);
      End;
{Baze}
      IF Pos('SUM',Radek) = 0 Then
      Begin
	      IF Pos('I',Radek) > 0 Then For a := 1 to 3 do BazeObj[1,a] := CtiSingle;
	      IF Pos('J',Radek) > 0 Then For a := 1 to 3 do BazeObj[2,a] := CtiSingle;
	      IF Pos('K',Radek) > 0 Then For a := 1 to 3 do BazeObj[3,a] := CtiSingle;
	      IF Pos('S',Radek) > 0 Then For a := 1 to 3 do StredLokal[a] := CtiSingle;
      End;
{Body}
      IF Pos('SUMBODU',Radek) > 0 Then
      Begin
         MaxBod := Trunc(CtiSingle);
         IF MaxBod > TvrdyMaxBod Then Chyba;
         Faze := Body;
         Sum := 1;
      End;
      IF (Faze = Body) And (Pos('(',Radek) > 0) Then
      Begin
         IF Sum > TvrdyMaxBod Then Chyba;
         For a := 1 to 3 do LokalBody[Sum,a] := CtiSingle;
         Inc(Sum);
      End;
{Polygony}
      IF Pos('SUMPLOCH',Radek) > 0 Then
      Begin
         MaxPol := Trunc(CtiSingle);
         IF MaxPol > TvrdyMaxPol Then Chyba;
         Faze := Polygony;
         Sum := 1;
      End;
      IF (Faze = Polygony) And (Pos('(',Radek) > 0) Then
      Begin
      	IF Sum > TvrdyMaxPol Then Chyba;
         For a := 1 to TvrdyMaxHran do
         Begin
            b := Trunc(CtiSingle);
            IF a > 1 Then IF b = SezHran[Sum,1] Then
            Begin
               Dec(a);
					Break;
            End;
            SezHran[Sum,a] := b;
         End;
         SezHran[Sum,0] := a;
         Inc(Sum);
      End;
{Objekty}
      IF Pos('SUMPODCASTI',Radek) > 0 Then
      Begin
         MaxObj := Trunc(CtiSingle);
         IF MaxObj > TvrdyMaxObj Then Chyba;
         Faze := Objekty;
         Sum := 1;
      End;
      IF (Faze = Objekty) And (Pos('(',Radek) > 0) Then
      Begin
      	IF Sum > TvrdyMaxObj Then Chyba;
         For a := 1 to TvrdyMaxPloch do
         Begin
            b := Trunc(CtiSingle);
            IF a > 1 Then IF b = SezPloch[Sum,1] Then
            Begin
               Dec(a);
					Break;
            End;
            SezPloch[Sum,a] := b;
         End;
         SezPloch[Sum,0] := a;
         Inc(Sum);
      End;
{End}
      IF Pos('END',Radek) > 0 Then Goto Konec;
      Inc(CisloRadku);
   End;
Konec:
   Close(F);
   FileMode := 2;
   IF MaxObj = 0 Then
   Begin
   	MaxObj := 1;
      SezPloch[1,0] := MaxPol;
      For a := 1 To MaxPol Do SezPloch[1,a] := a;
   End;
   InitLokalTeziste;
   LokalDoABS;
   SeradTeziste; {init}
ObnovGrafiku:
   Adresa13 := AdrOkna;
   FontFlags := 0;
End;



Procedure Pocitej2D;
Var
   a:Integer;
   x:Single;
	D:Vektor;
Begin
   FOR a := 1 TO MaxBod do
   Begin
      NovyVek(D, Body[a], Oko);
      {x ...x-sova souradnice 3D Bodu v soustave BAZE OKA
       x = |Dxyz|*cos(Fi) = 1*|dxyz|*cos(Fi) = Dxyz*BazeOka[1]
		 Kdyz x = 0 tak Bod lezi v rovine oka
		 Kdyz x < 0 tak Bod je "za" okem}
      x := SkalSouc(BazeOka[1], D);
      IF x <= 0 THEN Obr[a].JeVidet := False
      ELSE
      Begin
         Obr[a].JeVidet := True;
         {(Oko..Bod)/x = (Oko..Prusecik)/BazeOka[1]
          (Oko..Bod)/x = (Oko..Prusecik)}
         x := 1 / x;
         {vektor Dxyz smeruje z Oka do Pruseciku(s rovinou obrazovky)}
         NasobVek(D, x);
         x := Xpul - MeritkoX * SkalSouc(BazeOka[2], D);
         IF Abs(x) > 20000 THEN
         Begin
				Obr[a].JeVidet := False;
            Continue;
         End;
			Obr[a].Sour.x := Round(x);
         x := Ypul - MeritkoY * SkalSouc(BazeOka[3], D);
         IF Abs(x) > 20000 THEN
         Begin
				Obr[a].JeVidet := False;
            Continue;
         End;
         Obr[a].Sour.y := Round(x);
      End;
   End;
End;



Procedure OtocBazi(var Baze:TypBaze;Od,K,Uhel:Byte);
Begin
  Baze[Od,1] := Baze[Od,1] * ctab[Uhel] + Baze[K,1] * stab[Uhel];
  Baze[Od,2] := Baze[Od,2] * ctab[Uhel] + Baze[K,2] * stab[Uhel];
  Baze[Od,3] := Baze[Od,3] * ctab[Uhel] + Baze[K,3] * stab[Uhel];
  VektSouc(Baze[K],Baze[K Mod 3 + 1],Baze[6-K-(K Mod 3 + 1)]);
End;



Procedure PohybOka;

Procedure PosunOka(a,b:ShortInt);
Begin
   Oko[1] := Oko[1] + BazeOka[a,1] * posun * b;
   Oko[2] := Oko[2] + BazeOka[a,2] * posun * b;
   Oko[3] := Oko[3] + BazeOka[a,3] * posun * b;
End;

begin
   {proti smeru hodinovych rucicek}
   IF (roz = ',') OR (roz = '<') THEN OtocBazi(BazeOka,3,2,Posun);

	{po smeru hodinovych rucicek}
   IF (roz = '.') OR (roz = '>') THEN OtocBazi(BazeOka,2,3,Posun);

   {dopredu} IF roz = '+' THEN PosunOka(1,1);
   {dozadu}  IF roz = '-' THEN PosunOka(1,-1);
   IF Roz[1] = #0 Then
   Case Roz[2] of
{nahoru}       'H': OtocBazi(BazeOka,3,1,Posun);
{dolu}         'P': OtocBazi(BazeOka,1,3,Posun);
{doleva}       'K': OtocBazi(BazeOka,1,2,Posun);
{doprava}      'M': OtocBazi(BazeOka,2,1,Posun);
{ukrok vlevo}  's': PosunOka(2,1);
{ukrok vpravo} 't': PosunOka(2,-1);
{ukrok nahoru} 'I': PosunOka(3,1);
{ukrok dolu}   'Q': PosunOka(3,-1);
	End; {case}
End;


Procedure Info;
Begin
   Color13  := 64;
   Adresa13 := AdrA000;
   ClearDevice;
   OutTextXY(1,1,'OVLADANI'#13);
   OutText(#24','#25','#26','#27',<,> ...otaceni baze'#13);
	OutText('+,-,Ctrl & '#26',Ctrl & '#27',PUp,PDown ...posun baze'#13);
   OutText('F1 ...tato napoveda'#13);
   OutText('F2,Alt + F2 ...+,- min. doby cyklu v 0.055 s'#13);
   OutText('F3 ...prepinac pohybu objektu'#13);
   OutText('F4 ...prepinac simulace ohne'#13);
   OutText('F5 ...prepinac rotace objektu'#13);
   OutText('F6 ...prepinac vyplne polygonu'#13);
   OutText('F7 ...prepinac stinovani'#13);
   OutText('F8 ...nahraje jiny objekt (*.3do)'#13);
   OutText('Alt + R,G,B ...prepinac slozek barvy'#13);
   OutText('Alt + 1..9 ...velikost otoceni a posunu'#13);
   OutText('? ...zobrazi znak ve 3D'#13);
	OutText('Esc ...konec'#13);

   OutText(#13'Konstanty 3do souboru');
   OutText(#13'MaxBodu     = ');    OutInteger(TvrdyMaxBod);
   OutText(#13'MaxPloch    = ');    OutInteger(TvrdyMaxPol);
   OutText(', MaxHran v plose = '); OutInteger(TvrdyMaxHran);

   OutText(#13'MaxPodcasti = ');    OutInteger(TvrdyMaxObj);
   OutText(', MaxPloch v pod. = '); OutInteger(TvrdyMaxPloch);

   Adresa13 := AdrOkna;
   Pause;
End;



Procedure KresliDoSchranky;
Var
	a,b,c,d:Integer;
   JeVidet:Boolean;
   r:Single;
   Vek:Vektor;
Begin
   IF Vypln Then SeradTeziste;
   Pocitej2D;
	For c := 1 to MaxObj Do
   For d := 1 to SezPloch[SerazeneTez[c],0] do
   begin
   	a := SezPloch[SerazeneTez[c],d];
      JeVidet := True;
      FOR b := 1 to SezHran[a,0] do
      Begin
      	IF Not Obr[SezHran[a,b]].JeVidet Then JeVidet := False;
         Polygon[b] := Obr[SezHran[a,b]].Sour;
      End;
      IF JeVidet then
      Begin
         NovyVek(Vek,StredPol[a],Oko);
         IF Stin Then Jednotkovy(Vek);
         r := SkalSouc(Kolmy[a], Vek);
         IF r < 0 Then Continue;
         IF Stin Then Color13 := 64 + 85 - Trunc(r*85) Else Color13 := 56 + ((a - 1) Mod 11) Shl 3;
         IF Vypln Then FillPoly(SezHran[a,0],Polygon)
         Else DrawPoly(SezHran[a,0],Polygon);
      End;
   End;
{PutPixel(Obr[MaxBod].Sour.x  ,Obr[MaxBod].Sour.y,55);
PutPixel(Obr[MaxBod-1].Sour.x,Obr[MaxBod-1].Sour.y,55);}
End;



Procedure PohybObjektu;
Var
	Vek:Vektor;
Begin
   IF MaxPol = 0 then Exit;
	IF Rotace Then
	Begin
   {po smeru hodinovych rucicek}
	   OtocBazi(BazeObj,2,3,1);
   {nahoru}
	   OtocBazi(BazeObj,3,1,2);
   {doprava}
	   OtocBazi(BazeObj,2,1,3);
   End;
	IF Pohyb Then
	Begin
   {proti smeru hodinovych rucicek}
	   OtocBazi(BazeStr,2,3,3);
   {dolu}
	   OtocBazi(BazeStr,1,3,2);
   {doleva}
	   OtocBazi(BazeStr,1,2,1);
	End;
   LokalDoAbs;
End;


Procedure PisString(S:String);
Var
	a,b:Byte;
   T:LongInt;
Begin
	For a := 1 To Length(S) Do
   Begin
     	SmazObjekt;
      NovePismeno(S[a],9,0);
      Vypln := True;
      For b := 0 To 106 Do
      Begin
      	T := PTime^;
         IF b > 52 Then Vypln := False;
	      ClearDevice;
	      PohybObjektu;
	      KresliDoSchranky;
	      CopyPole13(AdrOkna,AdrA000);
      	IF KeyPressed Then Exit;
         While PTime^ = T Do;
      End;
   End;
End;




Var
   T:LongInt;
   {cas}
   a,b  :Integer;
Begin
   {cas}
   PTime    := Ptr(Seg0040,$006c);
   Secti(#13#10);
   Secti(#9#9'ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿'#13#10);
   Secti(#9#9'³ GET OUT OF MY CODE, YOU SILLY MOTHERFUCKER! ³'#13#10);
   Secti(#9#9'³        Baruk Khazƒd! Khazƒd ai-mˆnu!        ³'#13#10);
   Secti(#9#9'ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ'#13#10);
   IF Je <> MaByt Then Halt;

   Cesta:=FExpand('.');
   IF Cesta[Length(Cesta)] <> '\' then Cesta := Cesta + '\';


	Asm {rychle opakovani dlouho(nastaveno na kratce) stiskle klavesy}
		mov	ax,$0305
	   mov	bx,$0000
		int	16h
	End;
   Zvyrazni[1]  := '.3do';
   InitGraph;
   AdrOkna := AlokujPole13;
   InitPalRGB(Red,Green,Blue);
   Adresa13 := AdrOkna;
   AdrA000 := Ptr(SegA000,0);
	PisString('Ogion@centrum.cz');
   Vypln := False;
   Stin  := False;
   LoadObjekt;

   Info;
   {'>>> Baruk Khazƒd! Khazƒd ai-mˆnu! 30.12.1996, 23.4.1998, 21.4.1999<<<'}

   ClearDevice;
   LokalDoABS;
   Repeat
      PohybObjektu;
      IF Not Ohen Then ClearDevice;

      KresliDoSchranky;

      Color13 := 64;

      CIRCLE(15, 10, 9,False);
      a := 15 - Trunc(10 * BazeOka[1,2]);
      b := 10 - Trunc(9  * BazeOka[1,1]);
      LINE (15, 10, a,b);

      CIRCLE(15, 29, 9,False);
      a := Trunc(10 * Sqrt(ABS(1 - BazeOka[1,3] * BazeOka[1,3])));
      IF BazeOka[3,3] < 0 THEN a := -a;
      a := 15 + a;
      b := 29 - trunc(9 * BazeOka[1,3]);
      LINE (15, 29, a,b);

      IF Ohen Then Rozmazni;
      LocateFont.y := 15;
      LocateFont.X := 30;
      While PTime^ < T + Cekej Do IF KeyPressed Then Break;
      OutInteger(PTime^-t); {}

      T := PTime^;
      LocateFont.x := 30;
      LocateFont.y := 25;
      OutInteger(Cekej);    {}
      If Red  = 30 Then OutTextXY(30,5,'r') Else IF Red  = 60 Then OutTextXY(30,5,'R');
      If Green= 30 Then OutTextXY(38,5,'g') Else IF Green= 60 Then OutTextXY(38,5,'G');
		If Blue = 30 Then OutTextXY(46,5,'b') Else IF Blue = 60 Then OutTextXY(46,5,'B');

      CopyPole13(AdrOkna,AdrA000);

      IF KeyPressed Then
      Begin
         Roz := ReadKey;
         IF Roz = #0 then Roz := Roz + ReadKey;
      End
      Else Roz := #255;

      IF Roz = #27 THEN
      Begin
         CloseGraph;
         Halt;
      End;

{F1}  IF Roz = #0#59 Then Info;

{F2}  IF (Roz = #0#60) AND (Cekej < 9) Then Cekej := Cekej + 1;

{Alt+F2}
		IF (Roz = #0#105) AND (Cekej > 0) Then Cekej := Cekej - 1;

{F3}  IF Roz = #0#61 Then Pohyb := Not Pohyb;

{F4}  IF Roz = #0#62 Then Ohen := Not Ohen;

{F5}  IF Roz = #0#63 Then Rotace := Not Rotace;

{F6}  IF Roz = #0#64 Then Vypln := Not Vypln;

{F7}  IF Roz = #0#65 Then Stin := Not Stin;

{F8}  IF Roz = #0#66 Then LoadObjekt;

{Alt + 1..9}
		IF Roz[1] = #0 Then
      For a := 1 To 9 do
		IF Ord(Roz[2]) = 119 + a Then
      Begin
         c5 := cTab[a];
         s5 := sTab[a];
         Posun := a;
      End;

      IF Roz = #0#19 Then Red   := (Red  + 30) Mod 90;
      IF Roz = #0#34 Then Green := (Green+ 30) Mod 90;
      IF Roz = #0#48 Then Blue  := (Blue + 30) Mod 90;
      IF (Roz = #0#19) OR (Roz = #0#34) OR (Roz = #0#48) Then
      IF (Red = 60) And (Green = 60) And (Blue = 60) Then InitPalSPEKTRUM
		Else InitPalRGB(Red,Green,Blue);

      Case Roz[1] Of
	      #0,#255,#32,'+','-',',','.':;
	      Else
	      Begin
	      	SmazObjekt;
	         NovePismeno(Roz[1],5,0);
	      End;
      End;

      PohybOka;
   Until False;
End.