diff options
| author | Lars-Dominik Braun <lars@6xq.net> | 2016-09-30 16:57:23 +0200 |
|---|---|---|
| committer | Lars-Dominik Braun <lars@6xq.net> | 2016-09-30 16:59:06 +0200 |
| commit | 724cc003460ec67eda269911da85c9f9e40aa6cf (patch) | |
| tree | 14e27b45e04279516e4be546b15dcf6fafe17268 /warenhaus | |
| download | eumel-src-724cc003460ec67eda269911da85c9f9e40aa6cf.tar.gz eumel-src-724cc003460ec67eda269911da85c9f9e40aa6cf.tar.bz2 eumel-src-724cc003460ec67eda269911da85c9f9e40aa6cf.zip | |
Add extracted sources from floppy disk images
Some files have no textual representation (yet) and were added as raw
dataspaces.
Diffstat (limited to 'warenhaus')
| -rw-r--r-- | warenhaus/ls-MENUKARTE:Warenhaus | bin | 0 -> 60928 bytes | |||
| -rw-r--r-- | warenhaus/ls-Warenhaus 0: mit Kartenleser an AKTRONIC-Adapter | 36 | ||||
| -rw-r--r-- | warenhaus/ls-Warenhaus 0: mit Kartenleser an MUFI als Endgerät | 36 | ||||
| -rw-r--r-- | warenhaus/ls-Warenhaus 0: mit Kartenleser an MUFI im Terminalkanal | 30 | ||||
| -rw-r--r-- | warenhaus/ls-Warenhaus 0: ohne Kartenleser | 27 | ||||
| -rw-r--r-- | warenhaus/ls-Warenhaus 1 | 37 | ||||
| -rw-r--r-- | warenhaus/ls-Warenhaus 2 | 112 | ||||
| -rw-r--r-- | warenhaus/ls-Warenhaus 3 | 82 | ||||
| -rw-r--r-- | warenhaus/ls-Warenhaus 4 | 48 | ||||
| -rw-r--r-- | warenhaus/ls-Warenhaus 5 | 103 | ||||
| -rw-r--r-- | warenhaus/ls-Warenhaus-gen | 29 |
11 files changed, 540 insertions, 0 deletions
diff --git a/warenhaus/ls-MENUKARTE:Warenhaus b/warenhaus/ls-MENUKARTE:Warenhaus Binary files differnew file mode 100644 index 0000000..414470a --- /dev/null +++ b/warenhaus/ls-MENUKARTE:Warenhaus diff --git a/warenhaus/ls-Warenhaus 0: mit Kartenleser an AKTRONIC-Adapter b/warenhaus/ls-Warenhaus 0: mit Kartenleser an AKTRONIC-Adapter new file mode 100644 index 0000000..36de5ef --- /dev/null +++ b/warenhaus/ls-Warenhaus 0: mit Kartenleser an AKTRONIC-Adapter @@ -0,0 +1,36 @@ +(* + + ********************************************************** + ********************************************************** + ** ** + ** 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 new file mode 100644 index 0000000..f108f7b --- /dev/null +++ b/warenhaus/ls-Warenhaus 0: mit Kartenleser an MUFI als Endgerät @@ -0,0 +1,36 @@ +(* + + ********************************************************** + ********************************************************** + ** ** + ** 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 new file mode 100644 index 0000000..30c69da --- /dev/null +++ b/warenhaus/ls-Warenhaus 0: mit Kartenleser an MUFI im Terminalkanal @@ -0,0 +1,30 @@ +(* + + ********************************************************** + ********************************************************** + ** ** + ** 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 new file mode 100644 index 0000000..4912d64 --- /dev/null +++ b/warenhaus/ls-Warenhaus 0: ohne Kartenleser @@ -0,0 +1,27 @@ +(* + + ********************************************************** + ********************************************************** + ** ** + ** 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 new file mode 100644 index 0000000..81fd8ee --- /dev/null +++ b/warenhaus/ls-Warenhaus 1 @@ -0,0 +1,37 @@ +(* + + ********************************************************** + ********************************************************** + ** ** + ** 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 new file mode 100644 index 0000000..7048aff --- /dev/null +++ b/warenhaus/ls-Warenhaus 2 @@ -0,0 +1,112 @@ +(* + + ********************************************************** + ********************************************************** + ** ** + ** 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 new file mode 100644 index 0000000..3473e0f --- /dev/null +++ b/warenhaus/ls-Warenhaus 3 @@ -0,0 +1,82 @@ +(* + + ********************************************************** + ********************************************************** + ** ** + ** 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 new file mode 100644 index 0000000..a19a6d6 --- /dev/null +++ b/warenhaus/ls-Warenhaus 4 @@ -0,0 +1,48 @@ +(* + + ********************************************************** + ********************************************************** + ** ** + ** 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 new file mode 100644 index 0000000..6b05bad --- /dev/null +++ b/warenhaus/ls-Warenhaus 5 @@ -0,0 +1,103 @@ +(* + + ********************************************************** + ********************************************************** + ** ** + ** 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 new file mode 100644 index 0000000..f4bd77f --- /dev/null +++ b/warenhaus/ls-Warenhaus-gen @@ -0,0 +1,29 @@ +(* + + ********************************************************** + ********************************************************** + ** ** + ** 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{} + |