summaryrefslogtreecommitdiff
path: root/warenhaus
diff options
context:
space:
mode:
Diffstat (limited to 'warenhaus')
-rw-r--r--warenhaus/ls-MENUKARTE:Warenhausbin60928 -> 0 bytes
-rw-r--r--warenhaus/ls-Warenhaus 0: mit Kartenleser an AKTRONIC-Adapter204
-rw-r--r--warenhaus/ls-Warenhaus 0: mit Kartenleser an MUFI als Endgerät211
-rw-r--r--warenhaus/ls-Warenhaus 0: mit Kartenleser an MUFI im Terminalkanal109
-rw-r--r--warenhaus/ls-Warenhaus 0: ohne Kartenleser49
-rw-r--r--warenhaus/ls-Warenhaus 1235
-rw-r--r--warenhaus/ls-Warenhaus 21257
-rw-r--r--warenhaus/ls-Warenhaus 3986
-rw-r--r--warenhaus/ls-Warenhaus 4421
-rw-r--r--warenhaus/ls-Warenhaus 51299
-rw-r--r--warenhaus/ls-Warenhaus-gen95
11 files changed, 0 insertions, 4866 deletions
diff --git a/warenhaus/ls-MENUKARTE:Warenhaus b/warenhaus/ls-MENUKARTE:Warenhaus
deleted file mode 100644
index 414470a..0000000
--- a/warenhaus/ls-MENUKARTE:Warenhaus
+++ /dev/null
Binary files differ
diff --git a/warenhaus/ls-Warenhaus 0: mit Kartenleser an AKTRONIC-Adapter b/warenhaus/ls-Warenhaus 0: mit Kartenleser an AKTRONIC-Adapter
deleted file mode 100644
index 0ac3237..0000000
--- a/warenhaus/ls-Warenhaus 0: mit Kartenleser an AKTRONIC-Adapter
+++ /dev/null
@@ -1,204 +0,0 @@
-(*
-
- **********************************************************
- **********************************************************
- ** **
- ** ls-Warenhaus 0 **
- ** **
- ** Anpassung für Kartenleser an AKTRONIC-Adapter **
- ** **
- ** 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 0 DEFINES
- interface anpassung,
- oeffne interface,
- schliesse interface,
- wert von interface,
- pressed key,
-(* --------------------------- *)
- kanalkoppler,
- interfacechannel,
- init interfacechannel:
-TEXT CONST interface anpassung :: "mit Kartenleser an AKTRONIC-Adapter";
-LET max channel = 24,
- initcode = 26,
- endcode = 27,
- read code = 28;
-INT CONST nicht initialisiert code :: -3,
- interface error code :: -4,
-
- kanal besetzt code :: -5;
-INT VAR interfacekanal :: 0;
-TEXT VAR puffer :: "";
-TASK VAR hardwaremanager :: niltask,
- interface task :: niltask,
- absender;
-DATASPACE VAR ds :: nilspace;
-INT PROC interfacechannel:
- interfacekanal
-END PROC interfacechannel;
-PROC oeffne interface (INT VAR status):
- puffer := "";
- forget (ds); ds := nilspace;
- pingpong (interfacetask, init code, ds, status);
- IF status > 0 THEN status DECR maxint FI;
-
- forget (ds); ds := nilspace
-END PROC oeffne interface;
-INT PROC wert von interface:
- INT VAR wert;
- puffer CAT incharety (1);
- call (interface task, read code, ds, wert);
- wert.
-END PROC wert von interface;
-PROC schliesse interface:
- forget (ds); ds := nilspace;
- send (interface task, end code, ds);
- forget (ds); ds := nilspace
-END PROC schliesse interface;
-TEXT PROC pressed key:
- IF puffer = ""
- THEN incharety
- ELSE erstes pufferzeichen
- FI.
- erstes pufferzeichen:
-
- TEXT VAR zeichen :: puffer SUB 1;
- puffer := subtext (puffer, 2);
- zeichen.
-END PROC pressed key;
-TEXT PROC pressed key (INT CONST warten):
- IF puffer = ""
- THEN incharety (warten)
- ELSE erstes pufferzeichen
- FI.
- erstes pufferzeichen:
- TEXT VAR zeichen :: puffer SUB 1;
- puffer := subtext (puffer, 2);
- zeichen.
-END PROC pressed key;
-(*************************************************************************)
-PROC kanalkoppler:
- enable stop;
- IF name (myself) <> "-"
-
- THEN errorstop ("Unzulässiges Kommando!")
- ELSE warte auf anrufe
- FI.
- warte auf anrufe:
- INT VAR codenummer, antwort;
- disable stop;
- REP wait (ds, codenummer, absender);
- reagiere auf anruf;
- loesche ggf fehlerzustand
- PER.
- reagiere auf anruf:
- IF codenummer = initcode
- THEN kopple an interface;
- IF interface ist betriebsbereit
- THEN bearbeite weitere auftraege
- ELSE gib negative rueckmeldung
-
- FI;
- gib kanal frei
- ELSE send (absender, nicht initialisiert code, ds)
- FI.
- loesche ggf fehlerzustand:
- IF is error
- THEN clear error
- FI.
- kopple an interface:
- IF task (interfacekanal) <> niltask AND task (interfacekanal) <> myself
- THEN antwort := kanal besetzt code;
- ELSE continue (interfacekanal);
- teste interface
- FI.
- teste interface:
- leere puffer;
- out (""240"");
- IF incharety (1) <> ""
- THEN antwort := 0;
-
- out (""176"")
- ELSE antwort := interface error code
- FI.
- leere puffer:
- REP UNTIL incharety = "" PER.
- interface ist betriebsbereit: antwort = 0.
- gib negative rueckmeldung: send (absender, antwort, ds).
- gib kanal frei: break (quiet).
- ende: out (""176"").
- bearbeite weitere auftraege:
- REP pingpong (absender, antwort, ds, codenummer);
- IF codenummer = read code
- THEN hole wert von interface
-
- ELIF codenummer < 0
- THEN send (absender, codenummer, ds);
- codenummer := endcode
- ELSE antwort := 0
- FI
- UNTIL codenummer = endcode PER;
- ende.
- hole wert von interface:
- out (""211"");
- antwort := code (incharety (1)).
-END PROC kanalkoppler;
-PROC init interfacechannel:
- teste auf zulaessigkeit;
- loesche interfacetask;
- erfrage interface kanal;
- generiere ggf neue interfacetask.
- teste auf zulaessigkeit:
-
- enable stop;
- IF hardwaremanager <> niltask AND hardwaremanager <> myself
- THEN errorstop ("Dieses Kommando kann nur von der Task '" +
- name (hardwaremanager) + "' aus gegeben werden!")
- ELSE hardwaremanager := myself
- FI.
- loesche interfacetask:
- disable stop;
- end (interfacetask);
- IF is error THEN clear error FI;
- enable stop.
- generiere ggf neue interfacetask:
- IF interface kanal = 0
- THEN interface task := niltask;
- hardwaremanager := niltask
-
- ELSE begin (PROC kanalkoppler, interface task);
- hardwaremanager := myself
- FI.
- erfrage interfacekanal:
- INT VAR kanalnummer;
- put ("Gib Interface - Kanal:");
- get (kanalnummer);
- set interfacechannel (kanalnummer).
-END PROC init interfacechannel;
-PROC set interface channel (INT CONST channel number):
- IF channel number < 0 OR channel number > max channel
- THEN errorstop ("Unzulässige Kanalnummer")
- ELSE interfacekanal := channel number
- FI
-END PROC set interface channel;
-
-BOOL OP <> (TASK CONST t1, t2):
- NOT (t1 = t2)
-END OP <>;
-init interfacechannel
-END PACKET ls warenhaus 0
-
-
diff --git a/warenhaus/ls-Warenhaus 0: mit Kartenleser an MUFI als Endgerät b/warenhaus/ls-Warenhaus 0: mit Kartenleser an MUFI als Endgerät
deleted file mode 100644
index 0098901..0000000
--- a/warenhaus/ls-Warenhaus 0: mit Kartenleser an MUFI als Endgerät
+++ /dev/null
@@ -1,211 +0,0 @@
-(*
-
- **********************************************************
- **********************************************************
- ** **
- ** ls-Warenhaus 0 **
- ** **
- ** Anpassung für Kartenleser an MUFI als Endgerät **
- ** **
- ** 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 0 DEFINES
- interface anpassung,
- oeffne interface,
- schliesse interface,
- wert von interface,
- pressed key,
-(* --------------------------- *)
- kanalkoppler,
- interfacechannel,
- init interfacechannel:
-TEXT CONST interface anpassung :: "mit Kartenleser an MUFI als Endgerät";
-LET mufikennung = ""27""27"",
- max channel = 24,
- initcode = 26,
- endcode = 27,
- read code = 28;
-INT CONST nicht initialisiert code :: -3,
- interface error code :: -4,
-
- kanal besetzt code :: -5;
-INT VAR interfacekanal :: 2;
-TEXT VAR puffer :: "";
-TASK VAR hardwaremanager :: niltask,
- interface task :: niltask,
- absender;
-DATASPACE VAR ds :: nilspace;
-INT PROC interfacechannel:
- interfacekanal
-END PROC interfacechannel;
-PROC oeffne interface (INT VAR status):
- puffer := "";
- forget (ds); ds := nilspace;
- pingpong (interfacetask, init code, ds, status);
- IF status > 0 THEN status DECR maxint FI;
-
- forget (ds); ds := nilspace
-END PROC oeffne interface;
-INT PROC wert von interface:
- INT VAR wert;
- puffer CAT incharety (1);
- call (interface task, read code, ds, wert);
- wert.
-END PROC wert von interface;
-PROC schliesse interface:
- forget (ds); ds := nilspace;
- send (interface task, end code, ds);
- forget (ds); ds := nilspace
-END PROC schliesse interface;
-TEXT PROC pressed key:
- IF puffer = ""
- THEN incharety
- ELSE erstes pufferzeichen
- FI.
- erstes pufferzeichen:
-
- TEXT VAR zeichen :: puffer SUB 1;
- puffer := subtext (puffer, 2);
- zeichen.
-END PROC pressed key;
-TEXT PROC pressed key (INT CONST warten):
- IF puffer = ""
- THEN incharety (warten)
- ELSE erstes pufferzeichen
- FI.
- erstes pufferzeichen:
- TEXT VAR zeichen :: puffer SUB 1;
- puffer := subtext (puffer, 2);
- zeichen.
-END PROC pressed key;
-(*************************************************************************)
-PROC kanalkoppler:
- enable stop;
- IF name (myself) <> "-"
-
- THEN errorstop ("Unzulässiges Kommando!")
- ELSE warte auf anrufe
- FI.
- warte auf anrufe:
- INT VAR codenummer, antwort;
- disable stop;
- REP wait (ds, codenummer, absender);
- reagiere auf anruf;
- loesche ggf fehlerzustand
- PER.
- reagiere auf anruf:
- IF codenummer = initcode
- THEN kopple an interface;
- IF interface ist betriebsbereit
- THEN bearbeite weitere auftraege
- ELSE gib negative rueckmeldung
-
- FI;
- gib kanal frei
- ELSE send (absender, nicht initialisiert code, ds)
- FI.
- loesche ggf fehlerzustand:
- IF is error
- THEN clear error
- FI.
- kopple an interface:
- IF task (interfacekanal) <> niltask AND task (interfacekanal) <> myself
- THEN antwort := kanal besetzt code;
- ELSE continue (interfacekanal);
- teste interface
- FI.
- teste interface:
- leere puffer;
- out (mufikennung + "10");
- fange status;
- IF status = mufikennung + "00"
-
- THEN antwort := 0;
- out (mufikennung + "1A18"22"")
- ELSE antwort := interface error code
- FI.
- leere puffer:
- REP UNTIL incharety = "" PER.
- fange status:
- INT VAR zaehler;
- TEXT VAR status :: "";
- FOR zaehler FROM 1 UPTO 4 REP
- status CAT incharety (1)
- PER.
- interface ist betriebsbereit: antwort = 0.
- gib negative rueckmeldung: send (absender, antwort, ds).
- gib kanal frei: break (quiet).
- ende: out (""25"").
-
- bearbeite weitere auftraege:
- REP pingpong (absender, antwort, ds, codenummer);
- IF codenummer = read code
- THEN hole wert von interface
- ELIF codenummer < 0
- THEN send (absender, codenummer, ds);
- codenummer := endcode
- ELSE antwort := 0
- FI
- UNTIL codenummer = endcode PER;
- ende.
- hole wert von interface:
- out (""76"");
- antwort := code (incharety (1)).
-END PROC kanalkoppler;
-PROC init interfacechannel:
-
- teste auf zulaessigkeit;
- loesche interfacetask;
- erfrage interface kanal;
- generiere ggf neue interfacetask.
- teste auf zulaessigkeit:
- enable stop;
- IF hardwaremanager <> niltask AND hardwaremanager <> myself
- THEN errorstop ("Dieses Kommando kann nur von der Task '" +
- name (hardwaremanager) + "' aus gegeben werden!")
- FI.
- loesche interfacetask:
- disable stop;
- end (interfacetask);
- IF is error THEN clear error FI;
- enable stop.
- generiere ggf neue interfacetask:
-
- IF interface kanal = 0
- THEN interface task := niltask;
- hardwaremanager := niltask
- ELSE begin (PROC kanalkoppler, interface task);
- hardwaremanager := myself
- FI.
- erfrage interfacekanal:
- INT VAR kanalnummer;
- put ("Gib Interface - Kanal:");
- get (kanalnummer);
- set interfacechannel (kanalnummer).
-END PROC init interfacechannel;
-PROC set interface channel (INT CONST channel number):
- IF channel number < 0 OR channel number > max channel
- THEN errorstop ("Unzulässige Kanalnummer!")
-
- ELSE interface kanal := channel number
- FI
-END PROC set interface channel;
-BOOL OP <> (TASK CONST t1, t2):
- NOT (t1 = t2)
-END OP <>;
-init interfacechannel
-END PACKET ls warenhaus 0
-
-
diff --git a/warenhaus/ls-Warenhaus 0: mit Kartenleser an MUFI im Terminalkanal b/warenhaus/ls-Warenhaus 0: mit Kartenleser an MUFI im Terminalkanal
deleted file mode 100644
index 54bb73e..0000000
--- a/warenhaus/ls-Warenhaus 0: mit Kartenleser an MUFI im Terminalkanal
+++ /dev/null
@@ -1,109 +0,0 @@
-(*
-
- **********************************************************
- **********************************************************
- ** **
- ** ls-Warenhaus 0 **
- ** **
- ** Anpassung für Kartenleser an MUFI im Terminalkanal **
- ** **
- ** 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 0 DEFINES
- interface anpassung,
- oeffne interface,
- schliesse interface,
- wert von interface,
- pressed key:
-TEXT CONST interface anpassung :: "mit Kartenleser an MUFI im Terminalkanal";
-LET mufikennung = ""31""31"";
-INT CONST interface error code :: -4;
-TEXT CONST readcode :: mufikennung + "4C";
-TEXT VAR puffer :: "";
-PROC oeffne interface (INT VAR status):
- cursor (2,24);
- warte etwas;
- leere eingangspuffer;
- out (""27""27"10");
- fange antwort;
- IF antwort = ""27""27"00"
-
- THEN status := 0;
- out (""27""27"1C" + hex (mufikennung))
- ELSE status := interface error code
- FI.
- warte etwas:
- pause (1); pause (1); pause (1); pause (1); pause (1).
- leere eingangspuffer:
- puffer := "";
- REP UNTIL incharety = "" PER.
- fange antwort:
- TEXT VAR antwort :: incharety (1);
- INT VAR i;
- FOR i FROM 1 UPTO 3 REP
- antwort CAT incharety (1)
- PER.
-END PROC oeffne interface;
-INT PROC wert von interface:
- puffer CAT incharety (1);
-
- out (readcode);
- fange mufikennung;
- dezimalwert (incharety (1), incharety (1)).
- fange mufikennung:
- REP puffer CAT incharety
- UNTIL pos (puffer, mufikennung) > 0 PER;
- change (puffer, mufikennung, "").
-END PROC wert von interface;
-PROC schliesse interface:
- cursor (2,24);
- out (mufikennung + "1C" + hex (""27""27""))
-END PROC schliesse interface;
-TEXT PROC pressed key:
- IF puffer = ""
- THEN incharety
- ELSE erstes pufferzeichen
- FI.
- erstes pufferzeichen:
-
- TEXT VAR zeichen :: puffer SUB 1;
- puffer := subtext (puffer, 2);
- zeichen.
-END PROC pressed key;
-TEXT PROC pressed key (INT CONST warten):
- IF puffer = ""
- THEN incharety (warten)
- ELSE erstes pufferzeichen
- FI.
- erstes pufferzeichen:
- TEXT VAR zeichen :: puffer SUB 1;
- puffer := subtext (puffer, 2);
- zeichen.
-END PROC pressed key;
-INT PROC dezimalwert (TEXT CONST zeichen 1, zeichen 2):
- 16 * pos (hexzeichen, zeichen 1) + pos (hexzeichen, zeichen 2).
-
- hexzeichen: "123456789ABCDEF".
-END PROC dezimalwert;
-TEXT PROC hex (TEXT CONST zwei zeichen):
- hex (code (zwei zeichen SUB 1)) + hex (code (zwei zeichen SUB 2))
-END PROC hex;
-TEXT PROC hex (INT CONST wert):
- (hexzeichen SUB (wert DIV 16 + 1)) + (hexzeichen SUB (wert MOD 16 + 1)).
- hexzeichen: "0123456789ABCDEF".
-END PROC hex
-END PACKET ls warenhaus 0
-
-
diff --git a/warenhaus/ls-Warenhaus 0: ohne Kartenleser b/warenhaus/ls-Warenhaus 0: ohne Kartenleser
deleted file mode 100644
index 96af5c1..0000000
--- a/warenhaus/ls-Warenhaus 0: ohne Kartenleser
+++ /dev/null
@@ -1,49 +0,0 @@
-(*
-
- **********************************************************
- **********************************************************
- ** **
- ** ls-Warenhaus 0 **
- ** **
- ** Anpassung für den Betrieb ohne Kartenleser **
- ** **
- ** 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 0 DEFINES
- interface anpassung,
- oeffne interface,
- schliesse interface,
- wert von interface,
- pressed key:
-TEXT CONST interface anpassung :: "ohne Kartenleser";
-PROC oeffne interface (INT VAR test):
- test := -6
-END PROC oeffne interface;
-PROC schliesse interface:
-END PROC schliesse interface;
-INT PROC wert von interface:
- INT VAR wert :: 0;
- wert
-END PROC wert von interface;
-TEXT PROC pressed key:
- incharety
-END PROC pressed key;
-TEXT PROC pressed key (INT CONST warten):
-
- incharety (warten)
-END PROC pressed key;
-END PACKET ls warenhaus 0
-
-
diff --git a/warenhaus/ls-Warenhaus 1 b/warenhaus/ls-Warenhaus 1
deleted file mode 100644
index c3976b4..0000000
--- a/warenhaus/ls-Warenhaus 1
+++ /dev/null
@@ -1,235 +0,0 @@
-(*
-
- **********************************************************
- **********************************************************
- ** **
- ** ls-Warenhaus 1 **
- ** **
- ** 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 monitor alt DEFINES original monitor:
- PROC original monitor:
- monitor
- END PROC originalmonitor
-END PACKET monitor alt;
-PACKET ls warenhaus 1 DEFINES
- zentrale,
- monitor,
- warenhaus direktstart,
- warenhaus hauptstelle,
- hauptstellenname:
-LET max kundenzahl = 31,
- min kundennummer = 129,
- kundendatei holen code = 100,
- kundendatei ergaenzen code = 200;
-TYPE KUNDENDATEN = STRUCT (TEXT nachname, vorname, geschlecht),
- KUNDENDATEI = ROW max kundenzahl KUNDENDATEN;
-
-
-BOUND KUNDENDATEN VAR kundendaten;
-BOUND KUNDENDATEI VAR bound kundendatei;
-KUNDENDATEI VAR kundendatei;
-DATASPACE VAR ds;
-TASK VAR absender,
- zentraltask :: niltask,
- hauptstelle :: niltask,
- direktstartmanager :: niltask;
-BOOL VAR mit direktstart :: FALSE,
- mit loeschen :: FALSE;
-INT VAR codenummer;
-PROC zentrale:
- enable stop;
- IF pos (name (myself), ".Zentrale") = 0
- THEN errorstop ("Unzulaessiger Befehl!")
-
-
- FI;
- disable stop;
- REP wait (ds, codenummer, absender);
- bearbeite auftrag;
- send (absender, codenummer, ds);
- IF is error THEN clear error FI
- PER.
- bearbeite auftrag:
- IF codenummer = kundendatei holen code
- THEN hole kundendatei
- ELIF codenummer = kundendatei ergaenzen code
- THEN ergaenze kundendatei
- ELIF codenummer >= min kundennummer
- THEN lies kundendaten
- ELSE speichere kundendaten
- FI.
-END PROC zentrale;
-
-
-PROC hole kundendatei:
- bound kundendatei := ds;
- bound kundendatei := kundendatei
-END PROC hole kundendatei;
-PROC ergaenze kundendatei:
- INT VAR kundennummer;
- bound kundendatei := ds;
- FOR kundennummer FROM 1 UPTO max kundenzahl REP
- IF kundendatei [kundennummer].nachname = ""
- THEN kundendatei [kundennummer] := bound kundendatei [kundennummer]
- FI
- PER;
- init ds
-END PROC ergaenze kundendatei;
-PROC lies kundendaten:
- kundendaten := ds;
- kundendaten := kundendatei [platznummer].
-
-
- platznummer: codenummer - min kundennummer + 1.
-END PROC lies kundendaten;
-PROC speichere kundendaten:
- kundendaten := ds;
- kundendatei [codenummer] := kundendaten;
- init ds
-END PROC speichere kundendaten;
-PROC warenhaus hauptstelle (BOOL CONST task soll hauptstelle sein):
- enable stop;
- IF task soll hauptstelle sein
- THEN mache task zur hauptstelle
- ELSE mache hauptstellenstatus rueckgaengig
- FI.
- mache task zur hauptstelle:
- sei eine hauptstelle;
- line (2);
-
-
- IF NOT mit direktstart CAND yes ("Mit Direktstart")
- THEN warenhaus direktstart (TRUE)
- ELSE global manager
- FI
-END PROC warenhaus hauptstelle;
-PROC sei eine hauptstelle:
- IF NOT (hauptstelle = niltask OR hauptstelle = myself)
- THEN errorstop ("Hauptstelle ist bereits die Task '" +
- name (hauptstelle) + "'!")
- FI;
- disable stop;
- end (zentraltask);
- IF is error THEN clear error FI;
- enable stop;
- hauptstelle := niltask;
- begin (name (myself) + ".Zentrale", PROC zentrale, zentraltask);
-
-
- hauptstelle := myself
-END PROC sei eine hauptstelle;
-PROC mache hauptstellenstatus rueckgaengig:
- IF NOT (hauptstelle = niltask OR hauptstelle = myself)
- THEN errorstop ("Dieses Kommando darf nur in der Task '" +
- name (hauptstelle) + " gegeben werden!")
- FI;
- disable stop;
- end (zentraltask);
- IF is error THEN clear error FI;
- enable stop;
- hauptstelle := niltask;
- warenhaus direktstart (FALSE)
-END PROC mache hauptstellenstatus rueckgaengig;
-PROC warenhaus direktstart (BOOL CONST wahl):
-
-
- pruefe zulaessigkeit;
- mit direktstart := wahl;
- IF mit direktstart
- THEN direktstartmanager := myself;
- mit loeschen := yes ("Mit automatischem Löschen")
- ELSE direktstartmanager := niltask
- FI;
- global manager.
- pruefe zulaessigkeit:
- enable stop;
- IF NOT (direktstartmanager = niltask OR direktstartmanager = myself)
- THEN errorstop ("Der Direktstart kann nur aus der Task '" +
- name (direktstartmanager) + "'geaendert werden!")
-
-
- FI.
-END PROC warenhaus direktstart;
-TEXT PROC hauptstellenname:
- name (hauptstelle)
-END PROC hauptstellenname;
-PROC monitor:
- IF mit direktstart
- THEN warenhaus monitor
- ELSE original monitor
- FI
-END PROC monitor;
-PROC warenhausmonitor:
- disable stop;
- INT VAR previous heapsize := heap size;
- REP command dialogue (TRUE);
- sysin (""); sysout ("");
- cry if not enough storage;
- reset dialog; erase menunotice;
- do ("warenhaus");
- IF is error
-
-
- THEN clear error
- ELSE sitzungsende
- FI
- PER.
- sitzungsende:
- collect heap garbage if necessary;
- page;
- IF mit loeschen
- THEN break; end (myself)
- ELSE end; break
- FI.
- collect heap garbage if necessary:
- IF heap size > previous heapsize + 10
- THEN collect heap garbage;
- previous heapsize := heap size
- FI.
- cry if not enough storage:
- INT VAR size, used;
- storage (size, used);
- IF used > size
- THEN out (""7"Speicher Engpass! Dateien loeschen!"13""10"")
-
-
- FI.
-END PROC warenhausmonitor;
-OP := (KUNDENDATEN VAR ziel, KUNDENDATEN CONST quelle):
- CONCR (ziel) := CONCR (quelle)
-END OP :=;
-OP := (KUNDENDATEI VAR ziel, KUNDENDATEI CONST quelle):
- CONCR (ziel) := CONCR (quelle)
-END OP :=;
-PROC init ds:
- forget (ds); ds := nilspace
-END PROC init ds;
-PROC initialisiere kundendatei:
- KUNDENDATEN CONST leer :: KUNDENDATEN : ("", "", "");
- INT VAR nr;
- FOR nr FROM 1 UPTO max kundenzahl REP
- kundendatei [nr] := leer
- PER
-END PROC initialisiere kundendatei;
-
-
-initialisiere kundendatei
-END PACKET ls warenhaus 1
-
-
-
diff --git a/warenhaus/ls-Warenhaus 2 b/warenhaus/ls-Warenhaus 2
deleted file mode 100644
index f7a9945..0000000
--- a/warenhaus/ls-Warenhaus 2
+++ /dev/null
@@ -1,1257 +0,0 @@
-(*
-
- **********************************************************
- **********************************************************
- ** **
- ** ls-Warenhaus 2 **
- ** **
- ** 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 2 DEFINES
- max artikelzahl,
- max kundenzahl,
- min kundennummer,
- max kundennummer,
- min artikelnummer,
- max artikelnummer,
- filialverwaltung,
- initialisiere verwaltung,
- hole artikeldaten,
- speichere artikeldaten,
- registriere verkauf,
- hole kundendaten,
- speichere kundendaten,
- sichere filialdaten,
- lade filialdaten,
- hole bestelliste,
- hole auskunft ein:
-LET max filialen = 10,
- max artikel = 15,
-
- max kunden = 31,
- min kundennr = 129,
- max kundennr = 159,
- min artikelnr = 1,
- max artikelnr = 15;
-LET zentrale kundendatei holen code = 100,
- zentrale kundendatei ergaenzen code = 200,
- filialdaten holen code = 201,
- filialdaten ergaenzen code = 202;
-INT CONST max artikelzahl :: max artikel,
- max kundenzahl :: max kunden,
- min kundennummer :: min kundennr,
- max kundennummer :: max kundennr,
-
- min artikelnummer :: min artikelnr,
- max artikelnummer :: max artikelnr;
-TYPE ARTIKELDATEN = STRUCT (TEXT artikelname, REAL preis,
- INT mindestbestand, bestand),
- KUNDENDATEN = STRUCT (TEXT nachname, vorname, geschlecht),
- WARENDATEI = ROW max artikel ARTIKELDATEN,
- KUNDENDATEI = ROW max kunden KUNDENDATEN,
- EINKAUFSDATEI = ROW max kunden ROW max artikel INT,
- VERKAUFSDATEI = ROW max artikel INT,
- FILIALDATEN = STRUCT (WARENDATEI waren, KUNDENDATEI kunden,
-
- EINKAUFSDATEI einkaeufe,
- VERKAUFSDATEI hitliste);
-KUNDENDATEI VAR kunde;
-WARENDATEI VAR artikel;
-EINKAUFSDATEI VAR einkaufsdatei;
-VERKAUFSDATEI VAR verkaufszahl;
-DATASPACE VAR ds;
-INT VAR codenummer, reply code;
-TASK VAR zentrale, verwaltung, absender;
-TEXT VAR hauptstelle :: "",
- filialnummer :: "0",
- filialverwaltungsname :: "";
-PROC filialverwaltung:
- enable stop;
-
- IF pos (name (myself), ".Filialverwaltung") = 0
- THEN errorstop ("Unzulaessiger Befehl!")
- FI;
- disable stop;
- REP wait (ds, codenummer, absender);
- bearbeite auftrag;
- send (absender, 0, ds);
- IF is error THEN clear error FI
- PER.
- bearbeite auftrag:
- IF codenummer <= max artikel
- THEN artikeldaten speichern
- ELIF codenummer <= max kundennr
- THEN kauf registrieren
- ELIF codenummer <= max kundennr + max kunden
- THEN kundendaten speichern
-
- ELIF codenummer = filialdaten holen code
- THEN filialdaten holen
- ELIF codenummer = filialdaten ergaenzen code
- THEN filialdaten ergaenzen; init ds
- ELIF codenummer = 256
- THEN sperre task
- FI.
- sperre task:
- call (absender, 256, ds, codenummer).
-END PROC filialverwaltung;
-PROC artikeldaten speichern:
- BOUND ARTIKELDATEN VAR artikeldaten :: ds;
- artikel [codenummer] := artikeldaten;
- init ds
-END PROC artikeldaten speichern;
-PROC kauf registrieren:
-
- artikelnummer aus ds lesen;
- artikel [artikelnummer].bestand DECR 1;
- verkaufszahl [artikelnummer] INCR 1;
- IF kundennummer > 0
- THEN einkaufsdatei [kundennummer][artikelnummer] INCR 1
- FI.
- artikelnummer aus ds lesen:
- BOUND INT VAR nummer :: ds;
- INT CONST artikelnummer :: nummer,
- kundennummer :: codenummer - min kundennr + 1;
- init ds
-END PROC kauf registrieren;
-PROC kundendaten speichern:
- BOUND KUNDENDATEN VAR kundendaten :: ds;
- kunde [codenummer - min kundennr - max kunden + 1] := kundendaten
-
-END PROC kundendaten speichern;
-PROC filialdaten holen:
- init ds;
- BOUND FILIALDATEN VAR filialdaten :: ds;
- CONCR (filialdaten.waren) := CONCR (artikel);
- CONCR (filialdaten.kunden) := CONCR (kunde);
- CONCR (filialdaten.einkaeufe) := CONCR (einkaufsdatei);
- CONCR (filialdaten.hitliste) := CONCR (verkaufszahl)
-END PROC filialdaten holen;
-PROC filialdaten ergaenzen:
- BOUND FILIALDATEN VAR neue daten :: ds;
- INT VAR kundennummer, artikelnummer;
- ergaenze artikeldatei und verkaufszahlen;
-
- ergaenze kundendatei;
- ergaenze einkaufsdatei.
- ergaenze artikeldatei und verkaufszahlen:
- FOR artikelnummer FROM 1 UPTO max artikel REP
- verkaufszahl [artikelnummer] INCR neue daten.hitliste [artikelnummer];
- IF artikel [artikelnummer].artikelname = ""
- THEN artikel [artikelnummer] := neue daten.waren [artikelnummer]
- FI
- PER.
- ergaenze kundendatei:
- FOR kundennummer FROM 1 UPTO max kunden REP
- IF kunde [kundennummer].nachname = ""
- THEN kunde [kundennummer] := neue daten.kunden [kundennummer]
-
- FI
- PER.
- ergaenze einkaufsdatei:
- FOR kundennummer FROM 1 UPTO max kunden REP
- FOR artikelnummer FROM 1 UPTO max artikel REP
- einkaufsdatei [kundennummer][artikelnummer]
- INCR neue daten.einkaeufe [kundennummer][artikelnummer]
- PER
- PER.
-END PROC filialdaten ergaenzen;
-OP := (ARTIKELDATEN VAR ziel, ARTIKELDATEN CONST quelle):
- CONCR (ziel) := CONCR (quelle)
-END OP :=;
-OP := (KUNDENDATEN VAR ziel, KUNDENDATEN CONST quelle):
- CONCR (ziel) := CONCR (quelle)
-
-END OP :=;
-PROC init ds:
- forget (ds); ds := nilspace
-END PROC init ds;
-(************************************************************************)
-PROC initialisiere verwaltung:
- hauptstelle := hauptstellenname;
- zentrale := task (hauptstelle + ".Zentrale");
- filialnummer := text (channel (myself));
- filialverwaltungsname := hauptstellenname + ".Filialverwaltung ";
- begin (filialverwaltungsname + filialnummer,
- PROC filialverwaltung, verwaltung)
-END PROC initialisiere verwaltung;
-
-PROC hole artikeldaten (INT CONST artikelnummer,
- TEXT VAR name, REAL VAR preis,
- INT VAR mindestbestand, bestand):
- enable stop;
- pruefe artikelnummer;
- hole daten.
- pruefe artikelnummer:
- INT CONST artikelindex :: artikelnummer - min artikelnr + 1;
- IF artikelindex < 1 OR artikelindex > max artikel
- THEN errorstop ("Unzulässige Artikelnummer!")
- FI.
- hole daten:
- name := artikel [artikelindex].artikelname;
-
- preis := artikel [artikelindex].preis;
- mindestbestand := artikel [artikelindex].mindestbestand;
- bestand := artikel [artikelindex].bestand.
-END PROC hole artikeldaten;
-PROC speichere artikeldaten (INT CONST artikelnummer,
- TEXT CONST name, REAL CONST preis,
- INT CONST mindestbestand, bestand):
- enable stop;
- pruefe artikelnummer;
- speichere daten;
- schicke kopie an verwaltung.
- pruefe artikelnummer:
-
- INT CONST artikelindex :: artikelnummer - min artikelnr + 1;
- IF artikelindex < 1 OR artikelindex > max artikel
- THEN errorstop ("Unzulässige Artikelnummer!")
- FI.
- speichere daten:
- artikel [artikelindex].artikelname := name;
- artikel [artikelindex].preis := preis;
- artikel [artikelindex].mindestbestand:= mindestbestand;
- artikel [artikelindex].bestand := bestand.
- schicke kopie an verwaltung:
- init ds;
- BOUND ARTIKELDATEN VAR artikeldaten :: ds;
-
- artikeldaten := artikel [artikelindex];
- call (verwaltung, artikelindex, ds, reply code).
-END PROC speichere artikeldaten;
-PROC registriere verkauf (INT CONST kundennummer, artikelnummer):
- enable stop;
- pruefe daten;
- speichere daten;
- schicke kopie zur verwaltung.
- pruefe daten:
- INT VAR kundenindex :: kundennummer - min kundennr + 1,
- artikelindex :: artikelnummer - min artikelnr + 1;
- IF kundenindex < 0 OR kundenindex > max kunden
- THEN errorstop ("Unzulässige Kundennummer!")
-
- ELIF artikelindex < 1 OR artikelindex > max artikel
- THEN errorstop ("Unzulässige Artikelnummer!")
- FI.
- speichere daten:
- IF artikel [artikelindex].bestand > 0
- THEN artikel [artikelindex].bestand DECR 1;
- verkaufszahl [artikelindex] INCR 1;
- IF kundenindex > 0
- THEN trage evtl in einkaufsdatei ein
- FI FI.
- trage evtl in einkaufsdatei ein:
- IF kunde [kundenindex].nachname = ""
- THEN kundenindex := 0
- ELSE einkaufsdatei [kundenindex][artikelindex] INCR 1
-
- FI.
- schicke kopie zur verwaltung:
- init ds;
- BOUND INT VAR nummer :: ds;
- nummer := artikelindex;
- call (verwaltung, kundenindex + min kundennr - 1, ds, reply code).
-END PROC registriere verkauf;
-PROC hole kundendaten (INT CONST kundennummer,
- TEXT VAR nachname, vorname, geschlecht):
- enable stop;
- pruefe kundennummer;
- rufe zentrale an;
- uebergib die zentraldaten;
- IF aenderungen vorhanden
- THEN aktualisiere filialdaten
- FI;
- forget (ds).
-
- pruefe kundennummer:
- INT CONST index :: kundennummer - min kundennr + 1;
- IF index < 1 OR index > max kunden
- THEN errorstop ("Unzulässige Kundennummer!")
- FI.
- rufe zentrale an:
- init ds;
- call (zentrale, kundennummer, ds, reply code).
- aenderungen vorhanden:
- (kunde [index].nachname <> nachname ) OR
- (kunde [index].vorname <> vorname ) OR
- (kunde [index].geschlecht <> geschlecht).
- aktualisiere filialdaten:
- kunde [index] := daten von zentrale;
-
- call (verwaltung, kundennummer + max kunden, ds, reply code).
- uebergib die zentraldaten:
- BOUND KUNDENDATEN VAR daten von zentrale :: ds;
- nachname := daten von zentrale.nachname;
- vorname := daten von zentrale.vorname;
- geschlecht := daten von zentrale.geschlecht.
-END PROC hole kundendaten;
-PROC speichere kundendaten(INT CONST kundennummer,
- TEXT CONST nachname, vorname, geschlecht):
- enable stop;
- pruefe kundennummer;
- IF kundendaten geaendert
-
- THEN speichere daten;
- schicke kopie an verwaltung und zentrale
- FI.
- pruefe kundennummer:
- IF kundennummer < min kundennr OR kundennummer > max kundennr
- THEN errorstop ("Unzulässige Kundennummer!")
- FI.
- kundendaten geaendert:
- INT CONST index :: kundennummer - min kundennr + 1;
- nachname <> kunde [index].nachname OR
- vorname <> kunde [index].vorname OR
- geschlecht <> kunde [index].geschlecht.
- speichere daten:
- kunde [index].nachname := nachname;
-
- kunde [index].vorname := vorname;
- kunde [index].geschlecht := geschlecht.
- schicke kopie an verwaltung und zentrale:
- init ds;
- BOUND KUNDENDATEN VAR kundendaten :: ds;
- kundendaten := kunde [index];
- call (verwaltung, kundennummer + max kunden, ds, reply code);
- call (zentrale, kundennummer - min kundennr + 1, ds, reply code);
- forget (ds).
-END PROC speichere kundendaten;
-PROC sichere filialdaten (TEXT CONST name):
- enable stop;
- filialdaten holen;
-
- type (ds, 1951);
- forget (name, quiet);
- copy (ds, name);
- forget (ds)
-END PROC sichere filialdaten;
-PROC lade filialdaten (TEXT CONST name):
- enable stop;
- forget (ds);
- ds := old (name);
- IF type (ds) = 1951
- THEN filialdaten ergaenzen;
- kopie an verwaltung schicken;
- kopie der kundendatei an zentrale schicken
- ELSE errorstop ("'" + name + "' enthält keine Filialdaten!")
- FI.
- kopie an verwaltung schicken:
- call (verwaltung, filialdaten ergaenzen code, ds, reply code).
-
- kopie der kundendatei an zentrale schicken:
- BOUND KUNDENDATEI VAR kundendatei :: ds;
- CONCR (CONCR (kundendatei)) := CONCR (kunde);
- call (zentrale, zentrale kundendatei ergaenzen code, ds, reply code).
-END PROC lade filialdaten;
-PROC hole bestelliste (FILE VAR f):
- bereite datei vor;
- schreibe daten in datei.
- bereite datei vor:
- forget("Nachbestellung",quiet);
- f := sequential file (output, "Nachbestellung");
- line (f);
- write (f, " Nachbestellungen für " +
-
- invers ("Filiale " + filialnummer)+":");
- line;
- write (f, " ==================================================");
- line (f, 2);
- write (f, " | Art.Nr. | Artikelname | Anzahl |");
- line (f);
- write (f, " +----------+-------------------------+-----------+");
- line (f).
- schreibe daten in datei:
- INT VAR artikelnummer;
- FOR artikelnummer FROM 1 UPTO max artikel REP
- IF artikel[artikelnummer].bestand
-
- < artikel[artikelnummer].mindestbestand
- THEN bestelle artikel nach
- FI
- PER;
- write (f, " +----------+-------------------------+-----------+");
- line (f).
- bestelle artikel nach:
- write (f, " | " + wirkliche artikelnummer + " | "
- + text (artikel [artikelnummer].artikelname, 23) + " | "
- + text (nachzubestellende anzahl, 6) + " |");
- line (f);
- artikel [artikelnummer].bestand
- := 2 * artikel [artikelnummer].mindestbestand.
-
- wirkliche artikelnummer:
- text (artikelnummer + min artikelnr - 1, 5).
- nachzubestellende anzahl:
- 2 * artikel [artikelnummer].mindestbestand
- - artikel [artikelnummer].bestand.
-END PROC hole bestelliste;
-PROC hole auskunft ein (INT CONST codenummer, artikel oder kundennummer,
- FILE VAR f):
- enable stop;
- hauptstelle := hauptstellenname;
- SELECT codenummer OF CASE 66 : hitliste von zentrale (f)
- CASE 67 : hitliste von filiale (f)
-
- CASE 68 : hitlisten aller filialen (f)
- (* --------------------------------------------- *)
- CASE 73 : artikelkaeuferliste von zentrale
- (artikel oder kundennummer, f)
- CASE 74 : artikelkaeuferliste von filiale
- (artikel oder kundennummer, f)
- CASE 75 : artikelkaeuferlisten aller filialen
- (artikel oder kundennummer, f)
-
- (* --------------------------------------------- *)
- CASE 77 : kundenliste von zentrale (f)
- CASE 78 : kundenliste von filiale (f)
- CASE 79 : kundenlisten aller filialen (f)
- (* --------------------------------------------- *)
- CASE 84 : kundeneinkaufsliste von zentrale
- (artikel oder kundennummer, f)
- CASE 85 : kundeneinkaufsliste von filiale
-
- (artikel oder kundennummer, f)
- CASE 86 : kundeneinkaufslisten aller filialen
- (artikel oder kundennummer, f)
- (* --------------------------------------------- *)
- CASE 89 : lageruebersicht von zentrale (f)
- CASE 90 : lageruebersicht von filiale (f)
- CASE 91 : lageruebersichten aller filialen (f)
- (* --------------------------------------------- *)
-
- OTHERWISE errorstop ("Unzulässige Code - Nummer bei Auskunft!")
- END SELECT
-END PROC hole auskunft ein;
-PROC hitliste von zentrale (FILE VAR f):
- INT VAR filialnr;
- beginne mit eigener filiale;
- FOR filialnr FROM 1 UPTO max filialen REP
- TEXT CONST aktuelle verwaltung ::
- hauptstelle + ".Filialverwaltung " + text (filialnr);
- IF filialnr <> int (filialnummer) CAND
- exists task (aktuelle verwaltung)
- THEN hole daten dieser filiale;
- schreibe daten in zentralliste
-
- FI
- PER;
- werte zentralliste aus.
- beginne mit eigener filiale:
- WARENDATEI VAR zentrale warendatei;
- CONCR (zentrale warendatei) := CONCR (artikel);
- VERKAUFSDATEI VAR zentrale verkaufsdatei;
- CONCR (zentrale verkaufsdatei) := CONCR (verkaufszahl).
- hole daten dieser filiale:
- init ds;
- call (task(aktuelle verwaltung), filialdaten holen code, ds, reply code);
- BOUND FILIALDATEN VAR aktuelle daten :: ds.
- schreibe daten in zentralliste:
- INT VAR i;
-
- FOR i FROM 1 UPTO max artikel REP
- IF zentrale warendatei [i].artikelname = ""
- THEN zentrale warendatei [i] := aktuelle daten.waren [i]
- FI;
- zentrale verkaufsdatei [i] INCR aktuelle daten.hitliste [i]
- PER.
- werte zentralliste aus:
- forget (ds);
- forget ("Auskunft: Zentrale", quiet);
- f := sequential file (output, "Auskunft: Zentrale");
- line (f);
- write (f, " Zentrale Warenliste, geordnet nach Verkaufszahlen:");
- sortiere (zentrale warendatei, zentrale verkaufsdatei);
-
- fuelle (f, zentrale warendatei, zentrale verkaufsdatei).
-END PROC hitliste von zentrale;
-PROC hitliste von filiale (FILE VAR f):
- bereite auskunftsdatei vor;
- kopiere artikeldatei und verkaufsdatei;
- sortiere (hilfsdatei artikel, hilfsdatei verkaufszahlen);
- fuelle (f,hilfsdatei artikel, hilfsdatei verkaufszahlen).
- kopiere artikeldatei und verkaufsdatei:
- WARENDATEI VAR hilfsdatei artikel;
- CONCR (hilfsdatei artikel) := CONCR (artikel);
- VERKAUFSDATEI VAR hilfsdatei verkaufszahlen;
-
- CONCR (hilfsdatei verkaufszahlen) := CONCR (verkaufszahl).
- bereite auskunftsdatei vor:
- forget ("Auskunft: Filiale " + filialnummer, quiet);
- f := sequential file (output, "Auskunft: Filiale " + filialnummer);
- line (f);
- write (f, " Warenliste, geordnet nach Verkaufszahlen:").
-END PROC hitliste von filiale;
-PROC hitlisten aller filialen (FILE VAR f):
- WARENDATEI VAR aktuelle warendatei;
- VERKAUFSDATEI VAR aktuelle verkaufsdatei;
- INT VAR filialnr;
-
- bereite auskunftsdatei vor;
- FOR filialnr FROM 1 UPTO max filialen REP
- TEXT CONST aktuelle verwaltung ::
- hauptstelle + ".Filialverwaltung " + text (filialnr);
- IF filialnr = int (filialnummer)
- THEN nimm eigene daten
- ELIF exists task (aktuelle verwaltung)
- THEN hole daten dieser filiale;
- arbeite mit diesen daten
- FI
- PER;
- forget (ds).
- bereite auskunftsdatei vor:
- forget ("Auskunft: Alle Filialen", quiet);
- f := sequential file (output, "Auskunft: Alle Filialen");
-
- line (f).
- nimm eigene daten:
- CONCR (aktuelle warendatei) := CONCR (artikel);
- CONCR (aktuelle verkaufsdatei) := CONCR (verkaufszahl);
- sortiere und fuelle.
- sortiere und fuelle:
- write (f, " Warenliste von " + invers ("Filiale " + text (filialnr))
- + ", geordnet nach Verkaufszahlen:");
- sortiere (aktuelle warendatei, aktuelle verkaufsdatei);
- fuelle (f,aktuelle warendatei, aktuelle verkaufsdatei).
- hole daten dieser filiale:
- init ds;
- call (task(aktuelle verwaltung), filialdaten holen code, ds, reply code);
-
- BOUND FILIALDATEN VAR aktuelle daten :: ds.
- arbeite mit diesen daten:
- CONCR (aktuelle warendatei) := CONCR (aktuelle daten.waren);
- CONCR (aktuelle verkaufsdatei) := CONCR (aktuelle daten.hitliste);
- sortiere und fuelle.
-END PROC hitlisten aller filialen;
-PROC sortiere (WARENDATEI VAR warendatei, VERKAUFSDATEI VAR stueckzahl):
- INT VAR i,j;
- FOR i FROM 1 UPTO max artikel - 1 REP
- FOR j FROM i + 1 UPTO max artikel REP
- IF stueckzahl [i] < stueckzahl [j]
- THEN vertausche
-
- FI
- PER PER.
- vertausche:
- INT CONST hilfsint :: stueckzahl [i];
- ARTIKELDATEN CONST hilfsartikel :: warendatei [i];
- stueckzahl [i] := stueckzahl [j];
- warendatei [i] := warendatei [j];
- stueckzahl [j] := hilfsint;
- warendatei [j] := hilfsartikel.
-END PROC sortiere;
-PROC fuelle (FILE VAR f, WARENDATEI VAR warendat, VERKAUFSDATEI VAR anzahl):
- INT VAR nummer, platz :: 0;
- bereite datei vor;
- schreibe daten in datei.
-bereite datei vor:
- line (f);
- write(f," ============================================================");
-
- line (f,2);
- write(f," | Platz | Verk.Anzahl | Artikelname | Preis |");
- line (f);
- write(f," +-------+-------------+------------------------+-----------+");
- line (f).
-schreibe daten in datei:
- FOR nummer FROM 1 UPTO max artikel REP
- IF warendat [nummer].artikelname <> ""
- THEN schreibe in datei; line (f)
- FI
- PER;
- write(f," +-------+-------------+------------------------+-----------+");
- line (f,3).
-schreibe in datei:
- platz INCR 1;
- write (f, " |" + text (platz, 5) + " |"
-
- + text (anzahl [nummer], 9) + " | "
- + text (warendat [nummer].artikelname, 22) + " | "
- + text (warendat [nummer].preis,8,2) + " |").
-END PROC fuelle;
-PROC artikelkaeuferliste von zentrale (INT CONST artikelnummer, FILE VAR f):
- INT VAR filialnr;
- pruefe artikelnummer;
- beginne mit eigener filiale;
- FOR filialnr FROM 1 UPTO max filialen REP
- TEXT CONST aktuelle verwaltung ::
- hauptstelle + ".Filialverwaltung " + text (filialnr);
-
- IF filialnr <> int (filialnummer) CAND
- exists task (aktuelle verwaltung)
- THEN hole daten dieser filiale;
- schreibe daten in zentralliste
- FI
- PER;
- werte zentralliste aus.
- pruefe artikelnummer:
- INT CONST artikelindex :: artikelnummer - min artikelnr + 1;
- IF artikelindex < 1 OR artikelindex > max artikel
- THEN errorstop ("Unzulässige Artikelnummer!")
- FI.
- beginne mit eigener filiale:
- TEXT VAR aktueller artikelname :: artikel [artikelindex].artikelname;
-
- KUNDENDATEI VAR hilfsdatei;
- CONCR (hilfsdatei) := CONCR (kunde);
- ROW max kunden INT VAR kaeufe;
- INT VAR i;
- FOR i FROM 1 UPTO max kunden REP
- kaeufe [i] := einkaufsdatei [i][artikelindex]
- PER.
- hole daten dieser filiale:
- init ds;
- call (task(aktuelle verwaltung), filialdaten holen code, ds, reply code).
- schreibe daten in zentralliste:
- BOUND FILIALDATEN VAR aktuelle daten :: ds;
- IF aktueller artikelname = ""
- THEN aktueller artikelname
-
- := aktuelle daten.waren [artikelindex].artikelname
- FI;
- FOR i FROM 1 UPTO max kunden REP
- kaeufe [i] INCR aktuelle daten.einkaeufe [i][artikelindex];
- IF hilfsdatei [i].nachname = ""
- THEN hilfsdatei [i] := aktuelle daten.kunden [i]
- FI
- PER.
- werte zentralliste aus:
- forget (ds);
- forget ("Auskunft: Zentrale", quiet);
- f := sequential file (output, "Auskunft: Zentrale");
- line (f);
- IF aktueller artikelname = ""
- THEN write (f, " Der Artikel Nr. " + text (artikelindex)
-
- + " wird in keiner Filiale geführt.");
- line (f);
- write(f,
- " ============================================================");
- line (f,3);
- ELSE write (f, " Gesamtkäuferliste des Artikels "
- + invers (aktueller artikelname) + ":");
- fuelle (f, hilfsdatei, kaeufe)
- FI.
-END PROC artikelkaeuferliste von zentrale;
-PROC artikelkaeuferliste von filiale (INT CONST artikelnummer, FILE VAR f):
-
- pruefe artikelnummer;
- kopiere einkaufszahlen in hilfsliste;
- erstelle filialliste.
- pruefe artikelnummer:
- INT CONST artikelindex :: artikelnummer - min artikelnr + 1;
- IF artikelindex < 1 OR artikelindex > max artikel
- THEN errorstop ("Unzulässige Artikelnummer!")
- FI.
- kopiere einkaufszahlen in hilfsliste:
- ROW max kunden INT VAR kaeufe;
- INT VAR i;
- FOR i FROM 1 UPTO max kunden REP
- kaeufe [i] := einkaufsdatei [i][artikelindex]
- PER.
- erstelle filialliste:
-
- forget ("Auskunft: Filiale " + filialnummer, quiet);
- f := sequential file (output, "Auskunft: Filiale " + filialnummer);
- line (f);
- IF artikel [artikelindex].artikelname = ""
- THEN write (f, " Der Artikel Nr. " + text (artikelindex)
- + " wird in dieser Filiale nicht geführt.");
- line (f);
- write(f,
- " ============================================================");
- line (f,3);
- ELSE write (f, " Käufer des Artikels "
-
- + invers (artikel [artikelindex].artikelname)
- + ":");
- fuelle (f, kunde, kaeufe)
- FI.
-END PROC artikelkaeuferliste von filiale;
-PROC artikelkaeuferlisten aller filialen(INT CONST artikelnummer,FILE VAR f):
- INT VAR i, filialnr;
- ROW max kunden INT VAR kaeufe;
- pruefe artikelnummer;
- bereite datei vor;
- FOR filialnr FROM 1 UPTO max filialen REP
- TEXT CONST aktuelle verwaltung ::
- hauptstelle + ".Filialverwaltung " + text (filialnr);
-
- IF filialnr = int (filialnummer)
- THEN kopiere eigene einkaufszahlen in hilfsliste;
- schreibe eigene daten in auskunftsdatei
- ELIF exists task (aktuelle verwaltung)
- THEN hole daten dieser filiale;
- schreibe daten in auskunftsdatei
- FI
- PER;
- forget (ds).
- pruefe artikelnummer:
- INT CONST artikelindex :: artikelnummer - min artikelnr + 1;
- IF artikelindex < 1 OR artikelindex > max artikel
- THEN errorstop ("Unzulässige Artikelnummer!")
-
- FI.
- bereite datei vor:
- forget ("Auskunft: Alle Filialen", quiet);
- f := sequential file (output, "Auskunft: Alle Filialen");
- line (f).
- kopiere eigene einkaufszahlen in hilfsliste:
- FOR i FROM 1 UPTO max kunden REP
- kaeufe [i] := einkaufsdatei [i][artikelindex]
- PER.
- schreibe eigene daten in auskunftsdatei:
- IF artikel [artikelindex].artikelname = ""
- THEN write (f, " Der Artikel Nr. " + text (artikelindex)
- + " wird in "
-
- + invers ("Filiale " + filialnummer)
- + " nicht geführt.");
- line (f);
- write(f,
- " ============================================================");
- line (f,3)
- ELSE write (f, " Käufer des Artikels '"
- + artikel [artikelindex].artikelname
- + "' in " + invers ("Filiale " + filialnummer) + ":");
- fuelle(f, kunde, kaeufe)
- FI.
- hole daten dieser filiale:
-
- init ds;
- call (task(aktuelle verwaltung), filialdaten holen code, ds, reply code);
- BOUND FILIALDATEN VAR aktuelle daten :: ds;
- TEXT CONST aktueller artikelname
- := aktuelle daten.waren [artikelindex].artikelname
- FOR i FROM 1 UPTO max kunden REP
- kaeufe [i] := aktuelle daten.einkaeufe [i][artikelindex];
- PER.
- schreibe daten in auskunftsdatei:
- IF aktueller artikelname = ""
- THEN write (f, " Der Artikel Nr. " + text (artikelindex)
-
- + " wird in "
- + invers ("Filiale " + text (filialnr))
- + " nicht geführt.");
- line (f);
- write(f,
- " ============================================================");
- line (f,3)
- ELSE write (f, " Käufer des Artikels '"
- + aktueller artikelname
- + "' in " + invers ("Filiale " + text(filialnr)) + ":");
- fuelle(f, aktuelle daten.kunden, kaeufe)
-
- FI.
-END PROC artikelkaeuferlisten aller filialen;
-PROC fuelle (FILE VAR f, KUNDENDATEI CONST kundenliste,
- ROW max kunden INT CONST einkaufszahlen):
- INT VAR kundennummer;
- bereite datei vor;
- schreibe daten in datei.
-bereite datei vor:
- line (f);
- write(f," ============================================================");
- line (f, 2);
- write(f," | Anzahl | Nachname, Vorname | Geschlecht |");
- line (f);
- write(f," +--------+------------------------------------+------------+");
-
- line (f).
-schreibe daten in datei:
- FOR kundennummer FROM 1 UPTO max kunden REP
- IF einkaufszahlen [kundennummer] > 0
- THEN schreibe in datei; line (f);
- FI
- PER;
- write(f," +--------+------------------------------------+------------+");
- line (f, 3).
-schreibe in datei:
- write(f," |" + text(einkaufszahlen [kundennummer], 5) + " | "
- + text(kundenliste [kundennummer].nachname + ",", 17) + " "
- + text(kundenliste [kundennummer].vorname, 16) + " | ");
-
- IF kundenliste [kundennummer].geschlecht = "m"
- THEN write (f, " männlich |")
- ELIF kundenliste [kundennummer].geschlecht = "w"
- THEN write (f, " weiblich |")
- ELSE write (f, " |")
- FI.
-END PROC fuelle;
-PROC kundenliste von zentrale (FILE VAR f):
- hole kundenliste von zentrale;
- bereite datei vor;
- schreibe daten in datei.
- hole kundenliste von zentrale:
- init ds;
- call (zentrale, zentrale kundendatei holen code, ds, reply code);
- BOUND KUNDENDATEI VAR zentrale kundenliste :: ds.
-
- bereite datei vor:
- forget ("Auskunft: Zentrale", quiet);
- f := sequential file (output, "Auskunft: Zentrale");
- line (f);
- write (f, " Zentrale Kundenliste:").
- schreibe daten in datei:
- fuelle (f, zentrale kundenliste);
- forget (ds).
-END PROC kundenliste von zentrale;
-PROC kundenliste von filiale (FILE VAR f):
- bereite datei vor;
- schreibe daten in datei.
- bereite datei vor:
- forget ("Auskunft: Filiale " + filialnummer, quiet);
- f := sequential file (output, "Auskunft: Filiale " + filialnummer);
-
- line (f);
- write (f," Kundenliste:").
- schreibe daten in datei:
- fuelle (f, kunde).
-END PROC kundenliste von filiale;
-PROC kundenlisten aller filialen (FILE VAR f):
- INT VAR filialnr;
- bereite datei vor;
- FOR filialnr FROM 1 UPTO max filialen REP
- TEXT CONST aktuelle verwaltung ::
- hauptstelle + ".Filialverwaltung " + text (filialnr);
- IF filialnr = int (filialnummer)
- THEN schreibe eigene daten in auskunftsdatei
- ELIF exists task (aktuelle verwaltung)
-
- THEN hole daten dieser filiale;
- schreibe daten dieser filiale in auskunftsdatei
- FI
- PER.
- bereite datei vor:
- forget ("Auskunft: Alle Filialen", quiet);
- f := sequential file (output, "Auskunft: Alle Filialen");
- line (f).
- schreibe eigene daten in auskunftsdatei:
- schreibe ueberschrift;
- fuelle (f, kunde).
- hole daten dieser filiale:
- init ds;
- call (task(aktuelle verwaltung), filialdaten holen code, ds, reply code);
- BOUND FILIALDATEN VAR aktuelle filialdaten :: ds.
-
- schreibe daten dieser filiale in auskunftsdatei:
- schreibe ueberschrift;
- fuelle (f, aktuelle filialdaten.kunden).
- schreibe ueberschrift:
- write (f, " Kundenliste für " +
- invers ("Filiale " + text (filialnr)) + ":").
-END PROC kundenlisten aller filialen;
-PROC fuelle (FILE VAR f, KUNDENDATEI VAR kundendatei):
- INT VAR kundennummer;
- bereite datei vor;
- schreibe daten in datei.
-bereite datei vor:
- line (f);
- write(f," ============================================================");
-
- line (f,2);
- write(f," | Kun.Nr.| Nachname, Vorname | Geschlecht |");
- line (f);
- write(f," +--------+------------------------------------+------------+");
- line (f).
-schreibe daten in datei:
- FOR kundennummer FROM 1 UPTO max kunden REP
- IF kundendatei [kundennummer].nachname <> ""
- THEN schreibe in datei; line (f)
- FI
- PER;
- write(f," +--------+------------------------------------+------------+");
- line (f, 3).
-schreibe in datei:
- write (f, " |" + text (kundennummer + min kundennummer - 1, 6) + " | "
-
- + text (kundendatei [kundennummer].nachname + ",", 17) + " "
- + text (kundendatei [kundennummer].vorname, 16) + " | ");
- IF kundendatei [kundennummer].geschlecht = "m"
- THEN write (f, " männlich |")
- ELIF kundendatei [kundennummer].geschlecht = "w"
- THEN write (f, " weiblich |")
- ELSE write (f, " |")
- FI.
-END PROC fuelle;
-PROC kundeneinkaufsliste von zentrale (INT CONST kundennummer, FILE VAR f):
- INT VAR filialnr;
-
- pruefe kundennummer;
- beginne mit eigener filiale;
- FOR filialnr FROM 1 UPTO max filialen REP
- TEXT CONST aktuelle verwaltung ::
- hauptstelle + ".Filialverwaltung " + text (filialnr);
- IF filialnr <> int (filialnummer) CAND
- exists task (aktuelle verwaltung)
- THEN hole daten dieser filiale;
- schreibe daten in zentralliste
- FI
- PER;
- werte zentralliste aus.
- pruefe kundennummer:
- INT CONST kundenindex :: kundennummer - min kundennr + 1;
-
- IF kundenindex < 1 OR kundenindex > max kunden
- THEN errorstop ("Unzulässige Kundennummer!")
- FI.
- beginne mit eigener filiale:
- KUNDENDATEN VAR aktueller kunde :: kunde [kundenindex];
- WARENDATEI VAR hilfsdatei;
- CONCR (hilfsdatei) := CONCR (artikel);
- ROW max artikel INT VAR kaeufe;
- INT VAR i;
- FOR i FROM 1 UPTO max artikel REP
- kaeufe [i] := einkaufsdatei [kundenindex][i]
- PER.
- hole daten dieser filiale:
- init ds;
- call (task(aktuelle verwaltung), filialdaten holen code, ds, reply code).
-
- schreibe daten in zentralliste:
- BOUND FILIALDATEN VAR aktuelle daten :: ds;
- IF aktueller kunde.nachname = ""
- THEN aktueller kunde := aktuelle daten.kunden [kundenindex]
- FI;
- FOR i FROM 1 UPTO max artikel REP
- kaeufe [i] INCR aktuelle daten.einkaeufe [kundenindex][i];
- IF hilfsdatei [i].artikelname = ""
- THEN hilfsdatei [i] := aktuelle daten.waren [i]
- FI
- PER.
- werte zentralliste aus:
- forget (ds);
- forget ("Auskunft: Zentrale", quiet);
-
- f := sequential file (output, "Auskunft: Zentrale");
- line (f);
- IF aktueller kunde.nachname = ""
- THEN write (f, " Ein Kunde mit Nr. " + text (kundenindex)
- + " ist in keiner Filiale bekannt.");
- line (f);
- write(f,
- " ============================================================");
- line (f,3);
- ELSE write (f, " Gesamteinkaufsliste " + anrede
- + invers (aktueller kundenname) + ":");
-
- fuelle (f, hilfsdatei, kaeufe)
- FI.
- anrede:
- IF aktueller kunde.geschlecht = "m"
- THEN "des Kunden "
- ELIF aktueller kunde.geschlecht = "w"
- THEN "der Kundin "
- ELSE "von "
- FI.
- aktueller kundenname:
- (aktueller kunde.vorname SUB 1) + ". " + aktueller kunde.nachname.
-END PROC kundeneinkaufsliste von zentrale;
-PROC kundeneinkaufsliste von filiale (INT CONST kundennummer, FILE VAR f):
- pruefe kundennummer;
- erstelle filialliste.
-
- pruefe kundennummer:
- INT CONST kundenindex :: kundennummer - min kundennr + 1;
- IF kundenindex < 1 OR kundenindex > max kunden
- THEN errorstop ("Unzulässige Kundennummer!")
- FI.
- erstelle filialliste:
- forget ("Auskunft: Filiale " + filialnummer, quiet);
- f := sequential file (output, "Auskunft: Filiale " + filialnummer);
- line (f);
- IF kunde [kundenindex].nachname = ""
- THEN schicke leere liste zurueck
- ELSE schreibe dateikopf;
- fuelle (f, artikel, einkaufsdatei [kundenindex])
-
- FI.
- schicke leere liste zurueck:
- write (f," Ein Kunde mit Nr. " + text (kundennummer) + " ist in "
- + "dieser Filiale nicht bekannt.");
- line (f);
- write (f,
- " ============================================================");
- line (f,3).
- schreibe dateikopf:
- write (f, " Einkaufsliste " + anrede +
- invers ((kunde [kundenindex].vorname SUB 1) + ". " +
- kunde [kundenindex].nachname) + ":").
- anrede:
- IF kunde [kundenindex].geschlecht = "m"
-
- THEN "des Kunden "
- ELIF kunde [kundenindex].geschlecht = "w"
- THEN "der Kundin "
- ELSE "von "
- FI.
-END PROC kundeneinkaufsliste von filiale;
-PROC kundeneinkaufslisten aller filialen (INT CONST kundennummer,FILE VAR f):
- INT VAR filialnr;
- pruefe kundennummer;
- bereite datei vor;
- FOR filialnr FROM 1 UPTO max filialen REP
- TEXT CONST aktuelle verwaltung ::
- hauptstelle + ".Filialverwaltung " + text (filialnr);
- IF filialnr = int (filialnummer)
-
- THEN schreibe eigene daten in auskunftsdatei
- ELIF exists task (aktuelle verwaltung)
- THEN hole daten dieser filiale;
- schreibe daten in auskunftsdatei
- FI
- PER;
- forget (ds).
- pruefe kundennummer:
- INT CONST kundenindex :: kundennummer - min kundennr + 1;
- IF kundenindex < 1 OR kundenindex > max kunden
- THEN errorstop ("Unzulässige Kundennummer!")
- FI.
- bereite datei vor:
- forget ("Auskunft: Alle Filialen", quiet);
- f := sequential file (output, "Auskunft: Alle Filialen");
-
- line (f).
- schreibe eigene daten in auskunftsdatei:
- IF kunde [kundenindex].nachname = ""
- THEN write (f," Ein Kunde mit Nr. " + text (kundennummer)
- + " ist in " + invers ("Filiale " + filialnummer)
- + " nicht bekannt.");
- line (f);
- write(f,
- " ============================================================");
- line (f,3)
- ELSE write (f, " Einkaufsliste " + anrede hier +
- (kunde [kundenindex].vorname SUB 1) + ". " +
-
- kunde [kundenindex].nachname +
- " in " + invers ("Filiale " + filialnummer) + ":");
- fuelle (f, artikel, einkaufsdatei [kundenindex])
- FI.
- anrede hier:
- IF kunde [kundenindex].geschlecht = "m"
- THEN "des Kunden "
- ELIF kunde [kundenindex].geschlecht = "w"
- THEN "der Kundin "
- ELSE "von "
- FI.
- hole daten dieser filiale:
- init ds;
- call (task(aktuelle verwaltung), filialdaten holen code, ds, reply code);
-
- BOUND FILIALDATEN VAR aktuelle daten :: ds;
- KUNDENDATEN CONST aktueller kunde := aktuelle daten.kunden [kundenindex].
- schreibe daten in auskunftsdatei:
- IF aktueller kunde.nachname = ""
- THEN write (f," Ein Kunde mit Nr. " + text (kundennummer)
- + " ist in " + invers ("Filiale " + text (filialnr))
- + " nicht bekannt.");
- line (f);
- write(f,
- " ============================================================");
-
- line (f,3)
- ELSE write (f, " Einkaufsliste " + anrede +
- (aktueller kunde.vorname SUB 1) + ". " +
- aktueller kunde.nachname +
- " in " + invers ("Filiale " + text (filialnr)) + ":");
- fuelle (f, aktuelle daten.waren,
- aktuelle daten.einkaeufe [kundenindex])
- FI.
- anrede:
- IF aktueller kunde.geschlecht = "m"
- THEN "des Kunden "
- ELIF aktueller kunde.geschlecht = "w"
-
- THEN "der Kundin "
- ELSE "von "
- FI.
-END PROC kundeneinkaufslisten aller filialen;
-PROC fuelle (FILE VAR f, WARENDATEI CONST warendatei,
- ROW max artikel INT CONST einkaufszahlen):
- INT VAR artikelnummer;
- REAL VAR gesamtpreis, summe :: 0.0;
- bereite datei vor;
- schreibe daten in datei.
-bereite datei vor:
- line (f);
- write(f," ============================================================");
- line (f,2);
- write(f," | Art.Nr.| Artikelname | Anzahl | Preis | Gesamt |");
-
- line (f);
- write(f," +--------+-------------------+--------+---------+----------+");
- line (f).
-schreibe daten in datei:
- FOR artikelnummer FROM 1 UPTO max artikel REP
- IF einkaufszahlen [artikelnummer] > 0
- THEN schreibe in datei; line (f)
- FI
- PER;
- write(f," +--------+-------------------+--------+---------+----------+");
- line (f);
- write(f," Summe: " +
- text (summe,8,2));
-
- line (f, 3).
-schreibe in datei:
- gesamtpreis := real (einkaufszahlen [artikelnummer]) *
- warendatei [artikelnummer].preis;
- summe INCR gesamtpreis;
- write (f," |" + text(artikelnummer,5) + " | "
- + text(warendatei [artikelnummer].artikelname,17) + " | "
- + text(einkaufszahlen [artikelnummer],4) + " |"
- + text(warendatei [artikelnummer].preis,7,2) + " |"
- + text(gesamtpreis,8,2) + " |").
-
-END PROC fuelle;
-PROC lageruebersicht von zentrale (FILE VAR f):
- INT VAR filialnr;
- beginne mit eigener filiale;
- FOR filialnr FROM 1 UPTO max filialen REP
- TEXT CONST aktuelle verwaltung ::
- hauptstelle + ".Filialverwaltung " + text (filialnr);
- IF filialnr <> int (filialnummer) CAND
- exists task (aktuelle verwaltung)
- THEN hole daten dieser filiale;
- schreibe daten in zentralliste
- FI
- PER;
- werte zentralliste aus.
- beginne mit eigener filiale:
-
- WARENDATEI VAR hilfsdatei;
- CONCR (hilfsdatei) := CONCR (artikel).
- hole daten dieser filiale:
- init ds;
- call (task(aktuelle verwaltung), filialdaten holen code, ds, reply code).
- schreibe daten in zentralliste:
- BOUND FILIALDATEN VAR aktuelle daten :: ds;
- INT VAR i;
- FOR i FROM 1 UPTO max artikel REP
- IF hilfsdatei [i].artikelname = ""
- THEN hilfsdatei [i] := aktuelle daten.waren [i]
- ELSE hilfsdatei [i].mindestbestand INCR aktuell.mindestbestand;
-
- hilfsdatei [i].bestand INCR aktuell.bestand
- FI
- PER.
- aktuell: aktuelle daten.waren [i].
- werte zentralliste aus:
- forget (ds);
- forget ("Auskunft: Zentrale", quiet);
- f := sequential file (output, "Auskunft: Zentrale");
- line (f);
- write (f, " Zentrale Lagerübersicht:");
- fuelle (f, hilfsdatei).
-END PROC lageruebersicht von zentrale;
-PROC lageruebersicht von filiale (FILE VAR f):
- forget ("Auskunft: Filiale " + filialnummer, quiet);
-
- f := sequential file (output, "Auskunft: Filiale " + filialnummer);
- schreibe dateikopf;
- fuelle (f, artikel).
- schreibe dateikopf:
- line (f);
- write (f, " Lagerübersicht:").
-END PROC lageruebersicht von filiale;
-PROC lageruebersichten aller filialen (FILE VAR f):
- INT VAR filialnr;
- bereite datei vor;
- FOR filialnr FROM 1 UPTO max filialen REP
- TEXT CONST aktuelle verwaltung ::
- hauptstelle + ".Filialverwaltung " + text (filialnr);
- IF filialnr = int (filialnummer)
-
- THEN schreibe eigene daten in auskunftsdatei
- ELIF exists task (aktuelle verwaltung)
- THEN hole daten dieser filiale;
- schreibe daten in auskunftsdatei
- FI
- PER;
- forget (ds).
- bereite datei vor:
- forget ("Auskunft: Alle Filialen", quiet);
- f := sequential file (output, "Auskunft: Alle Filialen").
- schreibe eigene daten in auskunftsdatei:
- line (f);
- write (f, " Lagerübersicht für " +
- invers ("Filiale " + filialnummer) + ":");
-
- fuelle (f, artikel).
- hole daten dieser filiale:
- init ds;
- call (task(aktuelle verwaltung), filialdaten holen code, ds, reply code);
- BOUND FILIALDATEN VAR aktuelle daten :: ds.
- schreibe daten in auskunftsdatei:
- line (f);
- write (f, " Lagerübersicht für " +
- invers ("Filiale " + text (filialnr)) + ":");
- fuelle (f, aktuelle daten.waren).
-END PROC lageruebersichten aller filialen;
-PROC fuelle (FILE VAR f, WARENDATEI CONST warendatei):
- INT VAR artikelnummer;
-
- bereite datei vor;
- schreibe daten in datei.
-bereite datei vor:
- line (f);
- write(f," ============================================================");
- line (f,2);
- write(f," | Art.Nr.| Artikelname | Preis | Min.Best.| Bestand |");
- line (f);
- write(f," +--------+-------------------+--------+----------+---------+");
- line (f).
-schreibe daten in datei:
- FOR artikelnummer FROM 1 UPTO max artikel REP
- IF warendatei[artikelnummer].artikelname <> ""
- THEN schreibe in datei; line (f)
-
- FI
- PER;
- write(f," +--------+-------------------+--------+----------+---------+");
- line (f, 3).
-schreibe in datei:
- write (f, " |" + text(artikelnummer,5) + " | "
- + text(warendatei[artikelnummer].artikelname,17) + " |"
- + text(warendatei[artikelnummer].preis,7,2) + " | "
- + text(warendatei[artikelnummer].mindestbestand,6)+" | "
- + text(warendatei[artikelnummer].bestand,6) + " |").
-END PROC fuelle;
-
-PROC initialisiere dateien:
- INT VAR kundennummer, artikelnummer;
- FOR kundennummer FROM 1 UPTO max kunden REP
- kunde [kundennummer].nachname := "";
- kunde [kundennummer].vorname := "";
- kunde [kundennummer].geschlecht := ""
- PER;
- FOR artikelnummer FROM 1 UPTO max artikel REP
- verkaufszahl [artikelnummer] := 0;
- artikel [artikelnummer].mindestbestand := 0;
- artikel [artikelnummer].bestand := 0;
- artikel [artikelnummer].artikelname := "";
-
- artikel [artikelnummer].preis := 0.0;
- FOR kundennummer FROM 1 UPTO max kunden REP
- einkaufsdatei[kundennummer][artikelnummer] := 0
- PER;
- PER
-END PROC initialisiere dateien;
-initialisiere dateien
-END PACKET ls warenhaus 2
-
-
diff --git a/warenhaus/ls-Warenhaus 3 b/warenhaus/ls-Warenhaus 3
deleted file mode 100644
index 71ef216..0000000
--- a/warenhaus/ls-Warenhaus 3
+++ /dev/null
@@ -1,986 +0,0 @@
-(*
-
- **********************************************************
- **********************************************************
- ** **
- ** ls-Warenhaus 3 **
- ** **
- ** 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 3 DEFINES
- artikelnummer lesen,
- artikeldaten eingeben,
- kundennummer lesen,
- kundendaten eingeben,
- neues blatt,
- rechnungskopf,
- artikel kaufen,
- abrechnung,
- nachbestellen,
- auskunft,
- stoptaste gedrueckt,
- stoptaste gedrückt,
- dezimalwert lesen,
- bitmuster lesen,
- bildschirm neu,
-(* ------------------------------ *)
- tastatureingabe,
- eingabesicherheit,
- eingabe mit codekartenleser,
-
- cursor w3 1 1:
-LET esc = ""27"",
- stopzeichen = "q",
- abbruchzeichen = "h";
-WINDOW VAR w1 :: window (43, 3, 36, 16),
- w2 :: window (43, 20, 36, 3),
- w3k :: window ( 2, 4, 40, 3),
- w3 :: window ( 2, 7, 40, 16),
- w4 :: window ( 8, 4, 66, 18);
-BOOL VAR ende gewuenscht := FALSE,
- artikelnummer ist eingelesen := FALSE,
- kundennummer ist eingelesen := FALSE,
- codekartenleser aktiviert := FALSE,
-
- auf neuem blatt := TRUE;
-INT VAR artikelnummer :: 0,
- mindestbestand :: 0,
- bestand :: 0,
- kundennummer :: 0,
- sicherheit :: 5;
-TEXT VAR artikelname :: "",
- nachname :: "",
- vorname :: "",
- geschlecht :: "",
- ueberschrift :: " RECHNUNG",
- hilfstext, exit char;
-REAL VAR preis :: 0.0,
- summe :: 0.0;
-PROC eingabesicherheit (INT CONST wert):
-
- sicherheit := abs (wert)
-END PROC eingabesicherheit;
-PROC cursor w3 1 1:
- cursor (w1, 1, 1);
- cursor (w2, 1, 1);
- cursor (w3, 1, 1);
- cursor (w3k, 1, 1);
- forget ("WARENHAUS:Rechnung", quiet);
- setze variable in anfangszustand
-END PROC cursor w3 1 1;
-PROC setze variable in anfangszustand:
- ende gewuenscht := FALSE;
- artikelnummer ist eingelesen := FALSE;
- kundennummer ist eingelesen := FALSE;
- artikelnummer := 0;
- mindestbestand := 0;
- bestand := 0;
-
- kundennummer := 0;
- artikelname := "";
- nachname := "";
- vorname := "";
- geschlecht := "";
- ueberschrift := " RECHNUNG";
- preis := 0.0;
- summe := 0.0
-END PROC setze variable in anfangszustand;
-PROC bildschirm neu:
- cursor off;
- pruefe abbruch;
- cursor (w1, 1, 1);
- cursor (w2, 1, 1);
- cursor (w3, 1, 1);
- cursor (w3k,1, 1);
- auf neuem blatt := TRUE;
- page;
- out ("WARENHAUS: Info Eingabeart Kommandos "15"Programme "14" " +
-
- "Filialdaten Archiv"); line;
- out (ecke oben links + (40 * waagerecht) + balken oben
- + (36 * waagerecht) + ecke oben rechts);
- INT VAR zeile;
- FOR zeile FROM 3 UPTO 22 REP
- cursor ( 1, zeile); out (senkrecht);
- cursor (42, zeile); out (senkrecht);
- cursor (79, zeile); out (senkrecht)
- PER;
- cursor (1, 23);
- out (ecke unten links + (40 * waagerecht) + balken unten
- + (36 * waagerecht) + ecke unten rechts);
-
- cursor (42, 19);
- out (balken links + (36 * waagerecht) + balken rechts);
- cursor (2, 24);
- out ("Programmabbruch: <ESC><" + abbruchzeichen + ">");
- cursor on
-END PROC bildschirm neu;
-PROC pruefe abbruch:
- IF pressed key = esc
- THEN pruefe weiter
- FI.
- pruefe weiter:
- TEXT VAR naechstes zeichen :: pressed key (20);
- IF naechstes zeichen = stopzeichen
- THEN ende gewuenscht := TRUE
- ELIF naechstes zeichen = abbruch zeichen
-
- THEN setze variable in anfangszustand;
- cursor off;
- errorstop (1951, "Programm - Abbruch durch <ESC><"
- + abbruchzeichen + ">")
- FI
-END PROC pruefe abbruch;
-PROC regeneriere w2:
- cursor (42, 19);
- out (ecke oben links + (36 * waagerecht));
- INT VAR zeile;
- FOR zeile FROM 20 UPTO 22 REP
- cursor (42, zeile); out (senkrecht);
- PER;
- cursor (42, 23); out (balken unten);
- page (w2)
-
-END PROC regeneriere w2;
-PROC fenster putzen:
- page (w1);
- page (w2)
-END PROC fenster putzen;
-PROC lies nummer ein (INT VAR nummer):
- line (w2, 2);
- out (w2, " Stoptaste: <ESC><" + stopzeichen + ">");
- hilfstext := text (nummer);
- REP cursor (w1, 19, 2);
- editget (w1, hilfstext, 4, 4, "", stopzeichen + abbruchzeichen,
- exit char);
- pruefe exit char;
- change all (hilfstext, " ", "")
- UNTIL hilfstext >= "0" AND hilfstext <= "9999" PER;
-
- nummer := int (hilfstext).
- pruefe exit char:
- IF exit char = esc + stopzeichen
- THEN ende gewuenscht := TRUE;
- cursor off; fenster putzen; cursor on;
- nummer := 0;
- LEAVE lies nummer ein
- ELIF exit char = esc + abbruchzeichen
- THEN setze variable in anfangszustand;
- errorstop (1951, "Progamm - Abbruch durch <ESC><"
- + abbruchzeichen + ">")
- ELSE ende gewuenscht := FALSE
- FI.
-
-END PROC lies nummer ein;
-PROC lies artikelnummer ein:
- page (w2);
- cursor (w1, 2, 2);
- out (w1, "Artikelnummer : ");
- IF codekartenleser aktiviert
- THEN artikelnummer := gesicherter wert von interface
- (min artikelnummer , max artikelnummer, "Warenkarte")
- ELSE artikelnummer von tastatur lesen
- FI;
- IF ende gewuenscht
- THEN artikelnummer ist eingelesen := FALSE
- ELSE artikelnummer ist eingelesen := TRUE
-
- FI.
- artikelnummer von tastatur lesen:
- cursor on;
- REP out (w2, " Artikelnummer eingeben");
- lies nummer ein (artikelnummer);
- UNTIL ende gewuenscht COR artikelnummer zulaessig PER.
- artikelnummer zulaessig:
- IF (artikelnummer < min artikelnummer OR
- artikelnummer > max artikelnummer)
- THEN page (w2); out (""7"");
- out (w2, " Unzulässige Artikelnummer!");
- line (w2, 2);
- out (w2, " Bitte irgendeine Taste tippen!");
-
- pause; page (w2);
- FALSE
- ELSE TRUE
- FI.
-END PROC lies artikelnummer ein;
-PROC artikelnummer lesen:
- pruefe abbruch;
- lies artikelnummer ein;
- IF artikelnummer ist eingelesen
- THEN hole artikeldaten (artikelnummer, artikelname, preis,
- mindestbestand, bestand)
- FI
-END PROC artikelnummer lesen;
-PROC kundennummer lesen:
- pruefe abbruch;
- lies kundennummer ein;
- IF kundennummer ist eingelesen
- THEN hole kundendaten (kundennummer, nachname, vorname, geschlecht)
-
- FI
-END PROC kundennummer lesen;
-PROC lies kundennummer ein:
- page (w2);
- cursor (w1, 2, 2);
- out (w1, "Kundennummer : ");
- IF codekartenleser aktiviert
- THEN kundennummer := gesicherter wert von interface
- (min kundennummer , max kundennummer, "Kundenkarte")
- ELSE kundennummer von tastatur lesen
- FI;
- IF ende gewuenscht
- THEN kundennummer ist eingelesen := FALSE
- ELSE kundennummer ist eingelesen := TRUE
- FI.
- kundennummer von tastatur lesen:
-
- cursor on;
- REP out (w2, " Kundennummer eingeben");
- lies nummer ein (kundennummer)
- UNTIL ende gewuenscht COR kundennummer zulaessig PER.
- kundennummer zulaessig:
- IF (kundennummer < min kundennummer OR
- kundennummer > max kundennummer)
- THEN page (w2); out (""7"");
- out (w2, " Unzulässige Kundennummer!");
- line (w2, 2);
- out (w2, " Bitte irgendeine Taste tippen!");
- pause; page (w2);
- FALSE
-
- ELSE TRUE
- FI.
-END PROC lies kundennummer ein;
-PROC zeige artikeldaten:
- cursor (w1, 2, 6);
- out (w1, "Artikelname : " + text (artikelname, 16));
- cursor (w1, 2, 8);
- out (w1, "Preis : " + text preis + " ");
- cursor (w1, 2, 10);
- out (w1, "Mindestbestand : " + text (mindestbestand) + " ");
- cursor (w1, 2, 12);
- out (w1, "Bestand : " + text (bestand) + " ").
- text preis:
- TEXT VAR hilfe :: text (preis, min (8, pos(text(preis),".")+2), 2);
-
- change (hilfe, " ", "0");
- hilfe.
-END PROC zeige artikeldaten;
-PROC zeige kundendaten:
- cursor (w1, 2, 6);
- out (w1, "Nachname : " + text (nachname, 16));
- cursor (w1, 2, 8);
- out (w1, "Vorname : " + text (vorname , 16));
- cursor (w1, 2, 10);
- out (w1, "Geschlecht : " + geschlecht + " ");
-END PROC zeige kundendaten;
-PROC artikeldaten speichern:
- pruefe abbruch;
- page (w2); line (w2);
- out (w2, " Artikeldaten werden gespeichert") ;
-
- speichere artikeldaten (artikelnummer, artikelname, preis,
- mindestbestand, bestand);
- pause (10);
- IF codekartenleser aktiviert
- THEN lasse karte entfernen (FALSE)
- FI
-END PROC artikeldaten speichern;
-PROC kundendaten speichern:
- pruefe abbruch;
- page (w2); line (w2);
- out (w2, " Kundendaten werden gespeichert") ;
- speichere kundendaten (kundennummer, nachname,vorname, geschlecht);
- pause (10);
- IF codekartenleser aktiviert
- THEN lasse karte entfernen (FALSE)
-
- FI
-END PROC kundendaten speichern;
-BOOL PROC stoptaste gedrueckt:
- pruefe abbruch;
- ende gewuenscht
-END PROC stoptaste gedrueckt;
-BOOL PROC stoptaste gedrückt:
- stoptaste gedrueckt
-END PROC stoptaste gedrückt;
-PROC neues blatt:
- pruefe abbruch;
- page (w3k);
- page (w3);
- auf neuem blatt := TRUE;
- forget ("WARENHAUS:Rechnung", quiet)
-END PROC neues blatt;
-PROC nachbestellen:
- pruefe abbruch;
- FILE VAR f;
- warten in w2;
- hole bestelliste (f);
- pruefe abbruch;
- cursor (2,24);
-
- out ("Weiter mit <ESC><q>; Cursor bewegen: <Pfeile>");
- cursor on;
- show (w4, f);
- cursor off;
- cursor (1, 24); out (""5"");
- WINDOW VAR w :: window(45,18,25,3);
- outframe (w);
- IF yes (w, "Bestelliste drucken", FALSE)
- THEN drucke (headline (f))
- FI;
- cursor on;
- forget (headline (f), quiet)
-END PROC nachbestellen;
-PROC warten in w2:
- cursor off;
- page (w2);
- line (w2);
- out (w2, " Bitte warten!");
- cursor on
-END PROC warten in w2;
-PROC codenummer von tastatur lesen (INT VAR codenummer):
-
- codenummer := 0;
- out (w2, " Codenummer eingeben");
- cursor on;
- lies nummer ein (codenummer)
-END PROC codenummer von tastatur lesen;
-PROC auskunft:
- pruefe abbruch;
- FILE VAR f;
- INT VAR codenummer :: 0;
- cursor (w1, 2, 2);
- out (w1, "Codenummer : ");
- page (w2);
- IF codekartenleser aktiviert
- THEN codenummer := gesicherter wert von interface (0,254, "Codekarte");
- lasse karte entfernen (FALSE)
- ELSE codenummer von tastatur lesen (codenummer)
-
- FI;
- IF ende gewuenscht THEN LEAVE auskunft FI;
- SELECT codenummer OF CASE 66, 67, 68 : hitliste
- CASE 73, 74, 75 : kaeuferliste
- CASE 77, 78, 79 : kundenliste
- CASE 84, 85, 86 : einkaufsliste
- CASE 89, 90, 91 : lageruebersicht
- OTHERWISE teste auf artikel oder kundennummer
- END SELECT;
- IF codekartenleser aktiviert CAND wert von interface <> 255
- THEN karte entfernen
- FI.
- karte entfernen:
-
- SELECT codenummer OF
- CASE 66, 67, 68, 73, 74, 75, 77, 78, 79, 84, 85, 86, 89, 90,
- 91: lasse karte entfernen (TRUE)
- OTHERWISE lasse karte entfernen (FALSE)
- END SELECT.
- teste auf artikel oder kundennummer:
- IF codenummer >= min artikelnummer AND codenummer <= max artikelnummer
- THEN gib auskunft ueber artikeldaten
- ELIF codenummer >= min kundennummer AND codenummer <= max kundennummer
- THEN gib auskunft ueber kundendaten
- ELSE unzulaessige codenummer
-
- FI.
- unzulaessige codenummer:
- out (10 * ""7"");
- page (w2);
- out (w2, " Unzulässige Codenummer !!!");
- line (w2, 2);
- out (w2, " Bitte irgendeine Taste tippen!");
- pause;
- page (w2).
- gib auskunft ueber artikeldaten:
- hole artikeldaten (codenummer, artikelname, preis,
- mindestbestand, bestand);
- zeige artikeldaten;
- artikelnummer ist eingelesen := FALSE;
- stop w2;
- page (w1).
- gib auskunft ueber kundendaten:
- hole kundendaten (codenummer, nachname, vorname, geschlecht);
-
- zeige kundendaten;
- kundennummer ist eingelesen := FALSE;
- stop w2;
- page (w1).
- hitliste:
- warten in w2;
- hole auskunft ein (codenummer, 0, f);
- zeige f.
- kundenliste:
- warten in w2;
- hole auskunft ein (codenummer, 0, f);
- zeige f.
- zeige f:
- pruefe abbruch;
- cursor (2, 24);
- out ("Weiter mit <ESC><q>; Cursor bewegen: <Pfeile>");
- show (w4, f);
- cursor (1, 24); out (""5"");
- evtl drucken.
- lageruebersicht:
- warten in w2;
-
- hole auskunft ein (codenummer, 0, f);
- zeige f.
- kaeuferliste:
- lies artikelnummer ein;
- IF artikelnummer ist eingelesen
- THEN artikelnummer ist eingelesen := FALSE;
- warten in w2;
- hole auskunft ein (codenummer, artikelnummer, f);
- zeige f
- FI.
- einkaufsliste:
- lies kundennummer ein;
- IF kundennummer ist eingelesen
- THEN kundennummer ist eingelesen := FALSE;
- warten in w2;
- hole auskunft ein (codenummer, kundennummer, f);
-
- zeige f
- FI.
- evtl drucken:
- WINDOW VAR w :: window(46,18,22,3);
- cursor off;
- outframe (w);
- IF yes (w, "Auskunft drucken", FALSE)
- THEN drucke (headline (f))
- FI;
- cursor on;
- forget (headline (f), quiet).
-END PROC auskunft;
-PROC rechnungskopf:
- pruefe abbruch;
- IF kundennummer ist eingelesen AND nachname <> ""
- THEN ueberschrift := " RECHNUNG für " + anrede + (vorname SUB 1) +
- ". " + text (nachname, 10)
- ELSE ueberschrift := " RECHNUNG"
-
- FI;
- summe := 0.0;
- schreibe ueberschrift auf bildschirm;
- schreibe in rechnungsdatei;
- IF codekartenleser aktiviert
- THEN lasse karte entfernen (FALSE)
- FI.
- schreibe in rechnungsdatei:
- sysout ("WARENHAUS:Rechnung");
- line;
- put (ueberschrift);
- line;
- put (" ==================================");
- line (2);
- sysout ("").
- anrede:
- IF geschlecht = "m"
- THEN "Herrn "
- ELIF geschlecht = "w"
- THEN "Frau "
- ELSE ""
-
- FI.
-END PROC rechnungskopf;
-PROC schreibe ueberschrift auf bildschirm:
- INT VAR spalte, zeile;
- get cursor (w3, spalte, zeile);
- IF zeile = 1
- THEN auf neuem blatt := TRUE;
- schreibe in w3k
- ELSE auf neuem blatt := FALSE;
- schreibe in w3
- FI.
- schreibe in w3:
- IF remaining lines (w3) < 7
- THEN page (w3);
- page (w3k);
- auf neuem blatt := TRUE;
- schreibe in w3k
- ELSE line (w3);
- out (w3, ueberschrift);
-
- line (w3);
- out (w3, " ==================================");
- line (w3, 2)
- FI.
- schreibe in w3k:
- out (w3k, ueberschrift);
- line (w3k);
- out (w3k, " ==================================").
-END PROC schreibe ueberschrift auf bildschirm;
-PROC artikel kaufen:
- pruefe abbruch;
- IF artikelnummer ist eingelesen
- THEN kauf registrieren
- ELSE setze variable in anfangszustand;
- errorstop ("Es ist keine Artikelnummer eingelesen worden!")
-
- FI;
- IF codekartenleser aktiviert
- THEN lasse karte entfernen (FALSE)
- FI.
- kauf registrieren:
- artikelnummer ist eingelesen := FALSE;
- IF bestand > 0
- THEN artikel auf rechnung setzen;
- registrieren
- ELSE page (w2); out (""7"");
- IF artikelname = ""
- THEN out (w2, " Artikel hier nicht erhältlich!")
- ELSE out (w2, " Der Artikel ist ausverkauft!")
- FI;
- line (w2, 2);
- out (w2, " Weiter durch Tippen einer Taste");
-
- pause
- FI.
- registrieren:
- IF kundennummer ist eingelesen
- THEN registriere verkauf (kundennummer, artikelnummer)
- ELSE registriere verkauf (min kundennummer - 1, artikelnummer)
- FI.
- artikel auf rechnung setzen:
- summe INCR preis;
- IF remaining lines (w3) < 3
- THEN beginne wieder oben
- FI;
- out (w3, " " + text (artikelname, 15) + text (preis, 12, 2));
- line (w3);
- sysout ("WARENHAUS:Rechnung");
- put (" " + text (artikelname, 15) + text preis);
-
- line;
- sysout ("").
- beginne wieder oben:
- IF auf neuem blatt
- THEN page (w3)
- ELSE schreibe ueberschrift auf bildschirm
- FI.
- text preis:
- TEXT VAR hilfe :: text (preis, 12, 2);
- INT VAR vor punkt :: pos (hilfe, ".") - 1;
- IF (hilfe SUB vor punkt) = " "
- THEN change (hilfe, vor punkt, vor punkt, "0")
- FI;
- hilfe.
-END PROC artikel kaufen;
-PROC abrechnung:
- pruefe abbruch;
- schreibe summe auf bildschirm;
-
- schreibe summe in rechnungsdatei;
- setze variable zurueck;
- frage ob drucken;
- IF codekartenleser aktiviert
- THEN lasse karte entfernen (FALSE)
- FI.
- schreibe summe auf bildschirm:
- IF remaining lines (w3) < 2
- THEN beginne wieder oben
- FI;
- put (w3, " -------------");
- line (w3);
- put (w3, " Summe " + text (summe, 12, 2));
- line (w3).
- beginne wieder oben:
- IF auf neuem blatt
- THEN page (w3)
- ELSE schreibe ueberschrift auf bildschirm
-
- FI.
- schreibe summe in rechnungsdatei:
- sysout ("WARENHAUS:Rechnung");
- put (" -------------");
- line;
- put (" Summe " + text (summe, 12, 2));
- line;
- sysout ("").
- setze variable zurueck:
- BOOL VAR alter wert :: ende gewuenscht;
- setze variable in anfangszustand;
- ende gewuenscht := alter wert.
- frage ob drucken:
- IF yes (w2, "Rechnung drucken", FALSE)
- THEN cursor (3, 22);
- disable stop;
- print ("WARENHAUS:Rechnung");
-
- IF is error THEN clear error FI;
- enable stop
- FI.
-END PROC abrechnung;
-PROC artikeldaten eingeben:
- pruefe abbruch;
- IF artikelnummer ist eingelesen
- THEN lies artikeldaten ein;
- artikeldaten speichern
- ELSE setze variable in anfangszustand;
- errorstop ("Es ist keine Artikelnummer eingelesen worden!")
- FI.
- lies artikeldaten ein:
- zeige artikeldaten;
- IF artikelname <> ""
- THEN vielleicht schon fertig
- ELSE page (w2)
-
- FI;
- REP line (w2);
- put (w2, " Artikeldaten eingeben");
- eingabe
- UNTIL yes (w2, "Alles richtig", TRUE)
- PER;
- artikelnummer ist eingelesen := FALSE.
- vielleicht schon fertig:
- IF yes (w2, "Alles richtig", TRUE)
- THEN artikelnummer ist eingelesen := FALSE;
- IF codekartenleser aktiviert
- THEN lasse karte entfernen (FALSE)
- FI;
- LEAVE artikeldaten eingeben
- FI.
- eingabe:
- name holen;
-
- preis holen;
- mindestbestand holen;
- bestand holen.
- name holen:
- REP cursor (w1, 19, 6);
- editget (w1, artikelname, 80, 80, "", abbruchzeichen + stopzeichen,
- exit char);
- teste auf abbruch
- UNTIL artikelname <> "" PER.
- preis holen:
- hilfstext := text (preis, pos(text(preis),".") + 2, 2);
- change (hilfstext, " ", "0");
- REP cursor (w1, 19, 8);
- editget (w1, hilfstext, 8, 8, "", abbruch zeichen + stopzeichen,
-
- exit char);
- change (hilfstext, ",", ".");
- preis := round (real (hilfstext), 2);
- teste auf abbruch
- UNTIL preis >= 0.0 PER.
- mindestbestand holen:
- hilfstext := text (mindestbestand);
- REP cursor (w1, 19, 10);
- editget (w1, hilfstext, 4, 4, "", abbruch zeichen + stopzeichen,
- exit char);
- mindestbestand := int (hilfstext);
- teste auf abbruch
- UNTIL mindestbestand >= 0 PER.
-
- bestand holen:
- hilfstext := text (bestand);
- REP cursor (w1, 19, 12);
- editget (w1, hilfstext, 4, 4, "", abbruch zeichen + stopzeichen,
- exit char);
- bestand := int (hilfstext);
- teste auf abbruch
- UNTIL bestand >= 0 PER.
- teste auf abbruch:
- IF exit char = esc + stopzeichen
- THEN ende gewuenscht := TRUE
- ELIF exit char = esc + abbruchzeichen
- THEN setze variable in anfangszustand;
- errorstop (1951, "Programm - Abbruch durch <ESC><"
-
- + abbruchzeichen + ">")
- FI.
-END PROC artikeldaten eingeben;
-PROC kundendaten eingeben:
- IF kundennummer ist eingelesen
- THEN lies kundendaten ein;
- kundendaten speichern
- ELSE setze variable in anfangszustand;
- errorstop ("Es ist keine Kundennummer eingelesen worden!")
- FI.
- lies kundendaten ein:
- zeige kundendaten;
- IF nachname <> ""
- THEN vielleicht schon fertig
- ELSE page (w2)
- FI;
- REP line (w2);
-
- put (w2, " Kundendaten eingeben");
- eingabe
- UNTIL yes (w2, "Alles richtig", TRUE) PER;
- kundennummer ist eingelesen := FALSE.
- vielleicht schon fertig:
- IF yes (w2, "Alles richtig", TRUE)
- THEN kundennummer ist eingelesen := FALSE;
- IF codekartenleser aktiviert
- THEN lasse karte entfernen (FALSE)
- FI;
- LEAVE kundendaten eingeben
- FI.
- eingabe:
- nachname holen;
- vorname holen;
- geschlecht holen.
-
- nachname holen:
- REP cursor (w1, 19, 6);
- editget (w1, nachname, 80, 80, "", abbruch zeichen + stopzeichen,
- exit char);
- teste auf abbruch
- UNTIL nachname <> "" PER.
- vorname holen:
- REP cursor (w1, 19, 8);
- editget (w1, vorname, 80, 80, "", abbruch zeichen + stopzeichen,
- exit char);
- teste auf abbruch
- UNTIL vorname <> "" PER.
- geschlecht holen:
- REP cursor (w1, 19, 10);
-
- editget (w1, geschlecht, 9, 9, "", abbruchzeichen + stopzeichen,
- exit char);
- geschlecht := geschlecht SUB 1;
- teste auf abbruch
- UNTIL geschlecht = "m" OR geschlecht = "w" PER.
- teste auf abbruch:
- IF exit char = esc + stopzeichen
- THEN ende gewuenscht := TRUE
- ELIF exit char = esc + abbruchzeichen
- THEN setze variable in anfangszustand;
- errorstop (1951, "Programm - Abbruch durch <ESC><"
-
- + abbruchzeichen + ">")
- FI.
-END PROC kundendaten eingeben;
-PROC drucke (TEXT CONST name):
- TEXT VAR zeile;
- FILE VAR f :: sequential file (modify, name);
- to line (f, 1);
- insert record (f);
- write record (f, "#center#" + name);
- down (f);
- insert record (f);
- down (f);
- WHILE NOT eof (f) REP
- read record (f, zeile);
- IF pos (zeile, ""15"") > 0
- THEN change (zeile, ""15"", "#on(""r"")#");
- change (zeile, ""14"", "#off(""r"")#");
-
- write record (f, zeile)
- FI;
- down (f)
- PER;
- cursor (3, 22);
- print (name)
-END PROC drucke;
-PROC stop w2:
- cursor off;
- page (w2);
- out (w2," Zum Weitermachen bitte");line(w2);
- out (w2," irgendeine Taste tippen!");
- pause;
- page (w2);
- cursor on
-END PROC stop w2;
-BOOL PROC yes (WINDOW VAR w, TEXT CONST frage, BOOL CONST default):
- BOOL VAR antwort :: default;
- TEXT VAR taste;
- INT CONST ja pos :: (areaxsize (w) - 9) DIV 2;
- cursor off;
- cursor (42,24); out ("Ändern: <Pfeile> Bestätigen: <RETURN>");
-
- page (w);
- out (w, center (w, frage + " ?"));
- cursor (w, ja pos, 3);
- IF default
- THEN out (w, ""15"Ja "14" Nein ");
- cursor (w, ja pos, 3)
- ELSE out (w, " Ja "15"Nein "14"");
- cursor (w, ja pos + 5, 3)
- FI;
- tastendruck auswerten;
- page (w);
- cursor (42,24); out (""5"");
- cursor on;
- antwort.
- tastendruck auswerten:
- REP inchar (taste);
- SELECT code (taste) OF CASE 2, 8 : position aendern
- CASE 13 : LEAVE tastendruck auswerten
-
- CASE 74, 106 : antwort := TRUE; (*Jj*)
- LEAVE tastendruck auswerten
- CASE 78, 110 : antwort := FALSE; (*Nn*)
- LEAVE tastendruck auswerten
- OTHERWISE out (""7"") END SELECT
- PER.
- position aendern:
- IF antwort THEN antwort := FALSE;
- cursor (w, ja pos, 3);
- out (w, " Ja "15"Nein "14"");
-
- cursor (w, ja pos + 5, 3)
- ELSE antwort := TRUE;
- cursor (w, ja pos, 3);
- out (w, ""15"Ja "14" Nein ");
- cursor (w, ja pos, 3)
- FI.
-END PROC yes;
-PROC tastatureingabe (BOOL CONST erwuenscht, INT VAR rueckmeldung):
- IF erwuenscht
- THEN rueckmeldung := 0;
- codekartenleser aktiviert := FALSE;
- schliesse interface
- ELSE oeffne interface (rueckmeldung);
- IF rueckmeldung >= 0
-
- THEN codekartenleser aktiviert := TRUE
- ELSE codekartenleser aktiviert := FALSE
- FI
- FI
-END PROC tastatureingabe;
-BOOL PROC eingabe mit codekartenleser:
- codekartenleser aktiviert
-END PROC eingabe mit codekartenleser;
-PROC dezimalwert lesen:
- pruefe abbruch;
- IF codekartenleser aktiviert
- THEN interfacewerte zeigen
- ELSE setze variable in anfangszustand;
- errorstop ("Eingabeart ist auf Tastatur eingestellt!")
- FI.
- interfacewerte zeigen:
-
- cursor off;
- fenster putzen;
- line (w1, 4); line (w2);
- out (w1, " Dezimalwert :");
- out (w2, " Lesen beenden mit <ESC><q>");
- ende gewuenscht := FALSE;
- REP pruefe abbruch;
- cursor (w1, 17, 5);
- out (w1, text (wert von interface, 3))
- UNTIL ende gewuenscht PER;
- page (w2); cursor (w1, 1, 5); out (" ");
- cursor on.
-END PROC dezimalwert lesen;
-PROC bitmuster lesen:
- pruefe abbruch;
- IF codekartenleser aktiviert
-
- THEN interfacewerte zeigen
- ELSE setze variable in anfangszustand;
- errorstop ("Eingabeart ist auf Tastatur eingestellt!")
- FI.
- interfacewerte zeigen:
- cursor off;
- fenster putzen;
- line (w1, 4); line (w2);
- out (w1, " Bitmuster :");
- out (w2, " Lesen beenden mit <ESC><q>");
- ende gewuenscht := FALSE;
- REP pruefe abbruch;
- cursor (w1, 16, 5);
- out (w1, bitmuster (wert von interface))
- UNTIL ende gewuenscht PER;
- page (w2); cursor (w1, 1, 5); out (" ");
-
- cursor on.
-END PROC bitmuster lesen;
-TEXT PROC bitmuster (INT CONST wert):
- INT VAR bitnr;
- TEXT VAR muster :: "";
- FOR bitnr FROM 7 DOWNTO 0 REP
- IF bit (wert, bitnr)
- THEN muster CAT "I"
- ELSE muster CAT "O"
- FI
- PER;
- muster
-END PROC bitmuster;
-PROC lasse karte entfernen (BOOL CONST mit rahmen):
- IF wert von interface <> 255
- THEN cursor off;
- IF mit rahmen THEN regeneriere w2 ELSE page (w2) FI;
- line (w2);
- out (w2, " Bitte Karte entfernen");
-
- REP pruefe abbruch
- UNTIL (wert von interface = 255) OR ende gewuenscht PER;
- cursor on
- FI
-END PROC lasse karte entfernen;
-INT PROC gesicherter wert von interface (INT CONST von, bis,
- TEXT CONST kartenart):
- INT VAR wert, zaehler;
- ende gewuenscht := FALSE;
- cursor off;
- REP out (w2, " Bitte " + kartenart + " einschieben");
- line (w2, 2);
- out (w2, " Stoptaste: <ESC><" + stopzeichen + ">");
- cursor (79, 24);
-
- gesicherten wert einlesen;
- cursor (w1, 19, 2);
- out (w1, text (wert, 3));
- IF wert < von OR wert > bis
- THEN warnung
- FI
- UNTIL wert >= von AND wert <= bis PER;
- cursor on;
- wert.
- gesicherten wert einlesen:
- REP zaehler := 0;
- warte auf karte;
- wert := wert von interface;
- lies wert
- UNTIL wert gesichert AND wert <> 255 PER.
- warte auf karte:
- REP beachte esc q
- UNTIL wert von interface <> 255 PER.
- beachte esc q:
-
- pruefe abbruch;
- IF ende gewuenscht
- THEN cursor on;
- LEAVE gesicherter wert von interface WITH 0
- FI.
- lies wert:
- REP beachte esc q;
- IF wert = wert von interface
- THEN zaehler INCR 1
- ELSE LEAVE lies wert
- FI
- UNTIL wert gesichert PER.
- wert gesichert: zaehler = sicherheit.
- warnung:
- page (w2); out (""7"");
- out (w2, " Dies ist keine " + kartenart + "!");
- line (w2, 2);
- out (w2, " Bitte Karte entfernen");
-
- REP beachte esc q
- UNTIL wert von interface = 255 PER;
- page (w2).
-END PROC gesicherter wert von interface
-END PACKET ls warenhaus 3
-
-
diff --git a/warenhaus/ls-Warenhaus 4 b/warenhaus/ls-Warenhaus 4
deleted file mode 100644
index e90e60a..0000000
--- a/warenhaus/ls-Warenhaus 4
+++ /dev/null
@@ -1,421 +0,0 @@
-(*
-
- **********************************************************
- **********************************************************
- ** **
- ** ls-Warenhaus 4 **
- ** **
- ** 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 4 DEFINES
- uebersetze:
-TYPE VOKABEL = STRUCT (TEXT grin, elan),
- REFINEMENT = STRUCT (TEXT name, INT aufruf);
-LET befehlsanzahl = 10,
- max refinements = 20,
- max offene strukturen = 10,
- schleife = 1,
- abfrage = 2;
-ROW befehlsanzahl VOKABEL CONST befehl :: ROW befehlsanzahl VOKABEL :
- (VOKABEL : ("Artikelnummerlesen", "artikelnummer lesen"),
- VOKABEL : ("Artikeldateneingeben", "artikeldaten eingeben"),
- VOKABEL : ("Kundennummerlesen", "kundennummer lesen"),
-
-
- VOKABEL : ("Kundendateneingeben", "kundendaten eingeben"),
- VOKABEL : ("Rechnungskopf", "rechnungskopf"),
- VOKABEL : ("Artikelkaufen", "artikel kaufen"),
- VOKABEL : ("Abrechnung", "abrechnung"),
- VOKABEL : ("Auskunft", "auskunft"),
- VOKABEL : ("neuesBlatt", "neues blatt"),
- VOKABEL : ("Bildschirmneu", "bildschirm neu"));
-ROW max refinements REFINEMENT VAR refinement;
-ROW max offene strukturen INT VAR offene struktur;
-
-
-INT VAR zeilennummer, erster fehler;
-OP := (VOKABEL VAR links, VOKABEL CONST rechts):
- CONCR (links) := CONCR (rechts)
-END OP :=;
-PROC uebersetze (TEXT CONST dateiname):
-forget ("elanprogramm", quiet);
-FILE VAR quelle :: sequential file (input, dateiname),
- ziel :: sequential file (output, "elanprogramm");
-suche programmanfang;
-WHILE NOT (eof (quelle) OR anything noted) REP
- bearbeite zeile
-PER;
-IF NOT anything noted
- THEN abschlusspruefung
-FI;
-IF anything noted
- THEN quelle := sequential file (modify, dateiname);
-
-
- to line (quelle, erster fehler);
- col (1);
- noteedit (quelle);
- errorstop ("")
-FI.
-abschlusspruefung:
- IF anzahl refinements > 0
- THEN pruefe refinementliste
- ELSE pruefe programmende
- FI.
-pruefe programmende:
- IF programmende fehlt
- THEN zeilennummer INCR 1;
- fehler (16)
- FI.
-pruefe refinementliste:
- zeilennummer INCR 1;
- pruefe auf offene schleife oder abfrage;
- put (ziel, "END PROC refinement " + text (letztes refinement));
-
-
- FOR index FROM 1 UPTO anzahl refinements REP
- IF refinement [index].aufruf > 0
- THEN zeilennummer := refinement [index].aufruf;
- fehler (25)
- ELIF refinement [index].aufruf < 0
- THEN zeilennummer := - refinement [index].aufruf;
- fehler (26)
- FI
- PER.
-suche programmanfang:
- TEXT VAR restzeile, zeile :: "";
- BOOL VAR programmende fehlt := FALSE,
- refinement muss folgen := FALSE;
- INT VAR anzahl refinements := 0,
- letztes refinement := 0,
-
-
- letzte geoeffnete := 0,
- index;
- zeilennummer := 0;
- erster fehler := 0;
- WHILE NOT eof (quelle) AND zeile = "" REP
- getline (quelle, zeile);
- zeile := compress (zeile);
- zeilennummer INCR 1;
- cout (zeilennummer);
- IF zeile = "" THEN line (ziel) FI;
- PER;
- put (ziel, "bildschirm neu;");
- IF zeile = "" THEN LEAVE uebersetze
- ELIF pos (zeile, "PROGRAMM") = 1
- THEN programmende fehlt := TRUE
- ELSE fehler (1)
- FI.
-bearbeite zeile:
-
-
- zeilennummer INCR 1;
- cout (zeilennummer);
- getline (quelle, zeile);
- zeile := compress (zeile);
- change all (zeile, " ", "");
- IF zeile = ""
- THEN line (ziel)
- ELSE analysiere und uebersetze
- FI.
-analysiere und uebersetze:
- IF refinement muss folgen
- THEN erstes refinement
- ELSE pruefe zunaechst auf schluesselworte;
- durchsuche befehlsliste
- FI.
-erstes refinement:
- IF pos (zeile, ":") = 0
- THEN fehler (19)
- ELIF pos (zeile, ":") < length (zeile)
-
-
- THEN fehler (20)
- ELIF (pos (zeile, "PROGRAMM") = 1) OR
- (pos (zeile, "ENDE") = 1) OR
- (pos (zeile, "WIEDERHOLE") = 1) OR
- (pos (zeile, "BIS") = 1) OR
- (pos (zeile, "WENN") = 1)
- THEN fehler (21)
- ELIF (zeile = "Stoptastegedrückt:") OR
- (zeile = "nichtStoptastegedrückt:") OR
- (zeile = "Stoptastegedrueckt:") OR
- (zeile = "nichtStoptastegedrueckt:")
- THEN fehler (22)
- ELSE refinement muss folgen := FALSE;
-
-
- line (ziel);
- trage befehlsdefinition ein
- FI.
-trage befehlsdefinition ein:
- change (zeile, ":", "");
- FOR index FROM 1 UPTO anzahl refinements REP
- IF refinement [index].name = zeile
- THEN pruefe aufruf; LEAVE trage befehlsdefinition ein
- FI
- PER;
- anzahl refinements INCR 1;
- IF anzahl refinements > max refinements
- THEN fehler (24)
- ELSE refinement [anzahl refinements].name := zeile;
- refinement [anzahl refinements].aufruf := - zeilennummer;
-
-
- letztes refinement := anzahl refinements;
- line (ziel);
- put (ziel, "PROC refinement " + text (anzahl refinements) + ":")
- FI.
-pruefe aufruf:
- IF refinement [index].aufruf > 0
- THEN refinement [index].aufruf := 0;
- line (ziel);
- put (ziel, "PROC refinement " + text (index) + ":");
- letztes refinement := index
- ELSE fehler (23)
- FI.
-pruefe zunaechst auf schluesselworte:
- IF pos (zeile, "WIEDERHOLE") = 1
- THEN oeffne schleife; LEAVE analysiere und uebersetze
-
-
- ELIF pos (zeile, "WENN") = 1
- THEN oeffne if; LEAVE analysiere und uebersetze
- ELIF pos (zeile, "BIS") = 1
- THEN schliesse mit until; LEAVE analysiere und uebersetze
- ELIF pos (zeile, "ENDE") = 1
- THEN schliesse; LEAVE analysiere und uebersetze
- ELIF pos (zeile, "PROGRAMM") = 1
- THEN fehler (18); LEAVE analysiere und uebersetze
- FI.
-oeffne schleife:
- IF letzte geoeffnete = max offene strukturen
- THEN fehler (2)
- ELSE letzte geoeffnete INCR 1;
- offene struktur [letzte geoeffnete] := schleife;
-
-
- analysiere schleifenart
- FI.
-analysiere schleifenart:
- IF zeile = "WIEDERHOLE"
- THEN line (ziel); put (ziel, "REPEAT")
- ELSE es muss eine zaehlschleife sein
- FI.
-es muss eine zaehlschleife sein:
- restzeile := subtext (zeile, 11);
- INT VAR malpos := pos (restzeile, "MAL");
- IF malpos > 0
- THEN zaehlschleife
- ELSE fehler (3)
- FI.
-zaehlschleife:
- IF length (restzeile) > malpos + 2
- THEN fehler (4)
- ELSE bestimme anzahl der wiederholungen
- FI.
-
-
-bestimme anzahl der wiederholungen:
- INT VAR wdh := int (subtext (restzeile, 1, malpos - 1));
- IF last conversion ok
- THEN line (ziel);
- put (ziel, "INT VAR index" + text (zeilennummer) +
- "; FOR index" + text (zeilennummer) +
- " FROM 1 UPTO " + text (wdh) + " REPEAT")
- ELSE fehler (5)
- FI.
-oeffne if:
- IF letzte geoeffnete = max offene strukturen
- THEN fehler (6)
- ELSE letzte geoeffnete INCR 1;
- offene struktur [letzte geoeffnete] := abfrage;
-
-
- uebersetze abfrage
- FI.
-uebersetze abfrage:
- restzeile := subtext (zeile, 5);
- IF (restzeile = "Stoptastegedrückt") OR
- (restzeile = "Stoptastegedrueckt")
- THEN line (ziel); put (ziel, "IF stoptaste gedrueckt THEN")
- ELIF (restzeile = "nichtStoptastegedrückt") OR
- (restzeile = "nichtStoptastegedrueckt")
- THEN line (ziel); put (ziel, "IF NOT stoptaste gedrueckt THEN")
- ELIF restzeile = ""
- THEN fehler (7)
- ELSE fehler (8)
- FI.
-schliesse mit until:
-
-
- teste ob als letztes schleife offen;
- letzte geoeffnete DECR 1;
- restzeile := subtext (zeile, 4);
- IF (restzeile = "Stoptastegedrückt") OR
- (restzeile = "Stoptastegedrueckt")
- THEN line (ziel);
- put (ziel, "UNTIL stoptaste gedrueckt END REPEAT;");
- ELIF (restzeile = "nichtStoptastegedrückt") OR
- (restzeile = "nichtStoptastegedrueckt")
- THEN line (ziel);
- put (ziel, "UNTIL NOT stoptaste gedrueckt END REPEAT;");
- ELIF restzeile = ""
-
-
- THEN fehler (9)
- ELSE fehler (8)
- FI.
-schliesse:
- restzeile := subtext (zeile, 5);
- IF restzeile = "WIEDERHOLE"
- THEN schliesse schleife
- ELIF restzeile = "WENN"
- THEN schliesse if
- ELIF restzeile = "PROGRAMM"
- THEN programmende
- ELSE fehler (10)
- FI.
-schliesse schleife:
- teste ob als letztes schleife offen;
- letzte geoeffnete DECR 1;
- line (ziel); put (ziel, "END REPEAT;").
-teste ob als letztes schleife offen:
- IF letzte geoeffnete = 0
- THEN fehler (11);
-
-
- LEAVE bearbeite zeile
- ELIF offene struktur [letzte geoeffnete] = abfrage
- THEN fehler (12)
- FI.
-schliesse if:
- teste ob als letztes abfrage offen;
- line (ziel); put (ziel, "END IF;");
- letzte geoeffnete DECR 1.
-teste ob als letztes abfrage offen:
- IF letzte geoeffnete = 0
- THEN fehler (13);
- LEAVE bearbeite zeile
- ELIF offene struktur [letzte geoeffnete] = schleife
- THEN fehler (14)
- FI.
-programmende:
- IF programmende fehlt
- THEN programmende fehlt := FALSE;
-
-
- refinement muss folgen := TRUE
- ELSE fehler (17);
- LEAVE programmende
- FI;
- pruefe auf offene schleife oder abfrage.
-pruefe auf offene schleife oder abfrage:
- IF letzte geoeffnete = 0
- THEN alles okay
- ELIF offene struktur [letzte geoeffnete] = schleife
- THEN fehler (14)
- ELSE fehler (12)
- FI.
- alles okay: .
-durchsuche befehlsliste:
- IF pos (zeile, ":") > 0
- THEN auf refinementdefinition pruefen
- ELSE befehl suchen
- FI.
-befehl suchen:
-
-
- BOOL VAR gefunden := FALSE;
- INT VAR i;
- verhindere bedingung;
- FOR i FROM 1 UPTO befehlsanzahl REP
- IF befehl [i].grin = zeile
- THEN gefunden := TRUE;
- line (ziel);
- put (ziel, befehl [i].elan + ";")
- FI
- UNTIL gefunden PER;
- IF NOT gefunden
- THEN trage in refinementliste ein
- FI.
-auf refinementdefinition pruefen:
- IF pos (zeile, ":") < length (zeile)
- THEN fehler (20)
- ELIF programmende fehlt
- THEN fehler (16)
- ELIF (zeile = "Stoptastegedrückt:") OR
-
-
- (zeile = "nichtStoptastegedrückt:") OR
- (zeile = "Stoptastegedrueckt:") OR
- (zeile = "nichtStoptastegedrueckt:")
- THEN fehler (22)
- ELSE pruefe auf offene schleife oder abfrage;
- put (ziel, "END PROC refinement " + text (letztes refinement)
- + ";");
- trage befehlsdefinition ein
- FI.
-trage in refinementliste ein:
- FOR index FROM 1 UPTO anzahl refinements REP
- IF refinement [index].name = zeile
-
-
- THEN trage evtl aufruf ein;
- LEAVE trage in refinementliste ein
- FI
- PER;
- anzahl refinements INCR 1;
- IF anzahl refinements > max refinements
- THEN fehler (24)
- ELSE refinement [anzahl refinements].name := zeile;
- refinement [anzahl refinements].aufruf := zeilennummer;
- line (ziel);
- put (ziel, "refinement " + text (anzahl refinements) + ";")
- FI.
-trage evtl aufruf ein:
- line (ziel);
- put (ziel, "refinement " + text (index) + ";");
-
-
- IF refinement [index].aufruf < 0
- THEN refinement [index].aufruf := 0
- FI.
-verhindere bedingung:
- IF (zeile = "Stoptastegedrückt") OR (zeile = "nichtStoptastegedrückt") OR
- (zeile = "Stoptastegedrueckt") OR (zeile = "nichtStoptastegedrueckt")
- THEN fehler (15);
- LEAVE bearbeite zeile
- FI.
-END PROC uebersetze;
-PROC fehler (INT CONST fehlernr):
- noteline;
- note ("FEHLER in Zeile " + text (zeilennummer) + ": ");
- noteline;
- note (" " + anwendungstext (fehlernr + 20));
-
-
- noteline;
- IF erster fehler = 0
- THEN erster fehler := zeilennummer
- FI
-END PROC fehler
-END PACKET ls warenhaus 4
-
-
-
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
-
-
diff --git a/warenhaus/ls-Warenhaus-gen b/warenhaus/ls-Warenhaus-gen
deleted file mode 100644
index 2e0476e..0000000
--- a/warenhaus/ls-Warenhaus-gen
+++ /dev/null
@@ -1,95 +0,0 @@
-(*
-
- **********************************************************
- **********************************************************
- ** **
- ** ls-Warenhaus/gen **
- ** **
- ** Version 1.01 **
- ** **
- ** **
- ** (Stand: 30.08.89) **
- ** **
- ** **
- ** **
- ** Autor: Bruno Pollok, Bielefeld **
- ** **
- ** Copyright (C) 1988 Eva Latta-Weber, Bielefeld **
- ** Copyright (C) 1990 ERGOS GmbH, Siegburg **
- ** **
- **********************************************************
- **********************************************************
-
- *)
-LET kartenleserkennung = "ls-Warenhaus 0: mit Kartenleser";
-baue bildschirm auf;
-schicke menukarte ab;
-erfrage anpassung;
-check off;
-warnings off;
-insertiere (anpassung);
-loesche alle anpassungen;
-insertiere ("ls-Warenhaus 1");
-insertiere ("ls-Warenhaus 2");
-insertiere ("ls-Warenhaus 3");
-insertiere ("ls-Warenhaus 4");
-insertiere ("ls-Warenhaus 5");
-check on;
-frage nach grin;
-frage nach hauptstelle.
-baue bildschirm auf:
- page;
- cursor (18, 1);
- out (invers ("ls-Warenhaus : Automatische Generierung"));
- line (3).
-erfrage anpassung:
-
- WINDOW VAR w :: window (1, 1, 79, 24);
- TEXT VAR anpassung :: boxone (w, alle kartenleser,
- "Auswahl einer Interface - Anpassung für den Codekartenleser",
- "Wenn kein Kartenleser benutzt wird, <ESC><q> tippen!", FALSE);
- IF anpassung = ""
- THEN anpassung := "ls-Warenhaus 0: ohne Kartenleser"
- FI;
- baue bildschirm auf.
-alle kartenleser:
- infix namen (ALL myself, kartenleserkennung).
-loesche alle anpassungen:
- command dialogue (FALSE);
- forget (infixnamen (ALL myself, "ls-Warenhaus 0"));
-
- forget ("--------------------------------------------------------",quiet);
- command dialogue (TRUE).
-schicke menukarte ab:
- command dialogue (FALSE);
- save ("ls-MENUKARTE:Warenhaus", /"ls-MENUKARTEN");
- command dialogue (TRUE);
- forget ("ls-MENUKARTE:Warenhaus", quiet);
- forget ("ls-Warenhaus/gen", quiet).
-frage nach grin:
- line;
- IF yes ("Version für GRIN")
- THEN do ("grin (TRUE)")
- ELSE do ("grin (FALSE)")
- FI.
-frage nach hauptstelle:
- line (2);
- IF yes ("Soll diese Task Warenhaus - Hauptstelle sein")
-
- THEN do ("warenhaus hauptstelle (TRUE)")
- ELSE global manager
- FI.
-;
-PROC insertiere (TEXT CONST dateiname):
- INT VAR s, z;
- out ("'" + dateiname + "'");
- get cursor (s, z);
- out (" wird insertiert. ");
- insert (dateiname);
- forget (dateiname, quiet);
- cursor (s, z);
- out (""4"") ;
- line
-END PROC insertiere
-
-
generated by cgit v1.2.3 (git 2.39.1) at 2024-05-19 11:39:38 +0000