home *** CD-ROM | disk | FTP | other *** search
- (* ------------------------------------------------------ *)
- (* PLGRAPH.PAS *)
- (* Umsetzung von PGRAPH (TOOLBOX 12'88) auf HPGL-Plotter *)
- (* (c) 1989 Peter Kurzweil, Gerd Kraus & TOOLBOX *)
- (* ------------------------------------------------------ *)
- UNIT PLGRAPH; (* erfordert die Unit HPGL *)
-
- INTERFACE
-
- USES HPGL;
-
- CONST
- {$IFDEF CPU87} (* math. Coprozessor ??? *)
- MaxInt = 2147483647;
- {$ENDIF}
- nmax = 200;
-
- TYPE
- {$IFDEF CPU87}
- REAL = EXTENDED;
- {$ELSE}
- DOUBLE = REAL; SINGLE = REAL;
- EXTENDED = REAL; COMP = REAL;
- {$ENDIF}
- Vektor = ARRAY[1..nmax] OF REAL;
-
- PROCEDURE AngleTrueScale(VAR x1, x2, y1, y2 : REAL);
- PROCEDURE Curve(VAR x, y : Vektor;
- n, Lintyp, Thickness, Color : WORD);
- PROCEDURE Curvex(VAR x, y : Vektor; n : WORD; Color : BYTE);
- FUNCTION EXP10(x : REAL) : REAL;
- FUNCTION Exponent(x : REAL) : INTEGER;
- PROCEDURE Extrema(z : Vektor; n : WORD;
- VAR zmin, zmax : REAL);
- PROCEDURE GraphikWindow(x1, x2, y1, y2 : INTEGER);
- PROCEDURE LinaxScale(VAR a, b, dx, Ex : REAL;
- Density : BYTE; VAR ExpStrg : strg80);
- FUNCTION LOG10(x : REAL) : REAL;
- PROCEDURE LogXAxis(LogX1, LogX2 : REAL; XText : strg80;
- Font, Size : WORD);
- PROCEDURE LogYAxis(LogY1, LogY2 : REAL; YText : strg80;
- Font, Size : WORD);
- FUNCTION RealToString(x : REAL) : strg80;
- PROCEDURE Scale(x, y : REAL; VAR u, v : INTEGER);
- PROCEDURE Uscale(VAR x1, x2, y1, y2 : REAL;
- Origin, AngleTrue : BOOLEAN; Expans : REAL);
- PROCEDURE XAxis(x1, x2 : REAL; XText : strg80;
- Font, Size : WORD);
- PROCEDURE Xgrid(x : REAL);
- PROCEDURE Xmark(x : REAL; VAR u : INTEGER; Len : BYTE);
- PROCEDURE YAxis(y1, y2 : REAL; YText : strg80;
- Font, Size : WORD);
- PROCEDURE Ymark(y : REAL; VAR v : INTEGER; Len : BYTE);
- PROCEDURE Ygrid(y : REAL);
-
- IMPLEMENTATION
-
- PROCEDURE AngleTrueScale(VAR x1, x2, y1, y2 : REAL);
- (* Winkeltreue Skalierung *)
- VAR C,dx,dy,xx,yy,xm,ym,F:REAL; Xasp,Yasp:WORD;
- BEGIN
- F := (Abs(UaxMin - UaxMax) / Abs(VaxMin - VaxMax));
- dx := Abs(x2 - x1);
- dy := Abs(y2-y1);
- IF dx >= dy THEN BEGIN
- yy := 0.5 * dx / F;
- IF y1 > y2 THEN yy := -yy; (* y-Achse strecken *)
- ym := 0.5 * (y1 + y2); y1 := ym - yy; y2 := ym + yy;
- END ELSE BEGIN
- xx := 0.5 * dy * F;
- IF x1 > x2 THEN xx := -xx; (* x-Achse strecken *)
- xm := 0.5 * (x1 + x2); x1 := xm - xx; x2 := xm + xx;
- END;
- END;
-
- PROCEDURE Curve(VAR x, y : Vektor;
- n, Lintyp, Thickness, Color : WORD);
- (* Polygonzug *)
- VAR i, u1, v1, u2, v2 : INTEGER;
- BEGIN
- P_SetLineStyle(Lintyp, Thickness, 0);
- (* ^ statt Liniendicke Wiederholschrittweite *)
- P_SetColor(Color);
- Scale(x[1], y[1], u1, v1);
- FOR i := 2 TO n DO BEGIN
- Scale(x[i], y[i], u2, v2); P_Line(u1, v1, u2, v2);
- u1 := u2; v1 := v2;
- END;
- END;
-
- PROCEDURE Curvex(VAR x, y : Vektor; n : WORD; Color : BYTE);
- (* Punkte auftragen *)
- VAR i, u, v : INTEGER;
- BEGIN
- FOR i := 1 TO n DO BEGIN
- Scale(x[i], y[i], u, v); P_PutPixel(u, v, Color);
- END;
- END;
-
- FUNCTION EXP10(x : REAL) : REAL;
- VAR S : STRING[80]; E : REAL; Code : WORD;
- BEGIN
- IF x = Int(x) THEN BEGIN (* 10 hoch Integer *)
- Str(Trunc(x), S);
- Val(('1.0E' + S), E, Code); EXP10 := E; Exit;
- END;
- EXP10 := Exp(x * Ln(10)); (* 10 hoch Real *)
- END;
-
- FUNCTION Exponent(x : REAL) : INTEGER;
- (* Größenordnung einer Zahl *)
- VAR Ex, S : STRING[80]; n, Code : INTEGER;
- BEGIN
- Str(x, S); Ex := Copy(S, Pos('E', S) + 1, Length(S));
- Val(Ex, n, Code); Exponent := n;
- END;
-
- PROCEDURE Extrema(z : Vektor; n : WORD;
- VAR zmin, zmax : REAL);
- (* Maximum und Minimum des Vektors z[1..n] *)
- VAR i : WORD;
- BEGIN
- zmin := z[1]; zmax := z[1];
- FOR i := 2 TO n DO BEGIN
- IF z[i] < zmin THEN zmin := z[i];
- IF z[i] > zmax THEN zmax := z[i];
- END;
- END;
-
- PROCEDURE GraphikWindow(x1, x2, y1, y2 : INTEGER);
- (* Graphikfenster *)
- VAR h : INTEGER;
- BEGIN
- P_SetColor(Black);
- IF x1 > x2 THEN BEGIN
- h := x1; x1 := x2; x2 := h;
- END;
- IF y1 > y2 THEN BEGIN
- h := y1; y1 := y2; y2 := h;
- END;
- P_Line(x1, y1, x2, y1);
- P_Line(x2, y1, x2, y2);
- P_Line(x2, y2, x1, y2);
- P_Line(x1, y2, x1, y1);
- UaxMin := x1; UaxMax := x2;
- VaxMin := y1; VaxMax := y2; (* Fensterkoordinaten *)
- END;
-
- PROCEDURE LinaxScale(VAR a, b, dx, Ex : REAL;
- Density : BYTE; VAR ExpStrg : strg80);
- (* Hilfsroutine fuer Xaxis und Yaxis *)
- VAR x1, x2 : REAL;
- BEGIN
- IF Abs(a) < Abs(b) THEN
- Ex := Exponent(b) ELSE Ex := Exponent(a);
- x1 := a; x2 := b; dx := 0.25 * EXP10(Exponent(b - a));
- ExpStrg := '0';
- IF Abs(Ex) > 3 THEN BEGIN (* Exponent abtrennen *)
- a := a * EXP10(-Ex); b := b * EXP10(-Ex);
- dx := dx * EXP10(-Ex);
- Str(Ex:4:0, ExpStrg);
- WHILE ExpStrg[1] = #32 DO Delete(ExpStrg, 1, 1);
- END;
- WHILE ((b - a) / dx) >= Density DO
- dx := 2 * dx; (* Skalendichte *)
- IF b < a THEN dx := -dx;
- IF a = b THEN BEGIN a := a - dx; b := b + dx; END;
- a := dx * Round(a / dx); (* Günstig runden *)
- b := dx * Round(b / dx);
- IF a < b THEN BEGIN
- IF a < x1 THEN a := a + dx;
- IF b > x2 THEN b := b - dx;
- END ELSE BEGIN
- IF a > x1 THEN a := a - dx;
- IF b < x2 THEN b := b + dx;
- END;
- END;
-
- FUNCTION LOG10(x : REAL) : REAL; (* dekad. Logarithmus *)
- BEGIN
- IF x <> 0 THEN
- LOG10 := Ln(Abs(x)) / Ln(10.0) ELSE LOG10 := 0;
- END;
-
- PROCEDURE LogXAxis(LogX1, LogX2 : REAL; XText : strg80;
- Font,Size : WORD); (* Log. x-Achse *)
- CONST Density = 10; (* Skalendichte *)
- VAR dn, n1, n2, n, k, u, v : INTEGER;
- x : REAL; S : STRING[6]; PSize : REAL;
- BEGIN
- P_Line(UaxMin, VaxMin,UaxMax, VaxMin);
- PSize := Size / 10; (* Einheit [cm]! *)
- u := (UaxMax + UaxMin) DIV 2;
- v := (VaxMin - Round (5 * Size));
- P_SetTextStyle(Font, P_HorizDir, PSize);
- P_OutTextXY(u, v, XText);
-
- n1 := Trunc(LogX1); n2 := Trunc(LogX2);
- IF n1 > n2 THEN BEGIN k := n1; n1 := n2; n2 := k; END;
- dn:=1;
- WHILE (n2 - n1) DIV dn >= Density DO dn := Density * dn;
- IF dn = 1 THEN BEGIN
- FOR n := n1 - 1 TO n2 + 1 DO
- FOR k := 2 TO 9 DO BEGIN
- x := n + LOG10(k); Xmark(x, u, 2);
- END;
- END;
- FOR n := n1 TO n2 DO BEGIN
- IF (dn DIV 10 <> 0) THEN
- IF (dn<>1) AND ((n MOD (dn DIV 10)) = 0) THEN
- Xmark(n, u, 2);
- IF (n MOD dn) = 0 THEN BEGIN
- Xmark(n, u, 4);
- Str(n, S);
- P_OutTextXY(u + Round (8 * PSize),
- VaxMin - (Round (45 * PSize)) DIV 2, S);
- P_OutTextXY(u - (Round (15 * PSize)) DIV 2,
- VaxMin - Round (30 * PSize), '10');
- END;
- END;
- END;
-
- PROCEDURE LogYAxis(LogY1, LogY2 : REAL; YText : strg80;
- Font, Size : WORD);
- (* log. y-Achse *)
- CONST Density = 10;
- VAR dn, n1, n2, n, k, u, v : INTEGER;
- y : REAL; S : STRING[6]; PSize : REAL;
- BEGIN
- P_Line(UaxMin, VaxMin, UaxMin, VaxMax);
- PSize := Size / 10;
- v := (VaxMax + VaxMin) DIV 2;
- u := (UaxMin - Round (5 * Size));
- P_SetTextStyle(Font, P_VertDir, PSize);
- P_OutTextXY(u, v, YText);
-
- n1 := Trunc(LogY1); n2 := Trunc(LogY2);
- IF n1 > n2 THEN BEGIN
- k := n1; n1 := n2; n2 := k;
- END;
- dn := 1;
- WHILE (n2 - n1) DIV dn >= Density DO dn := Density * dn;
- IF dn = 1 THEN BEGIN
- FOR n := n1 - 1 TO n2 + 1 DO
- FOR k := 2 TO 9 DO BEGIN
- y := n + LOG10(k); Ymark(y, v, 2);
- END;
- END;
- FOR n := n1 TO n2 DO BEGIN
- IF (dn DIV 10 <> 0) THEN
- IF (dn <> 1) AND ((n MOD (dn DIV 10)) = 0) THEN
- Ymark(n, u, 2);
- IF (n MOD dn) = 0 THEN BEGIN
- Ymark(n, v, 4);
- Str(n, S);
- P_OutTextXY(UaxMin - Round(25 * PSize),
- v + Round(PSize), S);
- P_OutTextXY(UaxMin - Round(25 * PSize) DIV 2,
- v - (Round(20 * PSize)) DIV 2, '10');
- END;
- END;
- END;
-
- FUNCTION RealToString(x : REAL) : strg80;
- (* Reelle Zahl in handlichen String *)
- VAR S : strg80; Code : WORD;
- BEGIN
- Str(x:16:10, S);
- WHILE S[1] = #32 DO Delete(S, 1, 1);
- WHILE S[Length(S)] = '0' DO Delete(S,Length(S),1);
- IF Pos('.', S) = Length(S) THEN Delete(S, Length(S), 1);
- Val(S, x, Code); IF x = 0 THEN S := '0';
- RealToString := S;
- END;
-
- PROCEDURE Scale(x, y : REAL; VAR u, v : INTEGER);
- (* Absolute Skalierung *)
- BEGIN
- u := UaxMin + Round((x - Xaxmin) / (Xaxmax - Xaxmin) *
- (UaxMax - UaxMin));
- v := VaxMin + Round((y - Yaxmin) / (Yaxmax - Yaxmin) *
- (VaxMax-VaxMin));
- END;
-
- PROCEDURE Uscale(VAR x1, x2, y1, y2 : REAL;
- Origin, AngleTrue : BOOLEAN; Expans : REAL);
- (* Benutzer-Koordinatensystem *)
- VAR xx, yy : REAL;
- CONST Tol = 0.01;
- ExpFaktor = 10; (* Kompatibilität mit Unit PGraph *)
-
- BEGIN
- Expans:= ExpFaktor * Abs(Expans); (* ! *)
- (* damit bei gleichem Parameter in etwa gleiches *)
- (* Koordinatensystem ! *)
-
- xx := Abs(x2 - x1) * 0.005 * Expans;
- IF x1 > x2 THEN xx := -xx;
- x1 := x1 - xx; x2 := x2 + xx;
- IF Abs(x2 - x1) < 1E-8 THEN BEGIN
- x1 := x1 * (1 - 0.01 * Expans);
- x2 := x2 * (1 + 0.01 * Expans);
- END;
- yy := Abs(y2 - y1) * 0.005 * Expans;
- IF y1 > y2 THEN yy := -yy;
- y1 := y1 - yy; y2 := y2 +yy;
- IF Abs(y2 - y1) < 1E-8 THEN BEGIN
- y1 := y1 * (1 - 0.01 * Expans);
- y2 := y2 * (1 + 0.01 * Expans);
- END;
- IF Origin THEN BEGIN (* 2. Ursprung *)
- IF x1 <= x2 THEN BEGIN
- IF x2 < 0 THEN x2 := 0;
- IF x1 > 0 THEN x1 := 0;
- END ELSE BEGIN
- IF x2 > 0 THEN x2 := 0;
- IF x1 < 0 THEN x1 := 0;
- END;
- IF y1 <= y2 THEN BEGIN
- IF y2 < 0 THEN y2 := 0;
- IF y1 > 0 THEN y1 := 0;
- END ELSE BEGIN
- IF y2 > 0 THEN y2 := 0;
- IF y1 < 0 THEN y1 := 0;
- END;
- END;
- IF AngleTrue THEN AngleTrueScale(x1, x2, y1, y2);
- IF Abs((x2 - x1) / x2) < Tol THEN BEGIN
- IF x1 < x2 THEN BEGIN
- x1 := x1 * (1 - Tol); x2 := x2 * (1 + Tol);
- END ELSE BEGIN
- x2 := x2 * (1 - Tol); x1 := x1 * (1 + Tol);
- END;
- END;
- IF Abs((y2 - y1) / y2) < Tol THEN BEGIN
- IF y1 < y2 THEN BEGIN
- y1 := y1 * (1 - Tol); y2 := y2 * (1 + Tol);
- END ELSE BEGIN
- y2 := y2 * (1 - Tol); y1 := y1 * (1 + Tol);
- END;
- END;
- Xaxmin := x1; Xaxmax := x2;
- Yaxmin := y1; Yaxmax := y2;
- END;
-
- PROCEDURE XAxis(x1, x2 : REAL; XText : strg80;
- Font, Size : WORD);
- VAR Xpos, Ypos : INTEGER;
- Ex, u, v, a, b, x, dx, h : REAL; E, S : strg80;
- PSize : REAL;
- CONST Density = 6;
- BEGIN
- P_Line(UaxMin, VaxMin,UaxMax, VaxMin);
- PSize := Size / 10;
- Xpos := (UaxMax + UaxMin) DIV 2;
- (* - Round (10.0 * PSize); *)
- Ypos := (VaxMin - Round (5 * Size));
- a := x1; b := x2;
- IF a > b THEN BEGIN h := b; b := a; a := b; END;
- LinaxScale(x1, x2, dx, Ex, Density, E);
- IF x1 > x2 THEN BEGIN
- h := x1; x1 := x2; x2 := h; dx := Abs(dx);
- END;
- P_SetTextStyle(Font, P_HorizDir, PSize);
- IF E='0' THEN
- P_OutTextXY(Xpos, Ypos, XText)
- ELSE BEGIN
- u := Xaxmin; v := Xaxmax;
- P_OutTextXY(Xpos, Ypos, XText + ' *E' + E);
- a := a * EXP10(-Ex); b := b * EXP10(-Ex);
- Xaxmin := a; Xaxmax := b;
- END;
- x := x1;
- Xmark(x - dx / 2, Xpos, 2);
- REPEAT
- Xmark(x + dx / 2, Xpos, 2);
- Xmark(x, Xpos, 2);
- S := RealToString(x);
- P_Line(Xpos, VaxMin, Xpos, VaxMin - 2);
- IF Length(S) < 6 THEN
- P_OutTextXY(Xpos, VaxMin - Round (25 * PSize), S);
- x := x + dx;
- UNTIL (x >= b) OR ( x <= a);
- IF E <> '0' THEN BEGIN Xaxmin := u; Xaxmax := v; END;
- END;
-
- PROCEDURE Xgrid(x : REAL);
- (* Parallele zur x-Achse *)
- VAR u, v : INTEGER;
- BEGIN
- Scale(x, 0, u, v);
- IF u > UaxMin THEN P_Line(u, VaxMin, u, VaxMax);
- END;
-
- PROCEDURE Xmark(x : REAL; VAR u : INTEGER; Len : BYTE);
- (* x-Achsenmarken: *)
- VAR v : INTEGER;
- BEGIN
- Scale(x, Yaxmin, u, v);
- IF (u >= UaxMin) AND (u <= UaxMax) THEN
- P_Line(u, VaxMin, u, VaxMin + Len);
- END;
-
- PROCEDURE YAxis(y1, y2 : REAL; YText : strg80;
- Font, Size : WORD);
- (* lineare y-Achse *)
- VAR Xpos, Ypos : INTEGER;
- Ex, u, v, a, b, y, dy, h : REAL; E, S : strg80;
- PSize : REAL;
- CONST Density = 8;
- BEGIN
- P_Line(UaxMin, VaxMin, UaxMin, VaxMax);
- PSize := Size / 10;
- Ypos := (VaxMax + VaxMin) DIV 2;
- Xpos := (UaxMin - Round (5 * Size));
- a := y1; b := y2;
- IF a > b THEN BEGIN h := b; b := a; a := b; END;
- LinaxScale(y1, y2, dy, Ex, Density, E);
- IF y1 > y2 THEN BEGIN
- h := y1; y1 := y2; y2 := h; dy := Abs(dy);
- END;
- P_SetTextStyle(Font, P_VertDir, PSize);
- IF E = '0' THEN P_OutTextXY(Xpos, Ypos, YText)
- ELSE BEGIN
- u := Yaxmin; v := Yaxmax;
- P_OutTextXY(Xpos, Ypos, YText + ' *E' + E);
- a := a * EXP10(-Ex); b := b * EXP10(-Ex);
- Yaxmin := a; Yaxmax := b;
- END;
- y := y1;
- Ymark(y - dy / 2, Ypos, 2);
- REPEAT
- Ymark(y + dy / 2, Ypos, 2);
- S := RealToString(y);
- Ymark(y, Ypos, 2);
- P_Line(UaxMin, Ypos, UaxMin - 2, Ypos);
- IF Length(S) < 6 THEN
- P_OutTextXY(UaxMin - Round(25 * PSize), Ypos, S);
- y := y + dy;
- UNTIL (y >= b) OR (y <= a);
- IF E <> '0' THEN BEGIN Yaxmin := u; Yaxmax := v; END;
- END;
-
- PROCEDURE Ygrid(y : REAL);
- (* Parallele zur y-Achse *)
- VAR u, v : INTEGER;
- BEGIN
- Scale(0, y, u, v);
- IF v > VaxMin THEN P_Line(UaxMin, v, UaxMax, v);
- END;
-
- PROCEDURE Ymark(y : REAL; VAR v : INTEGER; Len : BYTE);
- (* y-Achsenmarken: *)
- VAR u : INTEGER;
- BEGIN
- Scale(Xaxmin, y, u, v);
- IF (v > VaxMin) AND (v < VaxMax) THEN
- P_Line(UaxMin, v, UaxMin + Len, v);
- END;
-
- END.
- (* ------------------------------------------------------ *)
- (* Ende von PLGRAPH.PAS *)