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
|
PACKET name conversion DEFINES (* Copyright (C) 1985 *)
(* Frank Klapper *)
adapted name: (* 20.02.86 *)
LET upper case chars = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789$#&@!(){}",
lower case chars = "abcdefghijklmnopqrstuvwxyz";
TEXT VAR name pre,
name post,
new,
char;
INT VAR point pos,
count;
TEXT PROC adapted name (TEXT CONST eu name, BOOL CONST read modus):
enable stop;
point pos := pos (eu name, ".");
IF name extension exists
THEN changed name with extension
ELSE changed name without extension
FI.
name extension exists:
point pos > 0.
changed name with extension:
name pre := compress (subtext (eu name, 1, point pos - 1));
name post := compress (subtext (eu name, point pos + 1));
IF LENGTH name pre = 0 OR LENGTH name pre > 8 OR LENGTH name post > 3
THEN error
FI;
IF LENGTH name post = 0
THEN new name (name pre, read modus)
ELSE new name (name pre, read modus) + "."
+ new name (name post, read modus)
FI.
changed name without extension:
IF LENGTH eu name > 8 OR LENGTH euname < 1
THEN error
FI;
new name (eu name, read modus).
error:
errorstop ("Unzulässiger Name").
END PROC adapted name;
TEXT PROC new name (TEXT CONST old name, BOOL CONST read modus):
new := "";
FOR count FROM 1 UPTO LENGTH old name REP
convert char
PER;
new.
convert char:
char := old name SUB count;
IF is lower case char
THEN new CAT (upper case chars SUB string pos)
ELIF is upper case char OR read modus
THEN new CAT char
ELSE error stop ("Unzulässiger Name")
FI.
is lower case char:
pos (lower case chars, char) > 0.
is upper case char:
pos (upper case chars, char) > 0.
string pos:
pos (lower case chars, char).
END PROC new name;
END PACKET name conversion;
|
