From afd4c3c448381f6eb706090911a15c162fdaf8af Mon Sep 17 00:00:00 2001 From: Lars-Dominik Braun Date: Sun, 9 Oct 2016 11:28:19 +0200 Subject: Decompress source files MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit EUMEL’s TEXT dataspaces wastes a lot of storage space. Some files were therefore “compressed” by storing them as a single line, reducing overhead significantly. --- warenhaus/ls-Warenhaus 5 | 1352 +++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 1274 insertions(+), 78 deletions(-) (limited to 'warenhaus/ls-Warenhaus 5') diff --git a/warenhaus/ls-Warenhaus 5 b/warenhaus/ls-Warenhaus 5 index 6b05bad..3a64e00 100644 --- a/warenhaus/ls-Warenhaus 5 +++ b/warenhaus/ls-Warenhaus 5 @@ -22,82 +22,1278 @@ *) 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: ");{} 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: ");{} 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: "));{} - 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{} + 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: "); + 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: "); + 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: ")); + + 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 + -- cgit v1.2.3