diff options
Diffstat (limited to 'system/std.graphik/1.8.7/src/HP7475.plot')
| -rw-r--r-- | system/std.graphik/1.8.7/src/HP7475.plot | 254 |
1 files changed, 254 insertions, 0 deletions
diff --git a/system/std.graphik/1.8.7/src/HP7475.plot b/system/std.graphik/1.8.7/src/HP7475.plot new file mode 100644 index 0000000..860dd03 --- /dev/null +++ b/system/std.graphik/1.8.7/src/HP7475.plot @@ -0,0 +1,254 @@ +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 + |