path: root/warenhaus/ls-Warenhaus 5

(* 
        
         ********************************************************** 
         ********************************************************** 
         **                                                      ** 
         **                    ls-Warenhaus 5                    ** 
         **                                                      ** 
         **                     Version 1.01                     ** 
         **                                                      ** 
         **                                                      ** 
         **                  (Stand:  30.08.89)                  ** 
         **                                                      ** 
         **                                                      ** 
         **                                                      ** 
         **           Autor: Bruno Pollok, Bielefeld             ** 
         **                                                      ** 
         **    Copyright (C) 1988  Eva Latta-Weber, Bielefeld    ** 
         **    Copyright (C) 1990  ERGOS GmbH, Siegburg          ** 
         **                                                      ** 
         ********************************************************** 
         ********************************************************** 
 
                                                                           *) 
PACKET ls warenhaus 5 DEFINES                        
       warenhaus,
       grin,
       direktbefehl 1,
       direktbefehl 2,
       direktbefehl 3,
       direktbefehl 4,
       direktbefehl 5,
       direktbefehl 6,
       direktbefehl 7,
       warenhausbefehle zeigen,
       eingabe grundeinstellung,
       tastatur einstellen,
       kartenleser einstellen,
       evtl d und b sperren,
       loesche zwischenraum,
       eingabeart anzeigen,
       filialdaten zusammenstellen,
       filialdaten eintragen,
       filialdaten verzeichnis,

       filialdaten umbenennen,
       filialdaten loeschen,
       warenhausprogramme verzeichnis,
       warenhausprogramm neu erstellen,
       warenhausprogramm ansehen,
       warenhausprogramm kopieren,
       warenhausprogramm umbenennen,
       warenhausprogramme loeschen,
       warenhausprogramme drucken,
       warenhausprogramm starten,
       warenhausprogramm wiederholen:
LET  menukarte       = "ls-MENUKARTE:Warenhaus",
     praefix         = "Filialdaten:",
     filialdatentyp  =       1951,

     niltext         =         "",
     maxlaenge       =         45,
     maxnamenslaenge =         35;
TEXT VAR  filialdatenname :: "",
          programmname    :: "";
INT  VAR  fehlerzeile     :: 0;
BOOL VAR  grin version    :: FALSE,
          noch kein programm gelaufen :: TRUE,
          bildschirm neu eingesetzt   :: FALSE;
WINDOW VAR w :: window (1, 3, 79, 19);
INITFLAG VAR in this task :: FALSE;
PROC warenhausbefehle zeigen:
  TEXT VAR info, liste, tasten;
  INT  VAR grinoffset;

  IF grin version
     THEN grinbefehle
     ELSE elanbefehle
  FI;
  REP
   INT VAR auswahl := menualternative (info, liste, tasten, 5, FALSE);
   SELECT auswahl OF
     CASE 1, 101, 105 : menuinfo (anwendungstext (1 + grinoffset))
     CASE 2, 102, 106 : menuinfo (anwendungstext (2 + grinoffset))
     CASE 3, 103, 107 : menuinfo (anwendungstext (3 + grinoffset))
   END SELECT
  UNTIL auswahl = 4 OR auswahl = 104 OR auswahl = 108 PER.
  grinbefehle:
    grinoffset := 13;
    info := "       "15"Info zu den Programmierbefehlen "14""13""13""

          + "          d  Datei - Bearbeitung           "13""
          + "          e  Einkaufen und Auskunft        "13""
          + "          k  Kontroll - Strukturen         "13""13""
          + "          z  Zurück zum Hauptmenü          ";
  liste  := "Datei"13"Kaufen/Auskunft"13"Kontroll"13"Zurück";
  tasten := "dekzDEKZ".
  elanbefehle:
    grinoffset := 0;
    info := "       "15"Info zu den Programmierbefehlen "14""13""13""
          + "          d  Datei - Bearbeitung           "13""

          + "          e  Einkaufen und Auskunft        "13""
          + "          s  Sonstige Befehle              "13""13""
          + "          z  Zurück zum Hauptmenü          ";
  liste  := "Datei"13"Kaufen/Auskunft"13"Sonstige"13"Zurück";
  tasten := "deszDESZ".
END PROC warenhausbefehle zeigen;
PROC eingabe grundeinstellung:
  INT VAR dummy;
  IF eingabe mit codekartenleser
     THEN tastatureingabe (TRUE, dummy)
  FI
END PROC eingabe grundeinstellung;
PROC tastatur einstellen:

  eingabe grundeinstellung;
  menuinfo (anwendungstext (6), 4)
END PROC tastatur einstellen;
PROC kartenleser einstellen:
  INT VAR ergebnis;
  IF eingabe mit codekartenleser
     THEN tastatureingabe (TRUE, ergebnis)
  FI;
  pause (10);
  tastatureingabe (FALSE, ergebnis);
  IF ergebnis < 0
     THEN menuinfo (anwendungstext (7 - ergebnis), 5)
     ELSE menuinfo (anwendungstext (7), 4)
  FI
END PROC kartenleser einstellen;
PROC loesche zwischenraum:
  INT VAR zeile;
  cursor (1, 2); out (79 * waagerecht + " ");

  FOR zeile FROM 3 UPTO 22 REP
    cursor (1, zeile); out (""5"");
  PER;
  cursor (1, 23); out (79 * waagerecht + " ");
  cursor (1, 24); out (""5"");
END PROC loesche zwischenraum;
PROC ergaenze bildschirm:
  cursor ( 1, 2); out (ecke oben links);
  cursor (42, 2); out (balken oben);
  cursor (80, 2); out (ecke oben rechts);
  INT VAR zeile;
  FOR zeile FROM 3 UPTO 22 REP
    cursor ( 1, zeile); out (senkrecht);
    cursor (42, zeile); out (senkrecht);
    cursor (80, zeile); out (senkrecht)

  PER;
  cursor ( 1, 23); out (ecke unten links);
  cursor (42, 23); out (balken unten);
  cursor (80, 23); out (ecke unten rechts);
  cursor (42, 19);
  out (balken links + (37 * waagerecht) + balken rechts);
  cursor w3 1 1
END PROC ergaenze bildschirm;
PROC zweite zeile:
  cursor (1, 2); out (79 * waagerecht + " ")
END PROC zweite zeile;
PROC evtl d und b sperren:
  IF eingabe mit codekartenleser
     THEN activate ( 9);
          activate (10)
     ELSE deactivate ( 9);
          deactivate (10)

  FI
END PROC evtl d und b sperren;
PROC direktbefehl 1:
  disable stop;
  warendatei bearbeiten;
  cursor off;
  IF is error
     THEN regenerate menuscreen;
          menuinfo (" " + invers (errormessage));
          clear error
     ELSE zweite zeile;
          menu bildschirm
  FI;
  enable stop
END PROC direktbefehl 1;
PROC warendatei bearbeiten:
  enable stop;
  loesche zwischenraum;
  ergaenze bildschirm;
  cursor (2, 24); out (invers ("Warendatei bearbeiten"));
  REP artikelnummer lesen;

      IF NOT stoptaste gedrueckt
         THEN artikeldaten eingeben
      FI
  UNTIL stoptaste gedrueckt PER
END PROC warendatei bearbeiten;
PROC direktbefehl 2:
  disable stop;
  kundendatei bearbeiten;
  cursor off;
  IF is error
     THEN regenerate menuscreen;
          menuinfo (" " + invers (errormessage));
          clear error
     ELSE zweite zeile;
          menu bildschirm
  FI;
  enable stop
END PROC direktbefehl 2;
PROC kundendatei bearbeiten:
  enable stop;
  loesche zwischenraum;

  ergaenze bildschirm;
  cursor (2, 24); out (invers ("Kundendatei bearbeiten"));
  REP kundennummer lesen;
      IF NOT stoptaste gedrueckt
         THEN kundendaten eingeben
      FI
  UNTIL stoptaste gedrueckt PER
END PROC kundendatei bearbeiten;
PROC direktbefehl 3:
  disable stop;
  einkaufen gehen;
  cursor off;
  IF is error
     THEN regenerate menuscreen;
          menuinfo (" " + invers (errormessage));
          clear error
     ELSE zweite zeile;
          menu bildschirm

  FI;
  enable stop
END PROC direktbefehl 3;
PROC einkaufen gehen:
  enable stop;
  loesche zwischenraum;
  ergaenze bildschirm;
  cursor (2, 24); out (invers ("Einkaufen"));
  forget ("WARENHAUS:Rechnung", quiet);
  kundennummer lesen;
  rechnungskopf;
  REP   einkaufen
  UNTIL stoptaste gedrueckt PER;
  abrechnung;
  forget ("WARENHAUS:Rechnung", quiet).
  einkaufen:
    artikelnummer lesen;
    IF NOT stoptaste gedrueckt
       THEN artikel kaufen
    FI.
END PROC einkaufen gehen;

PROC direktbefehl 4:
  disable stop;
  auskunft einholen;
  cursor off;
  IF is error
     THEN regenerate menuscreen;
          menuinfo (" " + invers (errormessage));
          clear error
     ELSE zweite zeile;
          menu bildschirm
  FI;
  enable stop
END PROC direktbefehl 4;
PROC auskunft einholen:
  enable stop;
  loesche zwischenraum;
  ergaenze bildschirm;
  cursor (2, 24); out (invers ("Auskunft"));
  auskunft
END PROC auskunft einholen;
PROC direktbefehl 5:
  disable stop;

  ware nachbestellen;
  cursor off;
  IF is error
     THEN regenerate menuscreen;
          menuinfo (" " + invers (errormessage));
          clear error
     ELSE zweite zeile;
          menu bildschirm
  FI;
  enable stop
END PROC direktbefehl 5;
PROC ware nachbestellen:
  enable stop;
  loesche zwischenraum;
  ergaenze bildschirm;
  cursor (2, 24); out (invers ("Nachbestellen"));
  nachbestellen
END PROC ware nachbestellen;
PROC direktbefehl 6:
  disable stop;
  dezimalwerte von interface lesen;

  cursor off;
  IF is error
     THEN regenerate menuscreen;
          menuinfo (" " + invers (errormessage));
          clear error
     ELSE zweite zeile;
          menu bildschirm
  FI;
  enable stop
END PROC direktbefehl 6;
PROC dezimalwerte von interface lesen:
  enable stop;
  loesche zwischenraum;
  ergaenze bildschirm;
  cursor (2, 24); out (invers ("Dezimalwert lesen"));
  dezimalwert lesen
END PROC dezimalwerte von interface lesen;
PROC direktbefehl 7:
  disable stop;

  bitmuster von interface lesen;
  cursor off;
  IF is error
     THEN regenerate menuscreen;
          menuinfo (" " + invers (errormessage));
          clear error
     ELSE zweite zeile;
          menu bildschirm
  FI;
  enable stop
END PROC direktbefehl 7;
PROC bitmuster von interface lesen:
  enable stop;
  loesche zwischenraum;
  ergaenze bildschirm;
  cursor (2, 24); out (invers ("Bitmuster lesen"));
  bitmuster lesen
END PROC bitmuster von interface lesen;
PROC eingabeart anzeigen:

  IF eingabe mit codekartenleser
     THEN menuinfo (anwendungstext (7), 4)
     ELSE menuinfo (anwendungstext (6), 4)
  FI
END PROC eingabeart anzeigen;
PROC warenhaus:
  BOOL VAR am ende loeschen :: TRUE;
  pruefe zulaessigkeit;
  installiere menukarte mit anfangsbild;
  initialisiere warenhaus;
  handle menu ("WARENHAUS");
  IF am ende loeschen
     THEN sperre verwaltungstask;
          end (task (verwaltung))
  FI.
  installiere menukarte mit anfangsbild:
    install menu (menukarte, TRUE);

    cursor off;
    cursor (17, 20);
    out (" W A R E N H A U S ");
    cursor (21, 22);
    out (invers("Filiale " + text (channel (myself))));
    cursor (79, 24);
    pause (10).
  sperre verwaltungstask:
    DATASPACE VAR ds;
    INT VAR dummy;
    forget (ds); ds := nilspace;
    call (task (verwaltung), 256, ds, dummy).
  pruefe zulaessigkeit:
    IF   hauptstellenname = ""
         THEN line;
         putline ("Keine uebergeordnete Task ist 'warenhaus hauptstelle'!");
              end; LEAVE warenhaus

    ELIF name (myself) = hauptstellenname
         THEN errorstop ("Dieser Befehl darf nur von Söhnen dieser "
                       + "Task aus gegeben werden!");
              LEAVE warenhaus
    FI.
 initialisiere warenhaus:
  TEXT CONST verwaltung :: hauptstellenname + ".Filialverwaltung "
                                            + text (channel (myself));
  IF NOT exists task (verwaltung)
     THEN initialisiere verwaltung
     ELSE biete evtl loeschen an
  FI;
  IF NOT initialized (in this task)

     THEN filialdatenname := "";
          programmname    := ""
  FI;
  noch kein programm gelaufen := TRUE.
  biete evtl loeschen an:
    access catalogue;
    IF NOT (father (task (verwaltung)) = myself)
       THEN fehlermeldung;
            line;
            end;
            am ende loeschen := FALSE
    FI.
    fehlermeldung:
      cursor (1, 22);
      putline ("Filiale " + text (channel (myself)) +
               " ist bereits besetzt durch TASK '"
               + name (father (task (verwaltung))) + "'!");

      putline ("Es ist so kein geregelter Warenhaus-Betrieb moeglich!").
END PROC warenhaus;
PROC grin (BOOL CONST entscheidung):
  enable stop;
  IF hauptstellenname = "" OR hauptstellenname = name (myself)
     THEN grin version := entscheidung
     ELSE errorstop ("Dieser Befehl darf nur von der Task '" +
                      hauptstellenname + "' aus gegeben werden!")
  FI;
  bildschirm neu eingesetzt := FALSE
END PROC grin;
PROC filialdaten verzeichnis:
  disable stop;
  THESAURUS VAR filialdaten ::

  ohne praefix (infix namen (ALL myself, praefix, filialdatentyp), praefix);
  forget ("Verzeichnis der Filialdaten-Dateien", quiet);
  FILE VAR f ::
  sequential file (output, "Verzeichnis der Filialdaten-Dateien");
  f FILLBY filialdaten;
  modify (f);
  to line (f, 1); insert record (f);
  menufootnote ("Verlassen: <ESC> <q>");
  cursor on;
  show (w, f);
  cursor off;
  forget ("Verzeichnis der Filialdaten-Dateien", quiet);
  IF is error
     THEN regenerate menuscreen;
          out (""7"");

          menuinfo  (" " + invers ("FEHLER: " + errormessage));
          clear error
     ELSE menu bildschirm
  FI;
  enable stop
END PROC filialdaten verzeichnis;
PROC warenhausprogramme verzeichnis:
  disable stop;
  forget ("Verzeichnis der Programme", quiet);
  THESAURUS VAR programme ::
  ALL myself - infix namen (ALL myself, praefix, filialdatentyp);
  IF exists ("WARENHAUS:Rechnung")
     THEN programme := programme - "WARENHAUS:Rechnung"
  FI;
  FILE VAR f ::
  sequential file (output, "Verzeichnis der Programme");

  f FILLBY programme;
  modify (f);
  to line (f, 1); insert record (f);
  menufootnote ("Verlassen: <ESC> <q>");
  cursor on;
  show (w, f);
  cursor off;
  forget ("Verzeichnis der Programme", quiet);
  IF is error
     THEN regenerate menuscreen;
          out (""7"");
          menuinfo  (" " + invers ("FEHLER: " + errormessage));
          clear error
     ELSE menu bildschirm
  FI;
  enable stop
END PROC warenhausprogramme verzeichnis;
PROC filialdaten zusammenstellen:
  hole filialdatenname;

  kontrolliere den filialdatennamen;
  disable stop;
  sichere filialdaten (praefix + filialdatenname);
  IF is error
     THEN out (""7"");
          menuinfo  (" " + invers ("FEHLER: " + errormessage));
          clear error
     ELSE bestaetige
  FI;
  enable stop.
  hole filialdatenname:
    filialdatenname :=  menuanswer (ausgabe, filialdatenname, 5).
  ausgabe:
    center (maxlaenge, invers ("Filialdaten zusammenstellen")) + ""13""13""
                   + " Bitte den Namen für die Filialdaten "13""13"".

  kontrolliere den filialdatennamen:
    IF   filialdatenname = niltext
         THEN enable stop; LEAVE filialdaten zusammenstellen
    ELIF length (filialdatenname) > maxnamenslaenge
         THEN meckere zu langen namen an;
              filialdatenname := niltext;
              enable stop; LEAVE filialdaten zusammenstellen
    ELIF exists (praefix + filialdatenname)
         THEN meckere existierenden filialdatennamen an;
              enable stop; LEAVE filialdaten zusammenstellen

    FI.
    bestaetige:
      menuinfo ("           "15"Bestätigung "14" "13""13"" +
                "  Die  Filialdaten  wurden von der  "13"" +
                "  Verwaltung unter dem gewünschten  "13"" +
                "  Namen zusammengestellt.           "13"" , 3).
END PROC filialdaten zusammenstellen;
PROC warenhausprogramm neu erstellen:
  hole programmname;
  kontrolliere den programmnamen;
  command dialogue (FALSE);
  cursor on;
  disable stop;
  stdinfoedit (programmname, 3);

  cursor off;
  command dialogue (TRUE);
  IF is error
     THEN regenerate menuscreen;
          out (""7"");
          menuinfo  (" " + invers (errormessage));
          clear error
     ELSE menu bildschirm
  FI;
  enable stop.
  hole programmname:
    programmname := "";
    programmname :=  menuanswer (ausgabe, programmname, 5).
  ausgabe:
    center (maxlaenge, invers ("Programm neu erstellen")) + ""13""13""
                 + " Bitte den Namen für das Programm "13""13"".
  kontrolliere den programmnamen:

    IF   programmname = niltext
         THEN LEAVE warenhausprogramm neu erstellen
    ELIF length (programmname) > maxnamenslaenge
         THEN meckere zu langen namen an;
              programmname := niltext;
              LEAVE warenhausprogramm neu erstellen
    ELIF exists (programmname)
         THEN meckere existierendes programm an;
              LEAVE warenhausprogramm neu erstellen
    FI.
END PROC warenhausprogramm neu erstellen;
PROC warenhausprogramm ansehen:
  IF programmname <> niltext CAND exists (programmname)

     THEN frage nach diesem programm
     ELSE lasse programm auswaehlen
  FI;
  cursor on;
  disable stop;
  stdinfoedit (programmname, 3);
  cursor off;
  IF is error
     THEN regenerate menuscreen;
          out (""7"");
          menuinfo  (" " + invers ("FEHLER: " + errormessage));
          clear error
     ELSE menu bildschirm
  FI;
  enable stop.
  frage nach diesem programm:
    IF menuno (ueberschrift + " Zuletzt bearbeitetes Programm: " + name
              + " Soll mit diesem Programm gearbeitet werden", 5)

       THEN lasse programm auswaehlen
    FI.
  ueberschrift:
    center (maxlaenge, invers ("Programm ansehen/ändern")) + ""13""13"".
  name:
    ""13""13" " + invers (programmname) + ""13""13"".
  lasse programm auswaehlen:
    THESAURUS VAR verfuegbare ::
    ALL myself - infix namen (ALL myself, praefix, filialdatentyp);
    IF exists ("WARENHAUS:Rechnung")
       THEN verfuegbare := verfuegbare - "WARENHAUS:Rechnung"
    FI;
    IF NOT not empty (verfuegbare)
       THEN noch kein programm;

            LEAVE warenhausprogramm ansehen
       ELSE biete auswahl an
    FI.
  biete auswahl an:
    programmname := menuone (verfuegbare, "Programm ansehen/ändern",
                             "Bitte das gewünschte Programm ankreuzen!",
                              FALSE);
    IF programmname = niltext
       THEN menu bildschirm;
            LEAVE warenhausprogramm ansehen
    FI.
END PROC warenhausprogramm ansehen;
PROC filialdaten eintragen:
  lasse filialdaten auswaehlen;

  trage filialdaten ein;
  menu bildschirm.
  lasse filialdaten auswaehlen:
    THESAURUS VAR verfuegbare ::
    ohne praefix (infix namen (ALL myself,praefix,filialdatentyp),praefix);
    IF NOT not empty (verfuegbare)
       THEN noch keine filialdaten;
            LEAVE filialdaten eintragen
       ELSE biete auswahl an
    FI.
  biete auswahl an:
    verfuegbare := menusome (verfuegbare, bezeichnung,
    "Bitte die Filialdaten ankreuzen, die eingetragen werden sollen!", FALSE).
  trage filialdaten ein:

    show menuwindow;
    steige ggf bei leerem thesaurus aus;
    menuwindowout (menuwindowcenter (invers (bezeichnung)));
    menuwindowline (2);
    command dialogue (FALSE);
    fuehre einzelne operationen aus;
    command dialogue (TRUE);
    schlage ggf neue seite auf;
    menuwindowout (schlussbemerkung);
    menuwindowstop.
  bezeichnung:
    "Filialdaten eintragen/ergänzen".
  schlussbemerkung:
    " Alle ausgewählten Filialdaten wurden eingetragen!".
  fuehre einzelne operationen aus:

    INT VAR k;
    FOR k FROM 1 UPTO highest entry (verfuegbare) REP
      IF name (verfuegbare, k) <> ""
         THEN disable stop;
              menuwindowout ( " Filialdaten """ + name (verfuegbare, k)
                                    + """ werden eingetragen!");
              menuwindowline;
              lade filialdaten (praefix + name (verfuegbare, k));
              fehlerbehandlung
      FI
    PER.
  steige ggf bei leerem thesaurus aus:
    IF NOT not empty (verfuegbare)

       THEN menuwindowline (2);
            menuwindowout (" Es wurde keine Filialdaten-Datei ausgewählt!");
            menuwindowstop;
            menu bildschirm;
            LEAVE filialdaten eintragen
    FI.
  schlage ggf neue seite auf:
    IF remaining menuwindowlines < 7
       THEN menuwindowpage; menuwindowline
       ELSE menuwindowline (2)
    FI.
  fehlerbehandlung:
    IF is error
       THEN regenerate menuscreen; out (""7"");
            menuinfo  (" " + invers (errormessage));

            clear error; enable stop;
            LEAVE filialdaten eintragen
       ELSE enable stop
    FI.
END PROC filialdaten eintragen;
PROC warenhausprogramme drucken:
  lasse programme auswaehlen;
  drucke programme;
  menu bildschirm.
  lasse programme auswaehlen:
    THESAURUS VAR verfuegbare ::
    ALL myself - infix namen (ALL myself, praefix, filialdatentyp);
    IF exists ("WARENHAUS:Rechnung")
       THEN verfuegbare := verfuegbare - "WARENHAUS:Rechnung"
    FI;
    IF NOT not empty (verfuegbare)

       THEN noch kein programm;
            LEAVE warenhausprogramme drucken
       ELSE biete auswahl an
    FI.
  biete auswahl an:
    verfuegbare := menusome (verfuegbare, "Programme drucken",
                   "Bitte die Programme ankreuzen, die gedruckt werden sollen!",
                    FALSE).
  drucke programme:
    show menuwindow;
    steige ggf bei leerem thesaurus aus;
    menuwindowout (menuwindowcenter (invers ("Programme drucken")));
    menuwindowline (2);
    command dialogue (FALSE);

    fuehre einzelne operationen aus;
    command dialogue (TRUE);
    schlage ggf neue seite auf;
    menuwindowout (" Alle ausgewählten Programme wurden gedruckt!");
    menuwindowstop.
  fuehre einzelne operationen aus:
    INT VAR k;
    FOR k FROM 1 UPTO highest entry (verfuegbare) REP
      IF name (verfuegbare, k) <> ""
         THEN disable stop;
              menuwindowout ( " """ + name (verfuegbare, k) +
                              """ wird gedruckt!");
              menuwindowline;

              print (name (verfuegbare, k));
              fehlerbehandlung
      FI
    PER.
  steige ggf bei leerem thesaurus aus:
    IF NOT not empty (verfuegbare)
       THEN menuwindowline (2);
            menuwindowout (" Es wurde kein Programm ausgewählt!");
            menuwindowstop;
            menu bildschirm;
            LEAVE warenhausprogramme drucken
    FI.
  schlage ggf neue seite auf:
    IF remaining menuwindowlines < 7
       THEN menuwindowpage; menuwindowline

       ELSE menuwindowline (2)
    FI.
  fehlerbehandlung:
    IF is error
       THEN regenerate menuscreen; out (""7"");
            menuinfo  (" " + invers (errormessage));
            clear error; enable stop;
            LEAVE warenhausprogramme drucken
       ELSE enable stop
    FI.
END PROC warenhausprogramme drucken;
PROC warenhausprogramm kopieren:
  ermittle alten programmnamen;
  erfrage neuen programmnamen;
  kopiere ggf das programm.
  ermittle alten programmnamen:
    IF NOT not empty (bestand)

       THEN noch kein programm;
            LEAVE warenhausprogramm kopieren
       ELSE biete auswahl an
    FI.
  biete auswahl an:
    TEXT VAR alter name := menuone ( bestand, "Programm kopieren",
            "Bitte das Programm ankreuzen, das kopiert werden soll!",FALSE);
    menu bildschirm;
    IF alter name = niltext
       THEN LEAVE warenhausprogramm kopieren
    FI.
  bestand:
    ALL myself - infix namen (ALL myself, praefix, filialdatentyp)
               - "WARENHAUS:Rechnung".

  erfrage neuen programmnamen:
    TEXT VAR neuer name :: menuanswer (ausgabe, alter name, 5).
  ausgabe:
     ueberschrift + " Name des 'alten' Programms: " + bisheriger name
                  + " Bitte den Namen für die Kopie: ".
  ueberschrift:
    center (maxlaenge, invers ("Programm kopieren")) + ""13""13"".
  bisheriger name:
    ""13""13" " + invers (alter name) + ""13""13"".
  kopiere ggf das programm:
    IF   neuer name = niltext
         THEN menuinfo (" " + invers ("Der gewünschte Name ist unzulässig!"));

              LEAVE warenhausprogramm kopieren
    ELIF exists (neuer name)
         THEN mache vorwurf;
              LEAVE warenhausprogramm kopieren
       ELSE copy (alter name, neuer name)
    FI.
  mache vorwurf:
    menuinfo (" " + invers ("Ein Programm mit diesem Namen gibt es bereits!")).
END PROC warenhausprogramm kopieren;
PROC filialdaten umbenennen:
  ermittle alten filialdatennamen;
  erfrage neuen filialdatennamen;
  benenne ggf die filialdaten um.
  ermittle alten filialdatennamen:

    IF NOT not empty (bestand)
       THEN noch keine filialdaten;
            LEAVE filialdaten umbenennen
       ELSE biete auswahl an
    FI.
  biete auswahl an:
    TEXT VAR alter name := menuone ( bestand, text1, text2, FALSE);
    menu bildschirm;
    IF alter name = niltext
       THEN LEAVE filialdaten umbenennen
    FI.
  bestand:
    ohne praefix (infix namen (ALL myself, praefix, filialdatentyp), praefix).
  text1: "Filialdaten umbenennen".
  text2:
    "Bitte die Filialdaten-Datei ankreuzen, die umbenannt werden soll!" .

  erfrage neuen filialdatennamen:
    TEXT VAR neuer name :: menuanswer (ausgabe, alter name, 5).
  ausgabe:
     ueberschrift + hinweis auf alt + bisheriger name + aufforderung.
  ueberschrift:
    center (maxlaenge, invers ("Filialdaten umbenennen")) + ""13""13"".
  hinweis auf alt:
    " Bisheriger  Filialdaten-Name: ".
  bisheriger name:
    ""13""13" " + invers (alter name) + ""13""13"".
  aufforderung:
    " Zukünftiger Filialdaten-Name: ".
  benenne ggf die filialdaten um:
    IF   neuer name = niltext

         THEN menuinfo (" " + invers ("Der gewünschte Name ist unzulässig!"));
              LEAVE filialdaten umbenennen
    ELIF exists (praefix + neuer name)
         THEN menuinfo (" " + invers("Filialdaten mit diesem Namen gibt es bereits!"));
              LEAVE filialdaten umbenennen
    ELSE rename (praefix + alter name, praefix + neuer name);
         filialdatenname := neuer name
    FI.
END PROC filialdaten umbenennen;
PROC warenhausprogramm umbenennen:
  ermittle alten programmnamen;

  erfrage neuen programmnamen;
  benenne ggf das programm um.
  ermittle alten programmnamen:
    IF NOT not empty (bestand)
       THEN noch kein programm;
            LEAVE warenhausprogramm umbenennen
       ELSE biete auswahl an
    FI.
  biete auswahl an:
    TEXT VAR alter name := menuone ( bestand, "Programm umbenennen",
        "Bitte das Programm ankreuzen, das umbenannt werden soll!", FALSE);
    menu bildschirm;
    IF alter name = niltext
       THEN LEAVE warenhausprogramm umbenennen

    FI.
  bestand:
    ALL myself - infix namen (ALL myself, praefix, filialdatentyp)
               - "WARENHAUS:Rechnung".
  erfrage neuen programmnamen:
    TEXT VAR neuer name :: menuanswer (ausgabe, alter name, 5).
  ausgabe:
     ueberschrift + " Bisheriger  Programmname: " + bisheriger name
                  + " Zukünftiger Programmname: ".
  ueberschrift:
    center (maxlaenge, invers ("Programm umbenennen")) + ""13""13"".
  bisheriger name:
    ""13""13" " + invers (alter name) + ""13""13"".

  benenne ggf das programm um:
    IF   neuer name = niltext
         THEN menuinfo (" " + invers ("Der gewünschte Name ist unzulässig!"));
              LEAVE warenhausprogramm umbenennen
    ELIF exists (neuer name)
         THEN mache vorwurf;
              LEAVE warenhausprogramm umbenennen
       ELSE rename (alter name, neuer name);
            programmname := neuer name
    FI.
  mache vorwurf:
    menuinfo (" " + invers ("Ein Programm mit diesem Namen gibt es bereits!")).
END PROC warenhausprogramm umbenennen;

PROC filialdaten loeschen:
  lasse filialdaten auswaehlen;
  loesche filialdaten;
  menu bildschirm.
  lasse filialdaten auswaehlen:
    THESAURUS VAR verfuegbare ::
    ohne praefix (infix namen (ALL myself, praefix, filialdatentyp), praefix);
    IF NOT not empty (verfuegbare)
       THEN noch keine filialdaten;
            LEAVE filialdaten loeschen
       ELSE biete auswahl an
    FI.
  biete auswahl an:
    verfuegbare := menusome (verfuegbare, "Filialdaten-Dateien löschen",
    "Bitte alle Dateien ankreuzen, die gelöscht werden sollen!", FALSE).

  loesche filialdaten:
    show menuwindow;
    steige ggf bei leerem thesaurus aus;
    menuwindowout (menuwindowcenter (invers ("Filialdaten-Dateien löschen")));
    menuwindowline (2);
    command dialogue (FALSE);
    fuehre einzelne operationen aus;
    command dialogue (TRUE);
    schlage ggf neue seite auf;
    menuwindowout (" Alle ausgewählten Dateien wurden gelöscht!");
    menuwindowstop.
  fuehre einzelne operationen aus:
    INT VAR k;
    FOR k FROM 1 UPTO highest entry (verfuegbare) REP

      IF name (verfuegbare, k) <> ""
         THEN disable stop;
              IF menuwindowyes (" """ + name (verfuegbare, k)
                                      + """ löschen")
                 THEN forget (praefix + name (verfuegbare, k), quiet)
              FI;
              fehlerbehandlung
      FI
    PER;
    filialdatenname := "".
  steige ggf bei leerem thesaurus aus:
    IF NOT not empty (verfuegbare)
       THEN menuwindowline (2);
            menuwindowout (" Es wurde keine Filialdaten-Datei ausgewählt!");

            menuwindowstop;
            menu bildschirm;
            LEAVE filialdaten loeschen
    FI.
  schlage ggf neue seite auf:
    IF remaining menuwindowlines < 7
       THEN menuwindowpage; menuwindowline
       ELSE menuwindowline (2)
    FI.
  fehlerbehandlung:
    IF is error
       THEN regenerate menuscreen;
            menuinfo  (" " + invers (errormessage));
            clear error; enable stop;
            LEAVE filialdaten loeschen
       ELSE enable stop
    FI.

END PROC filialdaten loeschen;
PROC warenhausprogramme loeschen:
  lasse programme auswaehlen;
  loesche programme;
  menu bildschirm.
  lasse programme auswaehlen:
    THESAURUS VAR verfuegbare ::
              ALL myself - infix namen (ALL myself, praefix, filialdatentyp);
    IF exists ("WARENHAUS:Rechnung")
       THEN verfuegbare := verfuegbare - "WARENHAUS:Rechnung"
    FI;
    IF NOT not empty (verfuegbare)
       THEN noch kein programm;
            LEAVE warenhausprogramme loeschen

       ELSE biete auswahl an
    FI.
  biete auswahl an:
    verfuegbare := menusome (verfuegbare, "Programm löschen",
    "Bitte alle Programme ankreuzen, die gelöscht werden sollen!", FALSE).
  loesche programme:
    show menuwindow;
    steige ggf bei leerem thesaurus aus;
    menuwindowout (menuwindowcenter (invers ("Programme löschen")));
    menuwindowline (2);
    command dialogue (FALSE);
    fuehre einzelne operationen aus;
    command dialogue (TRUE);
    schlage ggf neue seite auf;

    menuwindowout (" Alle ausgewählten Programme wurden gelöscht!");
    menuwindowstop.
  fuehre einzelne operationen aus:
    INT VAR k;
    FOR k FROM 1 UPTO highest entry (verfuegbare) REP
      IF name (verfuegbare, k) <> ""
         THEN disable stop;
              IF menuwindowyes (" """ + name (verfuegbare, k) + """ löschen")
                 THEN forget (name (verfuegbare, k), quiet)
              FI;
              fehlerbehandlung
      FI
    PER;
    programmname := "".

  steige ggf bei leerem thesaurus aus:
    IF NOT not empty (verfuegbare)
       THEN menuwindowline (2);
            menuwindowout (" Es wurde kein Programm ausgewählt!");
            menuwindowstop;
            menu bildschirm;
            LEAVE warenhausprogramme loeschen
    FI.
  schlage ggf neue seite auf:
    IF remaining menuwindowlines < 7
       THEN menuwindowpage; menuwindowline
       ELSE menuwindowline (2)
    FI.
  fehlerbehandlung:
    IF is error
       THEN regenerate menuscreen; out (""7"");

            menuinfo  (" " + invers (errormessage));
            clear error; enable stop;
            LEAVE warenhausprogramme loeschen
       ELSE enable stop
    FI.
END PROC warenhausprogramme loeschen;
PROC warenhausprogramm starten:
  IF grin version
     THEN warenhausprogramm uebersetzen und starten
     ELSE warenhausprogramm direkt starten
  FI
END PROC warenhausprogramm starten;
PROC warenhausprogramm direkt starten:
  programmname ermitteln;
  bildschirm neu eingesetzt := FALSE;

  untersuche programmdatei auf bildschirm neu;
  cursor w3 1 1;
  cursor (1, 24); out(""5"Das Programm wird übersetzt.  Zeilen-Nr.: ");
  cursor on;
  check on;
  warnings off;
  disable stop;
  run (programmname);
  noch kein programm gelaufen := FALSE;
  IF bildschirm neu eingesetzt
     THEN entferne befehl aus programmdatei
  FI;
  cursor off;
  fehlerbehandlung;
  cursor (2,23); out ((40 * waagerecht) + balken unten + (36 * waagerecht));
  cursor (2,24);
  out ("Das Programm ist beendet. " +

       "Zum Weitermachen bitte irgendeine Taste tippen!");
  pause;
  regenerate menuscreen.
  fehlerbehandlung:
    IF is error
       THEN fehler ggf melden
       ELSE enable stop
    FI.
  fehler ggf melden:
    IF errormessage = ""
       THEN regenerate menuscreen
       ELSE fehler melden
    FI;
    clear error; enable stop;
    LEAVE warenhausprogramm direkt starten.
  fehler melden:
    out (""7"");
    IF errorcode = 1  OR  errorcode = 1951
       THEN regenerate menuscreen;

            menuinfo  (" " + invers (errormessage))
       ELSE programm mit fehler zeigen;
            regenerate menuscreen
    FI.
  programmname ermitteln:
    IF programmname <> niltext CAND exists (programmname)
       THEN frage nach diesem programm
       ELSE lasse programm auswaehlen
    FI.
  frage nach diesem programm:
    IF menuno (ueberschrift + " Zuletzt bearbeitetes Programm: " +
               name + " Soll mit diesem Programm gearbeitet werden", 5)
       THEN lasse programm auswaehlen

    FI.
  ueberschrift:
    center (maxlaenge, invers ("Programm starten")) + ""13""13"".
  name:
    ""13""13" " + invers (programmname) + ""13""13"".
  lasse programm auswaehlen:
    THESAURUS VAR verfuegbare ::
              ALL myself - infix namen (ALL myself, praefix, filialdatentyp);
    IF exists ("WARENHAUS:Rechnung")
       THEN verfuegbare := verfuegbare - "WARENHAUS:Rechnung"
    FI;
    IF NOT not empty (verfuegbare)
       THEN noch kein programm;
            LEAVE warenhausprogramm direkt starten

       ELSE biete auswahl an
    FI.
  biete auswahl an:
    programmname := menuone (verfuegbare, "Programm starten",
                    "Bitte das gewünschte Programm ankreuzen!", FALSE);
    menubildschirm;
    menufootnote ("");
    IF programmname = niltext
       THEN LEAVE warenhaus programm direkt starten
    FI.
  untersuche programmdatei auf bildschirm neu:
    FILE VAR a :: sequential file (modify, programmname);
    TEXT VAR zeile;
    to line (a, 1);
    REP
      read record (a, zeile);

      IF NOT eof (a) THEN down (a) FI
    UNTIL zeile <> "" OR eof (a) PER;
    change all (zeile, " ", "");
    IF pos (zeile, "bildschirmneu") = 0
       THEN setze befehl in datei ein
    FI.
  setze befehl in datei ein:
    to line (a, 1);
    zeile := "bildschirm neu; (* ergänzt *)";
    insert record (a);
    write record (a, zeile);
    bildschirm neu eingesetzt := TRUE.
  entferne befehl aus programmdatei:
    FILE VAR b :: sequential file (modify, programmname);
    to line (b, 1);

    REP
      read record (b, zeile);
      IF NOT eof (b) THEN down (b) FI
    UNTIL zeile <> "" OR eof (b) PER;
    change all (zeile, " ", "");
    IF pos (zeile, "bildschirmneu;(*ergänzt*)") > 0
       THEN up (b); delete record (b)
    FI.
END PROC warenhausprogramm direkt starten;
PROC warenhausprogramm uebersetzen und starten:
  programmname ermitteln;
  cursor w3 1 1;
  cursor (1, 24); out(""5"Das Programm wird übersetzt.  Zeilen-Nr.: ");
  cursor on;
  disable stop;
  uebersetze (programmname);

  IF NOT is error
     THEN check on;
          warnings off;
          run ("elanprogramm");
          noch kein programm gelaufen := FALSE
  FI;
  forget ("elanprogramm", quiet);
  cursor off;
  fehlerbehandlung;
  cursor (2,23); out ((40 * waagerecht) + balken unten + (36 * waagerecht));
  cursor (2,24);
  out ("Das Programm ist beendet. " +
       "Zum Weitermachen bitte irgendeine Taste tippen!");
  pause;
  regenerate menuscreen.
  fehlerbehandlung:
    IF is error
       THEN fehler ggf melden

       ELSE enable stop
    FI.
  fehler ggf melden:
    IF errormessage = ""
       THEN regenerate menuscreen
       ELSE fehler melden
    FI;
    clear error; enable stop;
    LEAVE warenhausprogramm uebersetzen und starten.
  fehler melden:
    out (""7"");
    IF errorcode = 1  OR  errorcode = 1951
       THEN regenerate menuscreen;
            menuinfo  (" " + invers (errormessage))
       ELSE programm mit fehler zeigen ;
            regenerate menuscreen
    FI.
 programmname ermitteln:

    IF programmname <> niltext CAND exists (programmname)
       THEN frage nach diesem programm
       ELSE lasse programm auswaehlen
    FI.
  frage nach diesem programm:
    IF menuno (ueberschrift + " Zuletzt bearbeitetes Programm: " +
               name + " Soll mit diesem Programm gearbeitet werden", 5)
       THEN lasse programm auswaehlen
    FI.
  ueberschrift:
    center (maxlaenge, invers ("Programm starten")) + ""13""13"".
  name:
    ""13""13" " + invers (programmname) + ""13""13"".

  lasse programm auswaehlen:
    THESAURUS VAR verfuegbare ::
              ALL myself - infix namen (ALL myself, praefix, filialdatentyp);
    IF exists ("WARENHAUS:Rechnung")
       THEN verfuegbare := verfuegbare - "WARENHAUS:Rechnung"
    FI;
    IF NOT not empty (verfuegbare)
       THEN noch kein programm;
            LEAVE warenhausprogramm uebersetzen und starten
       ELSE biete auswahl an
    FI.
  biete auswahl an:
    programmname := menuone (verfuegbare, "Programm starten",

                    "Bitte das gewünschte Programm ankreuzen!", FALSE);
    menubildschirm;
    menufootnote ("");
    IF programmname = niltext
       THEN LEAVE warenhaus programm uebersetzen und starten
    FI.
END PROC warenhausprogramm uebersetzen und starten;
PROC programm mit fehler zeigen:
  IF exists (programmname)
    THEN noteline;
         note (fehlermeldung mit zeilennummer);
         INT VAR i; FOR i FROM 1 UPTO 9 REP noteline PER;
         note (invers ("Verlassen: <ESC><q>"));

         FILE VAR f :: sequential file (modify, programmname);
         to line (f, max (1, fehlerzeile));
         col (1);
         clear error;
         cursor on;
         noteedit (f);
        cursor off
    ELSE menuinfo (invers (fehlermeldung mit zeilennummer))
  FI
END PROC programm mit fehler zeigen;
PROC warenhausprogramm wiederholen:
  cursor on;
  disable stop;
  IF noch kein programm gelaufen
     THEN errorstop ("'run again' nicht moeglich")
     ELSE runagain
  FI;

  cursor off;
  fehlerbehandlung;
  cursor (2,23); out ((40 * waagerecht) + balken unten + (36 * waagerecht));
  cursor (2,24);
  out ("Das Programm ist beendet. " +
       "Zum Weitermachen bitte irgendeine Taste tippen!");
  pause;
  regenerate menuscreen.
fehlerbehandlung:
    IF is error
       THEN regenerate menuscreen;
            fehler melden;
            clear error; enable stop;
            LEAVE warenhausprogramm wiederholen
       ELSE enable stop
    FI.
  fehler melden:

    out (""7"");
    IF errorcode = 1  OR  errorcode = 1951
       THEN menuinfo  (" " + invers (errormessage))
    ELIF errormessage = "'run again' nicht moeglich"
       THEN menuinfo  (" " + invers ("Wiederholung nicht möglich!"))
       ELSE menuinfo  (" " + invers (fehlermeldung mit zeilennummer))
    FI
END PROC warenhausprogramm wiederholen;
TEXT PROC fehlermeldung mit zeilennummer:
  TEXT VAR meldung :: "FEHLER: " + errormessage;
  fuege ggf fehlerzeile an;
  IF length (meldung) < 70

     THEN meldung
     ELSE subtext (meldung, 1, 69)
  FI.
  fuege ggf fehlerzeile an:
    fehlerzeile := errorline;
    IF errorline < 1
       THEN LEAVE fuege ggf fehlerzeile an
    ELIF bildschirm neu eingesetzt
       THEN meldung CAT " (bei Zeile " + text (errorline - 1) + ")"
       ELSE meldung CAT " (bei Zeile " + text (errorline) + ")"
    FI.
END PROC fehlermeldung mit zeilennummer;
PROC meckere zu langen namen an:
  menuinfo (" " + invers ("Hier dürfen Namen höchstens "

                + text (max namenslaenge)
                + " Zeichen lang sein!"))
END PROC meckere zu langen namen an;
PROC meckere existierenden filialdatennamen an:
  menuinfo (" " + invers ("Filialdaten mit diesem Namen gibt es bereits!"))
END PROC meckere existierenden filialdatennamen an;
PROC meckere existierendes programm an:
  menuinfo (" " + invers ("Ein Programm mit diesem Namen gibt es bereits!"))
END PROC meckere existierendes programm an;
PROC noch keine filialdaten:
  menuinfo (" " + invers ("Es existiert noch keine Filialdaten-Datei!"))

END PROC noch keine filialdaten;
PROC noch kein programm:
  menuinfo (" " + invers ("Es existiert noch kein Programm!"))
END PROC noch kein programm;
PROC menu bildschirm:
  cursor (1, 2);
  out (5 * waagerecht);
  cursor (1, 3);
  out (""4"");
  cursor (1, 23);
  out (79 * waagerecht);
  refresh submenu
END PROC menu bildschirm
END PACKET ls warenhaus 5