summaryrefslogtreecommitdiff
path: root/warenhaus/ls-Warenhaus 5
diff options
context:
space:
mode:
Diffstat (limited to 'warenhaus/ls-Warenhaus 5')
-rw-r--r--warenhaus/ls-Warenhaus 51299
1 files changed, 0 insertions, 1299 deletions
diff --git a/warenhaus/ls-Warenhaus 5 b/warenhaus/ls-Warenhaus 5
deleted file mode 100644
index 3a64e00..0000000
--- a/warenhaus/ls-Warenhaus 5
+++ /dev/null
@@ -1,1299 +0,0 @@
-(*
-
- **********************************************************
- **********************************************************
- ** **
- ** 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
-
-
generated by cgit v1.2.3 (git 2.39.1) at 2024-05-07 18:51:41 +0000