PACKET hp7475 plot DEFINES set range, (*Autor: Heiko Indenbirken *)
get range, (*Stand: 03.09.86/15:09 *)
drawing area,
begin plot,
end plot,
clear,
set pen, get pen,
move,
draw,
marker,
bar, circle,
where:
(* *)
(* Hardware Anschluß des HP7475A: *)
(* 9600 Baud, 8 Bit, no parity, RTS/CTS *)
(* Leitungen 1 ----- 1 *)
(* gekreuzt: 2 --x-- 3 *)
(* 3 --x-- 2 *)
(* *)
LET POS = STRUCT (INT x, y);
LET RANGE = STRUCT (POS min, max);
LET PEN = STRUCT (INT back, fore, thick, line);
LET width scale = 0.002690217391304,
height scale = 0.002728921124206;
LET term = ";",
comma = ",",
point = ".",
zero = "0",
nil = "",
etx = ""3"";
POS VAR old :: POS:(0, 0);
RANGE VAR area :: RANGE:(POS:(0,0), POS:(11040, 7721));
PEN VAR pen :: PEN : (0, 1, 0, 1);
TEXT VAR result;
ROW 16 TEXT VAR mark := ROW 16 TEXT:
("99,0,2,-2,0,0,-4,4,0,0,4,-2,0;",
"99,0,2,-1,0,-1,-1,0,-2,1,-1,2,0,1,1,0,2,-1,1,-1,0;",
"99,0,2,-2,-3,4,0,-2,3;",
"-99,-2,0,99,4,0,-99,-2,2,99,0,-4;",
"-99,-2,-2,99,4,4,-99,-4,0,99,4,-4;",
"99,0,2,-2,-2,2,-2,2,2,-2,2;",
"-99,0,-2,99,0,4,-2,-2,4,0,-2,2;",
"-99,-2,0,99,4,0,-99,-2,2,99,0,-4,2,2,-2,2,-2,-2,2,-2;",
"-99,-2,-2,99,4,4,-4,0,4,-4;",
"-99,-2,2,99,4,0,-4,-4,4,0;",
"99,0,-2,-99,-2,4,99,2,-2,2,2;",
"99,1,1,-2,0,0,-2,2,0,0,2,1,1,-99,-4,0,99,1,-1,-99,0,-2,99,-1,-1,-99,4,0,99,-1,1;",
"-99,-2,0,99,4,0,-99,-1,1,99,-2,-2,-99,1,-1,99,0,4,-99,-1,-1,99,2,-2;",
"-99,-2,2,99,4,0,-4,-4,4,0,-4,4;",
"-99,-2,0,99,4,0;",
"-99,0,299,0,-4;");
ROW 5 TEXT CONST line pattern := ROW 5 TEXT:("LT;", "LT1;", "LT2;", "LT3;", "LT4;");
ROW 8 TEXT CONST fill pattern := ROW 8 TEXT:("FT4,25,45;", "FT1,0,0;", "FT3,50,0;",
"FT3,50,90;", "FT4,50,0;", "FT3,50,-45;",
"FT3,50,45;", "FT4,50,45;");
PROC drawing area (REAL VAR x cm, y cm, INT VAR x pixel, y pixel) :
x cm := 29.7; y cm := 21.07;
x pixel := 11040; y pixel := 7721;
END PROC drawing area;
PROC set range (INT CONST h min, v min, h max, v max):
IF h min >= h max OR v min >= v max
THEN errorstop ("Incorrect Range") FI;
area := RANGE:(POS:(h min, v min), POS:(h max, v max))
END PROC set range;
PROC get range (INT VAR h min, v min, h max, v max):
h min := area.min.x; v min := area.min.y;
h max := area.max.x; v max := area.max.y
END PROC get range;
PROC begin plot:
out ("IN;")
ENDPROC begin plot;
PROC end plot:
TEXT VAR rec;
out ("IN;SP;PA22040,7721;DP;");
REP pause (10);
out ("OS;");
input (rec, ""13"", 600)
UNTIL enter pressed PER;
out ("IN;") .
enter pressed:
(int (rec) AND 4) > 0 .
ENDPROC end plot;
PROC clear:
new values (29.7, 21.07, 11040, 7721, area.min.x, area.max.x, area.min.y, area.max.y);
pen := PEN : (0, 1, 0, 1);
old := area.min;
out ("DF;IP;"); (* Default *)
out ("IW" + text (area.min.x, area.min.y) + ", " + (* Clipping *)
text (area.max.x, area.max.y) + term);
out ("SP1;"); (* Pen 1 *)
out ("LT;"); (* durchgehend *)
out ("PU;PA" + text (old.x, old.y)); (* Startpunkt *)
END PROC clear;
PROC set pen (INT CONST back, fore, thick, type):
set colour;
set linetype .
set colour:
IF abs (fore) >= 1 AND abs (fore) <= 6
THEN out ("SP" + text (abs (fore)) + term);
pen.fore := abs (fore);
FI .
set linetype:
IF type >= 1 AND type <= 5
THEN out (line pattern [type]);
pen.line := type
ELSE out ("SP;");
pen.line := 0
FI .
END PROC set pen;
PROC get pen (INT VAR back, fore, thick, line):
back := pen.back;
fore := pen.fore;
thick := pen.thick;
line := pen.line
END PROC get pen;
PROC move (INT CONST x, y) :
out ("PU;PA" + text (x, y) + term);
old := POS : (x, y)
END PROC move;
PROC draw (INT CONST x, y):
out ("PD;PA" + text (x, y) + term);
old := POS : (x, y)
END PROC draw;
PROC draw (TEXT CONST msg, REAL CONST angle, INT CONST height, width):
set angle;
set height and width;
plot msg .
set angle:
out ("DI " + text (cosd (angle), sind (angle)) + term) .
set height and width:
IF width = 0 AND height = 0
THEN out ("SR;")
ELSE out ("SI" + text (real (width) * width scale,
real (height) * height scale) + term)
FI .
plot msg:
out ("LB" + msg + etx) .
END PROC draw;
PROC bar (INT CONST from x, from y, to x, to y, pattern):
out ("PU;PA" + text (from x, from y) + term);
out ("LT;EA" + text (to x, to y) + term);
IF pattern > 0 AND pattern <= 8
THEN out (fill pattern [pattern]);
out ("RA" + text (to x, to y) + term);
FI;
out ("PU;PA" + text (old.x, old.y) + term);
out (line pattern [pen.line]) .
END PROC bar;
PROC circle (INT CONST x, y, rad, REAL CONST from, to, INT CONST pattern):
out ("LT;PU;PA" + text (x, y) + term);
IF (from MOD 360.0) = 0.0 AND (to MOD 360.0) = 0.0
THEN out ("CI" + text (rad) + term)
ELSE out ("EW" + text (rad) + comma + text (from, to-from) + term) FI;
IF pattern > 0 AND pattern <= 6
THEN out (fill pattern [pattern]);
out ("WG" + text (rad) + comma + text (from, to-from) + term)
FI;
out ("PU;PA" + text (old.x, old.y) + term);
out (line pattern [pen.line]) .
END PROC circle;
PROC marker (INT CONST x, y, no, size):
out ("LT;PU;PA" + text (x, y) + term);
out ("DI1,0;");
IF size = 0
THEN out ("SI0.25,0.5;")
ELSE out ("SI" + text (real (size)*0.001, real (size)*0.002) + term) FI;
out ("UC" + mark [mark no]);
out ("PU;PA" + text (old.x, old.y) + term);
out (line pattern [pen.line]) .
mark no:
IF no >= 1 AND no <= 16
THEN no
ELSE 1 FI .
END PROC marker;
PROC where (INT VAR x, y):
x := old.x; y := old.y
END PROC where;
TEXT PROC text (INT CONST x, y):
text (x) + comma + text (y)
END PROC text;
TEXT PROC text (REAL CONST x, y):
text (x) + comma + text (y)
END PROC text;
TEXT PROC text (REAL CONST x):
result := compress (text (x, 9, 4));
IF (result SUB 1) = point
THEN insert char (result, zero, 1)
ELIF (result SUB LENGTH result) = point
THEN result CAT zero FI;
result
END PROC text;
PROC input (TEXT VAR rec, TEXT CONST del, INT CONST time):
enable stop;
rec := nil;
REP TEXT CONST char := incharety (time);
IF char = nil
THEN errorstop ("Timeout after " + text (time))
ELIF pos (del, char) > 0
THEN LEAVE input
ELSE rec CAT char FI
PER .
END PROC input;
END PACKET hp7475 plot