PACKET std plot DEFINES (* J. Liedtke 06.02.81 *)
(* H.Indenbirken, 19.08.82 *)
transform,
set values,
clear ,
begin plot ,
end plot ,
dir move,
dir draw ,
pen,
pen info :
LET pen down = "*"8"" ,
y raster = 43,
display hor = 78.0,
display vert = 43.0;
INT CONST up := 1 ,
right := 1 ,
down := -1 ,
left := -1 ;
REAL VAR h min limit :: 0.0, h max limit :: display hor,
v min limit :: 0.0, v max limit :: display vert,
h :: display hor/2.0, v :: display vert/2.0,
size hor :: 23.5, size vert :: 15.5;
ROW 5 ROW 5 REAL VAR p :: ROW 5 ROW 5 REAL :
(ROW 5 REAL : (1.0, 0.0, 0.0, 0.0, 0.0),
ROW 5 REAL : (0.0, 1.0, 0.0, 0.0, 0.0),
ROW 5 REAL : (0.0, 0.0, 1.0, 0.0, 0.0),
ROW 5 REAL : (0.0, 0.0, 0.0, 1.0, 0.0),
ROW 5 REAL : (0.0, 0.0, 0.0, 0.0, 1.0));
ROW 5 ROW 5 REAL VAR result;
INT VAR i, j;
ROW 5 ROW 5 REAL OP * (ROW 5 ROW 5 REAL CONST l, r) :
ROW 5 ROW 5 REAL VAR erg;
FOR i FROM 1 UPTO 5
REP FOR j FROM 1 UPTO 5
REP erg [i] [j] := zeile i mal spalte j
PER
PER;
erg .
zeile i mal spalte j :
INT VAR k;
REAL VAR summe :: 0.0;
FOR k FROM 1 UPTO 5
REP summe INCR zeile i * spalte j PER;
summe .
zeile i : l [i] [k] .
spalte j : r [k] [j] .
END OP *;
PROC set values (ROW 3 ROW 2 REAL CONST size,
ROW 2 ROW 2 REAL CONST limits,
ROW 3 REAL CONST angles,
ROW 2 REAL CONST oblique,
ROW 3 REAL CONST perspective) :
norm p;
set views;
calc two dim extrema;
calc limits;
calc result values .
norm p :
p := ROW 5 ROW 5 REAL :
(ROW 5 REAL : (1.0/dx, 0.0, 0.0, 0.0, 0.0),
ROW 5 REAL : ( 0.0, 1.0/dy, 0.0, 0.0, 0.0),
ROW 5 REAL : ( 0.0, 0.0, 1.0/dz, 0.0, 0.0),
ROW 5 REAL : ( 0.0, 0.0, 0.0, 1.0, 0.0),
ROW 5 REAL : (size [1][1]/dx, size [2][1]/dy,
size [3][1]/dz, 0.0, 1.0)) .
dx : size [1][2] - size [1][1] .
dy : size [2][2] - size [2][1] .
dz : size [3][2] - size [3][1] .
set views :
REAL VAR sin a := sind (angles [1]), cos a := cosd (angles [1]),
sin p := sind (angles [2]), cos p := cosd (angles [2]),
sin t := sind (angles [3]), cos t := cosd (angles [3]),
norm a :: oblique [1] * p [1][1],
norm b :: oblique [2] * p [2][2],
norm cx :: perspective [1] * p [1][1],
norm cy :: perspective [2] * p [2][2],
norm cz :: perspective [3] * p [3][3];
result := ROW 5 ROW 5 REAL :
(ROW 5 REAL : (cos p*cos t, -sin p, cos p*sin t, 0.0, 0.0),
ROW 5 REAL : (sin p*cos t, cos p, sin p*sin t, 0.0, 0.0),
ROW 5 REAL : ( -sin t, 0.0, cos t, 0.0, 0.0),
ROW 5 REAL : ( 0.0, 0.0, 0.0, 1.0, 0.0),
ROW 5 REAL : ( 0.0, 0.0, 0.0, 0.0, 1.0));
p := p*result;
result := ROW 5 ROW 5 REAL :
(ROW 5 REAL : ( 1.0, 0.0, 0.0, 0.0, 0.0),
ROW 5 REAL : ( 0.0, 1.0, 0.0, 0.0, 0.0),
ROW 5 REAL : ( norm a, norm b, 0.0, norm cz, 0.0),
ROW 5 REAL : (-norm cx, -norm cy, 0.0, 1.0, 0.0),
ROW 5 REAL : ( 0.0, 0.0, 0.0, 0.0, 1.0));
p := p * result;
result := ROW 5 ROW 5 REAL :
(ROW 5 REAL : (cos a,-sin a, 0.0, 0.0, 0.0),
ROW 5 REAL : (sin a, cos a, 0.0, 0.0, 0.0),
ROW 5 REAL : ( 0.0, 0.0, 1.0, 0.0, 0.0),
ROW 5 REAL : ( 0.0, 0.0, 0.0, 1.0, 0.0),
ROW 5 REAL : ( 0.0, 0.0, 0.0, 0.0, 1.0));
p := p * result .
calc two dim extrema :
REAL VAR max x :: - max real, min x :: max real,
max y :: - max real, min y :: max real, x, y;
transform (size [1][1], size [2][1], size [3][1], x, y);
extrema;
transform (size [1][2], size [2][1], size [3][1], x, y);
extrema;
transform (size [1][2], size [2][2], size [3][1], x, y);
extrema;
transform (size [1][1], size [2][2], size [3][1], x, y);
extrema;
transform (size [1][1], size [2][1], size [3][2], x, y);
extrema;
transform (size [1][2], size [2][1], size [3][2], x, y);
extrema;
transform (size [1][2], size [2][2], size [3][2], x, y);
extrema;
transform (size [1][1], size [2][2], size [3][2], x, y);
extrema .
extrema :
min x := min (min x, x);
max x := max (max x, x);
min y := min (min y, y);
max y := max (max y, y) .
calc limits :
IF all limits smaller than 2
THEN prozente
ELSE zentimeter FI .
all limits smaller than 2 :
limits [1][2] < 2.0 AND limits [2][2] < 2.0 .
prozente :
h min limit := limits [1][1] * display hor * (size vert/size hor);
h max limit := limits [1][2] * display hor * (size vert/size hor);
v min limit := limits [2][1] * display vert;
v max limit := limits [2][2] * display vert .
zentimeter :
h min limit := display hor * (limits [1][1]/size hor);
h max limit := display hor * (limits [1][2]/size hor);
v min limit := display vert * (limits [2][1]/size vert);
v max limit := display vert * (limits [2][2]/size vert) .
calc result values :
REAL VAR sh := (h max limit - h min limit) / (max x - min x),
sv := (v max limit - v min limit) / (max y - min y),
dh := h min limit - min x*sh,
dv := v min limit - min y*sv;
result := ROW 5 ROW 5 REAL :
(ROW 5 REAL : ( sh, 0.0, 0.0, 0.0, 0.0),
ROW 5 REAL : (0.0, sv, 0.0, 0.0, 0.0),
ROW 5 REAL : (0.0, 0.0, 1.0, 0.0, 0.0),
ROW 5 REAL : (0.0, 0.0, 0.0, 1.0, 0.0),
ROW 5 REAL : ( dh, dv, 0.0, 0.0, 1.0));
p := p * result .
END PROC set values;
PROC transform (REAL CONST x, y, z, REAL VAR h, v) :
REAL CONST w :: 1.0/(x*p [1][4] + y*p [2][4] + z*p [3][4] + p [4][4]);
h := (x*p [1][1]+y*p [2][1]+z*p [3][1]+p [4][1])*w + p [5][1];
v := (x*p [1][2]+y*p [2][2]+z*p [3][2]+p [4][2])*w + p [5][2];
END PROC transform;
(************************** Eigentliches plot *************************)
INT VAR x pos := 0 ,
y pos := 0 ,
new x pos ,
new y pos ;
ROW 24 TEXT VAR display;
clear ;
PROC clear :
INT VAR i;
display (1) := 79 * " " ;
FOR i FROM 2 UPTO 24
REP display [i] := display [1]
PER;
out (""6""2""0""4"")
END PROC clear ;
PROC begin plot :
cursor (x pos + 1, 24 - (y pos) DIV 2 )
ENDPROC begin plot ;
PROC end plot :
ENDPROC end plot ;
PROC dir move (REAL CONST x, y, z) :
transform (x, y, z, h, v);
move (round (h), round (v))
END PROC dir move;
PROC move (INT CONST x val, y val) :
x pos := x val;
y pos := y val
ENDPROC move ;
PROC dir draw (REAL CONST x, y, z) :
transform (x, y, z, h, v);
draw (round (h), round (v))
END PROC dir draw;
PROC draw (INT CONST x val, y val) :
new x pos := x val;
new y pos := y val;
plot vector (new x pos - x pos, new y pos - y pos) ;
END PROC draw ;
PROC dir draw (TEXT CONST text, REAL CONST angle, height) :
out (""6"");
out (code (23 - (y pos DIV 2)));
out (code (x pos));
out (text)
END PROC dir draw;
INT VAR act no :: 1, act thickness :: 1, act line type :: 1;
PROC pen (INT CONST no, thickness, line type) :
act no := no;
act thickness := thickness;
act line type := line type
ENDPROC pen ;
PROC pen info (INT VAR no, thickness, line type) :
no := act no;
thickness := act thickness;
line type := act line type
END PROC pen info;
PROC plot vector (INT CONST dx , dy) :
IF dx >= 0
THEN IF dy > dx THEN vector (y pos, x pos, dy, dx, up, right)
ELIF dy > 0 THEN vector (x pos, y pos, dx, dy, right, up)
ELIF dy > -dx THEN vector (x pos, y pos, dx, -dy, right, down)
ELSE vector (y pos, x pos, -dy, dx, down, right)
FI
ELSE IF dy > -dx THEN vector (y pos, x pos, dy, -dx, up, left)
ELIF dy > 0 THEN vector (x pos, y pos, -dx, dy, left, up)
ELIF dy > dx THEN vector (x pos, y pos, -dx, -dy, left, down)
ELSE vector (y pos, x pos, -dy, -dx, down, left)
FI
FI .
ENDPROC plot vector ;
PROC vector (INT VAR x pos, y pos; INT CONST dx, dy, right, up) :
prepare first step ;
INT VAR i ;
FOR i FROM 1 UPTO dx REP
do one step
PER .
prepare first step :
point;
INT VAR old error := 0 ,
up right error := dy - dx ,
right error := dy .
do one step :
IF right is better
THEN do right step
ELSE do up right step
FI .
right is better :
abs (old error + right error) < abs (old error + up right error) .
do upright step :
x pos INCR right ;
y pos INCR up ;
point ;
old error INCR upright error .
do right step :
x pos INCR right ;
point ;
old error INCR right error .
ENDPROC vector ;
PROC point :
INT CONST line :: y pos DIV 2;
BOOL CONST above :: (y pos MOD 2) = 1;
TEXT CONST point :: display [line+1] SUB (x pos+1),
new point :: calculated point;
replace (display [line+1], x pos+1, new point);
out (""6"") ;
out (code (23-line)) ;
out (code (x pos)) ;
out (new point) .
calculated point :
IF above
THEN IF point = "," OR point = "|"
THEN "|"
ELSE "'" FI
ELSE IF point = "'" OR point = "|"
THEN "|"
ELSE "," FI
FI
END PROC point;
REAL CONST real max int := real (max int);
INT PROC round (REAL CONST x) :
IF x > real max int
THEN max int
ELIF x < 0.0
THEN 0
ELSE int (x + 0.5) FI
END PROC round;
ENDPACKET std plot ;