(*************************************************************************)
(* *)
(* K L A R T E X T *)
(* =============== *)
(* *)
(* Tastenbelegungen im Klartext fuer Steuertasten *)
(* *)
(* Autor: Thomas Berlage *)
(* Stand: 27.04.88 *)
(* Version 1.0 *)
(* *)
(* Zweck: Lernsequenzen koennen editiert werden, wobei fuer *)
(* die Steuertasten symbolische Namen in spitzen *)
(* Klammern verwendet werden. Folgende Namen sind *)
(* zulaessig: *)
(* *)
(* <hop> <links> <rechts> <oben> <unten> <tab> *)
(* <rubin> <rubout> <mark> <esc> *)
(* *)
(* Aufruf: *)
(* PROC lernsequenz editieren (TEXT CONST taste) *)
(* *)
(**************************************************************************)
PACKET case conversion (* Stand: 07.02.88 *)
DEFINES
to lowercase,
to uppercase :
PROC to uppercase (TEXT VAR line) :
INT VAR p := 0;
REP
p := pos (line, "a", "z", p + 1);
IF p = 0 THEN LEAVE to uppercase END IF;
replace (line, p, code (code (line SUB p) - 32))
END REP
END PROC to uppercase;
PROC to lowercase (TEXT VAR line) :
INT VAR p := 0;
REP
p := pos (line, "A", "Z", p + 1);
IF p = 0 THEN LEAVE to lowercase END IF;
replace (line, p, code (code (line SUB p) + 32))
END REP
END PROC to lowercase;
END PACKET case conversion;
PACKET klartextbelegung
DEFINES
sieben bit modus,
klartext,
kodierung :
BOOL VAR sieben bit := TRUE;
ROW 33 TEXT CONST tasten := ROW 33 TEXT : (
"nul", "hop", "rechts", "oben", "-(4)", "fkt1", "fkt2", "-(7)", "links",
"tab", "unten", "rubin", "rubout", "return", "fkt3", "fkt4", "mark",
"-(17)", "-(18)", "-(19)", "-(20)", "fkt5", "fkt6", "-(23)", "fkt7",
"fkt8", "fkt9", "esc", "fkt10", "fkt11", "fkt12", "fkt13", "blank");
LET
separator anfang = "<",
separator ende = ">";
TEXT VAR ergebnis;
BOOL PROC sieben bit modus :
sieben bit
END PROC sieben bit modus;
PROC sieben bit modus (BOOL CONST modus) :
sieben bit := modus
END PROC sieben bit modus;
TEXT PROC klartext (TEXT CONST t) :
INT VAR i;
ergebnis := "";
FOR i FROM 1 UPTO length (t) REP
klartext eines zeichens bestimmen
END REP;
ergebnis .
klartext eines zeichens bestimmen :
INT CONST c := code (t SUB i);
IF c < 33 THEN
ergebnis CAT separator anfang + tasten (c + 1) + separator ende
ELIF c >= 127 CAND sieben bit CAND kein umlaut THEN
ergebnis CAT separator anfang + text (c) + separator ende
ELSE
ergebnis CAT code (c)
END IF .
kein umlaut :
pos (eumel sonderzeichen, code (c)) = 0 .
eumel sonderzeichen :
""214""215""216""217""218""219""220""221""222""223""251""252"" .
END PROC klartext;
TEXT PROC kodierung (TEXT CONST t) :
INT VAR
sep pos := pos (t, separator anfang),
sep ende := 0;
enable stop;
ergebnis := "";
WHILE sep pos > 0 REP
text vor separator uebernehmen;
separiertes zeichen behandeln;
sep pos := pos (t, separator anfang, sep ende)
END REP;
restliche zeichen uebernehmen;
ergebnis .
text vor separator uebernehmen :
ergebnis CAT subtext (t, sep ende + 1, sep pos - 1) .
separiertes zeichen behandeln :
sep ende := pos (t, separator ende, sep pos);
IF sep ende = 0 THEN
errorstop ("""" + separator ende + """ fehlt.")
ELSE
separiertes zeichen kodieren
END IF .
separiertes zeichen kodieren :
TEXT VAR bezeichnung := subtext (t, sep pos + 1, sep ende - 1);
change all (bezeichnung, " ", "");
to lowercase (bezeichnung);
INT VAR c := int (bezeichnung);
IF keine zahl THEN
mit tabelle vergleichen
END IF;
ergebnis CAT code (c) .
keine zahl :
NOT last conversion ok .
mit tabelle vergleichen :
INT VAR i;
FOR i FROM 1 UPTO 33 REP
IF bezeichnung = tasten (i) THEN
c := i - 1;
LEAVE mit tabelle vergleichen
END IF
END REP;
errorstop ("unbekannte Tastenbezeichnung: """ + bezeichnung + """") .
restliche zeichen uebernehmen :
ergebnis CAT subtext (t, sep ende + 1) .
END PROC kodierung;
END PACKET klartextbelegung;
PACKET klartext anwendung
DEFINES
klartext auf taste,
klartext auf taste legen,
klartext aus file,
klartext in file,
lernsequenz editieren :
LET
separator anfang = "<",
separator ende = ">";
TEXT VAR
zeile,
sequenz,
aenderung;
DATASPACE VAR
ds;
TEXT PROC klartext auf taste (TEXT CONST taste) :
klartext (lernsequenz auf taste (kodierung (taste)))
END PROC klartext auf taste;
PROC klartext auf taste legen (TEXT CONST taste, belegung) :
lernsequenz auf taste legen (kodierung (taste), kodierung (belegung))
END PROC klartext auf taste legen;
PROC klartext in file (FILE VAR f, TEXT CONST belegung) :
INT VAR
ende,
anfang := 1;
output (f);
zeile := klartext (belegung);
REP
ende der zeile bestimmen;
putline (f, subtext (zeile, anfang, ende - 1));
anfang := ende
UNTIL anfang > length (zeile) END REP .
ende der zeile bestimmen :
TEXT CONST zeichen := subtext (zeile, anfang, anfang + 4);
IF zeichen = "<hop>" OR zeichen = "<esc>" THEN
ende := pos (zeile, separator anfang, anfang + 6)
ELSE
ende := pos (zeile, separator anfang, anfang + 1)
END IF;
IF ende = 0 THEN ende := length (zeile) + 1 END IF;
ende := min (anfang + maxlinelength (f), ende) .
(*
IF (ende - anfang) > maxlinelength (f) THEN
ende := anfang + maxlinelength (f)
ELIF ende > 5 THEN
letzten separator bestimmen
END IF .
letzten separator bestimmen :
TEXT CONST zeichen := subtext (zeile, ende - 4, ende - 2);
IF zeichen = "esc" OR zeichen = "hop" THEN
ende verschieben
ELSE
ende := pos (zeile, separator ende, ende)
END IF .
ende verschieben :
IF (zeile SUB ende + 5) = separator anfang THEN
ende := pos (zeile, separator ende, ende + 5);
IF ende = 0 THEN ende := length (zeile) END IF
ELSE
ende := ende + 5
END IF .
*)
END PROC klartext in file;
PROC klartext aus file (FILE VAR f, TEXT VAR belegung) :
input (f);
belegung := "";
WHILE NOT eof (f) REP
getline (f, zeile);
IF (zeile SUB LENGTH zeile) = " " THEN
zeile := subtext (zeile, 1, length (zeile) - 1)
END IF;
belegung CAT kodierung (zeile)
END REP .
END PROC klartext aus file;
PROC lernsequenz editieren (TEXT CONST taste) :
disable stop;
ds := nilspace;
editieren (taste);
forget (ds)
END PROC lernsequenz editieren;
PROC editieren (TEXT CONST taste) :
enable stop;
FILE VAR f := sequential file (output, ds);
sequenz := lernsequenz auf taste (taste);
klartext in file (f, sequenz);
headline (f, "Tastenbelegung");
edit (f);
klartext aus file (f, aenderung);
IF aenderung <> sequenz CAND wirklich aendern THEN
lernsequenz auf taste legen (taste, aenderung)
END IF .
wirklich aendern :
yes ("Lernsequenz aendern") .
END PROC editieren;
END PACKET klartext anwendung;