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
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
|
(*
**********************************************************
**********************************************************
** **
** 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
|
