diff options
Diffstat (limited to 'warenhaus/ls-Warenhaus 3')
| -rw-r--r-- | warenhaus/ls-Warenhaus 3 | 1018 |
1 files changed, 961 insertions, 57 deletions
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: <ESC><" + abbruchzeichen + ">");{} cursor on{}END PROC bildschirm neu;{}PROC pruefe abbruch:{} IF pressed key = esc{} THEN pruefe weiter{} FI.{} pruefe weiter:{} TEXT VAR naechstes zeichen :: pressed key (20);{} IF naechstes zeichen = stopzeichen{} THEN ende gewuenscht := TRUE{} ELIF naechstes zeichen = abbruch zeichen{} - THEN setze variable in anfangszustand;{} cursor off;{} errorstop (1951, "Programm - Abbruch durch <ESC><"{} + abbruchzeichen + ">"){} FI{}END PROC pruefe abbruch;{}PROC regeneriere w2:{} cursor (42, 19);{} out (ecke oben links + (36 * waagerecht));{} INT VAR zeile;{} FOR zeile FROM 20 UPTO 22 REP{} cursor (42, zeile); out (senkrecht);{} PER;{} cursor (42, 23); out (balken unten);{} page (w2){} -END PROC regeneriere w2;{}PROC fenster putzen:{} page (w1);{} page (w2){}END PROC fenster putzen;{}PROC lies nummer ein (INT VAR nummer):{} line (w2, 2);{} out (w2, " Stoptaste: <ESC><" + stopzeichen + ">");{} hilfstext := text (nummer);{} REP cursor (w1, 19, 2);{} editget (w1, hilfstext, 4, 4, "", stopzeichen + abbruchzeichen,{} exit char);{} pruefe exit char;{} change all (hilfstext, " ", ""){} UNTIL hilfstext >= "0" AND hilfstext <= "9999" PER;{} - nummer := int (hilfstext).{} pruefe exit char:{} IF exit char = esc + stopzeichen{} THEN ende gewuenscht := TRUE;{} cursor off; fenster putzen; cursor on;{} nummer := 0;{} LEAVE lies nummer ein{} ELIF exit char = esc + abbruchzeichen{} THEN setze variable in anfangszustand;{} errorstop (1951, "Progamm - Abbruch durch <ESC><"{} + abbruchzeichen + ">"){} ELSE ende gewuenscht := FALSE{} FI.{} -END PROC lies nummer ein;{}PROC lies artikelnummer ein:{} page (w2);{} cursor (w1, 2, 2);{} out (w1, "Artikelnummer : ");{} IF codekartenleser aktiviert{} THEN artikelnummer := gesicherter wert von interface{} (min artikelnummer , max artikelnummer, "Warenkarte"){} ELSE artikelnummer von tastatur lesen{} FI;{} IF ende gewuenscht{} THEN artikelnummer ist eingelesen := FALSE{} ELSE artikelnummer ist eingelesen := TRUE{} - FI.{} artikelnummer von tastatur lesen:{} cursor on;{} REP out (w2, " Artikelnummer eingeben");{} lies nummer ein (artikelnummer);{} UNTIL ende gewuenscht COR artikelnummer zulaessig PER.{} artikelnummer zulaessig:{} IF (artikelnummer < min artikelnummer OR{} artikelnummer > max artikelnummer){} THEN page (w2); out (""7"");{} out (w2, " Unzulässige Artikelnummer!");{} line (w2, 2);{} out (w2, " Bitte irgendeine Taste tippen!");{} - pause; page (w2);{} FALSE{} ELSE TRUE{} FI.{}END PROC lies artikelnummer ein;{}PROC artikelnummer lesen:{} pruefe abbruch;{} lies artikelnummer ein;{} IF artikelnummer ist eingelesen{} THEN hole artikeldaten (artikelnummer, artikelname, preis,{} mindestbestand, bestand){} FI{}END PROC artikelnummer lesen;{}PROC kundennummer lesen:{} pruefe abbruch;{} lies kundennummer ein;{} IF kundennummer ist eingelesen{} THEN hole kundendaten (kundennummer, nachname, vorname, geschlecht){} - FI{}END PROC kundennummer lesen;{}PROC lies kundennummer ein:{} page (w2);{} cursor (w1, 2, 2);{} out (w1, "Kundennummer : ");{} IF codekartenleser aktiviert{} THEN kundennummer := gesicherter wert von interface{} (min kundennummer , max kundennummer, "Kundenkarte"){} ELSE kundennummer von tastatur lesen{} FI;{} IF ende gewuenscht{} THEN kundennummer ist eingelesen := FALSE{} ELSE kundennummer ist eingelesen := TRUE{} FI.{} kundennummer von tastatur lesen:{} - cursor on;{} REP out (w2, " Kundennummer eingeben");{} lies nummer ein (kundennummer){} UNTIL ende gewuenscht COR kundennummer zulaessig PER.{} kundennummer zulaessig:{} IF (kundennummer < min kundennummer OR{} kundennummer > max kundennummer){} THEN page (w2); out (""7"");{} out (w2, " Unzulässige Kundennummer!");{} line (w2, 2);{} out (w2, " Bitte irgendeine Taste tippen!");{} pause; page (w2);{} FALSE{} - ELSE TRUE{} FI.{}END PROC lies kundennummer ein;{}PROC zeige artikeldaten:{} cursor (w1, 2, 6);{} out (w1, "Artikelname : " + text (artikelname, 16));{} cursor (w1, 2, 8);{} out (w1, "Preis : " + text preis + " ");{} cursor (w1, 2, 10);{} out (w1, "Mindestbestand : " + text (mindestbestand) + " ");{} cursor (w1, 2, 12);{} out (w1, "Bestand : " + text (bestand) + " ").{} text preis:{} TEXT VAR hilfe :: text (preis, min (8, pos(text(preis),".")+2), 2);{} - change (hilfe, " ", "0");{} hilfe.{}END PROC zeige artikeldaten;{}PROC zeige kundendaten:{} cursor (w1, 2, 6);{} out (w1, "Nachname : " + text (nachname, 16));{} cursor (w1, 2, 8);{} out (w1, "Vorname : " + text (vorname , 16));{} cursor (w1, 2, 10);{} out (w1, "Geschlecht : " + geschlecht + " ");{}END PROC zeige kundendaten;{}PROC artikeldaten speichern:{} pruefe abbruch;{} page (w2); line (w2);{} out (w2, " Artikeldaten werden gespeichert") ;{} - speichere artikeldaten (artikelnummer, artikelname, preis,{} mindestbestand, bestand);{} pause (10);{} IF codekartenleser aktiviert{} THEN lasse karte entfernen (FALSE){} FI{}END PROC artikeldaten speichern;{}PROC kundendaten speichern:{} pruefe abbruch;{} page (w2); line (w2);{} out (w2, " Kundendaten werden gespeichert") ;{} speichere kundendaten (kundennummer, nachname,vorname, geschlecht);{} pause (10);{} IF codekartenleser aktiviert{} THEN lasse karte entfernen (FALSE){} - FI{}END PROC kundendaten speichern;{}BOOL PROC stoptaste gedrueckt:{} pruefe abbruch;{} ende gewuenscht{}END PROC stoptaste gedrueckt;{}BOOL PROC stoptaste gedrückt:{} stoptaste gedrueckt{}END PROC stoptaste gedrückt;{}PROC neues blatt:{} pruefe abbruch;{} page (w3k);{} page (w3);{} auf neuem blatt := TRUE;{} forget ("WARENHAUS:Rechnung", quiet){}END PROC neues blatt;{}PROC nachbestellen:{} pruefe abbruch;{} FILE VAR f;{} warten in w2;{} hole bestelliste (f);{} pruefe abbruch;{} cursor (2,24);{} - out ("Weiter mit <ESC><q>; Cursor bewegen: <Pfeile>");{} cursor on;{} show (w4, f);{} cursor off;{} cursor (1, 24); out (""5"");{} WINDOW VAR w :: window(45,18,25,3);{} outframe (w);{} IF yes (w, "Bestelliste drucken", FALSE){} THEN drucke (headline (f)){} FI;{} cursor on;{} forget (headline (f), quiet){}END PROC nachbestellen;{}PROC warten in w2:{} cursor off;{} page (w2);{} line (w2);{} out (w2, " Bitte warten!");{} cursor on{}END PROC warten in w2;{}PROC codenummer von tastatur lesen (INT VAR codenummer):{} - codenummer := 0;{} out (w2, " Codenummer eingeben");{} cursor on;{} lies nummer ein (codenummer){}END PROC codenummer von tastatur lesen;{}PROC auskunft:{} pruefe abbruch;{} FILE VAR f;{} INT VAR codenummer :: 0;{} cursor (w1, 2, 2);{} out (w1, "Codenummer : ");{} page (w2);{} IF codekartenleser aktiviert{} THEN codenummer := gesicherter wert von interface (0,254, "Codekarte");{} lasse karte entfernen (FALSE){} ELSE codenummer von tastatur lesen (codenummer){} - FI;{} IF ende gewuenscht THEN LEAVE auskunft FI;{} SELECT codenummer OF CASE 66, 67, 68 : hitliste{} CASE 73, 74, 75 : kaeuferliste{} CASE 77, 78, 79 : kundenliste{} CASE 84, 85, 86 : einkaufsliste{} CASE 89, 90, 91 : lageruebersicht{} OTHERWISE teste auf artikel oder kundennummer{} END SELECT;{} IF codekartenleser aktiviert CAND wert von interface <> 255{} THEN karte entfernen{} FI.{} karte entfernen:{} - SELECT codenummer OF{} CASE 66, 67, 68, 73, 74, 75, 77, 78, 79, 84, 85, 86, 89, 90,{} 91: lasse karte entfernen (TRUE){} OTHERWISE lasse karte entfernen (FALSE){} END SELECT.{} teste auf artikel oder kundennummer:{} IF codenummer >= min artikelnummer AND codenummer <= max artikelnummer{} THEN gib auskunft ueber artikeldaten{} ELIF codenummer >= min kundennummer AND codenummer <= max kundennummer{} THEN gib auskunft ueber kundendaten{} ELSE unzulaessige codenummer{} - FI.{} unzulaessige codenummer:{} out (10 * ""7"");{} page (w2);{} out (w2, " Unzulässige Codenummer !!!");{} line (w2, 2);{} out (w2, " Bitte irgendeine Taste tippen!");{} pause;{} page (w2).{} gib auskunft ueber artikeldaten:{} hole artikeldaten (codenummer, artikelname, preis,{} mindestbestand, bestand);{} zeige artikeldaten;{} artikelnummer ist eingelesen := FALSE;{} stop w2;{} page (w1).{} gib auskunft ueber kundendaten:{} hole kundendaten (codenummer, nachname, vorname, geschlecht);{} - zeige kundendaten;{} kundennummer ist eingelesen := FALSE;{} stop w2;{} page (w1).{} hitliste:{} warten in w2;{} hole auskunft ein (codenummer, 0, f);{} zeige f.{} kundenliste:{} warten in w2;{} hole auskunft ein (codenummer, 0, f);{} zeige f.{} zeige f:{} pruefe abbruch;{} cursor (2, 24);{} out ("Weiter mit <ESC><q>; Cursor bewegen: <Pfeile>");{} show (w4, f);{} cursor (1, 24); out (""5"");{} evtl drucken.{} lageruebersicht:{} warten in w2;{} - hole auskunft ein (codenummer, 0, f);{} zeige f.{} kaeuferliste:{} lies artikelnummer ein;{} IF artikelnummer ist eingelesen{} THEN artikelnummer ist eingelesen := FALSE;{} warten in w2;{} hole auskunft ein (codenummer, artikelnummer, f);{} zeige f{} FI.{} einkaufsliste:{} lies kundennummer ein;{} IF kundennummer ist eingelesen{} THEN kundennummer ist eingelesen := FALSE;{} warten in w2;{} hole auskunft ein (codenummer, kundennummer, f);{} - zeige f{} FI.{} evtl drucken:{} WINDOW VAR w :: window(46,18,22,3);{} cursor off;{} outframe (w);{} IF yes (w, "Auskunft drucken", FALSE){} THEN drucke (headline (f)){} FI;{} cursor on;{} forget (headline (f), quiet).{}END PROC auskunft;{}PROC rechnungskopf:{} pruefe abbruch;{} IF kundennummer ist eingelesen AND nachname <> ""{} THEN ueberschrift := " RECHNUNG für " + anrede + (vorname SUB 1) +{} ". " + text (nachname, 10){} ELSE ueberschrift := " RECHNUNG"{} - FI;{} summe := 0.0;{} schreibe ueberschrift auf bildschirm;{} schreibe in rechnungsdatei;{} IF codekartenleser aktiviert{} THEN lasse karte entfernen (FALSE){} FI.{} schreibe in rechnungsdatei:{} sysout ("WARENHAUS:Rechnung");{} line;{} put (ueberschrift);{} line;{} put (" ==================================");{} line (2);{} sysout ("").{} anrede:{} IF geschlecht = "m"{} THEN "Herrn "{} ELIF geschlecht = "w"{} THEN "Frau "{} ELSE ""{} - FI.{}END PROC rechnungskopf;{}PROC schreibe ueberschrift auf bildschirm:{} INT VAR spalte, zeile;{} get cursor (w3, spalte, zeile);{} IF zeile = 1{} THEN auf neuem blatt := TRUE;{} schreibe in w3k{} ELSE auf neuem blatt := FALSE;{} schreibe in w3{} FI.{} schreibe in w3:{} IF remaining lines (w3) < 7{} THEN page (w3);{} page (w3k);{} auf neuem blatt := TRUE;{} schreibe in w3k{} ELSE line (w3);{} out (w3, ueberschrift);{} - line (w3);{} out (w3, " ==================================");{} line (w3, 2){} FI.{} schreibe in w3k:{} out (w3k, ueberschrift);{} line (w3k);{} out (w3k, " ==================================").{}END PROC schreibe ueberschrift auf bildschirm;{}PROC artikel kaufen:{} pruefe abbruch;{} IF artikelnummer ist eingelesen{} THEN kauf registrieren{} ELSE setze variable in anfangszustand;{} errorstop ("Es ist keine Artikelnummer eingelesen worden!"){} - FI;{} IF codekartenleser aktiviert{} THEN lasse karte entfernen (FALSE){} FI.{} kauf registrieren:{} artikelnummer ist eingelesen := FALSE;{} IF bestand > 0{} THEN artikel auf rechnung setzen;{} registrieren{} ELSE page (w2); out (""7"");{} IF artikelname = ""{} THEN out (w2, " Artikel hier nicht erhältlich!"){} ELSE out (w2, " Der Artikel ist ausverkauft!"){} FI;{} line (w2, 2);{} out (w2, " Weiter durch Tippen einer Taste");{} - pause{} FI.{} registrieren:{} IF kundennummer ist eingelesen{} THEN registriere verkauf (kundennummer, artikelnummer){} ELSE registriere verkauf (min kundennummer - 1, artikelnummer){} FI.{} artikel auf rechnung setzen:{} summe INCR preis;{} IF remaining lines (w3) < 3{} THEN beginne wieder oben{} FI;{} out (w3, " " + text (artikelname, 15) + text (preis, 12, 2));{} line (w3);{} sysout ("WARENHAUS:Rechnung");{} put (" " + text (artikelname, 15) + text preis);{} - line;{} sysout ("").{} beginne wieder oben:{} IF auf neuem blatt{} THEN page (w3){} ELSE schreibe ueberschrift auf bildschirm{} FI.{} text preis:{} TEXT VAR hilfe :: text (preis, 12, 2);{} INT VAR vor punkt :: pos (hilfe, ".") - 1;{} IF (hilfe SUB vor punkt) = " "{} THEN change (hilfe, vor punkt, vor punkt, "0"){} FI;{} hilfe.{}END PROC artikel kaufen;{}PROC abrechnung:{} pruefe abbruch;{} schreibe summe auf bildschirm;{} - schreibe summe in rechnungsdatei;{} setze variable zurueck;{} frage ob drucken;{} IF codekartenleser aktiviert{} THEN lasse karte entfernen (FALSE){} FI.{} schreibe summe auf bildschirm:{} IF remaining lines (w3) < 2{} THEN beginne wieder oben{} FI;{} put (w3, " -------------");{} line (w3);{} put (w3, " Summe " + text (summe, 12, 2));{} line (w3).{} beginne wieder oben:{} IF auf neuem blatt{} THEN page (w3){} ELSE schreibe ueberschrift auf bildschirm{} - FI.{} schreibe summe in rechnungsdatei:{} sysout ("WARENHAUS:Rechnung");{} put (" -------------");{} line;{} put (" Summe " + text (summe, 12, 2));{} line;{} sysout ("").{} setze variable zurueck:{} BOOL VAR alter wert :: ende gewuenscht;{} setze variable in anfangszustand;{} ende gewuenscht := alter wert.{} frage ob drucken:{} IF yes (w2, "Rechnung drucken", FALSE){} THEN cursor (3, 22);{} disable stop;{} print ("WARENHAUS:Rechnung");{} - IF is error THEN clear error FI;{} enable stop{} FI.{}END PROC abrechnung;{}PROC artikeldaten eingeben:{} pruefe abbruch;{} IF artikelnummer ist eingelesen{} THEN lies artikeldaten ein;{} artikeldaten speichern{} ELSE setze variable in anfangszustand;{} errorstop ("Es ist keine Artikelnummer eingelesen worden!"){} FI.{} lies artikeldaten ein:{} zeige artikeldaten;{} IF artikelname <> ""{} THEN vielleicht schon fertig{} ELSE page (w2){} - FI;{} REP line (w2);{} put (w2, " Artikeldaten eingeben");{} eingabe{} UNTIL yes (w2, "Alles richtig", TRUE){} PER;{} artikelnummer ist eingelesen := FALSE.{} vielleicht schon fertig:{} IF yes (w2, "Alles richtig", TRUE){} THEN artikelnummer ist eingelesen := FALSE;{} IF codekartenleser aktiviert{} THEN lasse karte entfernen (FALSE){} FI;{} LEAVE artikeldaten eingeben{} FI.{} eingabe:{} name holen;{} - preis holen;{} mindestbestand holen;{} bestand holen.{} name holen:{} REP cursor (w1, 19, 6);{} editget (w1, artikelname, 80, 80, "", abbruchzeichen + stopzeichen,{} exit char);{} teste auf abbruch{} UNTIL artikelname <> "" PER.{} preis holen:{} hilfstext := text (preis, pos(text(preis),".") + 2, 2);{} change (hilfstext, " ", "0");{} REP cursor (w1, 19, 8);{} editget (w1, hilfstext, 8, 8, "", abbruch zeichen + stopzeichen,{} - exit char);{} change (hilfstext, ",", ".");{} preis := round (real (hilfstext), 2);{} teste auf abbruch{} UNTIL preis >= 0.0 PER.{} mindestbestand holen:{} hilfstext := text (mindestbestand);{} REP cursor (w1, 19, 10);{} editget (w1, hilfstext, 4, 4, "", abbruch zeichen + stopzeichen,{} exit char);{} mindestbestand := int (hilfstext);{} teste auf abbruch{} UNTIL mindestbestand >= 0 PER.{} - bestand holen:{} hilfstext := text (bestand);{} REP cursor (w1, 19, 12);{} editget (w1, hilfstext, 4, 4, "", abbruch zeichen + stopzeichen,{} exit char);{} bestand := int (hilfstext);{} teste auf abbruch{} UNTIL bestand >= 0 PER.{} teste auf abbruch:{} IF exit char = esc + stopzeichen{} THEN ende gewuenscht := TRUE{} ELIF exit char = esc + abbruchzeichen{} THEN setze variable in anfangszustand;{} errorstop (1951, "Programm - Abbruch durch <ESC><"{} - + abbruchzeichen + ">"){} FI.{}END PROC artikeldaten eingeben;{}PROC kundendaten eingeben:{} IF kundennummer ist eingelesen{} THEN lies kundendaten ein;{} kundendaten speichern{} ELSE setze variable in anfangszustand;{} errorstop ("Es ist keine Kundennummer eingelesen worden!"){} FI.{} lies kundendaten ein:{} zeige kundendaten;{} IF nachname <> ""{} THEN vielleicht schon fertig{} ELSE page (w2){} FI;{} REP line (w2);{} - put (w2, " Kundendaten eingeben");{} eingabe{} UNTIL yes (w2, "Alles richtig", TRUE) PER;{} kundennummer ist eingelesen := FALSE.{} vielleicht schon fertig:{} IF yes (w2, "Alles richtig", TRUE){} THEN kundennummer ist eingelesen := FALSE;{} IF codekartenleser aktiviert{} THEN lasse karte entfernen (FALSE){} FI;{} LEAVE kundendaten eingeben{} FI.{} eingabe:{} nachname holen;{} vorname holen;{} geschlecht holen.{} - nachname holen:{} REP cursor (w1, 19, 6);{} editget (w1, nachname, 80, 80, "", abbruch zeichen + stopzeichen,{} exit char);{} teste auf abbruch{} UNTIL nachname <> "" PER.{} vorname holen:{} REP cursor (w1, 19, 8);{} editget (w1, vorname, 80, 80, "", abbruch zeichen + stopzeichen,{} exit char);{} teste auf abbruch{} UNTIL vorname <> "" PER.{} geschlecht holen:{} REP cursor (w1, 19, 10);{} - editget (w1, geschlecht, 9, 9, "", abbruchzeichen + stopzeichen,{} exit char);{} geschlecht := geschlecht SUB 1;{} teste auf abbruch{} UNTIL geschlecht = "m" OR geschlecht = "w" PER.{} teste auf abbruch:{} IF exit char = esc + stopzeichen{} THEN ende gewuenscht := TRUE{} ELIF exit char = esc + abbruchzeichen{} THEN setze variable in anfangszustand;{} errorstop (1951, "Programm - Abbruch durch <ESC><"{} - + abbruchzeichen + ">"){} FI.{}END PROC kundendaten eingeben;{}PROC drucke (TEXT CONST name):{} TEXT VAR zeile;{} FILE VAR f :: sequential file (modify, name);{} to line (f, 1);{} insert record (f);{} write record (f, "#center#" + name);{} down (f);{} insert record (f);{} down (f);{} WHILE NOT eof (f) REP{} read record (f, zeile);{} IF pos (zeile, ""15"") > 0{} THEN change (zeile, ""15"", "#on(""r"")#");{} change (zeile, ""14"", "#off(""r"")#");{} - write record (f, zeile){} FI;{} down (f){} PER;{} cursor (3, 22);{} print (name){}END PROC drucke;{}PROC stop w2:{} cursor off;{} page (w2);{} out (w2," Zum Weitermachen bitte");line(w2);{} out (w2," irgendeine Taste tippen!");{} pause;{} page (w2);{} cursor on{}END PROC stop w2;{}BOOL PROC yes (WINDOW VAR w, TEXT CONST frage, BOOL CONST default):{} BOOL VAR antwort :: default;{} TEXT VAR taste;{} INT CONST ja pos :: (areaxsize (w) - 9) DIV 2;{} cursor off;{} cursor (42,24); out ("Ändern: <Pfeile> Bestätigen: <RETURN>");{} - page (w);{} out (w, center (w, frage + " ?"));{} cursor (w, ja pos, 3);{} IF default{} THEN out (w, ""15"Ja "14" Nein ");{} cursor (w, ja pos, 3){} ELSE out (w, " Ja "15"Nein "14"");{} cursor (w, ja pos + 5, 3){} FI;{} tastendruck auswerten;{} page (w);{} cursor (42,24); out (""5"");{} cursor on;{} antwort.{} tastendruck auswerten:{} REP inchar (taste);{} SELECT code (taste) OF CASE 2, 8 : position aendern{} CASE 13 : LEAVE tastendruck auswerten{} - CASE 74, 106 : antwort := TRUE; (*Jj*){} LEAVE tastendruck auswerten{} CASE 78, 110 : antwort := FALSE; (*Nn*){} LEAVE tastendruck auswerten{} OTHERWISE out (""7"") END SELECT{} PER.{} position aendern:{} IF antwort THEN antwort := FALSE;{} cursor (w, ja pos, 3);{} out (w, " Ja "15"Nein "14"");{} - cursor (w, ja pos + 5, 3){} ELSE antwort := TRUE;{} cursor (w, ja pos, 3);{} out (w, ""15"Ja "14" Nein ");{} cursor (w, ja pos, 3){} FI.{}END PROC yes;{}PROC tastatureingabe (BOOL CONST erwuenscht, INT VAR rueckmeldung):{} IF erwuenscht{} THEN rueckmeldung := 0;{} codekartenleser aktiviert := FALSE;{} schliesse interface{} ELSE oeffne interface (rueckmeldung);{} IF rueckmeldung >= 0{} - THEN codekartenleser aktiviert := TRUE{} ELSE codekartenleser aktiviert := FALSE{} FI{} FI{}END PROC tastatureingabe;{}BOOL PROC eingabe mit codekartenleser:{} codekartenleser aktiviert{}END PROC eingabe mit codekartenleser;{}PROC dezimalwert lesen:{} pruefe abbruch;{} IF codekartenleser aktiviert{} THEN interfacewerte zeigen{} ELSE setze variable in anfangszustand;{} errorstop ("Eingabeart ist auf Tastatur eingestellt!"){} FI.{} interfacewerte zeigen:{} - cursor off;{} fenster putzen;{} line (w1, 4); line (w2);{} out (w1, " Dezimalwert :");{} out (w2, " Lesen beenden mit <ESC><q>");{} ende gewuenscht := FALSE;{} REP pruefe abbruch;{} cursor (w1, 17, 5);{} out (w1, text (wert von interface, 3)){} UNTIL ende gewuenscht PER;{} page (w2); cursor (w1, 1, 5); out (" ");{} cursor on.{}END PROC dezimalwert lesen;{}PROC bitmuster lesen:{} pruefe abbruch;{} IF codekartenleser aktiviert{} - THEN interfacewerte zeigen{} ELSE setze variable in anfangszustand;{} errorstop ("Eingabeart ist auf Tastatur eingestellt!"){} FI.{} interfacewerte zeigen:{} cursor off;{} fenster putzen;{} line (w1, 4); line (w2);{} out (w1, " Bitmuster :");{} out (w2, " Lesen beenden mit <ESC><q>");{} ende gewuenscht := FALSE;{} REP pruefe abbruch;{} cursor (w1, 16, 5);{} out (w1, bitmuster (wert von interface)){} UNTIL ende gewuenscht PER;{} page (w2); cursor (w1, 1, 5); out (" ");{} - cursor on.{}END PROC bitmuster lesen;{}TEXT PROC bitmuster (INT CONST wert):{} INT VAR bitnr;{} TEXT VAR muster :: "";{} FOR bitnr FROM 7 DOWNTO 0 REP{} IF bit (wert, bitnr){} THEN muster CAT "I"{} ELSE muster CAT "O"{} FI{} PER;{} muster{}END PROC bitmuster;{}PROC lasse karte entfernen (BOOL CONST mit rahmen):{} IF wert von interface <> 255{} THEN cursor off;{} IF mit rahmen THEN regeneriere w2 ELSE page (w2) FI;{} line (w2);{} out (w2, " Bitte Karte entfernen");{} - REP pruefe abbruch{} UNTIL (wert von interface = 255) OR ende gewuenscht PER;{} cursor on{} FI{}END PROC lasse karte entfernen;{}INT PROC gesicherter wert von interface (INT CONST von, bis,{} TEXT CONST kartenart):{} INT VAR wert, zaehler;{} ende gewuenscht := FALSE;{} cursor off;{} REP out (w2, " Bitte " + kartenart + " einschieben");{} line (w2, 2);{} out (w2, " Stoptaste: <ESC><" + stopzeichen + ">");{} cursor (79, 24);{} - gesicherten wert einlesen;{} cursor (w1, 19, 2);{} out (w1, text (wert, 3));{} IF wert < von OR wert > bis{} THEN warnung{} FI{} UNTIL wert >= von AND wert <= bis PER;{} cursor on;{} wert.{} gesicherten wert einlesen:{} REP zaehler := 0;{} warte auf karte;{} wert := wert von interface;{} lies wert{} UNTIL wert gesichert AND wert <> 255 PER.{} warte auf karte:{} REP beachte esc q{} UNTIL wert von interface <> 255 PER.{} beachte esc q:{} - pruefe abbruch;{} IF ende gewuenscht{} THEN cursor on;{} LEAVE gesicherter wert von interface WITH 0{} FI.{} lies wert:{} REP beachte esc q;{} IF wert = wert von interface{} THEN zaehler INCR 1{} ELSE LEAVE lies wert{} FI{} UNTIL wert gesichert PER.{} wert gesichert: zaehler = sicherheit.{} warnung:{} page (w2); out (""7"");{} out (w2, " Dies ist keine " + kartenart + "!");{} line (w2, 2);{} out (w2, " Bitte Karte entfernen");{} - REP beachte esc q{} UNTIL wert von interface = 255 PER;{} page (w2).{}END PROC gesicherter wert von interface{}END PACKET ls warenhaus 3{} + artikelnummer lesen, + artikeldaten eingeben, + kundennummer lesen, + kundendaten eingeben, + neues blatt, + rechnungskopf, + artikel kaufen, + abrechnung, + nachbestellen, + auskunft, + stoptaste gedrueckt, + stoptaste gedrückt, + dezimalwert lesen, + bitmuster lesen, + bildschirm neu, +(* ------------------------------ *) + tastatureingabe, + eingabesicherheit, + eingabe mit codekartenleser, + + cursor w3 1 1: +LET esc = ""27"", + stopzeichen = "q", + abbruchzeichen = "h"; +WINDOW VAR w1 :: window (43, 3, 36, 16), + w2 :: window (43, 20, 36, 3), + w3k :: window ( 2, 4, 40, 3), + w3 :: window ( 2, 7, 40, 16), + w4 :: window ( 8, 4, 66, 18); +BOOL VAR ende gewuenscht := FALSE, + artikelnummer ist eingelesen := FALSE, + kundennummer ist eingelesen := FALSE, + codekartenleser aktiviert := FALSE, + + auf neuem blatt := TRUE; +INT VAR artikelnummer :: 0, + mindestbestand :: 0, + bestand :: 0, + kundennummer :: 0, + sicherheit :: 5; +TEXT VAR artikelname :: "", + nachname :: "", + vorname :: "", + geschlecht :: "", + ueberschrift :: " RECHNUNG", + hilfstext, exit char; +REAL VAR preis :: 0.0, + summe :: 0.0; +PROC eingabesicherheit (INT CONST wert): + + sicherheit := abs (wert) +END PROC eingabesicherheit; +PROC cursor w3 1 1: + cursor (w1, 1, 1); + cursor (w2, 1, 1); + cursor (w3, 1, 1); + cursor (w3k, 1, 1); + forget ("WARENHAUS:Rechnung", quiet); + setze variable in anfangszustand +END PROC cursor w3 1 1; +PROC setze variable in anfangszustand: + ende gewuenscht := FALSE; + artikelnummer ist eingelesen := FALSE; + kundennummer ist eingelesen := FALSE; + artikelnummer := 0; + mindestbestand := 0; + bestand := 0; + + kundennummer := 0; + artikelname := ""; + nachname := ""; + vorname := ""; + geschlecht := ""; + ueberschrift := " RECHNUNG"; + preis := 0.0; + summe := 0.0 +END PROC setze variable in anfangszustand; +PROC bildschirm neu: + cursor off; + pruefe abbruch; + cursor (w1, 1, 1); + cursor (w2, 1, 1); + cursor (w3, 1, 1); + cursor (w3k,1, 1); + auf neuem blatt := TRUE; + page; + out ("WARENHAUS: Info Eingabeart Kommandos "15"Programme "14" " + + + "Filialdaten Archiv"); line; + out (ecke oben links + (40 * waagerecht) + balken oben + + (36 * waagerecht) + ecke oben rechts); + INT VAR zeile; + FOR zeile FROM 3 UPTO 22 REP + cursor ( 1, zeile); out (senkrecht); + cursor (42, zeile); out (senkrecht); + cursor (79, zeile); out (senkrecht) + PER; + cursor (1, 23); + out (ecke unten links + (40 * waagerecht) + balken unten + + (36 * waagerecht) + ecke unten rechts); + + cursor (42, 19); + out (balken links + (36 * waagerecht) + balken rechts); + cursor (2, 24); + out ("Programmabbruch: <ESC><" + abbruchzeichen + ">"); + cursor on +END PROC bildschirm neu; +PROC pruefe abbruch: + IF pressed key = esc + THEN pruefe weiter + FI. + pruefe weiter: + TEXT VAR naechstes zeichen :: pressed key (20); + IF naechstes zeichen = stopzeichen + THEN ende gewuenscht := TRUE + ELIF naechstes zeichen = abbruch zeichen + + THEN setze variable in anfangszustand; + cursor off; + errorstop (1951, "Programm - Abbruch durch <ESC><" + + abbruchzeichen + ">") + FI +END PROC pruefe abbruch; +PROC regeneriere w2: + cursor (42, 19); + out (ecke oben links + (36 * waagerecht)); + INT VAR zeile; + FOR zeile FROM 20 UPTO 22 REP + cursor (42, zeile); out (senkrecht); + PER; + cursor (42, 23); out (balken unten); + page (w2) + +END PROC regeneriere w2; +PROC fenster putzen: + page (w1); + page (w2) +END PROC fenster putzen; +PROC lies nummer ein (INT VAR nummer): + line (w2, 2); + out (w2, " Stoptaste: <ESC><" + stopzeichen + ">"); + hilfstext := text (nummer); + REP cursor (w1, 19, 2); + editget (w1, hilfstext, 4, 4, "", stopzeichen + abbruchzeichen, + exit char); + pruefe exit char; + change all (hilfstext, " ", "") + UNTIL hilfstext >= "0" AND hilfstext <= "9999" PER; + + nummer := int (hilfstext). + pruefe exit char: + IF exit char = esc + stopzeichen + THEN ende gewuenscht := TRUE; + cursor off; fenster putzen; cursor on; + nummer := 0; + LEAVE lies nummer ein + ELIF exit char = esc + abbruchzeichen + THEN setze variable in anfangszustand; + errorstop (1951, "Progamm - Abbruch durch <ESC><" + + abbruchzeichen + ">") + ELSE ende gewuenscht := FALSE + FI. + +END PROC lies nummer ein; +PROC lies artikelnummer ein: + page (w2); + cursor (w1, 2, 2); + out (w1, "Artikelnummer : "); + IF codekartenleser aktiviert + THEN artikelnummer := gesicherter wert von interface + (min artikelnummer , max artikelnummer, "Warenkarte") + ELSE artikelnummer von tastatur lesen + FI; + IF ende gewuenscht + THEN artikelnummer ist eingelesen := FALSE + ELSE artikelnummer ist eingelesen := TRUE + + FI. + artikelnummer von tastatur lesen: + cursor on; + REP out (w2, " Artikelnummer eingeben"); + lies nummer ein (artikelnummer); + UNTIL ende gewuenscht COR artikelnummer zulaessig PER. + artikelnummer zulaessig: + IF (artikelnummer < min artikelnummer OR + artikelnummer > max artikelnummer) + THEN page (w2); out (""7""); + out (w2, " Unzulässige Artikelnummer!"); + line (w2, 2); + out (w2, " Bitte irgendeine Taste tippen!"); + + pause; page (w2); + FALSE + ELSE TRUE + FI. +END PROC lies artikelnummer ein; +PROC artikelnummer lesen: + pruefe abbruch; + lies artikelnummer ein; + IF artikelnummer ist eingelesen + THEN hole artikeldaten (artikelnummer, artikelname, preis, + mindestbestand, bestand) + FI +END PROC artikelnummer lesen; +PROC kundennummer lesen: + pruefe abbruch; + lies kundennummer ein; + IF kundennummer ist eingelesen + THEN hole kundendaten (kundennummer, nachname, vorname, geschlecht) + + FI +END PROC kundennummer lesen; +PROC lies kundennummer ein: + page (w2); + cursor (w1, 2, 2); + out (w1, "Kundennummer : "); + IF codekartenleser aktiviert + THEN kundennummer := gesicherter wert von interface + (min kundennummer , max kundennummer, "Kundenkarte") + ELSE kundennummer von tastatur lesen + FI; + IF ende gewuenscht + THEN kundennummer ist eingelesen := FALSE + ELSE kundennummer ist eingelesen := TRUE + FI. + kundennummer von tastatur lesen: + + cursor on; + REP out (w2, " Kundennummer eingeben"); + lies nummer ein (kundennummer) + UNTIL ende gewuenscht COR kundennummer zulaessig PER. + kundennummer zulaessig: + IF (kundennummer < min kundennummer OR + kundennummer > max kundennummer) + THEN page (w2); out (""7""); + out (w2, " Unzulässige Kundennummer!"); + line (w2, 2); + out (w2, " Bitte irgendeine Taste tippen!"); + pause; page (w2); + FALSE + + ELSE TRUE + FI. +END PROC lies kundennummer ein; +PROC zeige artikeldaten: + cursor (w1, 2, 6); + out (w1, "Artikelname : " + text (artikelname, 16)); + cursor (w1, 2, 8); + out (w1, "Preis : " + text preis + " "); + cursor (w1, 2, 10); + out (w1, "Mindestbestand : " + text (mindestbestand) + " "); + cursor (w1, 2, 12); + out (w1, "Bestand : " + text (bestand) + " "). + text preis: + TEXT VAR hilfe :: text (preis, min (8, pos(text(preis),".")+2), 2); + + change (hilfe, " ", "0"); + hilfe. +END PROC zeige artikeldaten; +PROC zeige kundendaten: + cursor (w1, 2, 6); + out (w1, "Nachname : " + text (nachname, 16)); + cursor (w1, 2, 8); + out (w1, "Vorname : " + text (vorname , 16)); + cursor (w1, 2, 10); + out (w1, "Geschlecht : " + geschlecht + " "); +END PROC zeige kundendaten; +PROC artikeldaten speichern: + pruefe abbruch; + page (w2); line (w2); + out (w2, " Artikeldaten werden gespeichert") ; + + speichere artikeldaten (artikelnummer, artikelname, preis, + mindestbestand, bestand); + pause (10); + IF codekartenleser aktiviert + THEN lasse karte entfernen (FALSE) + FI +END PROC artikeldaten speichern; +PROC kundendaten speichern: + pruefe abbruch; + page (w2); line (w2); + out (w2, " Kundendaten werden gespeichert") ; + speichere kundendaten (kundennummer, nachname,vorname, geschlecht); + pause (10); + IF codekartenleser aktiviert + THEN lasse karte entfernen (FALSE) + + FI +END PROC kundendaten speichern; +BOOL PROC stoptaste gedrueckt: + pruefe abbruch; + ende gewuenscht +END PROC stoptaste gedrueckt; +BOOL PROC stoptaste gedrückt: + stoptaste gedrueckt +END PROC stoptaste gedrückt; +PROC neues blatt: + pruefe abbruch; + page (w3k); + page (w3); + auf neuem blatt := TRUE; + forget ("WARENHAUS:Rechnung", quiet) +END PROC neues blatt; +PROC nachbestellen: + pruefe abbruch; + FILE VAR f; + warten in w2; + hole bestelliste (f); + pruefe abbruch; + cursor (2,24); + + out ("Weiter mit <ESC><q>; Cursor bewegen: <Pfeile>"); + cursor on; + show (w4, f); + cursor off; + cursor (1, 24); out (""5""); + WINDOW VAR w :: window(45,18,25,3); + outframe (w); + IF yes (w, "Bestelliste drucken", FALSE) + THEN drucke (headline (f)) + FI; + cursor on; + forget (headline (f), quiet) +END PROC nachbestellen; +PROC warten in w2: + cursor off; + page (w2); + line (w2); + out (w2, " Bitte warten!"); + cursor on +END PROC warten in w2; +PROC codenummer von tastatur lesen (INT VAR codenummer): + + codenummer := 0; + out (w2, " Codenummer eingeben"); + cursor on; + lies nummer ein (codenummer) +END PROC codenummer von tastatur lesen; +PROC auskunft: + pruefe abbruch; + FILE VAR f; + INT VAR codenummer :: 0; + cursor (w1, 2, 2); + out (w1, "Codenummer : "); + page (w2); + IF codekartenleser aktiviert + THEN codenummer := gesicherter wert von interface (0,254, "Codekarte"); + lasse karte entfernen (FALSE) + ELSE codenummer von tastatur lesen (codenummer) + + FI; + IF ende gewuenscht THEN LEAVE auskunft FI; + SELECT codenummer OF CASE 66, 67, 68 : hitliste + CASE 73, 74, 75 : kaeuferliste + CASE 77, 78, 79 : kundenliste + CASE 84, 85, 86 : einkaufsliste + CASE 89, 90, 91 : lageruebersicht + OTHERWISE teste auf artikel oder kundennummer + END SELECT; + IF codekartenleser aktiviert CAND wert von interface <> 255 + THEN karte entfernen + FI. + karte entfernen: + + SELECT codenummer OF + CASE 66, 67, 68, 73, 74, 75, 77, 78, 79, 84, 85, 86, 89, 90, + 91: lasse karte entfernen (TRUE) + OTHERWISE lasse karte entfernen (FALSE) + END SELECT. + teste auf artikel oder kundennummer: + IF codenummer >= min artikelnummer AND codenummer <= max artikelnummer + THEN gib auskunft ueber artikeldaten + ELIF codenummer >= min kundennummer AND codenummer <= max kundennummer + THEN gib auskunft ueber kundendaten + ELSE unzulaessige codenummer + + FI. + unzulaessige codenummer: + out (10 * ""7""); + page (w2); + out (w2, " Unzulässige Codenummer !!!"); + line (w2, 2); + out (w2, " Bitte irgendeine Taste tippen!"); + pause; + page (w2). + gib auskunft ueber artikeldaten: + hole artikeldaten (codenummer, artikelname, preis, + mindestbestand, bestand); + zeige artikeldaten; + artikelnummer ist eingelesen := FALSE; + stop w2; + page (w1). + gib auskunft ueber kundendaten: + hole kundendaten (codenummer, nachname, vorname, geschlecht); + + zeige kundendaten; + kundennummer ist eingelesen := FALSE; + stop w2; + page (w1). + hitliste: + warten in w2; + hole auskunft ein (codenummer, 0, f); + zeige f. + kundenliste: + warten in w2; + hole auskunft ein (codenummer, 0, f); + zeige f. + zeige f: + pruefe abbruch; + cursor (2, 24); + out ("Weiter mit <ESC><q>; Cursor bewegen: <Pfeile>"); + show (w4, f); + cursor (1, 24); out (""5""); + evtl drucken. + lageruebersicht: + warten in w2; + + hole auskunft ein (codenummer, 0, f); + zeige f. + kaeuferliste: + lies artikelnummer ein; + IF artikelnummer ist eingelesen + THEN artikelnummer ist eingelesen := FALSE; + warten in w2; + hole auskunft ein (codenummer, artikelnummer, f); + zeige f + FI. + einkaufsliste: + lies kundennummer ein; + IF kundennummer ist eingelesen + THEN kundennummer ist eingelesen := FALSE; + warten in w2; + hole auskunft ein (codenummer, kundennummer, f); + + zeige f + FI. + evtl drucken: + WINDOW VAR w :: window(46,18,22,3); + cursor off; + outframe (w); + IF yes (w, "Auskunft drucken", FALSE) + THEN drucke (headline (f)) + FI; + cursor on; + forget (headline (f), quiet). +END PROC auskunft; +PROC rechnungskopf: + pruefe abbruch; + IF kundennummer ist eingelesen AND nachname <> "" + THEN ueberschrift := " RECHNUNG für " + anrede + (vorname SUB 1) + + ". " + text (nachname, 10) + ELSE ueberschrift := " RECHNUNG" + + FI; + summe := 0.0; + schreibe ueberschrift auf bildschirm; + schreibe in rechnungsdatei; + IF codekartenleser aktiviert + THEN lasse karte entfernen (FALSE) + FI. + schreibe in rechnungsdatei: + sysout ("WARENHAUS:Rechnung"); + line; + put (ueberschrift); + line; + put (" =================================="); + line (2); + sysout (""). + anrede: + IF geschlecht = "m" + THEN "Herrn " + ELIF geschlecht = "w" + THEN "Frau " + ELSE "" + + FI. +END PROC rechnungskopf; +PROC schreibe ueberschrift auf bildschirm: + INT VAR spalte, zeile; + get cursor (w3, spalte, zeile); + IF zeile = 1 + THEN auf neuem blatt := TRUE; + schreibe in w3k + ELSE auf neuem blatt := FALSE; + schreibe in w3 + FI. + schreibe in w3: + IF remaining lines (w3) < 7 + THEN page (w3); + page (w3k); + auf neuem blatt := TRUE; + schreibe in w3k + ELSE line (w3); + out (w3, ueberschrift); + + line (w3); + out (w3, " =================================="); + line (w3, 2) + FI. + schreibe in w3k: + out (w3k, ueberschrift); + line (w3k); + out (w3k, " =================================="). +END PROC schreibe ueberschrift auf bildschirm; +PROC artikel kaufen: + pruefe abbruch; + IF artikelnummer ist eingelesen + THEN kauf registrieren + ELSE setze variable in anfangszustand; + errorstop ("Es ist keine Artikelnummer eingelesen worden!") + + FI; + IF codekartenleser aktiviert + THEN lasse karte entfernen (FALSE) + FI. + kauf registrieren: + artikelnummer ist eingelesen := FALSE; + IF bestand > 0 + THEN artikel auf rechnung setzen; + registrieren + ELSE page (w2); out (""7""); + IF artikelname = "" + THEN out (w2, " Artikel hier nicht erhältlich!") + ELSE out (w2, " Der Artikel ist ausverkauft!") + FI; + line (w2, 2); + out (w2, " Weiter durch Tippen einer Taste"); + + pause + FI. + registrieren: + IF kundennummer ist eingelesen + THEN registriere verkauf (kundennummer, artikelnummer) + ELSE registriere verkauf (min kundennummer - 1, artikelnummer) + FI. + artikel auf rechnung setzen: + summe INCR preis; + IF remaining lines (w3) < 3 + THEN beginne wieder oben + FI; + out (w3, " " + text (artikelname, 15) + text (preis, 12, 2)); + line (w3); + sysout ("WARENHAUS:Rechnung"); + put (" " + text (artikelname, 15) + text preis); + + line; + sysout (""). + beginne wieder oben: + IF auf neuem blatt + THEN page (w3) + ELSE schreibe ueberschrift auf bildschirm + FI. + text preis: + TEXT VAR hilfe :: text (preis, 12, 2); + INT VAR vor punkt :: pos (hilfe, ".") - 1; + IF (hilfe SUB vor punkt) = " " + THEN change (hilfe, vor punkt, vor punkt, "0") + FI; + hilfe. +END PROC artikel kaufen; +PROC abrechnung: + pruefe abbruch; + schreibe summe auf bildschirm; + + schreibe summe in rechnungsdatei; + setze variable zurueck; + frage ob drucken; + IF codekartenleser aktiviert + THEN lasse karte entfernen (FALSE) + FI. + schreibe summe auf bildschirm: + IF remaining lines (w3) < 2 + THEN beginne wieder oben + FI; + put (w3, " -------------"); + line (w3); + put (w3, " Summe " + text (summe, 12, 2)); + line (w3). + beginne wieder oben: + IF auf neuem blatt + THEN page (w3) + ELSE schreibe ueberschrift auf bildschirm + + FI. + schreibe summe in rechnungsdatei: + sysout ("WARENHAUS:Rechnung"); + put (" -------------"); + line; + put (" Summe " + text (summe, 12, 2)); + line; + sysout (""). + setze variable zurueck: + BOOL VAR alter wert :: ende gewuenscht; + setze variable in anfangszustand; + ende gewuenscht := alter wert. + frage ob drucken: + IF yes (w2, "Rechnung drucken", FALSE) + THEN cursor (3, 22); + disable stop; + print ("WARENHAUS:Rechnung"); + + IF is error THEN clear error FI; + enable stop + FI. +END PROC abrechnung; +PROC artikeldaten eingeben: + pruefe abbruch; + IF artikelnummer ist eingelesen + THEN lies artikeldaten ein; + artikeldaten speichern + ELSE setze variable in anfangszustand; + errorstop ("Es ist keine Artikelnummer eingelesen worden!") + FI. + lies artikeldaten ein: + zeige artikeldaten; + IF artikelname <> "" + THEN vielleicht schon fertig + ELSE page (w2) + + FI; + REP line (w2); + put (w2, " Artikeldaten eingeben"); + eingabe + UNTIL yes (w2, "Alles richtig", TRUE) + PER; + artikelnummer ist eingelesen := FALSE. + vielleicht schon fertig: + IF yes (w2, "Alles richtig", TRUE) + THEN artikelnummer ist eingelesen := FALSE; + IF codekartenleser aktiviert + THEN lasse karte entfernen (FALSE) + FI; + LEAVE artikeldaten eingeben + FI. + eingabe: + name holen; + + preis holen; + mindestbestand holen; + bestand holen. + name holen: + REP cursor (w1, 19, 6); + editget (w1, artikelname, 80, 80, "", abbruchzeichen + stopzeichen, + exit char); + teste auf abbruch + UNTIL artikelname <> "" PER. + preis holen: + hilfstext := text (preis, pos(text(preis),".") + 2, 2); + change (hilfstext, " ", "0"); + REP cursor (w1, 19, 8); + editget (w1, hilfstext, 8, 8, "", abbruch zeichen + stopzeichen, + + exit char); + change (hilfstext, ",", "."); + preis := round (real (hilfstext), 2); + teste auf abbruch + UNTIL preis >= 0.0 PER. + mindestbestand holen: + hilfstext := text (mindestbestand); + REP cursor (w1, 19, 10); + editget (w1, hilfstext, 4, 4, "", abbruch zeichen + stopzeichen, + exit char); + mindestbestand := int (hilfstext); + teste auf abbruch + UNTIL mindestbestand >= 0 PER. + + bestand holen: + hilfstext := text (bestand); + REP cursor (w1, 19, 12); + editget (w1, hilfstext, 4, 4, "", abbruch zeichen + stopzeichen, + exit char); + bestand := int (hilfstext); + teste auf abbruch + UNTIL bestand >= 0 PER. + teste auf abbruch: + IF exit char = esc + stopzeichen + THEN ende gewuenscht := TRUE + ELIF exit char = esc + abbruchzeichen + THEN setze variable in anfangszustand; + errorstop (1951, "Programm - Abbruch durch <ESC><" + + + abbruchzeichen + ">") + FI. +END PROC artikeldaten eingeben; +PROC kundendaten eingeben: + IF kundennummer ist eingelesen + THEN lies kundendaten ein; + kundendaten speichern + ELSE setze variable in anfangszustand; + errorstop ("Es ist keine Kundennummer eingelesen worden!") + FI. + lies kundendaten ein: + zeige kundendaten; + IF nachname <> "" + THEN vielleicht schon fertig + ELSE page (w2) + FI; + REP line (w2); + + put (w2, " Kundendaten eingeben"); + eingabe + UNTIL yes (w2, "Alles richtig", TRUE) PER; + kundennummer ist eingelesen := FALSE. + vielleicht schon fertig: + IF yes (w2, "Alles richtig", TRUE) + THEN kundennummer ist eingelesen := FALSE; + IF codekartenleser aktiviert + THEN lasse karte entfernen (FALSE) + FI; + LEAVE kundendaten eingeben + FI. + eingabe: + nachname holen; + vorname holen; + geschlecht holen. + + nachname holen: + REP cursor (w1, 19, 6); + editget (w1, nachname, 80, 80, "", abbruch zeichen + stopzeichen, + exit char); + teste auf abbruch + UNTIL nachname <> "" PER. + vorname holen: + REP cursor (w1, 19, 8); + editget (w1, vorname, 80, 80, "", abbruch zeichen + stopzeichen, + exit char); + teste auf abbruch + UNTIL vorname <> "" PER. + geschlecht holen: + REP cursor (w1, 19, 10); + + editget (w1, geschlecht, 9, 9, "", abbruchzeichen + stopzeichen, + exit char); + geschlecht := geschlecht SUB 1; + teste auf abbruch + UNTIL geschlecht = "m" OR geschlecht = "w" PER. + teste auf abbruch: + IF exit char = esc + stopzeichen + THEN ende gewuenscht := TRUE + ELIF exit char = esc + abbruchzeichen + THEN setze variable in anfangszustand; + errorstop (1951, "Programm - Abbruch durch <ESC><" + + + abbruchzeichen + ">") + FI. +END PROC kundendaten eingeben; +PROC drucke (TEXT CONST name): + TEXT VAR zeile; + FILE VAR f :: sequential file (modify, name); + to line (f, 1); + insert record (f); + write record (f, "#center#" + name); + down (f); + insert record (f); + down (f); + WHILE NOT eof (f) REP + read record (f, zeile); + IF pos (zeile, ""15"") > 0 + THEN change (zeile, ""15"", "#on(""r"")#"); + change (zeile, ""14"", "#off(""r"")#"); + + write record (f, zeile) + FI; + down (f) + PER; + cursor (3, 22); + print (name) +END PROC drucke; +PROC stop w2: + cursor off; + page (w2); + out (w2," Zum Weitermachen bitte");line(w2); + out (w2," irgendeine Taste tippen!"); + pause; + page (w2); + cursor on +END PROC stop w2; +BOOL PROC yes (WINDOW VAR w, TEXT CONST frage, BOOL CONST default): + BOOL VAR antwort :: default; + TEXT VAR taste; + INT CONST ja pos :: (areaxsize (w) - 9) DIV 2; + cursor off; + cursor (42,24); out ("Ändern: <Pfeile> Bestätigen: <RETURN>"); + + page (w); + out (w, center (w, frage + " ?")); + cursor (w, ja pos, 3); + IF default + THEN out (w, ""15"Ja "14" Nein "); + cursor (w, ja pos, 3) + ELSE out (w, " Ja "15"Nein "14""); + cursor (w, ja pos + 5, 3) + FI; + tastendruck auswerten; + page (w); + cursor (42,24); out (""5""); + cursor on; + antwort. + tastendruck auswerten: + REP inchar (taste); + SELECT code (taste) OF CASE 2, 8 : position aendern + CASE 13 : LEAVE tastendruck auswerten + + CASE 74, 106 : antwort := TRUE; (*Jj*) + LEAVE tastendruck auswerten + CASE 78, 110 : antwort := FALSE; (*Nn*) + LEAVE tastendruck auswerten + OTHERWISE out (""7"") END SELECT + PER. + position aendern: + IF antwort THEN antwort := FALSE; + cursor (w, ja pos, 3); + out (w, " Ja "15"Nein "14""); + + cursor (w, ja pos + 5, 3) + ELSE antwort := TRUE; + cursor (w, ja pos, 3); + out (w, ""15"Ja "14" Nein "); + cursor (w, ja pos, 3) + FI. +END PROC yes; +PROC tastatureingabe (BOOL CONST erwuenscht, INT VAR rueckmeldung): + IF erwuenscht + THEN rueckmeldung := 0; + codekartenleser aktiviert := FALSE; + schliesse interface + ELSE oeffne interface (rueckmeldung); + IF rueckmeldung >= 0 + + THEN codekartenleser aktiviert := TRUE + ELSE codekartenleser aktiviert := FALSE + FI + FI +END PROC tastatureingabe; +BOOL PROC eingabe mit codekartenleser: + codekartenleser aktiviert +END PROC eingabe mit codekartenleser; +PROC dezimalwert lesen: + pruefe abbruch; + IF codekartenleser aktiviert + THEN interfacewerte zeigen + ELSE setze variable in anfangszustand; + errorstop ("Eingabeart ist auf Tastatur eingestellt!") + FI. + interfacewerte zeigen: + + cursor off; + fenster putzen; + line (w1, 4); line (w2); + out (w1, " Dezimalwert :"); + out (w2, " Lesen beenden mit <ESC><q>"); + ende gewuenscht := FALSE; + REP pruefe abbruch; + cursor (w1, 17, 5); + out (w1, text (wert von interface, 3)) + UNTIL ende gewuenscht PER; + page (w2); cursor (w1, 1, 5); out (" "); + cursor on. +END PROC dezimalwert lesen; +PROC bitmuster lesen: + pruefe abbruch; + IF codekartenleser aktiviert + + THEN interfacewerte zeigen + ELSE setze variable in anfangszustand; + errorstop ("Eingabeart ist auf Tastatur eingestellt!") + FI. + interfacewerte zeigen: + cursor off; + fenster putzen; + line (w1, 4); line (w2); + out (w1, " Bitmuster :"); + out (w2, " Lesen beenden mit <ESC><q>"); + ende gewuenscht := FALSE; + REP pruefe abbruch; + cursor (w1, 16, 5); + out (w1, bitmuster (wert von interface)) + UNTIL ende gewuenscht PER; + page (w2); cursor (w1, 1, 5); out (" "); + + cursor on. +END PROC bitmuster lesen; +TEXT PROC bitmuster (INT CONST wert): + INT VAR bitnr; + TEXT VAR muster :: ""; + FOR bitnr FROM 7 DOWNTO 0 REP + IF bit (wert, bitnr) + THEN muster CAT "I" + ELSE muster CAT "O" + FI + PER; + muster +END PROC bitmuster; +PROC lasse karte entfernen (BOOL CONST mit rahmen): + IF wert von interface <> 255 + THEN cursor off; + IF mit rahmen THEN regeneriere w2 ELSE page (w2) FI; + line (w2); + out (w2, " Bitte Karte entfernen"); + + REP pruefe abbruch + UNTIL (wert von interface = 255) OR ende gewuenscht PER; + cursor on + FI +END PROC lasse karte entfernen; +INT PROC gesicherter wert von interface (INT CONST von, bis, + TEXT CONST kartenart): + INT VAR wert, zaehler; + ende gewuenscht := FALSE; + cursor off; + REP out (w2, " Bitte " + kartenart + " einschieben"); + line (w2, 2); + out (w2, " Stoptaste: <ESC><" + stopzeichen + ">"); + cursor (79, 24); + + gesicherten wert einlesen; + cursor (w1, 19, 2); + out (w1, text (wert, 3)); + IF wert < von OR wert > bis + THEN warnung + FI + UNTIL wert >= von AND wert <= bis PER; + cursor on; + wert. + gesicherten wert einlesen: + REP zaehler := 0; + warte auf karte; + wert := wert von interface; + lies wert + UNTIL wert gesichert AND wert <> 255 PER. + warte auf karte: + REP beachte esc q + UNTIL wert von interface <> 255 PER. + beachte esc q: + + pruefe abbruch; + IF ende gewuenscht + THEN cursor on; + LEAVE gesicherter wert von interface WITH 0 + FI. + lies wert: + REP beachte esc q; + IF wert = wert von interface + THEN zaehler INCR 1 + ELSE LEAVE lies wert + FI + UNTIL wert gesichert PER. + wert gesichert: zaehler = sicherheit. + warnung: + page (w2); out (""7""); + out (w2, " Dies ist keine " + kartenart + "!"); + line (w2, 2); + out (w2, " Bitte Karte entfernen"); + + REP beachte esc q + UNTIL wert von interface = 255 PER; + page (w2). +END PROC gesicherter wert von interface +END PACKET ls warenhaus 3 + |