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