path: root/warenhaus/ls-Warenhaus 3

(* 
        
         ********************************************************** 
         ********************************************************** 
         **                                                      ** 
         **                    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