home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
magazine
/
insidetp
/
1990_09
/
vg2.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1990-09-04
|
5KB
|
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}