PACKET televideo plot DEFINES drawing area, { Autor: H. Indenbirken }
begin plot, { Stand: 31.01.85 }
end plot,
clear,
pen,
move,
draw,
get cursor,
cursor:
LET delete = 0, {Farbcodes}
std = 1,
black = 5,
white = 6,
nothing = 0, {Linientypen}
durchgehend = 1,
gepunktet = 2,
kurz gestrichelt = 3,
lang gestrichelt = 4,
strichpunkt = 5,
mittel gestrichelt = 6,
punkt punkt strich = 7;
INT VAR act thick :: 0;
LET POS = STRUCT (INT x, y);
POS VAR pos :: POS : (0, 0);
PROC drawing area (REAL VAR x cm, y cm, INT VAR x pixel, y pixel) :
x cm := 23.0; y cm := 13.7;
x pixel := 639; y pixel := 239
END PROC drawing area;
PROC begin plot :
page;
out (""27".0")
ENDPROC begin plot ;
PROC end plot :
out (""27".1")
ENDPROC end plot ;
PROC clear :
act thick := 0;
pos := POS : (0, 0);
out (""27"mCGD")
END PROC clear;
PROC pen (INT CONST background, foreground, thickness, linetype):
out (""27"m");
set background;
set foreground;
set thickness;
set linetype;
out ("D") .
set background:
IF background = white
THEN out (""27"n1")
ELSE out (""27"n0") FI .
set foreground:
IF foreground = delete
THEN out ("U0W1")
ELIF foreground < 0
THEN out ("U1W4")
ELSE out ("U1W1") FI .
set thickness:
act thick := thickness .
set linetype:
SELECT linetype OF
CASE durchgehend : out ("T1")
CASE gepunktet : out ("T3")
CASE kurz gestrichelt : out ("T6")
CASE lang gestrichelt : out ("T5")
CASE strichpunkt : out ("T4")
CASE mittel gestrichelt : out ("T2")
CASE punkt punkt strich : out ("T7")
END SELECT .
END PROC pen;
PROC move (INT CONST x, y) :
out (""27"mM" + text (x, y) + ";D");
pos := POS : (x, y)
END PROC move;
PROC draw (INT CONST x, y) :
IF act thick <> 0
THEN IF horizontal line
THEN thick y
ELSE thick x FI;
x MOVE y
ELSE out (""27"mL" + text (x, y) + ";D") FI;
pos := POS : (x, y) .
horizontal line:
abs (pos.x-x) > abs (pos.y-y) .
thick y:
INT VAR dy, old x :: pos.x-x ausgleich, new x :: x+x ausgleich;
FOR dy FROM 1 UPTO act thick
REP old x MOVE pos.y+dy;
new x DRAW y+dy;
old x MOVE pos.y-dy;
new x DRAW y-dy;
PER .
x ausgleich:
IF pos.x <= x
THEN act thick
ELSE -act thick FI .
thick x:
INT VAR dx, old y :: pos.y-y ausgleich, new y :: y+y ausgleich;
FOR dx FROM 1 UPTO act thick
REP pos.x+dx MOVE old y;
x+dx DRAW new y;
pos.x-dx MOVE old y;
x-dx DRAW new y;
PER .
y ausgleich:
IF pos.y <= y
THEN act thick
ELSE -act thick FI .
END PROC draw;
PROC draw (TEXT CONST record, REAL CONST angle, height, width):
out (""27"m""" + record + """D")
END PROC draw;
PROC draw (TEXT CONST record) :
draw (record, 0.0, 0.0, 0.0)
END PROC draw;
PROC get cursor (TEXT VAR t, INT VAR x, y) :
END PROC get cursor;
OP MOVE (INT CONST x, y):
out (""27"mM" + text (x, y) + ";D")
END OP MOVE;
OP DRAW (INT CONST x, y):
out (""27"mL" + text (x, y) + ";D")
END OP DRAW;
PROC cursor (INT CONST no,x,y):
out (""27"m|" + text (no) + "~0H" + text (x, y) + ";D")
END PROC cursor;
TEXT PROC text (INT CONST x,y):
x text + "," + y text .
x text:
IF x < 0
THEN "0"
ELIF x > 639
THEN "639"
ELSE text (x) FI .
y text:
IF y < 0
THEN "0"
ELIF y > 639
THEN "639"
ELSE text (y) FI .
END PROC text;
END PACKET televideo plot