PACKET graphic editor DEFINES graphic, (*Autor: H.Indenbirken *)
picfile, picture, (*Stand: 26.02.1985 *)
neu zeichnen,
UP, DOWN, T,
pen, select pen, selected pen, background,
extrema pic, extrema picfile:
LET norm cmd = ""1""27""3""10""9"epb"16"",
hop cmd = ""2""10""12""1"",
bell = ""7"",
esc = ""27"";
PICFILE VAR p;
PICTURE VAR pic;
TEXT VAR command :: "", old command :: "", char, headline :: "";
BOOL VAR within edit :: FALSE, new plot :: FALSE;
ROW 3 ROW 2 REAL VAR size;
ROW 2 ROW 2 REAL VAR limits;
ROW 4 REAL VAR angles;
ROW 2 REAL VAR oblique;
ROW 3 REAL VAR perspective;
PROC open graphic (TEXT CONST name, DATASPACE CONST ds):
p := ds;
get values (p, size, limits, angles, oblique, perspective);
head line := ""1""15"LEN ................................ DIM PEN .."14" Picture "15""14"";
replace (head line, 32-LENGTH name DIV 2, name);
new plot := TRUE;
within edit := TRUE
END PROC open graphic;
PROC graphic:
graphic (last param)
END PROC graphic;
PROC graphic (TEXT CONST name) :
IF NOT exists (name)
THEN IF yes ("Soll ein neuer Picfile eingerichtet werden")
THEN graphic (new (name), name) FI
ELSE graphic (old (name), name) FI
END PROC graphic;
PROC graphic (DATASPACE CONST f, TEXT CONST name) :
open graphic (name, f);
reset;
kommandos bearbeiten;
within edit := FALSE .
kommandos bearbeiten :
REP IF new plot
THEN plot (p);
new plot := FALSE
FI;
read picture (p, pic);
out head line;
inchar (command);
do command
PER .
out head line:
replace (headline, 7, text (length (pic), 5));
replace (headline, 50, text (dim (pic), 1));
replace (headline, 57, text (pen (pic), 2));
replace (headline, 72, text (picture no (p), 4));
out (head line) .
do command:
SELECT pos (norm cmd, command) OF
CASE 1: hop commands
CASE 2: escape commands
CASE 3: position up
CASE 4: position down
CASE 5: position direct
CASE 6: extrema pic
CASE 7: selected pen (pen (pic));
CASE 8: out (1, 2, ""15""5"Hintergrundfarbe: " +
colour of (background (p)) + " "14"")
CASE 9: identify (pic);
OTHERWISE out (bell) ENDSELECT .
position up :
IF is first picture (p)
THEN out (bell);
ELSE up (p) FI .
position down :
IF eof (p)
THEN out (bell)
ELSE down (p) FI .
position direct:
out (1, 68, "");
edit get (command, 4, 4);
to pic (p, int (command)) .
hop commands :
inchar (command);
SELECT pos (hop cmd, command) OF
CASE 1: to first pic (p)
CASE 2: to eof (p)
CASE 3: delete picture (p);
IF NOT new plot
THEN erase (pic) FI
CASE 4: new plot := TRUE
OTHERWISE out (bell) ENDSELECT .
escape commands :
inchar (command);
IF command = "q"
THEN LEAVE kommandos bearbeiten
ELIF command = "f"
THEN do (old command)
ELIF command = esc
THEN kommandomodus
ELSE do (kommando auf taste (command)) FI .
END PROC graphic;
PROC kommandomodus:
command := "";
disable stop;
REP get command;
do (command)
UNTIL command executed PER;
IF new values
THEN get values (size, limits, angles, oblique, perspective);
set values (p, size, limits, angles, oblique, perspective);
new plot := new plot OR new values
FI .
get command:
REP out (1, 2, ""15"Gib Graphikkommando: ");
edit get (command, 0, 54, "", "k", char);
out (""14"");
out (1, 2, ""5"");
IF char = ""13""
THEN LEAVE get command
ELIF char = ""27"k"
THEN command := old command FI
PER .
command executed:
IF is error
THEN out (1, 1, error message);
clear error;
FALSE
ELSE old command := command;
TRUE
FI .
END PROC kommandomodus;
PROC out (INT CONST x, y, TEXT CONST t):
cursor (x, y);
out (t)
END PROC out;
TEXT PROC colour of (INT CONST colour):
SELECT colour OF
CASE 0: "löschen"
CASE 1: "std"
CASE 2: "rot"
CASE 3: "blau"
CASE 4: "grün"
CASE 5: "schwarz"
CASE 6: "weiß"
OTHERWISE text (colour) ENDSELECT .
END PROC colour of;
TEXT PROC linetype of (INT CONST linetype):
SELECT linetype OF
CASE 0: "unsichtbar"
CASE 1: "durchgehend"
CASE 2: "gepunktet"
CASE 3: "kurz gestrichelt"
CASE 4: "lang gestrichelt"
CASE 5: "strichpunkt"
OTHERWISE text (linetype) ENDSELECT .
END PROC linetype of;
PICFILE PROC picfile :
IF NOT within edit
THEN errorstop ("Not within editmode") FI;
p
END PROC picfile;
PICTURE PROC picture :
IF NOT within edit
THEN errorstop ("Not within editmode") FI;
pic
END PROC picture;
PROC neu zeichnen:
new plot := TRUE
END PROC neu zeichnen;
OP UP (INT CONST distance):
up (p, distance);
read picture (p, pic)
END OP UP;
OP DOWN (INT CONST distance):
down (p, distance);
read picture (p, pic)
END OP DOWN;
OP T (INT CONST n):
to pic (p, n);
read picture (p, pic)
END OP T;
PROC pen (INT CONST n):
IF NOT new plot
THEN erase (pic) FI;
pen (pic, n);
write picture (p, pic);
IF NOT new plot
THEN show (pic) FI
END PROC pen;
PROC select pen (INT CONST n, colour, thickness, linetype, BOOL CONST hidden):
select pen (p, n, colour, thickness, linetype, hidden);
new plot := TRUE
END PROC select pen;
PROC select pen (INT CONST n, colour, thickness, linetype):
select pen (p, n, colour, thickness, linetype, FALSE);
new plot := TRUE
END PROC select pen;
PROC selected pen (INT CONST n, INT VAR colour, thickness, linetype,
BOOL VAR hidden):
selected pen (p, n, colour, thickness, linetype, hidden);
END PROC selected pen;
PROC selected pen (INT CONST n):
INT VAR colour, thickness, linetype;
BOOL VAR hidden;
selected pen (p, n, colour, thickness, linetype, hidden);
out (1, 2, ""5""15"PEN #" + text (n) + ": Farbe: " + colour of (colour) +
", Dicke " + text (thickness) + ", Linientyp " + linetype of (linetype) +
hidden text + " "14"") .
hidden text:
IF hidden
THEN ". "
ELSE ", nicht sichtbare Linien werden unterdrückt." FI .
END PROC selected pen;
INT PROC background:
background (p)
END PROC background;
PROC background (INT CONST n):
new plot := n <> background (p);
background (p, n)
END PROC background;
PROC extrema pic:
REAL VAR x min, x max, y min, y max, z min, z max;
IF dim (pic) = 2
THEN extrema (pic, x min, x max, y min, y max);
out (1, 2, ""5""15"Extrema: [" + text (x min) + "," + text (x max) +
"] [" + text (y min) + "," + text (y max) + "] "14"")
ELSE extrema (pic, x min, x max, y min, y max, z min, z max);
out (1, 2, ""5""15"Extrema: [" + text (x min) + "," + text (x max) +
"] [" + text (y min) + "," + text (y max) +
"] [" + text (z min) + "," + text (z max) +"] "14"")
FI
END PROC extrema pic;
PROC extrema picfile:
REAL VAR x min, x max, y min, y max, z min, z max;
extrema (p, x min, x max, y min, y max, z min, z max);
out (1, 2, ""5""15"Extrema: [" + text (x min) + "," + text (x max) +
"] [" + text (y min) + "," + text (y max) +
"] [" + text (z min) + "," + text (z max) +"] "14"")
END PROC extrema picfile;
PROC identify (PICTURE CONST pic):
begin plot;
hidden lines (TRUE);
pen (background (p), 1, 1, 2);
plot (pic);
end plot
END PROC identify;
PROC erase (PICTURE CONST pic):
INT VAR colour, thickness, linetype;
BOOL VAR hidden;
selected pen (p, pen (pic), colour, thickness, linetype, hidden);
begin plot;
hidden lines (TRUE);
pen (background (p), 0, thickness, linetype);
plot (pic);
end plot
END PROC erase;
PROC show (PICTURE CONST pic):
INT VAR colour, thickness, linetype;
BOOL VAR hidden;
selected pen (p, pen (pic), colour, thickness, linetype, hidden);
begin plot;
hidden lines (TRUE);
pen (background (p), colour, thickness, linetype);
plot (pic);
end plot
END PROC show;
END PACKET graphic editor;