summaryrefslogtreecommitdiff
path: root/system/dos/1986/src/name conversion
blob: 1f9a7977ebdbd93ac225a4ebd5f8a4d14300cdee (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
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;