Analytics geometry in plane

Delphi & Pascal (česká wiki)
Přejít na: navigace, hledání
Category: Homework in Pascal

Program: Angeom02.pas

Pascal unit (Unit) AnGeom02 - algebraic geometry includes functions for display and calculation of various graphics primitives like point, line, straight line. 
(* Prerábky na školský rok 2003/2004
 * 1. Do TPolygon dat usecky namiesto bodov a vektorov (pokryva!)
 * 2. Adekvátne prerobit PointSet, fCheck, ...
 * 3. Dat Print ako (virtualnu) metodu do kazdeho objektu
 * 4. Dorobit hlasenie chyb, rezim bDialog, ...
 *)
 
UNIT  AnGeom02; { Analytická geometria v rovine - }
                { zápočtový projekt z Programovania II }
                { Borsuk  So 2003/06/28 14:41  V001 }
 
INTERFACE
 
USES   Crt, UnInOut, Graph;
 
{----- Pomocné funkcie pre debug -----}
FUNCTION sRn( r: Real ):    String; { Výpis reálneho čísla vo formáte :5:4 }
FUNCTION sNn( n: Integer ): String; { Výpis celého čísla vo formáte :4 }
FUNCTION sAn( g: Real ):    String; { Výpis uhla -prevod z Rad do Deg }
FUNCTION sBn( b: Boolean):  String; { Výpis Booleovskej hodnoty }
 
 
{---------------------  Základný objekt TBaseObj ---------------------}
TYPE  TString16 = String[16];
 
      PBaseObj = ^TBaseObj;
      TBaseObj = OBJECT
        {PRIVATE}
        bYnit:    Boolean;
        InstName: TString16;
 
        PUBLIC
        FUNCTION fYnit: Boolean;
        FUNCTION fInstName: TString16;
        CONSTRUCTOR Fail( name: TString16 );
      END; { TBaseObj }
 
      PError = ^TError;
      TError = OBJECT     { Chybové hlásenie }
        ErrPred, ErrSucc: PError;
        ErrNum:   Integer;   { 0=OK, inak číslo chyby }
        ErrTxt:   String;    { Text chybovej hlášky }
        ErrTime:  LongInt;   { Packed Time podania chybovej hlášky }
        ErrTypeN: TString16; { Meno typu objektu }
        ErrInstN: TString16; { Meno inštancie objektu, ktorá poslala správu }
      END; { TError }
 
      PMessage = ^TMessage;
      TMessage = OBJECT   { Oznam o zvláštnej situácii }
        MsgPred, MsgSucc: PMessage;
 
        MsgNum:   Integer;   { 0=OK, inak číslo chyby }
        MsgTxt:   String;    { Text chybovej hlášky }
        MsgTime:  LongInt;   { Packed Time podania chybovej hlášky }
        MsgTypeN: TString16; { Meno typu objektu }
        MsgInstN: TString16; { Meno inštancie objektu, ktorá poslala správu }
      END; { TMessage }
 
  PROCEDURE Error( vErrNum: Integer; vErrTxt: String;
                   vErrTypeN, vErrInstN: TString16 );
 
  PROCEDURE Message( vMsgNum: Integer; vMsgTxt: String;
                     vMsgTypeN, vMsgInstN: TString16 );
 
  FUNCTION  ArcCos(x: Real): Real;
  FUNCTION  ArcSin(x: Real): Real;
 
(* * * * * * * * * * *  V e c i   p r e   G r a p h  * * * * * * * * * * *)
VAR GraphDriver, GraphMode: Integer;
    { Kreslíme akoze v prvom kvadrante, trosicku posunutom }
    { Napriklad pre rozlisenie 640 * 480 by bola }
    { os X vzdialena od laveho kraja obrazovky 64 pixelov }
    { Podobne aj pre os Y, ale svojim Pappenheimskym to aj otocime }
    { ako su zvyknuti. }
    GrOffsetX, GrOffsetY: Integer;
    { Skutocne rozlisenie, zistene pri InitGraph }
    GrMaxX, GrMaxY: Integer;
 
  { Prevod Reálnych súradníc do grafickych Integerov }
  FUNCTION GrX( x: Real ): Integer;
  FUNCTION GrY( y: Real ): Integer;
  PROCEDURE GrAxis; { Vykreslenie kvázi osí }
 
(* * * * * * * *  V e c i   p r e   G e o m e t r i u  * * * * * * * * * *)
CONST  Pi2 = Pi/2.0;  Pi3 = Pi/3.0;  Pi4 = Pi/4.0;  DvaPi = Pi + Pi;
 
  FUNCTION fStrR( vr: Real ): String;
  FUNCTION fStrI( vi: Integer ): String;
 
 
TYPE  PPoint = ^TPoint; { Bod }
      TPoint = OBJECT (TBaseObj)
        {PRIVATE} { Aby sa nám tam user nedostal unfair spôsobom }
        ox, oy: Real;  { Súradnice bodu v rovine }
 
        PUBLIC { Sem sa dostať môže, ba priam musí }
        CONSTRUCTOR Init( vx, vy: Real; vInstName: TString16 );
        FUNCTION fx: Real;
        FUNCTION fy: Real;
        PROCEDURE Draw( color: Word; pict: Char );
      END; { TPoint }
 
      { Kvôli dynamickému prideľovaniu miesta pre vektor vrcholov polygónu }
      DPoint = ^APoint;
      APoint = ARRAY [ Byte ] OF TPoint;
 
      { Vektor ako predchodca usecky a priamky }
      PVector = ^TVector;
      TVector = OBJECT (TBaseObj)
        wx, wy: Real; { "Koncové" súradnice vektora }
 
        PUBLIC
        CONSTRUCTOR Init( vx, vy: Real;   vInstName: TString16 );
 
        FUNCTION   Size: Real;
        PROCEDURE  Unify; { Prerobi svoj vektor (Self) na jednotkovy }
        PROCEDURE  Draw( color: Word; vpb: TPoint );
      END; { TVector }
 
      PLine = ^TLine; { Priamka }
      TLine = OBJECT  (TVector)
        {PRIVATE}
        ob: TPoint; { Začiatočný bod priamky a najmä úsečky }
        a, b, c: Real;
 
        PUBLIC
        CONSTRUCTOR Init_kq( vk, vq: Real; vInstName: TString16  );
        CONSTRUCTOR Init_x0( x0: Real; vInstName: TString16 );
        CONSTRUCTOR Init_PV( vo: TPoint; vw: TVector; vInstName: TString16 );
        CONSTRUCTOR Init_PP( vb, ve: TPoint; vInstName: TString16 );
 
        FUNCTION fa: Real;
        FUNCTION fb: Real;
        FUNCTION fc: Real;
        PROCEDURE Draw( color: Word );
      END; { TLine }
 
      PAbscissa = ^TAbscissa; { Úsečka }
      TAbscissa = OBJECT  (TLine)
        {PRIVATE}
        {ob, } oe: TPoint; { (Začiatočný a ) koncový bod úsečky }
 
        PUBLIC
        { Vytvorenie úsečky z koncových bodov }
        CONSTRUCTOR Init_pp( vpb, vpe: TPoint; vInstName: TString16 );
        { Vytvorenie úsečky zo začiatočného bodu a vektora }
        CONSTRUCTOR Init_pv( vpb: TPoint; vv: TVector;
                             vInstName: TString16 );
        { Os usecky }
        PROCEDURE Axis( VAR pLyne: PLine; vInstName: TString16 );
        PROCEDURE Draw( color: Word );
      END; { TAbscissa }
 
      DVector = ^AVector;
      AVector = ARRAY [ Byte ] OF TVector;
 
      { Kvôli dynamickému prideľovaniu miesta pre vektor vrcholov polygónu }
      PArAbscissa = ^ArAbscissa;
       ArAbscissa = ARRAY [ Byte ] OF TAbscissa;
 
      PCircle = ^TCircle; { Kružňyca }
      TCircle = OBJECT  (TBaseObj)
        {PRIVATE}
        o: TPoint; { Stred }
        r: Real;   { Polomer }
 
        PUBLIC
        CONSTRUCTOR Init_pr( vp: TPoint; vr: Real; vInstName: TString16 );
        PROCEDURE Draw( color: Word );
      END; { TCircle }
 
      PPolygon = ^TPolygon; { Mnohouholník }
      TPolygon = OBJECT  (TBaseObj)
        {PRIVATE}
        n: Byte; { Počet vrcholov, očíslovaných 1..n }
                 { a ešte nultý vrchol, zhodný s n-tým vrcholom }
        IsConvex:  Boolean; { Je mnohouholník konvexný? }
        ClockWise: Boolean; { Ako je orientovaná krivka? }
 
        PUBLIC
        a: PArAbscissa;
 
        CONSTRUCTOR Init( vn: Byte; vInstName: TString16 );
        DESTRUCTOR Done;
        FUNCTION fn: Byte;
        FUNCTION fCheck: Boolean;
 
        PROCEDURE PointSet   ( vi: Byte; vx, vy: Real );
        PROCEDURE GetPoint   ( vi: Byte; VAR rp: TPoint );
        PROCEDURE GetAbscissa( vi: Byte; VAR ra: TAbscissa );
        PROCEDURE Draw ( color: Word ); virtual; { bezne vykreslenie }
        PROCEDURE DrawL( colorA, colorL: Word ); virtual;
      END; { TPolygon }
 
  { Priesecník dvoch priamok (if any) }
  PROCEDURE  InterSection_LL( lyne1, lyne2: TLine;
                              var pCross: PPoint; name: TString16 );
 
  { Vzdialenosti }
  FUNCTION Distance_PP( pb, pe: TPoint ): Real;
 
  FUNCTION Distance_LP( Lyne: TLine; Point: TPoint ): Real;
 
  FUNCTION Distance_LL( Line1, Line2: TLine ): Real;
 
  FUNCTION Distance_AA( a1, a2: TAbscissa ): Real;
 
  FUNCTION Distance_AP( a: TAbscissa; Point: TPoint ): Real;
 
  { Uhly a ich osi }
  PROCEDURE Rotate( vSrc: TVector; vAngle: Real;
                    var pDst: PVector; vInstName: TString16 );
 
  FUNCTION Angle_VV( vector1, vector2: TVector ): Real;
 
  PROCEDURE AngleAxis_VV( vector1, vector2: TVector; point: TPoint;
                      var pAxis: PLine; vInstName: TString16 );
 
{ Debugovacie funkcie }
  procedure PrVe( w: TVector;   cUsm: String; color: Word ); { Print Vector  }
  procedure PrLn( L: Tline;     cUsm: String; color: Word ); { Print Line    }
  procedure PrPn( B: TPoint;    cUsm: String; color: Word ); { Draw  Point   }
  procedure PrCi( c: TCircle;   cUsm: String; color: Word ); { Print Circle  }
  procedure PrAb( A: TAbscissa; cUsm: String; color: Word ); { Print Abscissa }
  procedure PrPl( M: TPolygon;  cUsm: String; color: Word ); { Print Polygon }
 
  VAR  aAxisX, aAxisY: TAbscissa; { Mohli by to byt konstanty, keby ... }
       oOrigin: TPoint;
 
IMPLEMENTATION
 
  FUNCTION  ArcSin(x: Real): Real;
  BEGIN
    IF ( Abs(Abs(x) - 1.0) > 1.0E-12 )
    THEN  ArcSin := ArcTan ( x/sqrt(1-sqr(x)) )
      ELSE
        IF (x > 0.0)
        THEN ArcSin :=  Pi/2.0
        ELSE ArcSin := -Pi/2.0;
  END; { ArcSin }
 
  FUNCTION  ArcCos(x: Real): Real;
  VAR c: Real;
  BEGIN
    IF ( Abs(x) < 1.0E-9 )
    THEN c := Pi/2.0
    ELSE
    BEGIN
      IF ( x < (1.0E-9 - 1.0) )
      THEN c := Pi
      ELSE
      BEGIN
        c := ArcTan (sqrt (1-sqr (x)) /x);
        IF (c < 0.0) THEN c := Pi + c;
      END;
    END;
      ArcCos := c;
  END; { ArcCos }
 
{---------------------- Base, Error, Message  -------------------------}
  FUNCTION TBaseObj.fYnit: Boolean;
  BEGIN
    fYnit := bYnit;
  END; { TBaseObj.fYnit }
 
  FUNCTION TBaseObj.fInstName: TString16;
  BEGIN
    fInstName := InstName;
  END; { TBaseObj.fInstName }
 
  CONSTRUCTOR TBaseObj.Fail( name: TString16 );
  BEGIN
    bYnit := False;
    InstName := name;
  END; { TBaseObj.Fail }
 
  PROCEDURE Error( vErrNum: Integer; vErrTxt: String;
                   vErrTypeN, vErrInstN: TString16 );
  BEGIN
  END; { Error }
 
  PROCEDURE Message( vMsgNum: Integer; vMsgTxt: String;
                     vMsgTypeN, vMsgInstN: TString16 );
  BEGIN
  END; { Messsage }
 
  FUNCTION fStrR( vr: Real ): String;
  VAR  s: String;
  BEGIN  Str( vr, s );  fStrR := s;  END; { fStrR }
 
  FUNCTION fStrI( vi: Integer ): String;
  VAR  s: String;
  BEGIN  Str( vi, s );  fStrI := s;  END; { fStrI }
 
  {----------------------- Veci pre grafiku ---------------------------}
  FUNCTION GrX( x: Real ): Integer;
  BEGIN  GrX := Trunc(x) + GrOffsetX;  END; { GrX }
 
  FUNCTION GrY( y: Real ): Integer;
  BEGIN  GrY := GrMAxY - GrOffsetY - Trunc(y);  END; { GrY }
 
  PROCEDURE GrAxis; { Vykreslenie kvázi osí }
  CONST Krok = 50;
  VAR   farba: Word; x, y: Word;
  BEGIN
    { Vykreslíme pravítko "pod osu X" }
    MoveTo( 0, GrMaxY-1 ); { Začiatok "študentovej súradnicovej sústavy" }
    SetColor( EgaBlue ); { Záporná cast osi X }
    LineTo( GrOffsetX, GrMaxY-1 );
 
    farba := EgaRed; x := GrOffsetX;
    WHILE (x < GrMaxX) DO
    BEGIN
      IF (farba = EgaRed)
      THEN  farba := EgaWhite
      ELSE  farba := EgaRed;
      x := x + Krok;  SetColor(farba);  LineTo( x, GrMaxY - 1 );
    END; { WHILE }
 
    { Vykreslíme pravítko "vlavo od osi Y" }
    MoveTo( 0, GrMaxY-1 ); { Začiatok "študentovej súradnicovej sústavy" }
    SetColor( EgaBlue ); { Záporná cast osi Y }
    LineTo( 0, GrMaxY-GrOffsetY );
 
    farba := EgaRed; y := GrMaxY - GrOffsetY;
    WHILE (y < GrMaxY) DO
    BEGIN
      IF (farba = EgaRed)
      THEN  farba := EgaWhite
      ELSE  farba := EgaRed;
      y := y - Krok;  SetColor(farba);  LineTo( 0, y );
    END; { WHILE }
    { Vykreslíme os X }
    SetColor( EgaBlue );
    Line( 0, GrMaxY - GrOffsetY,   GrMaxX, GrMaxY - GrOffsetY );
    { Vykreslíme os Y }
    Line( GrOffsetX, 0,  GrOffsetX, GrMaxY );
  END; { GrAxis }
 
  { DEBUG: Formatovane vypisy realnych a celych cisel }
  FUNCTION sRn( r: Real ): String;
  CONST  MaxW = 5;  MaxD = 4;
  VAR sR: String;
  BEGIN
    Str( r:MaxW:MaxD, sR );
    IF  ( Length(sR) > MaxW+MaxD )   THEN  sR := '*' + sR;
    WHILE  ( Length(sR) < MaxW+MaxD )  DO  sR := ' ' + sR;
    sRn := sR
  END;  { sRn }
 
  FUNCTION sNn( n: Integer ): String;
  CONST MaxLen = 4;
  VAR sN: String;
  BEGIN
    Str( n:4, sN );
    IF  ( Length(sN) > MaxLen )  THEN   sN := '*' + sN;
    WHILE  ( Length(sN) < MaxLen )  DO  sN := ' ' + sN;
    sNn := sN;
  END;  { sNn }
 
  FUNCTION sAn( g: Real ): String; { Vypis uhla -prevod z Rad do Deg }
  BEGIN
    sAn := sNn( Trunc(g * 180.0/Pi) );
  END; { sAn }
 
  FUNCTION sBn( b: Boolean): String;  { Vypis Booleovskej hodnoty }
  BEGIN
    IF (b)
    THEN sBn := 'True '
    ELSE sBn := 'False';
  END; { sBn }
 
  { Všeobecné procedúry, ktoré nemôžu byť metódami, }
  { jelikož divoko referencujú "krížom-krážom forward" }
 
  { Sú dva vektory kolineárne (rovnobežné)? }
  FUNCTION bColin_vv( vwA, vwB: TVector ): Boolean;
  BEGIN
  END; { bColin_vv }
 
  {------------------------ TPoint ---------------------------------}
 
  CONSTRUCTOR TPoint.Init( vx, vy: Real; vInstName: TString16 );
  BEGIN
    bYnit := True;  InstName := vInstName;
    ox := vx;  oy := vy;
  END; { TPoint.Init }
 
  FUNCTION TPoint.fx: Real;
  BEGIN
    fx := ox; { Takto zabezpečíme, že to pre usera bude ReadOnly }
  END; { TPoint.fx }
 
  FUNCTION TPoint.fy: Real;
  BEGIN
    fy := oy;
  END; { TPoint.fy }
 
  PROCEDURE TPoint.Draw( color: Word; pict: Char );
    PROCEDURE  Plus;
    BEGIN
      PutPixel( GrX(ox),   GrY(oy),   color );
      PutPixel( GrX(ox-1), GrY(oy),   color );
      PutPixel( GrX(ox+1), GrY(oy),   color );
      PutPixel( GrX(ox),   GrY(oy-1), color );
      PutPixel( GrX(ox),   GrY(oy+1), color );
    END; { Plus }
 
    PROCEDURE Krat;
    BEGIN
      PutPixel( GrX(ox),   GrY(oy),   color );
      PutPixel( GrX(ox-1), GrY(oy-1), color );
      PutPixel( GrX(ox+1), GrY(oy+1), color );
      PutPixel( GrX(ox+1), GrY(oy-1), color );
      PutPixel( GrX(ox-1), GrY(oy+1), color );
    END; { Krat }
 
  BEGIN { TPoint.Draw }
    CASE  pict  OF
      '+': Plus;
 
      'x', 'X': Krat;
 
      '*': BEGIN Plus; Krat; END; { BREAK  }
 
      ELSE PutPixel( GrX(ox), GrY(oy), color );
    END;  { CASE }
  END; { TPoint.Draw }
 
  {--------------------------- TLine ------------------------------}
 
  CONSTRUCTOR TLine.Init_kq( vk, vq: Real; vInstName: TString16  );
  BEGIN
    bYnit := True;  InstName := vInstName;
    a := vk;  b := -1.0;  c := vq;
    wx := 0.0;  wy := vq;
  END; { TLine.Init_kq }
 
  CONSTRUCTOR TLine.Init_PP( vb, ve: TPoint; vInstName: TString16 );
  BEGIN
    bYnit := True;  InstName := vInstName;
    wx := ve.ox - vb.ox;  wy := ve.oy - vb.oy;
    ob.ox := vb.ox;  ob.oy := vb.oy;
    IF (wx <> 0.0)
    THEN
    BEGIN
      a := wy/wx;  b := -1.0;  c := ob.oy - a*ob.ox;
    END
    ELSE
    BEGIN
      a := -1.0;  b := 0.0;  c := ob.ox;
    END;
  END; { TLine.Init_PP }
 
  CONSTRUCTOR TLine.Init_PV( vo: TPoint; vw: TVector; vInstName: TString16 );
  BEGIN
    Self.InstName := vInstName;
    Self.wx    := vw.wx;  Self.wy    := vw.wy;
    Self.ob.ox := vo.ox;  Self.ob.oy := vo.oy;
    IF (Self.wx <> 0.0)
    THEN { priamka nie je rovnobezna s osou Y }
    BEGIN
      Self.a := Self.wy / Self.wx;  Self.b := -1.0;
      Self.c := vo.oy - Self.a * vo.ox;
    END
    ELSE { priamka je rovnobezna s osou Y }
    BEGIN
      Self.a := -1.0;  Self.b := 0.0;  Self.c := vo.ox;
    END; { IF }
  END; { TLine.Init_PV }
 
  CONSTRUCTOR TLine.Init_x0( x0: Real; vInstName: TString16  );
  BEGIN
    bYnit := True;  InstName := vInstName;
    a := -1.0;  b := 0.0;  c := x0;
    wx := x0;  wy := 1.0;
  END; { TLine.Init_x0 }
 
  FUNCTION TLine.fa: Real;
  BEGIN  fa := a;  END; { TLine.fa }
 
  FUNCTION TLine.fb: Real;
  BEGIN  fb := b;  END; { TLine.fb }
 
  FUNCTION TLine.fc: Real;
  BEGIN  fc := c;  END; { TLine.fc }
 
  PROCEDURE TLine.Draw( color: Word );
  VAR y0: Integer;
  BEGIN
    IF bYnit
    THEN
    BEGIN
      SetColor( color );
      IF (b = -1.0)
      THEN { bežná priamka k, q }
      BEGIN
        y0 := GrMaxY - GrOffsetY + Trunc(a*GrOffsetX - c);
        Line( 0, y0,  GrMaxX, y0 - Trunc(a*GrMaxX) );
      END
      ELSE { rovnobežka s osou y }
        Line( GrX(c), 0,   GrX(c), GrMaxY );
    END
    ELSE ;
  END; { TLine.Draw }
 
  {--------------------------- TAbscissa ------------------------------}
 
  { Vytvorenie úsečky z koncových bodov }
  CONSTRUCTOR TAbscissa.Init_PP( vpb, vpe: TPoint; vInstName: TString16 );
  BEGIN
    Instname := vInstName;
    bYnit := (vpb.ox <> vpe.ox) OR (vpb.oy <> vpe.oy);
    IF bYnit
    THEN
    BEGIN
      ob.ox := vpb.ox; ob.oy := vpb.oy;   oe.ox := vpe.ox; oe.oy := vpe.oy;
      wx := oe.ox - ob.ox;  wy := oe.oy - ob.oy;
      IF (wx <> 0.0)
      THEN
      BEGIN
        a := wy / wx;  b := -1.0;  c := ob.oy - a * ob.ox;
      END
      ELSE
      BEGIN
        a := -1.0;  b := 0.0;  c := ob.ox;
      END
    END
    ELSE Error( 1, 'Body zadávajúce úsečku sú totožné',
                'TAbscissa', InstName );
  END; { TAbscissa.Init_pp }
 
  { Vytvorenie úsečky zo začiatočného bodu a vektora }
  CONSTRUCTOR TAbscissa.Init_pv( vpb: TPoint; vv: TVector;
                                 vInstName: TString16 );
  BEGIN
    Instname := vInstName;
    bYnit := vpb.bYnit AND vv.bYnit AND (vv.Size > 0.0);
    IF bYnit THEN
    BEGIN
      ob.ox := vpb.ox;          ob.oy := vpb.oy;
      oe.oy := vpb.oy + vv.wx;  oe.oy := vpb.oy + vv.wy;
      wx := vv.wx;  wy := vv.wy;
      IF (wx <> 0.0)
      THEN
      BEGIN
        a := wy / wx;  b := -1.0;  c := ob.oy - a * ob.ox;
      END
      ELSE
      BEGIN
        a := -1.0;  b := 0.0;  c := ob.ox;
      END
    END
    ELSE
    BEGIN
      Error( -1, '', 'TAbscissa', vInstName )
    END;
  END; { TAbscissa.Init_pv }
 
  PROCEDURE TAbscissa.Draw( color: Word );
  BEGIN
    SetColor( color );
    Line( GrX(ob.ox), GrY(ob.oy),  GrX(oe.ox), GrY(oe.oy) );
  END; { TAbscissa.Draw }
 
  PROCEDURE TAbscissa.Axis( VAR pLyne: PLine; vInstName: TString16 );
  VAR vBx, vBy, vVx, vVy: Real;
  BEGIN
    IF  bYnit
    THEN { úsečka je OK }
    BEGIN
      { Súradnice stredového bodu úsecky: }
      vBx := (ob.ox + oe.ox) / 2.0;  vBy := (ob.oy + oe.oy) / 2.0;
      { Vektor osi: }
      vVy := oe.ox - ob.ox;  vVx := ob.oy - oe.oy;
 
      IF (vVx = 0.0)
      THEN  New( pLyne, Init_x0( vBx, vInstName ) )
      ELSE  New( pLyne, Init_kq( vVy/vVx, vBy - (vVy/vVx)*vBx, vInstName ) );
    END
    ELSE  New( pLyne, Fail( vInstName ) );
  END; { TAbscissa.Axis }
 
  { Priamka, na ktorej lezi usecka }
(*  PROCEDURE TAbscissa.Line_A( VAR pLyne: PLine; name: TString16 );
  BEGIN
  END; { TAbscissa.Line }
*)
 
 
  {------------------------ TVector ---------------------------------}
 
  CONSTRUCTOR TVector.Init( vx, vy: Real;  vInstName: TString16 );
  BEGIN
    bYnit := True;  Instname := vInstName;
    Self.wx := vx;  Self.wy := vy;
  END; { TVector.Init }
 
  FUNCTION TVector.Size: Real;
  BEGIN  Size := Sqrt( Sqr(wx) +Sqr(wy) );  END; { TVector.Size }
 
  PROCEDURE  TVector.Unify; { Prerobi svoj vektor (Self) na jednotkovy }
  VAR  syze: Real;
  BEGIN
    syze := Size;
    IF (syze > 0.0)
    THEN
    BEGIN
      wx := wx/syze;  wy := wy/syze;
    END;
  END; { TVector.Unify }
 
  PROCEDURE  TVector.Draw( color: Word; vpb: TPoint );
  BEGIN
    SetColor( color );
    Line( GrX(vpb.ox), GrY(vpb.oy),  GrX(vpb.ox + wx), GrY(vpb.oy + wy) );
  END; { TVector.Draw }
 
  PROCEDURE Rotate( vSrc: TVector; vAngle: Real;
                    var pDst: PVector; vInstName: TString16 );
  BEGIN
    New( pDst, Init( vSrc.wx*Cos(vAngle) + vSrc.wy*Sin(vAngle),
                     vSrc.wx*Sin(vAngle) - vSrc.wy*Cos(vAngle),
                     vInstName) );
  END; { Rotate }
 
  {------------------------ TCircle ---------------------------------}
 
  CONSTRUCTOR TCircle.Init_pr( vp: TPoint; vr: Real; vInstName: TString16 );
  BEGIN
    bYnit := (vr > 0.0);  InstName := vInstName;
    IF bYnit
    THEN  BEGIN  o.ox := vp.ox;  o.oy := vp.oy;  r := vr;  END
    ELSE  Error( 1, 'Polomer kružnice je nekladny: ' + fStrR( vr ),
                'TCircle', InstName );
  END; { TCircle.Init_pr }
 
  PROCEDURE TCircle.Draw( color: Word );
  BEGIN
    SetColor( color );
    o.Draw( color, '+' );
    Circle( Trunc(o.ox + GrOffsetX),
            Trunc(GrMaxY - GrOffsetY - o.oy), Trunc(r) );
  END; { TCircle.Draw }
 
 
  {-------------------------- TPolygon -----------------------------}
 
  CONSTRUCTOR TPolygon.Init( vn: Byte; vInstName: TString16 );
  BEGIN
    bYnit := (vn >= 3);
    Self.n := vn;  Self.InstName := vInstName;
    GetMem( a, (n+1)*SizeOf( TAbscissa ) );
  END; { TPolygon.Init }
 
  DESTRUCTOR TPolygon.Done;
  BEGIN
    FreeMem( a, (n+1)*SizeOf( TAbscissa ) );
  END; { TPolygon.Done }
 
  FUNCTION TPolygon.fn: Byte;
  BEGIN
    fn := n;
  END; { TPolygon.fn }
 
  PROCEDURE TPolygon.GetAbscissa( vi: Byte; VAR ra: TAbscissa );
  BEGIN
  END; { TPolygon.GetAbscissa }
 
  FUNCTION TPolygon.fCheck: Boolean;
  VAR  i, j: Byte;  Ok: Boolean;
       sPoints: TString16;
  BEGIN
    { Doplnime do bodu 0 bod n }
    a^[0].ob.ox := a^[n].ob.ox;  a^[0].ob.oy := a^[n].ob.oy;
 
    { Úvodný test: Opakujú sa body? Alebo sú vzájomne rôzne? }
    bYnit := True; { Optimistický predpoklad }
    i := 0;
    WHILE  bYnit AND (i < n-1)  DO
    BEGIN
      i := i + 1;
      j := i;
      WHILE  bYnit AND (j < n)  DO
      BEGIN
        j:= j + 1;
        bYnit := ( a^[i].ob.ox <> a^[j].ob.ox )
                 OR
                 ( a^[i].ob.oy <> a^[j].ob.oy );
      END; { while j }
      bYnit := bYnit AND (j >= n);
    END; { while i }
    IF  NOT bYnit
    THEN  Error( 1, 'Body nie sú vzájomne rôzne, napríklad ' + fStrI(i) +
                 ', ' + fStrI(j), 'TPolygon', InstName )
    ELSE { vpred do ďalších testov }
    BEGIN
      { Vyrobíme vektor strán a doplnime koncove body useciek }
      FOR  i := 0  TO  n - 1  DO
      BEGIN
        a^[i].oe.ox := a^[i+1].ob.ox;
        a^[i].oe.oy := a^[i+1].ob.oy;
        a^[i].wx := a^[i].oe.ox - a^[i].ob.ox;
        a^[i].wy := a^[i].oe.oy - a^[i].ob.oy;
      END; { FOR i }
      a^[n].wx := a^[0].wx;  a^[n].wy := a^[0].wy;
      a^[n].oe.ox := a^[0].oe.ox;
      a^[n].oe.oy := a^[0].oe.oy;
 
      { Slávnostne vyrobime usecky pomocou metod OOP }
      FOR  i := 0  TO  n  DO
      BEGIN
        sPoints := sNn( i ) + '_';
        IF (i = n)
        THEN sPoints := sPoints + sNn( i+1 )
        ELSE sPoints := sPoints + sNn( 1 );
        a^[i].Init_PP( a^[i].ob, a^[i].oe, 'usecka ' + sPoints );
      END; { FOR i }
 
      { Sú všetky susedné (spojené vrcholom) strany nekolineárne? }
      i := 0;
      WHILE  bYnit AND (i < n-1)  DO
      BEGIN
        i := i + 1;
        bYnit := NOT  bColin_vv( a^[i], a^[i+1] );
      END; { WHILE }
      bYnit := bYnit AND (i >= n-1);
 
      IF  NOT bYnit
      THEN  Error( 2, 'Vrchol ' + fStrI(i+1) + 'je "falošný", ' +
                   'strany s ním incidujúce sú na jednej priamke',
                   'TPolygon', InstName )
      ELSE
      BEGIN
        { Sú strany disjunktné? Alebo sa nesusedné strany pretínajú? }
 
      END; { IF kolineárne }
    END; { IF body vzájomne rôzne }
  END; { TPolygon.fCheck }
 
  PROCEDURE TPolygon.PointSet( vi: Byte; vx, vy: Real );
  BEGIN
    bYnit := (vi > 0) AND (vi <= n);
    IF (vi > 0) AND (vi <= n)
    THEN
    BEGIN
      a^[vi].ob.ox := vx;  a^[vi].ob.oy := vy;
    END
    ELSE { Vynadáme userovi do errorov }
    BEGIN
    END; { IF }
  END; { PROC TPolygon.PointSet }
 
  PROCEDURE TPolygon.GetPoint( vi: Byte; VAR rp: TPoint );
  BEGIN
  END; { TPolygon.GetPoint }
 
  PROCEDURE TPolygon.Draw( color: Word );
  VAR  i: Byte;
  BEGIN
    SetColor( color );
    MoveTo( GrX(a^[n].ob.ox), GrY(a^[n].ob.oy) );
    FOR  i := 1  TO  n  DO  LineTo( GrX(a^[i].ob.ox), GrY(a^[i].ob.oy) );
    a^[1].ob.Draw( color, '*' );  a^[2].ob.Draw( color, 'x' );
    a^[3].ob.Draw( color, '+' );
  END; { TPolygon.Draw }
 
  PROCEDURE TPolygon.DrawL( colorA, colorL: Word );
  VAR  i: Byte;  Lyne: TLine;
  BEGIN
    { Vykreslime priamky, na ktorych lezia strany }
    FOR  i := 1  TO  n  DO
    BEGIN
      Lyne.Init_PP( a^[i].ob, a^[i].oe, '' );
      Lyne.Draw( colorL );
    END; { FOR i }
 
    { Vykreslime usecky aj so zvyraznenymi prvymi troma bodmi }
    SetColor( colorA );
    MoveTo( GrX(a^[n].ob.ox), GrY(a^[n].ob.oy) );
    FOR  i := 1  TO  n  DO  LineTo( GrX(a^[i].ob.ox), GrY(a^[i].ob.oy) );
    a^[1].ob.Draw( colorA, '*' );  a^[2].ob.Draw( colorA, 'x' );
    a^[3].ob.Draw( colorA, '+' );
  END; { TPolygon.DrawL }
 
  { Priesecník dvoch priamok (if any) }
  PROCEDURE  InterSection_LL( lyne1, lyne2: TLine;
                              var pCross: PPoint; name: TString16 );
  VAR det, x, y: Real;  bY: Boolean;
  BEGIN
    det := lyne1.a * lyne2.b - lyne2.a * lyne1.b;
    bY := (det <> 0.0);
    IF bY
    THEN
    BEGIN
      x := (lyne1.b * lyne2.c - lyne2.b * lyne1.c) / det;
      y := (lyne2.a * lyne1.c - lyne1.a * lyne2.c) / det;
      New( pCross, Init( x, y, name ) );
    END
    ELSE  New( pCross, Fail( name ) );
  END; { InterSection_LL }
 
  FUNCTION Distance_PP( pb, pe: TPoint ): Real;
  BEGIN
    Distance_PP := Sqrt( Sqr(pe.ox - pb.ox) + Sqr(pe.oy - pb.oy) );
  END; { Distance_PP }
 
  FUNCTION Distance_LP( Lyne: TLine; Point: TPoint ): Real;
  BEGIN
    IF Lyne.bYnit
    THEN
      Distance_LP := Abs(Lyne.a * Point.ox + Lyne.b * Point.oy + Lyne.c) /
                     Sqrt( Sqr(Lyne.a) + Sqr(Lyne.b) )
    ELSE Distance_LP := -1.0;
  END; { Distance_LP }
 
  FUNCTION Distance_LL( Line1, Line2: TLine ): Real;
  BEGIN
  END; { Distance_LL }
 
  FUNCTION Distance_AA( a1, a2: TAbscissa ): Real;
  BEGIN
  END; { Distance_AA }
 
  FUNCTION Distance_AP( a: TAbscissa; Point: TPoint ): Real;
  BEGIN
  END; { Distance_LP }
 
  FUNCTION Angle_VV(  vector1, vector2: TVector ): Real;
  VAR a, g, c, s: Real; { a = sucin abs. hodnot vektorov, g = uhol,
                          c = skalarny, s = "vektorovy" sucin }
  BEGIN
    a := Sqrt( (Sqr(vector1.wx) + Sqr(vector1.wy)) *
               (Sqr(vector2.wx) + Sqr(vector2.wy)) );
    c := vector1.wx * vector2.wx + vector1.wy * vector2.wy;
    s := vector1.wx * vector2.wy - vector1.wy * vector2.wx;
    IF (a = 0.0)
    THEN g := 0.0
    ELSE g := ArcCos( c/a );
 
{    TextColor(Yellow);
    Write( 'Pred G = ', g:12:7, ' Po G = ' ); }
    IF (c < 0.0)
    THEN  { 2nd or 3rd Quadrant }
    BEGIN
      IF (s < 0.0) THEN g := DvaPi - g { 3rd Quadrant }
    END
    ELSE { 1st or 4th Quadrant }
      IF (s < 0.0) THEN g := DvaPi - g; { 4th Quadrant }
 
{    WriteLn( g:12:7 ); TextColor( White ); }
    Angle_VV := g;
  END; { Angle_VV }
 
  PROCEDURE AngleAxis_VV( vector1, vector2: TVector; point: TPoint;
                      var pAxis: PLine; vInstName: TString16 );
(*  VAR angle: Real;  pW: PVector;
  BEGIN
    angle := Angle_VV( vector1, vector2 );
    Rotate( vector1, angle/2.0, pW, 'Otoceny' );
 
TextColor( Blue );  WriteLn( 'AngleAxis_VV vypocítala uhol ',
  Trunc(angle*180/pi):5, ' vektor (', pW^.wx:8:5, ', ', pW^.wy:8:5,
  ')', #13#10, 'a dostala point [', point.ox:8:5, ', ', point.oy:8:5,
  '] a vInstName ', vInstName, 'Ÿ' );
TextColor( White );
 
    New( pAxis, Init_PV( point, pW^, vInstName ) );
PrLn( pAxis^, 'DEBUG AngleAxis vyrátala', Red );
*)
  VAR jv1, jv2, jvS: TVector; { Jednotkové vektory }
       d1,  d2,  dS: Real; { Absolútne hodnoty pôvodnych vektorov }
  BEGIN
    d1 := Sqrt( Sqr(vector1.wx) + Sqr(vector1.wy) );
    jv1.wx := vector1.wx/d1;  jv1.wy := vector1.wy/d1;
 
    d2 := Sqrt( Sqr(vector2.wx) + Sqr(vector2.wy) );
    jv2.wx := vector2.wx/d2;  jv2.wy := vector2.wy/d2;
 
    jvS.wx := jv1.wx + jv2.wx;  jvS.wy := jv1.wy + jv2.wy;
 
    New( pAxis, Init_PV( point, jvS, vInstName ) );
    pAxis^.bYnit := (d1 > 0.0) AND (d2 > 0.0);
  END; { AngleAxis_VV }
 
  { DEBUG:  Print Vector }
  procedure PrVe( w: TVector;   cUsm: String; color: Word );
  begin
    TextColor( color ); WriteLn( 'Vector   ', w.InstName, 'Ÿ v = (',
      sRn(w.wx), ', ', sRn(w.wy), ') "', cUsm, '"' );
    TextColor( White );
  end; { PrVe }
 
  { DEBUG: PrintLine }
  procedure PrLn( L: Tline; cUsm: String; color: Word );
  begin
    TextColor( color ); WriteLn( 'Line     ', L.InstName, 'Ÿ a b c = ',
      L.a:5:5, ' ', L.b:5:5, ' ',L.c:5:5, ' ', cUsm, #13#10,
        'v= (', L.wx   :5:5, ', ', L.wy:   5:5,
      ') o= [', L.ob.ox:5:5, ', ', L.ob.oy:5:5, ']' );
    TextColor( White );
  end; { PrLn }
 
  procedure PrAb( A: TAbscissa; cUsm: String; color: Word ); { Print Abscissa }
  begin
    TextColor( color ); WriteLn( 'Abscissa ', A.InstName, 'Ÿ ob= [',
      A.ob.ox:5:5, ', ', A.ob.oy:5:5, '] oe= [',
      A.oe.ox:5:5, ', ', A.oe.oy:5:5, ']', #13#10,
      '  a b c = ', A.a:5:5, ' ', A.b:5:5, ' ',A.c:5:5, ' "',
      cUsm, '"', #13#10,
      '  v= (', A.wx:5:5, ', ', A.wy:5:5, ')' );
    TextColor( White );
  end; { prAb }
 
  procedure PrCi( c: TCircle; cUsm: String; color: Word ); { Draw  Circle }
  begin
    TextColor( color );  WriteLn( 'Circle   ', c.InstName, 'Ÿ o= [',
      c.o.ox:5:5, ', ', c.o.oy:5:5, '] r= ', c.r:5:5, ' ', cUsm );
    TextColor( White );
  end; { PrCi }
 
  { DEBUG: Print Polygon }
  procedure PrPl( M: TPolygon;  cUsm: String; color: Word ); { Print Polygon }
  var i: Byte;
  begin
    TextColor( color );
    Write( 'Polygon  ', M.InstName, 'Ÿ (' );
    IF (M.bYnit) THEN Write( 'True  ' ) ELSE  Write( 'False ' );
    WriteLn( ') # vrcholov = ', M.n, ' "' + cUsm + '"' );
    for i := 0 to M.n do
      WriteLn( '{', i:2,
               '} w= (', sRn(M.a^[i].wx),    ', ', sRn(M.a^[i].wy),
               ') o= [', sRn(M.a^[i].ob.ox), ', ', sRn(M.a^[i].ob.oy),
               ']' );
    TextColor( White );
  end; { PrPl }
 
  { DEBUG: Print Point }
  procedure PrPn( B: TPoint;    cUsm: String; color: Word ); { Print Point }
  begin
    TextColor( color );
    WriteLn( 'Point   ', B.InstName, 'Ÿ o = [',
      sRn( B.ox ), ', ', sRn( B.oy ), ']' );
    TextColor( White );
  end; { PrPn }
 
BEGIN { AnGeom2 }
  oOrigin.Init( 0.0, 0.0, 'Origin' );
 
  aAxisX.Init_PP( oOrigin, oOrigin, 'aAxisX' ); { To bol podraz! }
  aAxisX.oe.ox := 1.0;  aAxisX.oe.oy := 0.0; { Teraz je to naozaj! }
  aAxisX.wx    := 1.0;  aAxisX.wy :=    0.0; { Teraz je to naozaj! }
  aAxisX.a     := 0.0;  aAxisX.b :=    -1.0;  aAxisX.c := 0.0;
 
  aAxisY.Init_PP( oOrigin, oOrigin, 'aAxisY' ); { To bol podraz! }
  aAxisY.oe.ox := 0.0;  aAxisY.oe.oy := 1.0; { Teraz je to naozaj! }
  aAxisY.wx :=    0.0;  aAxisY.wy    := 1.0; { Teraz je to naozaj! }
  aAxisY.a :=    -1.0;  aAxisY.b     := 0.0;  aAxisY.c := 0.0;
 
  DetectGraph( GraphDriver, GraphMode );
  GraphDriver := Detect;  InitGraph( GraphDriver, GraphMode, '' );  GrAxis;
  GrMaxX := GetMaxX;  GrMaxY := GetMaxY;  GrOffsetX := 50;  GrOffsetY := 50;
  RestoreCrtMode;
{  SetGraphMode( GraphMode );  GrAxis; }
END. { AnGeom02 }
 
(*
  CONSTRUCTOR TVector.Init_PP( pb, pe: TPoint; vInstName: TString16 );
  BEGIN
    bYnit := True;  Instname := vInstName;
    Self.x := pe.x - pb.x;  Self.y := pe.y - pb.y;
  END; { TVector.Init_PP }
*)