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;