ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/MAGAZINE/MISC/ITPSEP90.ZIP/VG2.PAS

Pascal/Delphi Source File | 1990-09-04 | 5.3 KB | 213 lines

{****************************************************************
* STARBNCE.PAS - Demo of 2D vector transforms                   *
****************************************************************}

USES Graph,Crt;

TYPE

  CartType = RECORD
    X, Y:  Real;
  END;

  PolarType = RECORD
    R, A:  Real;
  END;

  PhysType = RECORD
    X, Y:  Integer;
  END;

  Entity = RECORD
    Pos   : CartType;
    Polar : ARRAY [0..10] OF PolarType;
  END;

VAR
  Star : Entity;
  MC, MX, MY: Integer;


{-------------------------------------------------
- Name   : PolarToCart                           -
- Purpose: Converts polar coordinates to         -
-          cartessian coordinates                -
- Input  : A record of polar coordinates         -
-          A record of cartessian coordinates    -
-------------------------------------------------}

PROCEDURE PolarToCart(InPolar: PolarType;VAR OutCart: CartType);
BEGIN
  OutCart.X := Cos(InPolar.A) * InPolar.R;
  OutCart.Y := SIN(InPolar.A) * InPolar.R
END;


{-------------------------------------------------
- Name   : CartToPhys                            -
- Purpose: Converts cartessian coordinates to    -
-          physical coordinate system            -
- Input  : A record of cartessian coordinates    -
-          A record of physical coordinates      -
-------------------------------------------------}


PROCEDURE CartToPhys(InCart: CartType; VAR OutPhys: PhysType);
BEGIN
  OutPhys.X := Trunc((InCart.X + 1.0) * MX / 2);
  OutPhys.Y := Trunc((InCart.Y + 1.0) * MY / 2)
END;

PROCEDURE DrawStar(C : Integer);
VAR
  I     : Integer;
  C1    : CartType;
  P1,P2 : PhysType;
BEGIN
  SetColor(C);
  FOR I := 0 TO 4 DO BEGIN
    PolarToCart(Star.Polar[I+1],C1);
    C1.X := C1.X + Star.Pos.X;
    C1.Y := C1.Y + Star.Pos.Y;
    CartToPhys(C1,P1);
    PolarToCart(Star.Polar[I],C1);
    C1.X := C1.X + Star.Pos.X;
    C1.Y := C1.Y + Star.Pos.Y;
    CartToPhys(C1,P2);
    Line(P1.X,P1.Y,P2.X,P2.Y)
    END
  END;

VAR
  I, GrDriver, GrErr, GrMode : Integer;
  DA, DR, DX, DY, CurrentDR  : Real;
  C                          : Char;
  Done,DisplayOn             : Boolean;
  Temp                       : String;
  MaxHeight,MaxWidth,WidthNbr               : Integer;

BEGIN

  {Initialize graphics System}
  GrDriver := Detect;
  DetectGraph(GrDriver, GrMode);
  IF GrDriver < 0 THEN BEGIN
    WriteLn('No graphics hardware detected',#7);
    Halt(1)
    END;

  {*** Change location of graphics drivers in next line to ***}
  {*** match the subdirectory in your system               ***}

  InitGraph(GrDriver, GrMode,'P:\Graph');
  IF GrDriver < 0 THEN BEGIN
    WriteLn('InitGraph (' + GraphErrorMsg(GrDriver) + ')');
    Halt(2)
    END;
  MX := GetMaxX;
  MY := GetMaxY;
  MC := GetMaxColor;
  DisplayOn := TRUE;

  {** Create a star **}

  Star.Pos.X := 0.0;
  Star.Pos.Y := 0.0;

  FOR I := 0 TO 5 DO BEGIN
    Star.Polar[I].R := 0.6;
    Star.Polar[I].A := 4 * Pi / 5 * I;
    END;

  DA := 0.0; DR := 0.0; DX := 0.0; DY := 0.0;

  {** Do the demonstration **}

  Done := FALSE;
  SetTextStyle(TriplexFont,HorizDir,1);
  MaxHeight := TextHeight('Radius=');
  MaxWidth := TextWidth('Radius= ');
  WidthNbr := TextWidth('00000');
  CurrentDR := 0;

  OutTextXY(0,0,'Angle = ');
  OutTextXY(0,MaxHeight * 1,'Radius= ');
  OutTextXY(0,MaxHeight * 2,'DX    = ');
  OutTextXY(0,MaxHeight * 3,'DY    = ');
  OutTextXY(MX DIV 2,0,'Star Demo');
  OutTextXY(0,MY-2*MaxHeight,
    'Press spacebar to toggle value display, ESC to quit.');

  WHILE NOT Done DO BEGIN

    IF DisplayOn THEN BEGIN
      SetColor(7);

      SetViewPort(MaxWidth - 5, 0, MaxWidth + WidthNbr,
                                          MaxHeight * 4 ,TRUE);
      ClearViewPort;
      SetViewPort(0,0,MX,MY,TRUE);

      Str(DA:5:3,Temp);
      OutTextXY(MaxWidth,0,Temp);

      Str(CurrentDR:5:3,Temp);
      OutTextXY(MaxWidth,MaxHeight * 1,Temp);

      Str(DX:5:3,Temp);
      OutTextXY(MaxWidth,MaxHeight * 2,Temp);

      Str(DY:5:3,Temp);
      OutTextXY(MaxWidth,MaxHeight * 3,Temp);
      END;


    IF KeyPressed THEN BEGIN
      C := ReadKey;
      CASE UpCase(C) OF
        Chr(27) : Done := TRUE;
        'U'     : DY := DY - 0.025;
        'D'     : DY := DY + 0.025;
        'L'     : DX := DX - 0.025;
        'R'     : DX := DX + 0.025;
        'F'     : DA := DA + 0.05;
        'B'     : DA := DA - 0.05;
        '+'     : DR := DR + 0.005;
        '-'     : DR := DR - 0.005;
        ' '     : DisplayOn := NOT DisplayOn;
        ELSE
        END;  {CASE}
      END;  {IF}

  {** Perform any rotations & scaling **}

    FOR I := 0 TO 5 DO BEGIN
      Star.Polar[I].R := Star.Polar[I].R + DR;
      Star.Polar[I].A := Star.Polar[I].A + DA;
      END;
    CurrentDR := Star.Polar[0].R;
    DR := 0;

    {** Perform any translation **}

    Star.Pos.X := Star.Pos.X + DX;
    IF Abs(Star.Pos.X) > 1.0 THEN BEGIN
      DX := -DX;
      Star.Pos.X := Star.Pos.X + DX
      END;

    Star.Pos.Y := Star.Pos.Y + DY;
    IF Abs(Star.Pos.Y) > 1.0 THEN BEGIN
      DY := -DY;
      Star.Pos.Y := Star.Pos.Y + DY
      END;

    {** Draw the star **}

    DrawStar(MC);
    Delay(100);
    DrawStar(0);
    END;  {WHILE}
  CloseGraph;
  END. {BEGIN}