PACKET flint
(*************************************************************************)
(* *)
(* EUMEL Menue-Monitor *)
(* *)
(* Version 05 *)
(* *)
(* Autor: Thomas Berlage *)
(* Stand: 16.10.88 *)
(* *)
(*************************************************************************)
DEFINES
flint :
TEXT CONST flint vater := name (myself);
setze partner (2, "KAKTUS");
setze partner (3, "CHART");
PROC flint :
page;
fenstergroessen bestimmen;
disable stop;
REP
menue anbieten (ROW 6 TEXT :
("FLINT.Standard", "FLINT.Eigene", "FLINT.System",
"EUDAS.Dateien", "EUDAS.Archiv", ""),
fenster links, TRUE,
PROC (INT CONST, INT CONST) flint inter);
bereich wechseln
END REP
END PROC flint;
PROC fusszeile aktualisieren :
arbeitsbereich bestimmen;
fussteil (2, "", "")
END PROC fusszeile aktualisieren;
(*************************** FLINT Interpreter *****************************)
LET
t datum = #1300#
""15"Datum "14"",
kb von = #1301#
" KB von ",
sind belegt = #1302#
" KB sind belegt.",
p taskname = #1303#
"Name des Arbeitsbereichs:",
existiert nicht als task = #1304#
" ist kein Name eines Bereiches",
t loeschen = #1305#
" verlassen und löschen",
t speicher = #1306#
"Speicher:",
t cpu zeit = #1307#
" KB CPU-Zeit : ",
t zustand = #1308#
"Zustand : ",
t prio = #1309#
" Priorität: ",
t kanal = #1310#
" Kanal: ",
t busy = #1311#
"Arbeit",
t io = #1312#
"EinAus",
t wait = #1313#
"Warten",
t busy blocked = #1314#
"B(Arb)",
t io blocked = #1315#
"B(E/A)",
t wait blocked = #1316#
"B(Wrt)",
t dead = #1317#
">>TOT<",
bereich neu einrichten = #1318#
"Bereich existiert nicht. Neu einrichten",
p name vater = #1319#
"Unter welchem Vaterbereich (RET -> FLINT):",
weitermachen in = #1320#
"Weitermachen in Bereich:",
task ganz abkoppeln = #1321#
"Eigenen Bereich ganz abkoppeln";
TEXT VAR
wechsel taskname := "";
SATZ VAR sammel;
PROC flint inter (INT CONST menuenr, f nr) :
SELECT menuenr OF
CASE 0: sperren setzen
CASE 1: standard interpreter
CASE 2: eigene interpreter
CASE 3: system interpreter
CASE 4: dateiverwaltung (f nr)
CASE 5: archivverwaltung (menuenr, f nr)
END SELECT .
sperren setzen :
fusszeile ("", "", 35, t datum, 64);
fussteil (3, date) .
standard interpreter :
enable stop;
SELECT f nr OF
CASE 0 : fusszeile aktualisieren
CASE 1 : textverarbeitung
CASE 2 : eudas
CASE 3 : kaktus
CASE 4 : dgs superchart
CASE 5 : programme
CASE 6 : systemsteuerung
OTHERWISE ggf dialogfenster loeschen
END SELECT .
kaktus :
continue (abhaengige task (2));
page; bildschirm neu .
dgs superchart :
continue (abhaengige task (3));
page; bildschirm neu .
systemsteuerung :
continue (task ("OP"));
page; bildschirm neu .
ggf dialogfenster loeschen :
IF f nr = -1 THEN dialogfenster loeschen END IF .
eigene interpreter :
enable stop;
SELECT f nr OF
CASE 0 : fusszeile aktualisieren
OTHERWISE ggf dialogfenster loeschen
END SELECT .
system interpreter :
enable stop;
SELECT f nr OF
CASE 0 : fusszeile aktualisieren
CASE 1 : bereich wechseln
CASE 2 : bereichsuebersicht
CASE 3 : speicherbelegung
CASE 4 : eigener status
CASE 5 : fremder taskstatus
CASE 6 : task info (3); bildschirm neu; dialogfenster loeschen
CASE 7 : task loeschen
OTHERWISE ggf dialogfenster loeschen
END SELECT .
bereichsuebersicht :
disable stop;
bitte warten;
DATASPACE VAR list ds := nilspace;
FILE VAR f := sequential file (output, list ds);
task info (1, f);
IF NOT is error THEN
edit (f, fenster rechts, "SHOW/Taskinfo", FALSE)
END IF;
forget (list ds);
enable stop .
speicherbelegung :
INT VAR size, used;
storage (size, used);
size := int (real (size + 24) * 64.0 / 63.0);
IF l3 THEN
size := size DIV 1024;
used := used DIV 1024
END IF;
dialog (text (used) + kb von + text (size) + sind belegt) .
eigener status :
task zustand (myself) .
fremder taskstatus :
TEXT VAR taskname := "";
editget (p taskname, taskname, "GET/Taskname", "");
TASK VAR status task := task (task name);
IF exists (status task) THEN
task zustand (status task)
ELSE
errorstop (textdarstellung (taskname) + existiert nicht als task)
END IF .
task loeschen :
IF ja (textdarstellung (name (myself)) + t loeschen,
"JA/Task loeschen", FALSE) THEN
end partner (2); end partner (3);
deferred end;
bereich wechseln
END IF .
END PROC flint inter;
PROC bereich wechseln :
enable stop;
editget (weitermachen in, wechsel taskname, "z", "GET/wtaskname");
IF subtext (wechsel taskname, 1, 2) = ""27"z" THEN
bereich auswaehlen
ELIF wechsel taskname <> "" THEN
ggf task einrichten
ELIF ganz abkoppeln THEN
continue (niltask)
END IF;
fenstergroessen bestimmen;
page;
bildschirm neu .
bereich auswaehlen :
bitte warten;
alle tasknamen sammeln;
auswahl anbieten ("FLINT.Taskauswahl", fenster rechts, 1,
"AUSWAHL/Tasks", PROC (TEXT VAR, INT CONST) aus sammel);
IF wahl (1) <> 0 THEN
feld lesen (sammel, wahl (1), wechsel taskname);
continue (task (wechsel taskname))
END IF .
alle tasknamen sammeln :
access catalogue;
satz initialisieren (sammel);
wechsel taskname := subtext (wechsel taskname, 3);
pattern feststellen;
IF exists task (flint vater) THEN
sammel tasks (task (flint vater), pattern)
ELSE
sammel tasks (father, pattern)
END IF .
pattern feststellen :
TEXT VAR pattern;
IF pos (wechsel taskname, "*") = 0 THEN
pattern := ""
ELSE
pattern := wechsel taskname
END IF .
ggf task einrichten :
IF NOT exists task (wechsel taskname) THEN
IF ja (bereich neu einrichten, "JA/task einrichten") THEN
vater erfragen;
begin (wechsel taskname, name vater);
continue (task (wechsel taskname))
END IF
ELSE
continue (task (wechsel taskname))
END IF .
vater erfragen :
TEXT VAR name vater := "";
editget (p name vater, name vater, "", "GET/Vatertask");
IF name vater = "" THEN
name vater := flint vater
END IF .
ganz abkoppeln :
ja (task ganz abkoppeln, "JA/abkoppeln") .
END PROC bereich wechseln;
PROC aus sammel (TEXT VAR inhalt, INT CONST pos) :
IF pos > 200 THEN
inhalt := ""
ELSE
feld lesen (sammel, pos, inhalt)
END IF
END PROC aus sammel;
PROC sammel tasks (TASK CONST vater, TEXT CONST pattern) :
TASK VAR naechste := son (vater);
WHILE NOT is niltask (naechste) REP
ggf task sammeln;
sammel tasks (naechste, pattern);
naechste := brother (naechste)
END REP .
ggf task sammeln :
IF naechste = myself THEN
ELIF pattern = "" COR (name (naechste) LIKE pattern) THEN
feld aendern (sammel, felderzahl (sammel) + 1, name (naechste))
END IF .
END PROC sammel tasks;
PROC task zustand (TASK CONST status task) :
dialog (t speicher + speicher + t cpu zeit + cpu zeit);
out (t zustand); out status; out (t prio); out prio;
out (t kanal); out kanal .
speicher :
text (storage (status task), 5) .
cpu zeit :
disable stop;
TEXT VAR result := subtext (time (clock (status task), 12), 1, 10);
IF is error THEN
clear error; result := "**********"
END IF;
result .
out status :
SELECT status (status task) OF
CASE 0 : out (t busy)
CASE 1 : out (t io)
CASE 2 : out (t wait)
CASE 4 : out (t busy blocked)
CASE 5 : out (t io blocked)
CASE 6 : out (t wait blocked)
OTHERWISE out (t dead)
END SELECT .
out prio :
out (text (pcb (status task, 6))) .
out kanal :
IF channel (status task) = 0 THEN
out (" -")
ELSE
out (text (channel (status task), 2))
END IF .
END PROC task zustand;
(**************************** Textverarbeitung ****************************)
LET
t ausnahmen = #1400#
"Ausnahmen",
t druckertask = #1401#
"Name Druckertask: ",
task existiert nicht = #1402#
"Task existiert nicht",
t stationsnummer = #1403#
"Stationsnummer der Druckertask: ",
falsche stationsnummer = #1404#
"Falsche Stationsnummer",
t trennfaktor = #1405#
"Trennfaktor (4 bis 20): ",
t ersten kopf unterdruecken = #1406#
"Ersten Kopfteil unterdrücken",
t letzten fuss unterdruecken = #1407#
"Letzten Fußteil unterdrücken",
t fussabstand = #1408#
"Anzahl Leerzeilen vor Fußnoten (0 bis 9): ",
lineform manuell = #1409#
"Trennungen manuell bestimmen",
pageform manuell = #1410#
"Seitenaufteilung manuell bestimmen",
falscher trennfaktor = #1411#
"Falscher Trennfaktor (nur 4 bis 20)",
name fonttabelle = #1412#
"Name der Fonttabelle: ",
t neu einrichten = #1413#
" neu einrichten",
name der datei = #1414#
"Name der Datei: ";
LET
font file typ = 3009;
INT VAR
file typ := 1003;
IF l3 THEN file typ := 1004 END IF .
l3 : maxint DIV 2 > 17000 .
;
BOOL VAR
zeilen manuell := TRUE,
seiten manuell := TRUE;
TEXT VAR
druckertask := "PRINTER";
INT VAR
druckerstation := station (myself);
PROC textverarbeitung :
page; bildschirm neu;
BOOL CONST alter umbruch := word wrap;
word wrap (TRUE);
menue anbieten (ROW 6 TEXT :
("TEXTE.Erstellen", "TEXTE.Bearbeiten", "TEXTE.Einstellungen",
"EUDAS.Dateien", "EUDAS.Archiv", ""),
fenster links, TRUE,
PROC (INT CONST, INT CONST) text inter);
word wrap (alter umbruch);
page; bildschirm neu
END PROC textverarbeitung;
PROC text inter (INT CONST menuenr, f nr) :
SELECT menuenr OF
CASE 0: sperren setzen
CASE 1: erstellen interpreter
CASE 2: bearbeiten interpreter
CASE 3: einstellungen interpreter
CASE 4: dateiverwaltung (f nr)
CASE 5: archivverwaltung (menuenr, f nr)
END SELECT .
sperren setzen :
fusszeile ("", "", 35, t datum, 64);
fussteil (3, date) .
erstellen interpreter :
enable stop;
SELECT f nr OF
CASE 0 : fusszeile aktualisieren
CASE 1 : editieren
CASE 2 : drucken
CASE 3 : zeilen formatieren
CASE 4 : seiten formatieren
CASE 5 : automatik
OTHERWISE ggf dialogfenster loeschen
END SELECT .
editieren :
ausfuehrung (PROC (TEXT CONST) editiere);
dialogfenster loeschen .
drucken :
ausfuehrung (PROC (TEXT CONST) drucke) .
zeilen formatieren :
bildschirm neu;
IF zeilen manuell THEN
ausfuehrung (PROC (TEXT CONST) lineform)
ELSE
ausfuehrung (PROC (TEXT CONST) autoform)
END IF;
dialogfenster loeschen .
seiten formatieren :
bildschirm neu;
IF seiten manuell THEN
ausfuehrung (PROC (TEXT CONST) pageform)
ELSE
ausfuehrung (PROC (TEXT CONST) autopageform)
END IF;
dialogfenster loeschen .
automatik :
zeilen manuell := ja (lineform manuell,
"JA/lineform manuell", zeilen manuell);
seiten manuell := ja (pageform manuell,
"JA/pageform manuell", seiten manuell) .
ggf dialogfenster loeschen :
IF f nr = -1 THEN dialogfenster loeschen END IF .
bearbeiten interpreter :
enable stop;
SELECT f nr OF
CASE 0 : fusszeile aktualisieren
CASE 1 : index anlegen
CASE 2 : outline anlegen
CASE 3 : file sortieren
CASE 4 : macros laden
CASE 5 : macros anzeigen
CASE 6 : ausnahmen erweitern
OTHERWISE ggf dialogfenster loeschen
END SELECT .
index anlegen :
ausfuehrung (PROC (TEXT CONST) index);
bildschirm neu; dialogfenster loeschen .
outline anlegen :
ausfuehrung (PROC (TEXT CONST) outline);
bildschirm neu; dialogfenster loeschen .
file sortieren :
bitte warten;
ausfuehrung (PROC (TEXT CONST) sort) .
macros laden :
page;
einzelausfuehrung (PROC (TEXT CONST) load macros);
bildschirm neu; dialogfenster loeschen .
macros anzeigen :
bitte warten;
list macros;
bildschirm neu; dialogfenster loeschen .
ausnahmen erweitern :
TEXT VAR zwischendatei := t ausnahmen;
WHILE exists (zwischendatei) REP zwischendatei CAT " " END REP;
create (zwischendatei);
bitte warten;
entlade ausnahmen (zwischendatei);
edit (zwischendatei);
bitte warten;
lade ausnahmen (zwischendatei);
forget (zwischendatei, quiet) .
einstellungen interpreter :
enable stop;
SELECT f nr OF
CASE 0 : fusszeile aktualisieren
CASE 1 : fonttabelle laden
CASE 2 : fonts anzeigen
CASE 3 : druckertask verstellen
CASE 4 : trennfaktor einstellen
CASE 5 : briefmodus einstellen
CASE 6 : abstand fussnoten einstellen
OTHERWISE ggf dialogfenster loeschen
END SELECT .
fonttabelle laden :
TASK VAR fonttask;
IF exists task ("configurator") THEN
fonttask := task ("configurator")
ELSE
fonttask := niltask
END IF;
ausfuehrung (name fonttabelle, TRUE, font file typ, fonttask,
PROC (TEXT CONST) font table) .
fonts anzeigen :
bitte warten;
list fonts;
bildschirm neu; dialogfenster loeschen .
druckertask verstellen :
editget (t druckertask, druckertask, "GET/Druckertask", "");
IF NOT exists task (druckertask) THEN
errorstop (task existiert nicht)
ELIF station (myself) <> 0 THEN
erfrage station
ELSE
druckerstation := station (myself)
END IF .
erfrage station :
TEXT VAR st := text (druckerstation);
editget (t stationsnummer, st, "GET/Druckstation", "");
IF int (st) >= 0 AND last conversion ok THEN
druckerstation := int (st)
ELSE
errorstop (falsche stationsnummer)
END IF .
trennfaktor einstellen :
TEXT VAR faktor := "";
editget (t trennfaktor, faktor, "GET/Trennfaktor", "");
IF faktor <> "" THEN
INT CONST fa := int (faktor);
IF fa < 4 OR fa > 20 THEN
errorstop (falscher trennfaktor);
ELSE
hyphenation width (fa)
END IF
END IF .
briefmodus einstellen :
first head (NOT ja (t ersten kopf unterdruecken, "JA/firsthead", FALSE));
last bottom (NOT ja (t letzten fuss unterdruecken, "JA/lastbottom", FALSE)) .
abstand fussnoten einstellen :
TEXT VAR anzahl := "";
editget (t fussabstand, anzahl, "GET/Fussabstand", "");
IF anzahl <> "" THEN
number empty lines before foot (int (anzahl))
END IF .
END PROC text inter;
PROC drucke (TEXT CONST dateiname) :
save (dateiname, druckerstation / druckertask)
END PROC drucke;
PROC editiere (TEXT CONST dateiname) :
IF exists (dateiname) COR neu einrichten THEN
IF NOT exists (dateiname) THEN vorher einrichten END IF;
FILE VAR f := sequential file (modify, dateiname);
edit (f, fenster ganz, "EDIT/Text")
END IF .
neu einrichten :
ja (textdarstellung (dateiname) + t neu einrichten,
"JA/einrichten") .
vorher einrichten :
FILE VAR dummy := sequential file (modify, dateiname) .
END PROC editiere;
PROC ausfuehrung (PROC (TEXT CONST) operation) :
ausfuehrung (name der datei, FALSE, file typ, PROC (TEXT CONST) operation)
END PROC ausfuehrung;
PROC einzelausfuehrung (PROC (TEXT CONST) operation) :
ausfuehrung (name der datei, TRUE, file typ, PROC (TEXT CONST) operation)
END PROC einzelausfuehrung;
(*************************** Programme ***********************************)
LET
p name prozedur = #1500#
"Name der Prozedur:",
p name paket = #1501#
"Name des Pakets:",
t weiter mit taste = #1502#
"*** Weiter mit Taste ***";
PROC programme :
page; bildschirm neu;
BOOL CONST alter umbruch := word wrap;
word wrap (FALSE);
menue anbieten (ROW 6 TEXT : ("ELAN.Erstellen", "ELAN.Permanent",
"EUDAS.Dateien", "EUDAS.Archiv", "", ""),
fenster links, TRUE,
PROC (INT CONST, INT CONST) prog interpreter);
word wrap (alter umbruch);
page; bildschirm neu
END PROC programme;
PROC prog interpreter (INT CONST menuenr, f nr) :
SELECT menuenr OF
CASE 0 : sperren setzen
CASE 1 : erstellen interpreter
CASE 2 : permanent interpreter
CASE 3 : dateiverwaltung (f nr)
CASE 4 : archivverwaltung (menuenr, f nr)
END SELECT .
sperren setzen :
fusszeile ("", "", 35, t datum, 64);
fussteil (3, date) .
erstellen interpreter :
enable stop;
SELECT f nr OF
CASE 0 : fusszeile aktualisieren
CASE 1 : editieren
CASE 2 : ausfuehren
CASE 3 : wiederholen
CASE 4 : drucken
CASE 5 : testinstallation
OTHERWISE ggf dialogfenster loeschen
END SELECT .
ggf dialogfenster loeschen :
IF f nr = -1 THEN dialogfenster loeschen END IF .
editieren :
ausfuehrung (PROC (TEXT CONST) editiere);
dialogfenster loeschen .
drucken :
ausfuehrung (PROC (TEXT CONST) drucke) .
ausfuehren :
ausfuehrung (PROC (TEXT CONST) page and run);
dialogfenster loeschen .
wiederholen :
page;
bildschirm neu;
runagain;
warten auf antwort;
dialogfenster loeschen .
testinstallation :
ausfuehrung (PROC (TEXT CONST) page check on insert);
dialogfenster loeschen .
permanent interpreter :
SELECT f nr OF
CASE 0 : fusszeile aktualisieren
CASE 1 : installieren
CASE 2 : prozedurhilfe
CASE 3 : pakethilfe
CASE 4 : alle pakete
OTHERWISE ggf dialogfenster loeschen
END SELECT .
installieren :
ausfuehrung (PROC (TEXT CONST) page check off insert);
dialogfenster loeschen .
prozedurhilfe :
TEXT VAR prozedurname := "";
editget (p name prozedur, prozedurname, "", "GET/prozedurname");
IF prozedurname <> "" THEN
bildschirm neu;
bitte warten;
help (prozedurname);
dialogfenster loeschen
END IF .
pakethilfe :
prozedurname := "";
editget (p name paket, prozedurname, "", "GET/paketname");
IF prozedurname <> "" THEN
bildschirm neu;
bitte warten;
bulletin (prozedurname);
dialogfenster loeschen
END IF .
alle pakete :
bildschirm neu;
bitte warten;
packets;
dialogfenster loeschen .
END PROC prog interpreter;
PROC warten auf antwort :
TEXT VAR taste;
line; put (t weiter mit taste);
inchar (taste);
line
END PROC warten auf antwort;
PROC page and run (TEXT CONST dateiname) :
bildschirm neu;
page; bitte warten;
check on;
run (dateiname);
warten auf antwort
END PROC page and run;
PROC page check on insert (TEXT CONST dateiname) :
bildschirm neu;
page; bitte warten;
check on;
insert (dateiname);
warten auf antwort
END PROC page check on insert;
PROC page check off insert (TEXT CONST dateiname) :
bildschirm neu;
page; bitte warten;
check off;
insert (dateiname);
warten auf antwort
END PROC page check off insert;
END PACKET flint;
PACKET flint monitor DEFINES
monitor :
PROC monitor :
disable stop;
partner task (1, myself);
continue (niltask);
flint
END PROC monitor;
END PACKET flint monitor;