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