From afd4c3c448381f6eb706090911a15c162fdaf8af Mon Sep 17 00:00:00 2001 From: Lars-Dominik Braun Date: Sun, 9 Oct 2016 11:28:19 +0200 Subject: Decompress source files MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit EUMEL’s TEXT dataspaces wastes a lot of storage space. Some files were therefore “compressed” by storing them as a single line, reducing overhead significantly. --- ...arenhaus 0: mit Kartenleser an AKTRONIC-Adapter | 190 ++- ...0: mit Kartenleser an MUFI als Endger\303\244t" | 197 ++- ...aus 0: mit Kartenleser an MUFI im Terminalkanal | 89 +- warenhaus/ls-Warenhaus 0: ohne Kartenleser | 26 +- warenhaus/ls-Warenhaus 1 | 222 +++- warenhaus/ls-Warenhaus 2 | 1319 +++++++++++++++++-- warenhaus/ls-Warenhaus 3 | 1018 ++++++++++++++- warenhaus/ls-Warenhaus 4 | 419 +++++- warenhaus/ls-Warenhaus 5 | 1352 ++++++++++++++++++-- warenhaus/ls-Warenhaus-gen | 74 +- 10 files changed, 4616 insertions(+), 290 deletions(-) (limited to 'warenhaus') diff --git a/warenhaus/ls-Warenhaus 0: mit Kartenleser an AKTRONIC-Adapter b/warenhaus/ls-Warenhaus 0: mit Kartenleser an AKTRONIC-Adapter index 36de5ef..0ac3237 100644 --- a/warenhaus/ls-Warenhaus 0: mit Kartenleser an AKTRONIC-Adapter +++ b/warenhaus/ls-Warenhaus 0: mit Kartenleser an AKTRONIC-Adapter @@ -22,15 +22,183 @@ *) 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{} + 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\303\244t" "b/warenhaus/ls-Warenhaus 0: mit Kartenleser an MUFI als Endger\303\244t" index f108f7b..0098901 100644 --- "a/warenhaus/ls-Warenhaus 0: mit Kartenleser an MUFI als Endger\303\244t" +++ "b/warenhaus/ls-Warenhaus 0: mit Kartenleser an MUFI als Endger\303\244t" @@ -22,15 +22,190 @@ *) 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{} + 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 index 30c69da..54bb73e 100644 --- a/warenhaus/ls-Warenhaus 0: mit Kartenleser an MUFI im Terminalkanal +++ b/warenhaus/ls-Warenhaus 0: mit Kartenleser an MUFI im Terminalkanal @@ -22,9 +22,88 @@ *) 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{} + 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 index 4912d64..96af5c1 100644 --- a/warenhaus/ls-Warenhaus 0: ohne Kartenleser +++ b/warenhaus/ls-Warenhaus 0: ohne Kartenleser @@ -22,6 +22,28 @@ *) 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{} + 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 index 81fd8ee..c3976b4 100644 --- a/warenhaus/ls-Warenhaus 1 +++ b/warenhaus/ls-Warenhaus 1 @@ -22,16 +22,214 @@ *) 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{}{} + 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 index 7048aff..f7a9945 100644 --- a/warenhaus/ls-Warenhaus 2 +++ b/warenhaus/ls-Warenhaus 2 @@ -22,91 +22,1236 @@ *) 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{} + 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 index 3473e0f..71ef216 100644 --- a/warenhaus/ls-Warenhaus 3 +++ b/warenhaus/ls-Warenhaus 3 @@ -22,61 +22,965 @@ *) 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: <" + 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 <"{} + 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: <" + 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 <"{} + 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 ; Cursor bewegen: ");{} 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 ; Cursor bewegen: ");{} 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 <"{} - + 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 <"{} - + 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: Bestätigen: ");{} - 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 ");{} 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 ");{} 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: <" + 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{} + 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: <" + 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 <" + + 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: <" + 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 <" + + 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 ; Cursor bewegen: "); + 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 ; Cursor bewegen: "); + 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 <" + + + 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 <" + + + 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: Bestätigen: "); + + 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 "); + 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 "); + 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: <" + 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 index a19a6d6..e90e60a 100644 --- a/warenhaus/ls-Warenhaus 4 +++ b/warenhaus/ls-Warenhaus 4 @@ -22,27 +22,400 @@ *) 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{}{} + 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 index 6b05bad..3a64e00 100644 --- a/warenhaus/ls-Warenhaus 5 +++ b/warenhaus/ls-Warenhaus 5 @@ -22,82 +22,1278 @@ *) PACKET ls warenhaus 5 DEFINES - warenhaus,{} grin,{} direktbefehl 1,{} direktbefehl 2,{} direktbefehl 3,{} direktbefehl 4,{} direktbefehl 5,{} direktbefehl 6,{} direktbefehl 7,{} warenhausbefehle zeigen,{} eingabe grundeinstellung,{} tastatur einstellen,{} kartenleser einstellen,{} evtl d und b sperren,{} loesche zwischenraum,{} eingabeart anzeigen,{} filialdaten zusammenstellen,{} filialdaten eintragen,{} filialdaten verzeichnis,{} - filialdaten umbenennen,{} filialdaten loeschen,{} warenhausprogramme verzeichnis,{} warenhausprogramm neu erstellen,{} warenhausprogramm ansehen,{} warenhausprogramm kopieren,{} warenhausprogramm umbenennen,{} warenhausprogramme loeschen,{} warenhausprogramme drucken,{} warenhausprogramm starten,{} warenhausprogramm wiederholen:{}LET menukarte = "ls-MENUKARTE:Warenhaus",{} praefix = "Filialdaten:",{} filialdatentyp = 1951,{} - niltext = "",{} maxlaenge = 45,{} maxnamenslaenge = 35;{}TEXT VAR filialdatenname :: "",{} programmname :: "";{}INT VAR fehlerzeile :: 0;{}BOOL VAR grin version :: FALSE,{} noch kein programm gelaufen :: TRUE,{} bildschirm neu eingesetzt :: FALSE;{}WINDOW VAR w :: window (1, 3, 79, 19);{}INITFLAG VAR in this task :: FALSE;{}PROC warenhausbefehle zeigen:{} TEXT VAR info, liste, tasten;{} INT VAR grinoffset;{} - IF grin version{} THEN grinbefehle{} ELSE elanbefehle{} FI;{} REP{} INT VAR auswahl := menualternative (info, liste, tasten, 5, FALSE);{} SELECT auswahl OF{} CASE 1, 101, 105 : menuinfo (anwendungstext (1 + grinoffset)){} CASE 2, 102, 106 : menuinfo (anwendungstext (2 + grinoffset)){} CASE 3, 103, 107 : menuinfo (anwendungstext (3 + grinoffset)){} END SELECT{} UNTIL auswahl = 4 OR auswahl = 104 OR auswahl = 108 PER.{} grinbefehle:{} grinoffset := 13;{} info := " "15"Info zu den Programmierbefehlen "14""13""13""{} - + " d Datei - Bearbeitung "13""{} + " e Einkaufen und Auskunft "13""{} + " k Kontroll - Strukturen "13""13""{} + " z Zurück zum Hauptmenü ";{} liste := "Datei"13"Kaufen/Auskunft"13"Kontroll"13"Zurück";{} tasten := "dekzDEKZ".{} elanbefehle:{} grinoffset := 0;{} info := " "15"Info zu den Programmierbefehlen "14""13""13""{} + " d Datei - Bearbeitung "13""{} - + " e Einkaufen und Auskunft "13""{} + " s Sonstige Befehle "13""13""{} + " z Zurück zum Hauptmenü ";{} liste := "Datei"13"Kaufen/Auskunft"13"Sonstige"13"Zurück";{} tasten := "deszDESZ".{}END PROC warenhausbefehle zeigen;{}PROC eingabe grundeinstellung:{} INT VAR dummy;{} IF eingabe mit codekartenleser{} THEN tastatureingabe (TRUE, dummy){} FI{}END PROC eingabe grundeinstellung;{}PROC tastatur einstellen:{} - eingabe grundeinstellung;{} menuinfo (anwendungstext (6), 4){}END PROC tastatur einstellen;{}PROC kartenleser einstellen:{} INT VAR ergebnis;{} IF eingabe mit codekartenleser{} THEN tastatureingabe (TRUE, ergebnis){} FI;{} pause (10);{} tastatureingabe (FALSE, ergebnis);{} IF ergebnis < 0{} THEN menuinfo (anwendungstext (7 - ergebnis), 5){} ELSE menuinfo (anwendungstext (7), 4){} FI{}END PROC kartenleser einstellen;{}PROC loesche zwischenraum:{} INT VAR zeile;{} cursor (1, 2); out (79 * waagerecht + " ");{} - FOR zeile FROM 3 UPTO 22 REP{} cursor (1, zeile); out (""5"");{} PER;{} cursor (1, 23); out (79 * waagerecht + " ");{} cursor (1, 24); out (""5"");{}END PROC loesche zwischenraum;{}PROC ergaenze bildschirm:{} cursor ( 1, 2); out (ecke oben links);{} cursor (42, 2); out (balken oben);{} cursor (80, 2); out (ecke oben rechts);{} INT VAR zeile;{} FOR zeile FROM 3 UPTO 22 REP{} cursor ( 1, zeile); out (senkrecht);{} cursor (42, zeile); out (senkrecht);{} cursor (80, zeile); out (senkrecht){} - PER;{} cursor ( 1, 23); out (ecke unten links);{} cursor (42, 23); out (balken unten);{} cursor (80, 23); out (ecke unten rechts);{} cursor (42, 19);{} out (balken links + (37 * waagerecht) + balken rechts);{} cursor w3 1 1{}END PROC ergaenze bildschirm;{}PROC zweite zeile:{} cursor (1, 2); out (79 * waagerecht + " "){}END PROC zweite zeile;{}PROC evtl d und b sperren:{} IF eingabe mit codekartenleser{} THEN activate ( 9);{} activate (10){} ELSE deactivate ( 9);{} deactivate (10){} - FI{}END PROC evtl d und b sperren;{}PROC direktbefehl 1:{} disable stop;{} warendatei bearbeiten;{} cursor off;{} IF is error{} THEN regenerate menuscreen;{} menuinfo (" " + invers (errormessage));{} clear error{} ELSE zweite zeile;{} menu bildschirm{} FI;{} enable stop{}END PROC direktbefehl 1;{}PROC warendatei bearbeiten:{} enable stop;{} loesche zwischenraum;{} ergaenze bildschirm;{} cursor (2, 24); out (invers ("Warendatei bearbeiten"));{} REP artikelnummer lesen;{} - IF NOT stoptaste gedrueckt{} THEN artikeldaten eingeben{} FI{} UNTIL stoptaste gedrueckt PER{}END PROC warendatei bearbeiten;{}PROC direktbefehl 2:{} disable stop;{} kundendatei bearbeiten;{} cursor off;{} IF is error{} THEN regenerate menuscreen;{} menuinfo (" " + invers (errormessage));{} clear error{} ELSE zweite zeile;{} menu bildschirm{} FI;{} enable stop{}END PROC direktbefehl 2;{}PROC kundendatei bearbeiten:{} enable stop;{} loesche zwischenraum;{} - ergaenze bildschirm;{} cursor (2, 24); out (invers ("Kundendatei bearbeiten"));{} REP kundennummer lesen;{} IF NOT stoptaste gedrueckt{} THEN kundendaten eingeben{} FI{} UNTIL stoptaste gedrueckt PER{}END PROC kundendatei bearbeiten;{}PROC direktbefehl 3:{} disable stop;{} einkaufen gehen;{} cursor off;{} IF is error{} THEN regenerate menuscreen;{} menuinfo (" " + invers (errormessage));{} clear error{} ELSE zweite zeile;{} menu bildschirm{} - FI;{} enable stop{}END PROC direktbefehl 3;{}PROC einkaufen gehen:{} enable stop;{} loesche zwischenraum;{} ergaenze bildschirm;{} cursor (2, 24); out (invers ("Einkaufen"));{} forget ("WARENHAUS:Rechnung", quiet);{} kundennummer lesen;{} rechnungskopf;{} REP einkaufen{} UNTIL stoptaste gedrueckt PER;{} abrechnung;{} forget ("WARENHAUS:Rechnung", quiet).{} einkaufen:{} artikelnummer lesen;{} IF NOT stoptaste gedrueckt{} THEN artikel kaufen{} FI.{}END PROC einkaufen gehen;{} -PROC direktbefehl 4:{} disable stop;{} auskunft einholen;{} cursor off;{} IF is error{} THEN regenerate menuscreen;{} menuinfo (" " + invers (errormessage));{} clear error{} ELSE zweite zeile;{} menu bildschirm{} FI;{} enable stop{}END PROC direktbefehl 4;{}PROC auskunft einholen:{} enable stop;{} loesche zwischenraum;{} ergaenze bildschirm;{} cursor (2, 24); out (invers ("Auskunft"));{} auskunft{}END PROC auskunft einholen;{}PROC direktbefehl 5:{} disable stop;{} - ware nachbestellen;{} cursor off;{} IF is error{} THEN regenerate menuscreen;{} menuinfo (" " + invers (errormessage));{} clear error{} ELSE zweite zeile;{} menu bildschirm{} FI;{} enable stop{}END PROC direktbefehl 5;{}PROC ware nachbestellen:{} enable stop;{} loesche zwischenraum;{} ergaenze bildschirm;{} cursor (2, 24); out (invers ("Nachbestellen"));{} nachbestellen{}END PROC ware nachbestellen;{}PROC direktbefehl 6:{} disable stop;{} dezimalwerte von interface lesen;{} - cursor off;{} IF is error{} THEN regenerate menuscreen;{} menuinfo (" " + invers (errormessage));{} clear error{} ELSE zweite zeile;{} menu bildschirm{} FI;{} enable stop{}END PROC direktbefehl 6;{}PROC dezimalwerte von interface lesen:{} enable stop;{} loesche zwischenraum;{} ergaenze bildschirm;{} cursor (2, 24); out (invers ("Dezimalwert lesen"));{} dezimalwert lesen{}END PROC dezimalwerte von interface lesen;{}PROC direktbefehl 7:{} disable stop;{} - bitmuster von interface lesen;{} cursor off;{} IF is error{} THEN regenerate menuscreen;{} menuinfo (" " + invers (errormessage));{} clear error{} ELSE zweite zeile;{} menu bildschirm{} FI;{} enable stop{}END PROC direktbefehl 7;{}PROC bitmuster von interface lesen:{} enable stop;{} loesche zwischenraum;{} ergaenze bildschirm;{} cursor (2, 24); out (invers ("Bitmuster lesen"));{} bitmuster lesen{}END PROC bitmuster von interface lesen;{}PROC eingabeart anzeigen:{} - IF eingabe mit codekartenleser{} THEN menuinfo (anwendungstext (7), 4){} ELSE menuinfo (anwendungstext (6), 4){} FI{}END PROC eingabeart anzeigen;{}PROC warenhaus:{} BOOL VAR am ende loeschen :: TRUE;{} pruefe zulaessigkeit;{} installiere menukarte mit anfangsbild;{} initialisiere warenhaus;{} handle menu ("WARENHAUS");{} IF am ende loeschen{} THEN sperre verwaltungstask;{} end (task (verwaltung)){} FI.{} installiere menukarte mit anfangsbild:{} install menu (menukarte, TRUE);{} - cursor off;{} cursor (17, 20);{} out (" W A R E N H A U S ");{} cursor (21, 22);{} out (invers("Filiale " + text (channel (myself))));{} cursor (79, 24);{} pause (10).{} sperre verwaltungstask:{} DATASPACE VAR ds;{} INT VAR dummy;{} forget (ds); ds := nilspace;{} call (task (verwaltung), 256, ds, dummy).{} pruefe zulaessigkeit:{} IF hauptstellenname = ""{} THEN line;{} putline ("Keine uebergeordnete Task ist 'warenhaus hauptstelle'!");{} end; LEAVE warenhaus{} - ELIF name (myself) = hauptstellenname{} THEN errorstop ("Dieser Befehl darf nur von Söhnen dieser "{} + "Task aus gegeben werden!");{} LEAVE warenhaus{} FI.{} initialisiere warenhaus:{} TEXT CONST verwaltung :: hauptstellenname + ".Filialverwaltung "{} + text (channel (myself));{} IF NOT exists task (verwaltung){} THEN initialisiere verwaltung{} ELSE biete evtl loeschen an{} FI;{} IF NOT initialized (in this task){} - THEN filialdatenname := "";{} programmname := ""{} FI;{} noch kein programm gelaufen := TRUE.{} biete evtl loeschen an:{} access catalogue;{} IF NOT (father (task (verwaltung)) = myself){} THEN fehlermeldung;{} line;{} end;{} am ende loeschen := FALSE{} FI.{} fehlermeldung:{} cursor (1, 22);{} putline ("Filiale " + text (channel (myself)) +{} " ist bereits besetzt durch TASK '"{} + name (father (task (verwaltung))) + "'!");{} - putline ("Es ist so kein geregelter Warenhaus-Betrieb moeglich!").{}END PROC warenhaus;{}PROC grin (BOOL CONST entscheidung):{} enable stop;{} IF hauptstellenname = "" OR hauptstellenname = name (myself){} THEN grin version := entscheidung{} ELSE errorstop ("Dieser Befehl darf nur von der Task '" +{} hauptstellenname + "' aus gegeben werden!"){} FI;{} bildschirm neu eingesetzt := FALSE{}END PROC grin;{}PROC filialdaten verzeichnis:{} disable stop;{} THESAURUS VAR filialdaten ::{} - ohne praefix (infix namen (ALL myself, praefix, filialdatentyp), praefix);{} forget ("Verzeichnis der Filialdaten-Dateien", quiet);{} FILE VAR f ::{} sequential file (output, "Verzeichnis der Filialdaten-Dateien");{} f FILLBY filialdaten;{} modify (f);{} to line (f, 1); insert record (f);{} menufootnote ("Verlassen: ");{} cursor on;{} show (w, f);{} cursor off;{} forget ("Verzeichnis der Filialdaten-Dateien", quiet);{} IF is error{} THEN regenerate menuscreen;{} out (""7"");{} - menuinfo (" " + invers ("FEHLER: " + errormessage));{} clear error{} ELSE menu bildschirm{} FI;{} enable stop{}END PROC filialdaten verzeichnis;{}PROC warenhausprogramme verzeichnis:{} disable stop;{} forget ("Verzeichnis der Programme", quiet);{} THESAURUS VAR programme ::{} ALL myself - infix namen (ALL myself, praefix, filialdatentyp);{} IF exists ("WARENHAUS:Rechnung"){} THEN programme := programme - "WARENHAUS:Rechnung"{} FI;{} FILE VAR f ::{} sequential file (output, "Verzeichnis der Programme");{} - f FILLBY programme;{} modify (f);{} to line (f, 1); insert record (f);{} menufootnote ("Verlassen: ");{} cursor on;{} show (w, f);{} cursor off;{} forget ("Verzeichnis der Programme", quiet);{} IF is error{} THEN regenerate menuscreen;{} out (""7"");{} menuinfo (" " + invers ("FEHLER: " + errormessage));{} clear error{} ELSE menu bildschirm{} FI;{} enable stop{}END PROC warenhausprogramme verzeichnis;{}PROC filialdaten zusammenstellen:{} hole filialdatenname;{} - kontrolliere den filialdatennamen;{} disable stop;{} sichere filialdaten (praefix + filialdatenname);{} IF is error{} THEN out (""7"");{} menuinfo (" " + invers ("FEHLER: " + errormessage));{} clear error{} ELSE bestaetige{} FI;{} enable stop.{} hole filialdatenname:{} filialdatenname := menuanswer (ausgabe, filialdatenname, 5).{} ausgabe:{} center (maxlaenge, invers ("Filialdaten zusammenstellen")) + ""13""13""{} + " Bitte den Namen für die Filialdaten "13""13"".{} - kontrolliere den filialdatennamen:{} IF filialdatenname = niltext{} THEN enable stop; LEAVE filialdaten zusammenstellen{} ELIF length (filialdatenname) > maxnamenslaenge{} THEN meckere zu langen namen an;{} filialdatenname := niltext;{} enable stop; LEAVE filialdaten zusammenstellen{} ELIF exists (praefix + filialdatenname){} THEN meckere existierenden filialdatennamen an;{} enable stop; LEAVE filialdaten zusammenstellen{} - FI.{} bestaetige:{} menuinfo (" "15"Bestätigung "14" "13""13"" +{} " Die Filialdaten wurden von der "13"" +{} " Verwaltung unter dem gewünschten "13"" +{} " Namen zusammengestellt. "13"" , 3).{}END PROC filialdaten zusammenstellen;{}PROC warenhausprogramm neu erstellen:{} hole programmname;{} kontrolliere den programmnamen;{} command dialogue (FALSE);{} cursor on;{} disable stop;{} stdinfoedit (programmname, 3);{} - cursor off;{} command dialogue (TRUE);{} IF is error{} THEN regenerate menuscreen;{} out (""7"");{} menuinfo (" " + invers (errormessage));{} clear error{} ELSE menu bildschirm{} FI;{} enable stop.{} hole programmname:{} programmname := "";{} programmname := menuanswer (ausgabe, programmname, 5).{} ausgabe:{} center (maxlaenge, invers ("Programm neu erstellen")) + ""13""13""{} + " Bitte den Namen für das Programm "13""13"".{} kontrolliere den programmnamen:{} - IF programmname = niltext{} THEN LEAVE warenhausprogramm neu erstellen{} ELIF length (programmname) > maxnamenslaenge{} THEN meckere zu langen namen an;{} programmname := niltext;{} LEAVE warenhausprogramm neu erstellen{} ELIF exists (programmname){} THEN meckere existierendes programm an;{} LEAVE warenhausprogramm neu erstellen{} FI.{}END PROC warenhausprogramm neu erstellen;{}PROC warenhausprogramm ansehen:{} IF programmname <> niltext CAND exists (programmname){} - THEN frage nach diesem programm{} ELSE lasse programm auswaehlen{} FI;{} cursor on;{} disable stop;{} stdinfoedit (programmname, 3);{} cursor off;{} IF is error{} THEN regenerate menuscreen;{} out (""7"");{} menuinfo (" " + invers ("FEHLER: " + errormessage));{} clear error{} ELSE menu bildschirm{} FI;{} enable stop.{} frage nach diesem programm:{} IF menuno (ueberschrift + " Zuletzt bearbeitetes Programm: " + name{} + " Soll mit diesem Programm gearbeitet werden", 5){} - THEN lasse programm auswaehlen{} FI.{} ueberschrift:{} center (maxlaenge, invers ("Programm ansehen/ändern")) + ""13""13"".{} name:{} ""13""13" " + invers (programmname) + ""13""13"".{} lasse programm auswaehlen:{} THESAURUS VAR verfuegbare ::{} ALL myself - infix namen (ALL myself, praefix, filialdatentyp);{} IF exists ("WARENHAUS:Rechnung"){} THEN verfuegbare := verfuegbare - "WARENHAUS:Rechnung"{} FI;{} IF NOT not empty (verfuegbare){} THEN noch kein programm;{} - LEAVE warenhausprogramm ansehen{} ELSE biete auswahl an{} FI.{} biete auswahl an:{} programmname := menuone (verfuegbare, "Programm ansehen/ändern",{} "Bitte das gewünschte Programm ankreuzen!",{} FALSE);{} IF programmname = niltext{} THEN menu bildschirm;{} LEAVE warenhausprogramm ansehen{} FI.{}END PROC warenhausprogramm ansehen;{}PROC filialdaten eintragen:{} lasse filialdaten auswaehlen;{} - trage filialdaten ein;{} menu bildschirm.{} lasse filialdaten auswaehlen:{} THESAURUS VAR verfuegbare ::{} ohne praefix (infix namen (ALL myself,praefix,filialdatentyp),praefix);{} IF NOT not empty (verfuegbare){} THEN noch keine filialdaten;{} LEAVE filialdaten eintragen{} ELSE biete auswahl an{} FI.{} biete auswahl an:{} verfuegbare := menusome (verfuegbare, bezeichnung,{} "Bitte die Filialdaten ankreuzen, die eingetragen werden sollen!", FALSE).{} trage filialdaten ein:{} - show menuwindow;{} steige ggf bei leerem thesaurus aus;{} menuwindowout (menuwindowcenter (invers (bezeichnung)));{} menuwindowline (2);{} command dialogue (FALSE);{} fuehre einzelne operationen aus;{} command dialogue (TRUE);{} schlage ggf neue seite auf;{} menuwindowout (schlussbemerkung);{} menuwindowstop.{} bezeichnung:{} "Filialdaten eintragen/ergänzen".{} schlussbemerkung:{} " Alle ausgewählten Filialdaten wurden eingetragen!".{} fuehre einzelne operationen aus:{} - INT VAR k;{} FOR k FROM 1 UPTO highest entry (verfuegbare) REP{} IF name (verfuegbare, k) <> ""{} THEN disable stop;{} menuwindowout ( " Filialdaten """ + name (verfuegbare, k){} + """ werden eingetragen!");{} menuwindowline;{} lade filialdaten (praefix + name (verfuegbare, k));{} fehlerbehandlung{} FI{} PER.{} steige ggf bei leerem thesaurus aus:{} IF NOT not empty (verfuegbare){} - THEN menuwindowline (2);{} menuwindowout (" Es wurde keine Filialdaten-Datei ausgewählt!");{} menuwindowstop;{} menu bildschirm;{} LEAVE filialdaten eintragen{} FI.{} schlage ggf neue seite auf:{} IF remaining menuwindowlines < 7{} THEN menuwindowpage; menuwindowline{} ELSE menuwindowline (2){} FI.{} fehlerbehandlung:{} IF is error{} THEN regenerate menuscreen; out (""7"");{} menuinfo (" " + invers (errormessage));{} - clear error; enable stop;{} LEAVE filialdaten eintragen{} ELSE enable stop{} FI.{}END PROC filialdaten eintragen;{}PROC warenhausprogramme drucken:{} lasse programme auswaehlen;{} drucke programme;{} menu bildschirm.{} lasse programme auswaehlen:{} THESAURUS VAR verfuegbare ::{} ALL myself - infix namen (ALL myself, praefix, filialdatentyp);{} IF exists ("WARENHAUS:Rechnung"){} THEN verfuegbare := verfuegbare - "WARENHAUS:Rechnung"{} FI;{} IF NOT not empty (verfuegbare){} - THEN noch kein programm;{} LEAVE warenhausprogramme drucken{} ELSE biete auswahl an{} FI.{} biete auswahl an:{} verfuegbare := menusome (verfuegbare, "Programme drucken",{} "Bitte die Programme ankreuzen, die gedruckt werden sollen!",{} FALSE).{} drucke programme:{} show menuwindow;{} steige ggf bei leerem thesaurus aus;{} menuwindowout (menuwindowcenter (invers ("Programme drucken")));{} menuwindowline (2);{} command dialogue (FALSE);{} - fuehre einzelne operationen aus;{} command dialogue (TRUE);{} schlage ggf neue seite auf;{} menuwindowout (" Alle ausgewählten Programme wurden gedruckt!");{} menuwindowstop.{} fuehre einzelne operationen aus:{} INT VAR k;{} FOR k FROM 1 UPTO highest entry (verfuegbare) REP{} IF name (verfuegbare, k) <> ""{} THEN disable stop;{} menuwindowout ( " """ + name (verfuegbare, k) +{} """ wird gedruckt!");{} menuwindowline;{} - print (name (verfuegbare, k));{} fehlerbehandlung{} FI{} PER.{} steige ggf bei leerem thesaurus aus:{} IF NOT not empty (verfuegbare){} THEN menuwindowline (2);{} menuwindowout (" Es wurde kein Programm ausgewählt!");{} menuwindowstop;{} menu bildschirm;{} LEAVE warenhausprogramme drucken{} FI.{} schlage ggf neue seite auf:{} IF remaining menuwindowlines < 7{} THEN menuwindowpage; menuwindowline{} - ELSE menuwindowline (2){} FI.{} fehlerbehandlung:{} IF is error{} THEN regenerate menuscreen; out (""7"");{} menuinfo (" " + invers (errormessage));{} clear error; enable stop;{} LEAVE warenhausprogramme drucken{} ELSE enable stop{} FI.{}END PROC warenhausprogramme drucken;{}PROC warenhausprogramm kopieren:{} ermittle alten programmnamen;{} erfrage neuen programmnamen;{} kopiere ggf das programm.{} ermittle alten programmnamen:{} IF NOT not empty (bestand){} - THEN noch kein programm;{} LEAVE warenhausprogramm kopieren{} ELSE biete auswahl an{} FI.{} biete auswahl an:{} TEXT VAR alter name := menuone ( bestand, "Programm kopieren",{} "Bitte das Programm ankreuzen, das kopiert werden soll!",FALSE);{} menu bildschirm;{} IF alter name = niltext{} THEN LEAVE warenhausprogramm kopieren{} FI.{} bestand:{} ALL myself - infix namen (ALL myself, praefix, filialdatentyp){} - "WARENHAUS:Rechnung".{} - erfrage neuen programmnamen:{} TEXT VAR neuer name :: menuanswer (ausgabe, alter name, 5).{} ausgabe:{} ueberschrift + " Name des 'alten' Programms: " + bisheriger name{} + " Bitte den Namen für die Kopie: ".{} ueberschrift:{} center (maxlaenge, invers ("Programm kopieren")) + ""13""13"".{} bisheriger name:{} ""13""13" " + invers (alter name) + ""13""13"".{} kopiere ggf das programm:{} IF neuer name = niltext{} THEN menuinfo (" " + invers ("Der gewünschte Name ist unzulässig!"));{} - LEAVE warenhausprogramm kopieren{} ELIF exists (neuer name){} THEN mache vorwurf;{} LEAVE warenhausprogramm kopieren{} ELSE copy (alter name, neuer name){} FI.{} mache vorwurf:{} menuinfo (" " + invers ("Ein Programm mit diesem Namen gibt es bereits!")).{}END PROC warenhausprogramm kopieren;{}PROC filialdaten umbenennen:{} ermittle alten filialdatennamen;{} erfrage neuen filialdatennamen;{} benenne ggf die filialdaten um.{} ermittle alten filialdatennamen:{} - IF NOT not empty (bestand){} THEN noch keine filialdaten;{} LEAVE filialdaten umbenennen{} ELSE biete auswahl an{} FI.{} biete auswahl an:{} TEXT VAR alter name := menuone ( bestand, text1, text2, FALSE);{} menu bildschirm;{} IF alter name = niltext{} THEN LEAVE filialdaten umbenennen{} FI.{} bestand:{} ohne praefix (infix namen (ALL myself, praefix, filialdatentyp), praefix).{} text1: "Filialdaten umbenennen".{} text2:{} "Bitte die Filialdaten-Datei ankreuzen, die umbenannt werden soll!" .{} - erfrage neuen filialdatennamen:{} TEXT VAR neuer name :: menuanswer (ausgabe, alter name, 5).{} ausgabe:{} ueberschrift + hinweis auf alt + bisheriger name + aufforderung.{} ueberschrift:{} center (maxlaenge, invers ("Filialdaten umbenennen")) + ""13""13"".{} hinweis auf alt:{} " Bisheriger Filialdaten-Name: ".{} bisheriger name:{} ""13""13" " + invers (alter name) + ""13""13"".{} aufforderung:{} " Zukünftiger Filialdaten-Name: ".{} benenne ggf die filialdaten um:{} IF neuer name = niltext{} - THEN menuinfo (" " + invers ("Der gewünschte Name ist unzulässig!"));{} LEAVE filialdaten umbenennen{} ELIF exists (praefix + neuer name){} THEN menuinfo (" " + invers("Filialdaten mit diesem Namen gibt es bereits!"));{} LEAVE filialdaten umbenennen{} ELSE rename (praefix + alter name, praefix + neuer name);{} filialdatenname := neuer name{} FI.{}END PROC filialdaten umbenennen;{}PROC warenhausprogramm umbenennen:{} ermittle alten programmnamen;{} - erfrage neuen programmnamen;{} benenne ggf das programm um.{} ermittle alten programmnamen:{} IF NOT not empty (bestand){} THEN noch kein programm;{} LEAVE warenhausprogramm umbenennen{} ELSE biete auswahl an{} FI.{} biete auswahl an:{} TEXT VAR alter name := menuone ( bestand, "Programm umbenennen",{} "Bitte das Programm ankreuzen, das umbenannt werden soll!", FALSE);{} menu bildschirm;{} IF alter name = niltext{} THEN LEAVE warenhausprogramm umbenennen{} - FI.{} bestand:{} ALL myself - infix namen (ALL myself, praefix, filialdatentyp){} - "WARENHAUS:Rechnung".{} erfrage neuen programmnamen:{} TEXT VAR neuer name :: menuanswer (ausgabe, alter name, 5).{} ausgabe:{} ueberschrift + " Bisheriger Programmname: " + bisheriger name{} + " Zukünftiger Programmname: ".{} ueberschrift:{} center (maxlaenge, invers ("Programm umbenennen")) + ""13""13"".{} bisheriger name:{} ""13""13" " + invers (alter name) + ""13""13"".{} - benenne ggf das programm um:{} IF neuer name = niltext{} THEN menuinfo (" " + invers ("Der gewünschte Name ist unzulässig!"));{} LEAVE warenhausprogramm umbenennen{} ELIF exists (neuer name){} THEN mache vorwurf;{} LEAVE warenhausprogramm umbenennen{} ELSE rename (alter name, neuer name);{} programmname := neuer name{} FI.{} mache vorwurf:{} menuinfo (" " + invers ("Ein Programm mit diesem Namen gibt es bereits!")).{}END PROC warenhausprogramm umbenennen;{} -PROC filialdaten loeschen:{} lasse filialdaten auswaehlen;{} loesche filialdaten;{} menu bildschirm.{} lasse filialdaten auswaehlen:{} THESAURUS VAR verfuegbare ::{} ohne praefix (infix namen (ALL myself, praefix, filialdatentyp), praefix);{} IF NOT not empty (verfuegbare){} THEN noch keine filialdaten;{} LEAVE filialdaten loeschen{} ELSE biete auswahl an{} FI.{} biete auswahl an:{} verfuegbare := menusome (verfuegbare, "Filialdaten-Dateien löschen",{} "Bitte alle Dateien ankreuzen, die gelöscht werden sollen!", FALSE).{} - loesche filialdaten:{} show menuwindow;{} steige ggf bei leerem thesaurus aus;{} menuwindowout (menuwindowcenter (invers ("Filialdaten-Dateien löschen")));{} menuwindowline (2);{} command dialogue (FALSE);{} fuehre einzelne operationen aus;{} command dialogue (TRUE);{} schlage ggf neue seite auf;{} menuwindowout (" Alle ausgewählten Dateien wurden gelöscht!");{} menuwindowstop.{} fuehre einzelne operationen aus:{} INT VAR k;{} FOR k FROM 1 UPTO highest entry (verfuegbare) REP{} - IF name (verfuegbare, k) <> ""{} THEN disable stop;{} IF menuwindowyes (" """ + name (verfuegbare, k){} + """ löschen"){} THEN forget (praefix + name (verfuegbare, k), quiet){} FI;{} fehlerbehandlung{} FI{} PER;{} filialdatenname := "".{} steige ggf bei leerem thesaurus aus:{} IF NOT not empty (verfuegbare){} THEN menuwindowline (2);{} menuwindowout (" Es wurde keine Filialdaten-Datei ausgewählt!");{} - menuwindowstop;{} menu bildschirm;{} LEAVE filialdaten loeschen{} FI.{} schlage ggf neue seite auf:{} IF remaining menuwindowlines < 7{} THEN menuwindowpage; menuwindowline{} ELSE menuwindowline (2){} FI.{} fehlerbehandlung:{} IF is error{} THEN regenerate menuscreen;{} menuinfo (" " + invers (errormessage));{} clear error; enable stop;{} LEAVE filialdaten loeschen{} ELSE enable stop{} FI.{} -END PROC filialdaten loeschen;{}PROC warenhausprogramme loeschen:{} lasse programme auswaehlen;{} loesche programme;{} menu bildschirm.{} lasse programme auswaehlen:{} THESAURUS VAR verfuegbare ::{} ALL myself - infix namen (ALL myself, praefix, filialdatentyp);{} IF exists ("WARENHAUS:Rechnung"){} THEN verfuegbare := verfuegbare - "WARENHAUS:Rechnung"{} FI;{} IF NOT not empty (verfuegbare){} THEN noch kein programm;{} LEAVE warenhausprogramme loeschen{} - ELSE biete auswahl an{} FI.{} biete auswahl an:{} verfuegbare := menusome (verfuegbare, "Programm löschen",{} "Bitte alle Programme ankreuzen, die gelöscht werden sollen!", FALSE).{} loesche programme:{} show menuwindow;{} steige ggf bei leerem thesaurus aus;{} menuwindowout (menuwindowcenter (invers ("Programme löschen")));{} menuwindowline (2);{} command dialogue (FALSE);{} fuehre einzelne operationen aus;{} command dialogue (TRUE);{} schlage ggf neue seite auf;{} - menuwindowout (" Alle ausgewählten Programme wurden gelöscht!");{} menuwindowstop.{} fuehre einzelne operationen aus:{} INT VAR k;{} FOR k FROM 1 UPTO highest entry (verfuegbare) REP{} IF name (verfuegbare, k) <> ""{} THEN disable stop;{} IF menuwindowyes (" """ + name (verfuegbare, k) + """ löschen"){} THEN forget (name (verfuegbare, k), quiet){} FI;{} fehlerbehandlung{} FI{} PER;{} programmname := "".{} - steige ggf bei leerem thesaurus aus:{} IF NOT not empty (verfuegbare){} THEN menuwindowline (2);{} menuwindowout (" Es wurde kein Programm ausgewählt!");{} menuwindowstop;{} menu bildschirm;{} LEAVE warenhausprogramme loeschen{} FI.{} schlage ggf neue seite auf:{} IF remaining menuwindowlines < 7{} THEN menuwindowpage; menuwindowline{} ELSE menuwindowline (2){} FI.{} fehlerbehandlung:{} IF is error{} THEN regenerate menuscreen; out (""7"");{} - menuinfo (" " + invers (errormessage));{} clear error; enable stop;{} LEAVE warenhausprogramme loeschen{} ELSE enable stop{} FI.{}END PROC warenhausprogramme loeschen;{}PROC warenhausprogramm starten:{} IF grin version{} THEN warenhausprogramm uebersetzen und starten{} ELSE warenhausprogramm direkt starten{} FI{}END PROC warenhausprogramm starten;{}PROC warenhausprogramm direkt starten:{} programmname ermitteln;{} bildschirm neu eingesetzt := FALSE;{} - untersuche programmdatei auf bildschirm neu;{} cursor w3 1 1;{} cursor (1, 24); out(""5"Das Programm wird übersetzt. Zeilen-Nr.: ");{} cursor on;{} check on;{} warnings off;{} disable stop;{} run (programmname);{} noch kein programm gelaufen := FALSE;{} IF bildschirm neu eingesetzt{} THEN entferne befehl aus programmdatei{} FI;{} cursor off;{} fehlerbehandlung;{} cursor (2,23); out ((40 * waagerecht) + balken unten + (36 * waagerecht));{} cursor (2,24);{} out ("Das Programm ist beendet. " +{} - "Zum Weitermachen bitte irgendeine Taste tippen!");{} pause;{} regenerate menuscreen.{} fehlerbehandlung:{} IF is error{} THEN fehler ggf melden{} ELSE enable stop{} FI.{} fehler ggf melden:{} IF errormessage = ""{} THEN regenerate menuscreen{} ELSE fehler melden{} FI;{} clear error; enable stop;{} LEAVE warenhausprogramm direkt starten.{} fehler melden:{} out (""7"");{} IF errorcode = 1 OR errorcode = 1951{} THEN regenerate menuscreen;{} - menuinfo (" " + invers (errormessage)){} ELSE programm mit fehler zeigen;{} regenerate menuscreen{} FI.{} programmname ermitteln:{} IF programmname <> niltext CAND exists (programmname){} THEN frage nach diesem programm{} ELSE lasse programm auswaehlen{} FI.{} frage nach diesem programm:{} IF menuno (ueberschrift + " Zuletzt bearbeitetes Programm: " +{} name + " Soll mit diesem Programm gearbeitet werden", 5){} THEN lasse programm auswaehlen{} - FI.{} ueberschrift:{} center (maxlaenge, invers ("Programm starten")) + ""13""13"".{} name:{} ""13""13" " + invers (programmname) + ""13""13"".{} lasse programm auswaehlen:{} THESAURUS VAR verfuegbare ::{} ALL myself - infix namen (ALL myself, praefix, filialdatentyp);{} IF exists ("WARENHAUS:Rechnung"){} THEN verfuegbare := verfuegbare - "WARENHAUS:Rechnung"{} FI;{} IF NOT not empty (verfuegbare){} THEN noch kein programm;{} LEAVE warenhausprogramm direkt starten{} - ELSE biete auswahl an{} FI.{} biete auswahl an:{} programmname := menuone (verfuegbare, "Programm starten",{} "Bitte das gewünschte Programm ankreuzen!", FALSE);{} menubildschirm;{} menufootnote ("");{} IF programmname = niltext{} THEN LEAVE warenhaus programm direkt starten{} FI.{} untersuche programmdatei auf bildschirm neu:{} FILE VAR a :: sequential file (modify, programmname);{} TEXT VAR zeile;{} to line (a, 1);{} REP{} read record (a, zeile);{} - IF NOT eof (a) THEN down (a) FI{} UNTIL zeile <> "" OR eof (a) PER;{} change all (zeile, " ", "");{} IF pos (zeile, "bildschirmneu") = 0{} THEN setze befehl in datei ein{} FI.{} setze befehl in datei ein:{} to line (a, 1);{} zeile := "bildschirm neu; (* ergänzt *)";{} insert record (a);{} write record (a, zeile);{} bildschirm neu eingesetzt := TRUE.{} entferne befehl aus programmdatei:{} FILE VAR b :: sequential file (modify, programmname);{} to line (b, 1);{} - REP{} read record (b, zeile);{} IF NOT eof (b) THEN down (b) FI{} UNTIL zeile <> "" OR eof (b) PER;{} change all (zeile, " ", "");{} IF pos (zeile, "bildschirmneu;(*ergänzt*)") > 0{} THEN up (b); delete record (b){} FI.{}END PROC warenhausprogramm direkt starten;{}PROC warenhausprogramm uebersetzen und starten:{} programmname ermitteln;{} cursor w3 1 1;{} cursor (1, 24); out(""5"Das Programm wird übersetzt. Zeilen-Nr.: ");{} cursor on;{} disable stop;{} uebersetze (programmname);{} - IF NOT is error{} THEN check on;{} warnings off;{} run ("elanprogramm");{} noch kein programm gelaufen := FALSE{} FI;{} forget ("elanprogramm", quiet);{} cursor off;{} fehlerbehandlung;{} cursor (2,23); out ((40 * waagerecht) + balken unten + (36 * waagerecht));{} cursor (2,24);{} out ("Das Programm ist beendet. " +{} "Zum Weitermachen bitte irgendeine Taste tippen!");{} pause;{} regenerate menuscreen.{} fehlerbehandlung:{} IF is error{} THEN fehler ggf melden{} - ELSE enable stop{} FI.{} fehler ggf melden:{} IF errormessage = ""{} THEN regenerate menuscreen{} ELSE fehler melden{} FI;{} clear error; enable stop;{} LEAVE warenhausprogramm uebersetzen und starten.{} fehler melden:{} out (""7"");{} IF errorcode = 1 OR errorcode = 1951{} THEN regenerate menuscreen;{} menuinfo (" " + invers (errormessage)){} ELSE programm mit fehler zeigen ;{} regenerate menuscreen{} FI.{} programmname ermitteln:{} - IF programmname <> niltext CAND exists (programmname){} THEN frage nach diesem programm{} ELSE lasse programm auswaehlen{} FI.{} frage nach diesem programm:{} IF menuno (ueberschrift + " Zuletzt bearbeitetes Programm: " +{} name + " Soll mit diesem Programm gearbeitet werden", 5){} THEN lasse programm auswaehlen{} FI.{} ueberschrift:{} center (maxlaenge, invers ("Programm starten")) + ""13""13"".{} name:{} ""13""13" " + invers (programmname) + ""13""13"".{} - lasse programm auswaehlen:{} THESAURUS VAR verfuegbare ::{} ALL myself - infix namen (ALL myself, praefix, filialdatentyp);{} IF exists ("WARENHAUS:Rechnung"){} THEN verfuegbare := verfuegbare - "WARENHAUS:Rechnung"{} FI;{} IF NOT not empty (verfuegbare){} THEN noch kein programm;{} LEAVE warenhausprogramm uebersetzen und starten{} ELSE biete auswahl an{} FI.{} biete auswahl an:{} programmname := menuone (verfuegbare, "Programm starten",{} - "Bitte das gewünschte Programm ankreuzen!", FALSE);{} menubildschirm;{} menufootnote ("");{} IF programmname = niltext{} THEN LEAVE warenhaus programm uebersetzen und starten{} FI.{}END PROC warenhausprogramm uebersetzen und starten;{}PROC programm mit fehler zeigen:{} IF exists (programmname){} THEN noteline;{} note (fehlermeldung mit zeilennummer);{} INT VAR i; FOR i FROM 1 UPTO 9 REP noteline PER;{} note (invers ("Verlassen: "));{} - FILE VAR f :: sequential file (modify, programmname);{} to line (f, max (1, fehlerzeile));{} col (1);{} clear error;{} cursor on;{} noteedit (f);{} cursor off{} ELSE menuinfo (invers (fehlermeldung mit zeilennummer)){} FI{}END PROC programm mit fehler zeigen;{}PROC warenhausprogramm wiederholen:{} cursor on;{} disable stop;{} IF noch kein programm gelaufen{} THEN errorstop ("'run again' nicht moeglich"){} ELSE runagain{} FI;{} - cursor off;{} fehlerbehandlung;{} cursor (2,23); out ((40 * waagerecht) + balken unten + (36 * waagerecht));{} cursor (2,24);{} out ("Das Programm ist beendet. " +{} "Zum Weitermachen bitte irgendeine Taste tippen!");{} pause;{} regenerate menuscreen.{}fehlerbehandlung:{} IF is error{} THEN regenerate menuscreen;{} fehler melden;{} clear error; enable stop;{} LEAVE warenhausprogramm wiederholen{} ELSE enable stop{} FI.{} fehler melden:{} - out (""7"");{} IF errorcode = 1 OR errorcode = 1951{} THEN menuinfo (" " + invers (errormessage)){} ELIF errormessage = "'run again' nicht moeglich"{} THEN menuinfo (" " + invers ("Wiederholung nicht möglich!")){} ELSE menuinfo (" " + invers (fehlermeldung mit zeilennummer)){} FI{}END PROC warenhausprogramm wiederholen;{}TEXT PROC fehlermeldung mit zeilennummer:{} TEXT VAR meldung :: "FEHLER: " + errormessage;{} fuege ggf fehlerzeile an;{} IF length (meldung) < 70{} - THEN meldung{} ELSE subtext (meldung, 1, 69){} FI.{} fuege ggf fehlerzeile an:{} fehlerzeile := errorline;{} IF errorline < 1{} THEN LEAVE fuege ggf fehlerzeile an{} ELIF bildschirm neu eingesetzt{} THEN meldung CAT " (bei Zeile " + text (errorline - 1) + ")"{} ELSE meldung CAT " (bei Zeile " + text (errorline) + ")"{} FI.{}END PROC fehlermeldung mit zeilennummer;{}PROC meckere zu langen namen an:{} menuinfo (" " + invers ("Hier dürfen Namen höchstens "{} - + text (max namenslaenge){} + " Zeichen lang sein!")){}END PROC meckere zu langen namen an;{}PROC meckere existierenden filialdatennamen an:{} menuinfo (" " + invers ("Filialdaten mit diesem Namen gibt es bereits!")){}END PROC meckere existierenden filialdatennamen an;{}PROC meckere existierendes programm an:{} menuinfo (" " + invers ("Ein Programm mit diesem Namen gibt es bereits!")){}END PROC meckere existierendes programm an;{}PROC noch keine filialdaten:{} menuinfo (" " + invers ("Es existiert noch keine Filialdaten-Datei!")){} -END PROC noch keine filialdaten;{}PROC noch kein programm:{} menuinfo (" " + invers ("Es existiert noch kein Programm!")){}END PROC noch kein programm;{}PROC menu bildschirm:{} cursor (1, 2);{} out (5 * waagerecht);{} cursor (1, 3);{} out (""4"");{} cursor (1, 23);{} out (79 * waagerecht);{} refresh submenu{}END PROC menu bildschirm{}END PACKET ls warenhaus 5{} + warenhaus, + grin, + direktbefehl 1, + direktbefehl 2, + direktbefehl 3, + direktbefehl 4, + direktbefehl 5, + direktbefehl 6, + direktbefehl 7, + warenhausbefehle zeigen, + eingabe grundeinstellung, + tastatur einstellen, + kartenleser einstellen, + evtl d und b sperren, + loesche zwischenraum, + eingabeart anzeigen, + filialdaten zusammenstellen, + filialdaten eintragen, + filialdaten verzeichnis, + + filialdaten umbenennen, + filialdaten loeschen, + warenhausprogramme verzeichnis, + warenhausprogramm neu erstellen, + warenhausprogramm ansehen, + warenhausprogramm kopieren, + warenhausprogramm umbenennen, + warenhausprogramme loeschen, + warenhausprogramme drucken, + warenhausprogramm starten, + warenhausprogramm wiederholen: +LET menukarte = "ls-MENUKARTE:Warenhaus", + praefix = "Filialdaten:", + filialdatentyp = 1951, + + niltext = "", + maxlaenge = 45, + maxnamenslaenge = 35; +TEXT VAR filialdatenname :: "", + programmname :: ""; +INT VAR fehlerzeile :: 0; +BOOL VAR grin version :: FALSE, + noch kein programm gelaufen :: TRUE, + bildschirm neu eingesetzt :: FALSE; +WINDOW VAR w :: window (1, 3, 79, 19); +INITFLAG VAR in this task :: FALSE; +PROC warenhausbefehle zeigen: + TEXT VAR info, liste, tasten; + INT VAR grinoffset; + + IF grin version + THEN grinbefehle + ELSE elanbefehle + FI; + REP + INT VAR auswahl := menualternative (info, liste, tasten, 5, FALSE); + SELECT auswahl OF + CASE 1, 101, 105 : menuinfo (anwendungstext (1 + grinoffset)) + CASE 2, 102, 106 : menuinfo (anwendungstext (2 + grinoffset)) + CASE 3, 103, 107 : menuinfo (anwendungstext (3 + grinoffset)) + END SELECT + UNTIL auswahl = 4 OR auswahl = 104 OR auswahl = 108 PER. + grinbefehle: + grinoffset := 13; + info := " "15"Info zu den Programmierbefehlen "14""13""13"" + + + " d Datei - Bearbeitung "13"" + + " e Einkaufen und Auskunft "13"" + + " k Kontroll - Strukturen "13""13"" + + " z Zurück zum Hauptmenü "; + liste := "Datei"13"Kaufen/Auskunft"13"Kontroll"13"Zurück"; + tasten := "dekzDEKZ". + elanbefehle: + grinoffset := 0; + info := " "15"Info zu den Programmierbefehlen "14""13""13"" + + " d Datei - Bearbeitung "13"" + + + " e Einkaufen und Auskunft "13"" + + " s Sonstige Befehle "13""13"" + + " z Zurück zum Hauptmenü "; + liste := "Datei"13"Kaufen/Auskunft"13"Sonstige"13"Zurück"; + tasten := "deszDESZ". +END PROC warenhausbefehle zeigen; +PROC eingabe grundeinstellung: + INT VAR dummy; + IF eingabe mit codekartenleser + THEN tastatureingabe (TRUE, dummy) + FI +END PROC eingabe grundeinstellung; +PROC tastatur einstellen: + + eingabe grundeinstellung; + menuinfo (anwendungstext (6), 4) +END PROC tastatur einstellen; +PROC kartenleser einstellen: + INT VAR ergebnis; + IF eingabe mit codekartenleser + THEN tastatureingabe (TRUE, ergebnis) + FI; + pause (10); + tastatureingabe (FALSE, ergebnis); + IF ergebnis < 0 + THEN menuinfo (anwendungstext (7 - ergebnis), 5) + ELSE menuinfo (anwendungstext (7), 4) + FI +END PROC kartenleser einstellen; +PROC loesche zwischenraum: + INT VAR zeile; + cursor (1, 2); out (79 * waagerecht + " "); + + FOR zeile FROM 3 UPTO 22 REP + cursor (1, zeile); out (""5""); + PER; + cursor (1, 23); out (79 * waagerecht + " "); + cursor (1, 24); out (""5""); +END PROC loesche zwischenraum; +PROC ergaenze bildschirm: + cursor ( 1, 2); out (ecke oben links); + cursor (42, 2); out (balken oben); + cursor (80, 2); out (ecke oben rechts); + INT VAR zeile; + FOR zeile FROM 3 UPTO 22 REP + cursor ( 1, zeile); out (senkrecht); + cursor (42, zeile); out (senkrecht); + cursor (80, zeile); out (senkrecht) + + PER; + cursor ( 1, 23); out (ecke unten links); + cursor (42, 23); out (balken unten); + cursor (80, 23); out (ecke unten rechts); + cursor (42, 19); + out (balken links + (37 * waagerecht) + balken rechts); + cursor w3 1 1 +END PROC ergaenze bildschirm; +PROC zweite zeile: + cursor (1, 2); out (79 * waagerecht + " ") +END PROC zweite zeile; +PROC evtl d und b sperren: + IF eingabe mit codekartenleser + THEN activate ( 9); + activate (10) + ELSE deactivate ( 9); + deactivate (10) + + FI +END PROC evtl d und b sperren; +PROC direktbefehl 1: + disable stop; + warendatei bearbeiten; + cursor off; + IF is error + THEN regenerate menuscreen; + menuinfo (" " + invers (errormessage)); + clear error + ELSE zweite zeile; + menu bildschirm + FI; + enable stop +END PROC direktbefehl 1; +PROC warendatei bearbeiten: + enable stop; + loesche zwischenraum; + ergaenze bildschirm; + cursor (2, 24); out (invers ("Warendatei bearbeiten")); + REP artikelnummer lesen; + + IF NOT stoptaste gedrueckt + THEN artikeldaten eingeben + FI + UNTIL stoptaste gedrueckt PER +END PROC warendatei bearbeiten; +PROC direktbefehl 2: + disable stop; + kundendatei bearbeiten; + cursor off; + IF is error + THEN regenerate menuscreen; + menuinfo (" " + invers (errormessage)); + clear error + ELSE zweite zeile; + menu bildschirm + FI; + enable stop +END PROC direktbefehl 2; +PROC kundendatei bearbeiten: + enable stop; + loesche zwischenraum; + + ergaenze bildschirm; + cursor (2, 24); out (invers ("Kundendatei bearbeiten")); + REP kundennummer lesen; + IF NOT stoptaste gedrueckt + THEN kundendaten eingeben + FI + UNTIL stoptaste gedrueckt PER +END PROC kundendatei bearbeiten; +PROC direktbefehl 3: + disable stop; + einkaufen gehen; + cursor off; + IF is error + THEN regenerate menuscreen; + menuinfo (" " + invers (errormessage)); + clear error + ELSE zweite zeile; + menu bildschirm + + FI; + enable stop +END PROC direktbefehl 3; +PROC einkaufen gehen: + enable stop; + loesche zwischenraum; + ergaenze bildschirm; + cursor (2, 24); out (invers ("Einkaufen")); + forget ("WARENHAUS:Rechnung", quiet); + kundennummer lesen; + rechnungskopf; + REP einkaufen + UNTIL stoptaste gedrueckt PER; + abrechnung; + forget ("WARENHAUS:Rechnung", quiet). + einkaufen: + artikelnummer lesen; + IF NOT stoptaste gedrueckt + THEN artikel kaufen + FI. +END PROC einkaufen gehen; + +PROC direktbefehl 4: + disable stop; + auskunft einholen; + cursor off; + IF is error + THEN regenerate menuscreen; + menuinfo (" " + invers (errormessage)); + clear error + ELSE zweite zeile; + menu bildschirm + FI; + enable stop +END PROC direktbefehl 4; +PROC auskunft einholen: + enable stop; + loesche zwischenraum; + ergaenze bildschirm; + cursor (2, 24); out (invers ("Auskunft")); + auskunft +END PROC auskunft einholen; +PROC direktbefehl 5: + disable stop; + + ware nachbestellen; + cursor off; + IF is error + THEN regenerate menuscreen; + menuinfo (" " + invers (errormessage)); + clear error + ELSE zweite zeile; + menu bildschirm + FI; + enable stop +END PROC direktbefehl 5; +PROC ware nachbestellen: + enable stop; + loesche zwischenraum; + ergaenze bildschirm; + cursor (2, 24); out (invers ("Nachbestellen")); + nachbestellen +END PROC ware nachbestellen; +PROC direktbefehl 6: + disable stop; + dezimalwerte von interface lesen; + + cursor off; + IF is error + THEN regenerate menuscreen; + menuinfo (" " + invers (errormessage)); + clear error + ELSE zweite zeile; + menu bildschirm + FI; + enable stop +END PROC direktbefehl 6; +PROC dezimalwerte von interface lesen: + enable stop; + loesche zwischenraum; + ergaenze bildschirm; + cursor (2, 24); out (invers ("Dezimalwert lesen")); + dezimalwert lesen +END PROC dezimalwerte von interface lesen; +PROC direktbefehl 7: + disable stop; + + bitmuster von interface lesen; + cursor off; + IF is error + THEN regenerate menuscreen; + menuinfo (" " + invers (errormessage)); + clear error + ELSE zweite zeile; + menu bildschirm + FI; + enable stop +END PROC direktbefehl 7; +PROC bitmuster von interface lesen: + enable stop; + loesche zwischenraum; + ergaenze bildschirm; + cursor (2, 24); out (invers ("Bitmuster lesen")); + bitmuster lesen +END PROC bitmuster von interface lesen; +PROC eingabeart anzeigen: + + IF eingabe mit codekartenleser + THEN menuinfo (anwendungstext (7), 4) + ELSE menuinfo (anwendungstext (6), 4) + FI +END PROC eingabeart anzeigen; +PROC warenhaus: + BOOL VAR am ende loeschen :: TRUE; + pruefe zulaessigkeit; + installiere menukarte mit anfangsbild; + initialisiere warenhaus; + handle menu ("WARENHAUS"); + IF am ende loeschen + THEN sperre verwaltungstask; + end (task (verwaltung)) + FI. + installiere menukarte mit anfangsbild: + install menu (menukarte, TRUE); + + cursor off; + cursor (17, 20); + out (" W A R E N H A U S "); + cursor (21, 22); + out (invers("Filiale " + text (channel (myself)))); + cursor (79, 24); + pause (10). + sperre verwaltungstask: + DATASPACE VAR ds; + INT VAR dummy; + forget (ds); ds := nilspace; + call (task (verwaltung), 256, ds, dummy). + pruefe zulaessigkeit: + IF hauptstellenname = "" + THEN line; + putline ("Keine uebergeordnete Task ist 'warenhaus hauptstelle'!"); + end; LEAVE warenhaus + + ELIF name (myself) = hauptstellenname + THEN errorstop ("Dieser Befehl darf nur von Söhnen dieser " + + "Task aus gegeben werden!"); + LEAVE warenhaus + FI. + initialisiere warenhaus: + TEXT CONST verwaltung :: hauptstellenname + ".Filialverwaltung " + + text (channel (myself)); + IF NOT exists task (verwaltung) + THEN initialisiere verwaltung + ELSE biete evtl loeschen an + FI; + IF NOT initialized (in this task) + + THEN filialdatenname := ""; + programmname := "" + FI; + noch kein programm gelaufen := TRUE. + biete evtl loeschen an: + access catalogue; + IF NOT (father (task (verwaltung)) = myself) + THEN fehlermeldung; + line; + end; + am ende loeschen := FALSE + FI. + fehlermeldung: + cursor (1, 22); + putline ("Filiale " + text (channel (myself)) + + " ist bereits besetzt durch TASK '" + + name (father (task (verwaltung))) + "'!"); + + putline ("Es ist so kein geregelter Warenhaus-Betrieb moeglich!"). +END PROC warenhaus; +PROC grin (BOOL CONST entscheidung): + enable stop; + IF hauptstellenname = "" OR hauptstellenname = name (myself) + THEN grin version := entscheidung + ELSE errorstop ("Dieser Befehl darf nur von der Task '" + + hauptstellenname + "' aus gegeben werden!") + FI; + bildschirm neu eingesetzt := FALSE +END PROC grin; +PROC filialdaten verzeichnis: + disable stop; + THESAURUS VAR filialdaten :: + + ohne praefix (infix namen (ALL myself, praefix, filialdatentyp), praefix); + forget ("Verzeichnis der Filialdaten-Dateien", quiet); + FILE VAR f :: + sequential file (output, "Verzeichnis der Filialdaten-Dateien"); + f FILLBY filialdaten; + modify (f); + to line (f, 1); insert record (f); + menufootnote ("Verlassen: "); + cursor on; + show (w, f); + cursor off; + forget ("Verzeichnis der Filialdaten-Dateien", quiet); + IF is error + THEN regenerate menuscreen; + out (""7""); + + menuinfo (" " + invers ("FEHLER: " + errormessage)); + clear error + ELSE menu bildschirm + FI; + enable stop +END PROC filialdaten verzeichnis; +PROC warenhausprogramme verzeichnis: + disable stop; + forget ("Verzeichnis der Programme", quiet); + THESAURUS VAR programme :: + ALL myself - infix namen (ALL myself, praefix, filialdatentyp); + IF exists ("WARENHAUS:Rechnung") + THEN programme := programme - "WARENHAUS:Rechnung" + FI; + FILE VAR f :: + sequential file (output, "Verzeichnis der Programme"); + + f FILLBY programme; + modify (f); + to line (f, 1); insert record (f); + menufootnote ("Verlassen: "); + cursor on; + show (w, f); + cursor off; + forget ("Verzeichnis der Programme", quiet); + IF is error + THEN regenerate menuscreen; + out (""7""); + menuinfo (" " + invers ("FEHLER: " + errormessage)); + clear error + ELSE menu bildschirm + FI; + enable stop +END PROC warenhausprogramme verzeichnis; +PROC filialdaten zusammenstellen: + hole filialdatenname; + + kontrolliere den filialdatennamen; + disable stop; + sichere filialdaten (praefix + filialdatenname); + IF is error + THEN out (""7""); + menuinfo (" " + invers ("FEHLER: " + errormessage)); + clear error + ELSE bestaetige + FI; + enable stop. + hole filialdatenname: + filialdatenname := menuanswer (ausgabe, filialdatenname, 5). + ausgabe: + center (maxlaenge, invers ("Filialdaten zusammenstellen")) + ""13""13"" + + " Bitte den Namen für die Filialdaten "13""13"". + + kontrolliere den filialdatennamen: + IF filialdatenname = niltext + THEN enable stop; LEAVE filialdaten zusammenstellen + ELIF length (filialdatenname) > maxnamenslaenge + THEN meckere zu langen namen an; + filialdatenname := niltext; + enable stop; LEAVE filialdaten zusammenstellen + ELIF exists (praefix + filialdatenname) + THEN meckere existierenden filialdatennamen an; + enable stop; LEAVE filialdaten zusammenstellen + + FI. + bestaetige: + menuinfo (" "15"Bestätigung "14" "13""13"" + + " Die Filialdaten wurden von der "13"" + + " Verwaltung unter dem gewünschten "13"" + + " Namen zusammengestellt. "13"" , 3). +END PROC filialdaten zusammenstellen; +PROC warenhausprogramm neu erstellen: + hole programmname; + kontrolliere den programmnamen; + command dialogue (FALSE); + cursor on; + disable stop; + stdinfoedit (programmname, 3); + + cursor off; + command dialogue (TRUE); + IF is error + THEN regenerate menuscreen; + out (""7""); + menuinfo (" " + invers (errormessage)); + clear error + ELSE menu bildschirm + FI; + enable stop. + hole programmname: + programmname := ""; + programmname := menuanswer (ausgabe, programmname, 5). + ausgabe: + center (maxlaenge, invers ("Programm neu erstellen")) + ""13""13"" + + " Bitte den Namen für das Programm "13""13"". + kontrolliere den programmnamen: + + IF programmname = niltext + THEN LEAVE warenhausprogramm neu erstellen + ELIF length (programmname) > maxnamenslaenge + THEN meckere zu langen namen an; + programmname := niltext; + LEAVE warenhausprogramm neu erstellen + ELIF exists (programmname) + THEN meckere existierendes programm an; + LEAVE warenhausprogramm neu erstellen + FI. +END PROC warenhausprogramm neu erstellen; +PROC warenhausprogramm ansehen: + IF programmname <> niltext CAND exists (programmname) + + THEN frage nach diesem programm + ELSE lasse programm auswaehlen + FI; + cursor on; + disable stop; + stdinfoedit (programmname, 3); + cursor off; + IF is error + THEN regenerate menuscreen; + out (""7""); + menuinfo (" " + invers ("FEHLER: " + errormessage)); + clear error + ELSE menu bildschirm + FI; + enable stop. + frage nach diesem programm: + IF menuno (ueberschrift + " Zuletzt bearbeitetes Programm: " + name + + " Soll mit diesem Programm gearbeitet werden", 5) + + THEN lasse programm auswaehlen + FI. + ueberschrift: + center (maxlaenge, invers ("Programm ansehen/ändern")) + ""13""13"". + name: + ""13""13" " + invers (programmname) + ""13""13"". + lasse programm auswaehlen: + THESAURUS VAR verfuegbare :: + ALL myself - infix namen (ALL myself, praefix, filialdatentyp); + IF exists ("WARENHAUS:Rechnung") + THEN verfuegbare := verfuegbare - "WARENHAUS:Rechnung" + FI; + IF NOT not empty (verfuegbare) + THEN noch kein programm; + + LEAVE warenhausprogramm ansehen + ELSE biete auswahl an + FI. + biete auswahl an: + programmname := menuone (verfuegbare, "Programm ansehen/ändern", + "Bitte das gewünschte Programm ankreuzen!", + FALSE); + IF programmname = niltext + THEN menu bildschirm; + LEAVE warenhausprogramm ansehen + FI. +END PROC warenhausprogramm ansehen; +PROC filialdaten eintragen: + lasse filialdaten auswaehlen; + + trage filialdaten ein; + menu bildschirm. + lasse filialdaten auswaehlen: + THESAURUS VAR verfuegbare :: + ohne praefix (infix namen (ALL myself,praefix,filialdatentyp),praefix); + IF NOT not empty (verfuegbare) + THEN noch keine filialdaten; + LEAVE filialdaten eintragen + ELSE biete auswahl an + FI. + biete auswahl an: + verfuegbare := menusome (verfuegbare, bezeichnung, + "Bitte die Filialdaten ankreuzen, die eingetragen werden sollen!", FALSE). + trage filialdaten ein: + + show menuwindow; + steige ggf bei leerem thesaurus aus; + menuwindowout (menuwindowcenter (invers (bezeichnung))); + menuwindowline (2); + command dialogue (FALSE); + fuehre einzelne operationen aus; + command dialogue (TRUE); + schlage ggf neue seite auf; + menuwindowout (schlussbemerkung); + menuwindowstop. + bezeichnung: + "Filialdaten eintragen/ergänzen". + schlussbemerkung: + " Alle ausgewählten Filialdaten wurden eingetragen!". + fuehre einzelne operationen aus: + + INT VAR k; + FOR k FROM 1 UPTO highest entry (verfuegbare) REP + IF name (verfuegbare, k) <> "" + THEN disable stop; + menuwindowout ( " Filialdaten """ + name (verfuegbare, k) + + """ werden eingetragen!"); + menuwindowline; + lade filialdaten (praefix + name (verfuegbare, k)); + fehlerbehandlung + FI + PER. + steige ggf bei leerem thesaurus aus: + IF NOT not empty (verfuegbare) + + THEN menuwindowline (2); + menuwindowout (" Es wurde keine Filialdaten-Datei ausgewählt!"); + menuwindowstop; + menu bildschirm; + LEAVE filialdaten eintragen + FI. + schlage ggf neue seite auf: + IF remaining menuwindowlines < 7 + THEN menuwindowpage; menuwindowline + ELSE menuwindowline (2) + FI. + fehlerbehandlung: + IF is error + THEN regenerate menuscreen; out (""7""); + menuinfo (" " + invers (errormessage)); + + clear error; enable stop; + LEAVE filialdaten eintragen + ELSE enable stop + FI. +END PROC filialdaten eintragen; +PROC warenhausprogramme drucken: + lasse programme auswaehlen; + drucke programme; + menu bildschirm. + lasse programme auswaehlen: + THESAURUS VAR verfuegbare :: + ALL myself - infix namen (ALL myself, praefix, filialdatentyp); + IF exists ("WARENHAUS:Rechnung") + THEN verfuegbare := verfuegbare - "WARENHAUS:Rechnung" + FI; + IF NOT not empty (verfuegbare) + + THEN noch kein programm; + LEAVE warenhausprogramme drucken + ELSE biete auswahl an + FI. + biete auswahl an: + verfuegbare := menusome (verfuegbare, "Programme drucken", + "Bitte die Programme ankreuzen, die gedruckt werden sollen!", + FALSE). + drucke programme: + show menuwindow; + steige ggf bei leerem thesaurus aus; + menuwindowout (menuwindowcenter (invers ("Programme drucken"))); + menuwindowline (2); + command dialogue (FALSE); + + fuehre einzelne operationen aus; + command dialogue (TRUE); + schlage ggf neue seite auf; + menuwindowout (" Alle ausgewählten Programme wurden gedruckt!"); + menuwindowstop. + fuehre einzelne operationen aus: + INT VAR k; + FOR k FROM 1 UPTO highest entry (verfuegbare) REP + IF name (verfuegbare, k) <> "" + THEN disable stop; + menuwindowout ( " """ + name (verfuegbare, k) + + """ wird gedruckt!"); + menuwindowline; + + print (name (verfuegbare, k)); + fehlerbehandlung + FI + PER. + steige ggf bei leerem thesaurus aus: + IF NOT not empty (verfuegbare) + THEN menuwindowline (2); + menuwindowout (" Es wurde kein Programm ausgewählt!"); + menuwindowstop; + menu bildschirm; + LEAVE warenhausprogramme drucken + FI. + schlage ggf neue seite auf: + IF remaining menuwindowlines < 7 + THEN menuwindowpage; menuwindowline + + ELSE menuwindowline (2) + FI. + fehlerbehandlung: + IF is error + THEN regenerate menuscreen; out (""7""); + menuinfo (" " + invers (errormessage)); + clear error; enable stop; + LEAVE warenhausprogramme drucken + ELSE enable stop + FI. +END PROC warenhausprogramme drucken; +PROC warenhausprogramm kopieren: + ermittle alten programmnamen; + erfrage neuen programmnamen; + kopiere ggf das programm. + ermittle alten programmnamen: + IF NOT not empty (bestand) + + THEN noch kein programm; + LEAVE warenhausprogramm kopieren + ELSE biete auswahl an + FI. + biete auswahl an: + TEXT VAR alter name := menuone ( bestand, "Programm kopieren", + "Bitte das Programm ankreuzen, das kopiert werden soll!",FALSE); + menu bildschirm; + IF alter name = niltext + THEN LEAVE warenhausprogramm kopieren + FI. + bestand: + ALL myself - infix namen (ALL myself, praefix, filialdatentyp) + - "WARENHAUS:Rechnung". + + erfrage neuen programmnamen: + TEXT VAR neuer name :: menuanswer (ausgabe, alter name, 5). + ausgabe: + ueberschrift + " Name des 'alten' Programms: " + bisheriger name + + " Bitte den Namen für die Kopie: ". + ueberschrift: + center (maxlaenge, invers ("Programm kopieren")) + ""13""13"". + bisheriger name: + ""13""13" " + invers (alter name) + ""13""13"". + kopiere ggf das programm: + IF neuer name = niltext + THEN menuinfo (" " + invers ("Der gewünschte Name ist unzulässig!")); + + LEAVE warenhausprogramm kopieren + ELIF exists (neuer name) + THEN mache vorwurf; + LEAVE warenhausprogramm kopieren + ELSE copy (alter name, neuer name) + FI. + mache vorwurf: + menuinfo (" " + invers ("Ein Programm mit diesem Namen gibt es bereits!")). +END PROC warenhausprogramm kopieren; +PROC filialdaten umbenennen: + ermittle alten filialdatennamen; + erfrage neuen filialdatennamen; + benenne ggf die filialdaten um. + ermittle alten filialdatennamen: + + IF NOT not empty (bestand) + THEN noch keine filialdaten; + LEAVE filialdaten umbenennen + ELSE biete auswahl an + FI. + biete auswahl an: + TEXT VAR alter name := menuone ( bestand, text1, text2, FALSE); + menu bildschirm; + IF alter name = niltext + THEN LEAVE filialdaten umbenennen + FI. + bestand: + ohne praefix (infix namen (ALL myself, praefix, filialdatentyp), praefix). + text1: "Filialdaten umbenennen". + text2: + "Bitte die Filialdaten-Datei ankreuzen, die umbenannt werden soll!" . + + erfrage neuen filialdatennamen: + TEXT VAR neuer name :: menuanswer (ausgabe, alter name, 5). + ausgabe: + ueberschrift + hinweis auf alt + bisheriger name + aufforderung. + ueberschrift: + center (maxlaenge, invers ("Filialdaten umbenennen")) + ""13""13"". + hinweis auf alt: + " Bisheriger Filialdaten-Name: ". + bisheriger name: + ""13""13" " + invers (alter name) + ""13""13"". + aufforderung: + " Zukünftiger Filialdaten-Name: ". + benenne ggf die filialdaten um: + IF neuer name = niltext + + THEN menuinfo (" " + invers ("Der gewünschte Name ist unzulässig!")); + LEAVE filialdaten umbenennen + ELIF exists (praefix + neuer name) + THEN menuinfo (" " + invers("Filialdaten mit diesem Namen gibt es bereits!")); + LEAVE filialdaten umbenennen + ELSE rename (praefix + alter name, praefix + neuer name); + filialdatenname := neuer name + FI. +END PROC filialdaten umbenennen; +PROC warenhausprogramm umbenennen: + ermittle alten programmnamen; + + erfrage neuen programmnamen; + benenne ggf das programm um. + ermittle alten programmnamen: + IF NOT not empty (bestand) + THEN noch kein programm; + LEAVE warenhausprogramm umbenennen + ELSE biete auswahl an + FI. + biete auswahl an: + TEXT VAR alter name := menuone ( bestand, "Programm umbenennen", + "Bitte das Programm ankreuzen, das umbenannt werden soll!", FALSE); + menu bildschirm; + IF alter name = niltext + THEN LEAVE warenhausprogramm umbenennen + + FI. + bestand: + ALL myself - infix namen (ALL myself, praefix, filialdatentyp) + - "WARENHAUS:Rechnung". + erfrage neuen programmnamen: + TEXT VAR neuer name :: menuanswer (ausgabe, alter name, 5). + ausgabe: + ueberschrift + " Bisheriger Programmname: " + bisheriger name + + " Zukünftiger Programmname: ". + ueberschrift: + center (maxlaenge, invers ("Programm umbenennen")) + ""13""13"". + bisheriger name: + ""13""13" " + invers (alter name) + ""13""13"". + + benenne ggf das programm um: + IF neuer name = niltext + THEN menuinfo (" " + invers ("Der gewünschte Name ist unzulässig!")); + LEAVE warenhausprogramm umbenennen + ELIF exists (neuer name) + THEN mache vorwurf; + LEAVE warenhausprogramm umbenennen + ELSE rename (alter name, neuer name); + programmname := neuer name + FI. + mache vorwurf: + menuinfo (" " + invers ("Ein Programm mit diesem Namen gibt es bereits!")). +END PROC warenhausprogramm umbenennen; + +PROC filialdaten loeschen: + lasse filialdaten auswaehlen; + loesche filialdaten; + menu bildschirm. + lasse filialdaten auswaehlen: + THESAURUS VAR verfuegbare :: + ohne praefix (infix namen (ALL myself, praefix, filialdatentyp), praefix); + IF NOT not empty (verfuegbare) + THEN noch keine filialdaten; + LEAVE filialdaten loeschen + ELSE biete auswahl an + FI. + biete auswahl an: + verfuegbare := menusome (verfuegbare, "Filialdaten-Dateien löschen", + "Bitte alle Dateien ankreuzen, die gelöscht werden sollen!", FALSE). + + loesche filialdaten: + show menuwindow; + steige ggf bei leerem thesaurus aus; + menuwindowout (menuwindowcenter (invers ("Filialdaten-Dateien löschen"))); + menuwindowline (2); + command dialogue (FALSE); + fuehre einzelne operationen aus; + command dialogue (TRUE); + schlage ggf neue seite auf; + menuwindowout (" Alle ausgewählten Dateien wurden gelöscht!"); + menuwindowstop. + fuehre einzelne operationen aus: + INT VAR k; + FOR k FROM 1 UPTO highest entry (verfuegbare) REP + + IF name (verfuegbare, k) <> "" + THEN disable stop; + IF menuwindowyes (" """ + name (verfuegbare, k) + + """ löschen") + THEN forget (praefix + name (verfuegbare, k), quiet) + FI; + fehlerbehandlung + FI + PER; + filialdatenname := "". + steige ggf bei leerem thesaurus aus: + IF NOT not empty (verfuegbare) + THEN menuwindowline (2); + menuwindowout (" Es wurde keine Filialdaten-Datei ausgewählt!"); + + menuwindowstop; + menu bildschirm; + LEAVE filialdaten loeschen + FI. + schlage ggf neue seite auf: + IF remaining menuwindowlines < 7 + THEN menuwindowpage; menuwindowline + ELSE menuwindowline (2) + FI. + fehlerbehandlung: + IF is error + THEN regenerate menuscreen; + menuinfo (" " + invers (errormessage)); + clear error; enable stop; + LEAVE filialdaten loeschen + ELSE enable stop + FI. + +END PROC filialdaten loeschen; +PROC warenhausprogramme loeschen: + lasse programme auswaehlen; + loesche programme; + menu bildschirm. + lasse programme auswaehlen: + THESAURUS VAR verfuegbare :: + ALL myself - infix namen (ALL myself, praefix, filialdatentyp); + IF exists ("WARENHAUS:Rechnung") + THEN verfuegbare := verfuegbare - "WARENHAUS:Rechnung" + FI; + IF NOT not empty (verfuegbare) + THEN noch kein programm; + LEAVE warenhausprogramme loeschen + + ELSE biete auswahl an + FI. + biete auswahl an: + verfuegbare := menusome (verfuegbare, "Programm löschen", + "Bitte alle Programme ankreuzen, die gelöscht werden sollen!", FALSE). + loesche programme: + show menuwindow; + steige ggf bei leerem thesaurus aus; + menuwindowout (menuwindowcenter (invers ("Programme löschen"))); + menuwindowline (2); + command dialogue (FALSE); + fuehre einzelne operationen aus; + command dialogue (TRUE); + schlage ggf neue seite auf; + + menuwindowout (" Alle ausgewählten Programme wurden gelöscht!"); + menuwindowstop. + fuehre einzelne operationen aus: + INT VAR k; + FOR k FROM 1 UPTO highest entry (verfuegbare) REP + IF name (verfuegbare, k) <> "" + THEN disable stop; + IF menuwindowyes (" """ + name (verfuegbare, k) + """ löschen") + THEN forget (name (verfuegbare, k), quiet) + FI; + fehlerbehandlung + FI + PER; + programmname := "". + + steige ggf bei leerem thesaurus aus: + IF NOT not empty (verfuegbare) + THEN menuwindowline (2); + menuwindowout (" Es wurde kein Programm ausgewählt!"); + menuwindowstop; + menu bildschirm; + LEAVE warenhausprogramme loeschen + FI. + schlage ggf neue seite auf: + IF remaining menuwindowlines < 7 + THEN menuwindowpage; menuwindowline + ELSE menuwindowline (2) + FI. + fehlerbehandlung: + IF is error + THEN regenerate menuscreen; out (""7""); + + menuinfo (" " + invers (errormessage)); + clear error; enable stop; + LEAVE warenhausprogramme loeschen + ELSE enable stop + FI. +END PROC warenhausprogramme loeschen; +PROC warenhausprogramm starten: + IF grin version + THEN warenhausprogramm uebersetzen und starten + ELSE warenhausprogramm direkt starten + FI +END PROC warenhausprogramm starten; +PROC warenhausprogramm direkt starten: + programmname ermitteln; + bildschirm neu eingesetzt := FALSE; + + untersuche programmdatei auf bildschirm neu; + cursor w3 1 1; + cursor (1, 24); out(""5"Das Programm wird übersetzt. Zeilen-Nr.: "); + cursor on; + check on; + warnings off; + disable stop; + run (programmname); + noch kein programm gelaufen := FALSE; + IF bildschirm neu eingesetzt + THEN entferne befehl aus programmdatei + FI; + cursor off; + fehlerbehandlung; + cursor (2,23); out ((40 * waagerecht) + balken unten + (36 * waagerecht)); + cursor (2,24); + out ("Das Programm ist beendet. " + + + "Zum Weitermachen bitte irgendeine Taste tippen!"); + pause; + regenerate menuscreen. + fehlerbehandlung: + IF is error + THEN fehler ggf melden + ELSE enable stop + FI. + fehler ggf melden: + IF errormessage = "" + THEN regenerate menuscreen + ELSE fehler melden + FI; + clear error; enable stop; + LEAVE warenhausprogramm direkt starten. + fehler melden: + out (""7""); + IF errorcode = 1 OR errorcode = 1951 + THEN regenerate menuscreen; + + menuinfo (" " + invers (errormessage)) + ELSE programm mit fehler zeigen; + regenerate menuscreen + FI. + programmname ermitteln: + IF programmname <> niltext CAND exists (programmname) + THEN frage nach diesem programm + ELSE lasse programm auswaehlen + FI. + frage nach diesem programm: + IF menuno (ueberschrift + " Zuletzt bearbeitetes Programm: " + + name + " Soll mit diesem Programm gearbeitet werden", 5) + THEN lasse programm auswaehlen + + FI. + ueberschrift: + center (maxlaenge, invers ("Programm starten")) + ""13""13"". + name: + ""13""13" " + invers (programmname) + ""13""13"". + lasse programm auswaehlen: + THESAURUS VAR verfuegbare :: + ALL myself - infix namen (ALL myself, praefix, filialdatentyp); + IF exists ("WARENHAUS:Rechnung") + THEN verfuegbare := verfuegbare - "WARENHAUS:Rechnung" + FI; + IF NOT not empty (verfuegbare) + THEN noch kein programm; + LEAVE warenhausprogramm direkt starten + + ELSE biete auswahl an + FI. + biete auswahl an: + programmname := menuone (verfuegbare, "Programm starten", + "Bitte das gewünschte Programm ankreuzen!", FALSE); + menubildschirm; + menufootnote (""); + IF programmname = niltext + THEN LEAVE warenhaus programm direkt starten + FI. + untersuche programmdatei auf bildschirm neu: + FILE VAR a :: sequential file (modify, programmname); + TEXT VAR zeile; + to line (a, 1); + REP + read record (a, zeile); + + IF NOT eof (a) THEN down (a) FI + UNTIL zeile <> "" OR eof (a) PER; + change all (zeile, " ", ""); + IF pos (zeile, "bildschirmneu") = 0 + THEN setze befehl in datei ein + FI. + setze befehl in datei ein: + to line (a, 1); + zeile := "bildschirm neu; (* ergänzt *)"; + insert record (a); + write record (a, zeile); + bildschirm neu eingesetzt := TRUE. + entferne befehl aus programmdatei: + FILE VAR b :: sequential file (modify, programmname); + to line (b, 1); + + REP + read record (b, zeile); + IF NOT eof (b) THEN down (b) FI + UNTIL zeile <> "" OR eof (b) PER; + change all (zeile, " ", ""); + IF pos (zeile, "bildschirmneu;(*ergänzt*)") > 0 + THEN up (b); delete record (b) + FI. +END PROC warenhausprogramm direkt starten; +PROC warenhausprogramm uebersetzen und starten: + programmname ermitteln; + cursor w3 1 1; + cursor (1, 24); out(""5"Das Programm wird übersetzt. Zeilen-Nr.: "); + cursor on; + disable stop; + uebersetze (programmname); + + IF NOT is error + THEN check on; + warnings off; + run ("elanprogramm"); + noch kein programm gelaufen := FALSE + FI; + forget ("elanprogramm", quiet); + cursor off; + fehlerbehandlung; + cursor (2,23); out ((40 * waagerecht) + balken unten + (36 * waagerecht)); + cursor (2,24); + out ("Das Programm ist beendet. " + + "Zum Weitermachen bitte irgendeine Taste tippen!"); + pause; + regenerate menuscreen. + fehlerbehandlung: + IF is error + THEN fehler ggf melden + + ELSE enable stop + FI. + fehler ggf melden: + IF errormessage = "" + THEN regenerate menuscreen + ELSE fehler melden + FI; + clear error; enable stop; + LEAVE warenhausprogramm uebersetzen und starten. + fehler melden: + out (""7""); + IF errorcode = 1 OR errorcode = 1951 + THEN regenerate menuscreen; + menuinfo (" " + invers (errormessage)) + ELSE programm mit fehler zeigen ; + regenerate menuscreen + FI. + programmname ermitteln: + + IF programmname <> niltext CAND exists (programmname) + THEN frage nach diesem programm + ELSE lasse programm auswaehlen + FI. + frage nach diesem programm: + IF menuno (ueberschrift + " Zuletzt bearbeitetes Programm: " + + name + " Soll mit diesem Programm gearbeitet werden", 5) + THEN lasse programm auswaehlen + FI. + ueberschrift: + center (maxlaenge, invers ("Programm starten")) + ""13""13"". + name: + ""13""13" " + invers (programmname) + ""13""13"". + + lasse programm auswaehlen: + THESAURUS VAR verfuegbare :: + ALL myself - infix namen (ALL myself, praefix, filialdatentyp); + IF exists ("WARENHAUS:Rechnung") + THEN verfuegbare := verfuegbare - "WARENHAUS:Rechnung" + FI; + IF NOT not empty (verfuegbare) + THEN noch kein programm; + LEAVE warenhausprogramm uebersetzen und starten + ELSE biete auswahl an + FI. + biete auswahl an: + programmname := menuone (verfuegbare, "Programm starten", + + "Bitte das gewünschte Programm ankreuzen!", FALSE); + menubildschirm; + menufootnote (""); + IF programmname = niltext + THEN LEAVE warenhaus programm uebersetzen und starten + FI. +END PROC warenhausprogramm uebersetzen und starten; +PROC programm mit fehler zeigen: + IF exists (programmname) + THEN noteline; + note (fehlermeldung mit zeilennummer); + INT VAR i; FOR i FROM 1 UPTO 9 REP noteline PER; + note (invers ("Verlassen: ")); + + FILE VAR f :: sequential file (modify, programmname); + to line (f, max (1, fehlerzeile)); + col (1); + clear error; + cursor on; + noteedit (f); + cursor off + ELSE menuinfo (invers (fehlermeldung mit zeilennummer)) + FI +END PROC programm mit fehler zeigen; +PROC warenhausprogramm wiederholen: + cursor on; + disable stop; + IF noch kein programm gelaufen + THEN errorstop ("'run again' nicht moeglich") + ELSE runagain + FI; + + cursor off; + fehlerbehandlung; + cursor (2,23); out ((40 * waagerecht) + balken unten + (36 * waagerecht)); + cursor (2,24); + out ("Das Programm ist beendet. " + + "Zum Weitermachen bitte irgendeine Taste tippen!"); + pause; + regenerate menuscreen. +fehlerbehandlung: + IF is error + THEN regenerate menuscreen; + fehler melden; + clear error; enable stop; + LEAVE warenhausprogramm wiederholen + ELSE enable stop + FI. + fehler melden: + + out (""7""); + IF errorcode = 1 OR errorcode = 1951 + THEN menuinfo (" " + invers (errormessage)) + ELIF errormessage = "'run again' nicht moeglich" + THEN menuinfo (" " + invers ("Wiederholung nicht möglich!")) + ELSE menuinfo (" " + invers (fehlermeldung mit zeilennummer)) + FI +END PROC warenhausprogramm wiederholen; +TEXT PROC fehlermeldung mit zeilennummer: + TEXT VAR meldung :: "FEHLER: " + errormessage; + fuege ggf fehlerzeile an; + IF length (meldung) < 70 + + THEN meldung + ELSE subtext (meldung, 1, 69) + FI. + fuege ggf fehlerzeile an: + fehlerzeile := errorline; + IF errorline < 1 + THEN LEAVE fuege ggf fehlerzeile an + ELIF bildschirm neu eingesetzt + THEN meldung CAT " (bei Zeile " + text (errorline - 1) + ")" + ELSE meldung CAT " (bei Zeile " + text (errorline) + ")" + FI. +END PROC fehlermeldung mit zeilennummer; +PROC meckere zu langen namen an: + menuinfo (" " + invers ("Hier dürfen Namen höchstens " + + + text (max namenslaenge) + + " Zeichen lang sein!")) +END PROC meckere zu langen namen an; +PROC meckere existierenden filialdatennamen an: + menuinfo (" " + invers ("Filialdaten mit diesem Namen gibt es bereits!")) +END PROC meckere existierenden filialdatennamen an; +PROC meckere existierendes programm an: + menuinfo (" " + invers ("Ein Programm mit diesem Namen gibt es bereits!")) +END PROC meckere existierendes programm an; +PROC noch keine filialdaten: + menuinfo (" " + invers ("Es existiert noch keine Filialdaten-Datei!")) + +END PROC noch keine filialdaten; +PROC noch kein programm: + menuinfo (" " + invers ("Es existiert noch kein Programm!")) +END PROC noch kein programm; +PROC menu bildschirm: + cursor (1, 2); + out (5 * waagerecht); + cursor (1, 3); + out (""4""); + cursor (1, 23); + out (79 * waagerecht); + refresh submenu +END PROC menu bildschirm +END PACKET ls warenhaus 5 + diff --git a/warenhaus/ls-Warenhaus-gen b/warenhaus/ls-Warenhaus-gen index f4bd77f..2e0476e 100644 --- a/warenhaus/ls-Warenhaus-gen +++ b/warenhaus/ls-Warenhaus-gen @@ -22,8 +22,74 @@ *) 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, 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{} +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, 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 + -- cgit v1.2.3