(* 
        
         ********************************************************** 
         ********************************************************** 
         **                                                      ** 
         **                    ls-Warenhaus 0                    ** 
         **                                                      ** 
         **  Anpassung für Kartenleser an MUFI im Terminalkanal  ** 
         **                                                      ** 
         **                     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 0  DEFINES                     
       interface anpassung,
       oeffne interface,
       schliesse interface,
       wert von interface,
       pressed key:
TEXT CONST interface anpassung :: "mit Kartenleser an MUFI im Terminalkanal";
LET  mufikennung = ""31""31"";
INT  CONST interface error code :: -4;
TEXT CONST readcode :: mufikennung + "4C";
TEXT VAR   puffer   :: "";
PROC oeffne interface (INT VAR status):
  cursor (2,24);
  warte etwas;
  leere eingangspuffer;
  out (""27""27"10");
  fange antwort;
  IF antwort = ""27""27"00"

     THEN status := 0;
          out (""27""27"1C" + hex (mufikennung))
     ELSE status := interface error code
  FI.
  warte etwas:
    pause (1); pause (1); pause (1); pause (1); pause (1).
  leere eingangspuffer:
    puffer := "";
    REP UNTIL incharety = "" PER.
  fange antwort:
    TEXT VAR antwort :: incharety (1);
    INT VAR i;
    FOR i FROM 1 UPTO 3 REP
      antwort CAT incharety (1)
    PER.
END PROC oeffne interface;
INT PROC wert von interface:
  puffer CAT incharety (1);

  out (readcode);
  fange mufikennung;
  dezimalwert (incharety (1), incharety (1)).
  fange mufikennung:
    REP puffer CAT incharety
    UNTIL pos (puffer, mufikennung) > 0 PER;
    change (puffer, mufikennung, "").
END PROC wert von interface;
PROC schliesse interface:
  cursor (2,24);
  out (mufikennung + "1C" + hex (""27""27""))
END PROC schliesse interface;
TEXT PROC pressed key:
  IF puffer = ""
     THEN incharety
     ELSE erstes pufferzeichen
  FI.
  erstes pufferzeichen:

    TEXT VAR zeichen :: puffer SUB 1;
    puffer := subtext (puffer, 2);
    zeichen.
END PROC pressed key;
TEXT PROC pressed key (INT CONST warten):
  IF puffer = ""
     THEN incharety (warten)
     ELSE erstes pufferzeichen
  FI.
  erstes pufferzeichen:
    TEXT VAR zeichen :: puffer SUB 1;
    puffer := subtext (puffer, 2);
    zeichen.
END PROC pressed key;
INT PROC dezimalwert (TEXT CONST zeichen 1, zeichen 2):
  16 * pos (hexzeichen, zeichen 1) + pos (hexzeichen, zeichen 2).

  hexzeichen: "123456789ABCDEF".
END PROC dezimalwert;
TEXT PROC hex (TEXT CONST zwei zeichen):
  hex (code (zwei zeichen SUB 1)) + hex (code (zwei zeichen SUB 2))
END PROC hex;
TEXT PROC hex (INT CONST wert):
  (hexzeichen SUB (wert DIV 16 + 1)) + (hexzeichen SUB (wert MOD 16 + 1)).
  hexzeichen: "0123456789ABCDEF".
END PROC hex
END PACKET ls warenhaus 0