system/dos/1.8.7/src/fetch save interface

Raw file
Back to index

 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
PACKET fetch save DEFINES                   (* Copyright (C) 1986 *)
                                            (* Frank Klapper      *)
  save fetch mode,                          (* 22.04.87           *)
  path:

LET ascii        = 1,
    ascii german = 2,
    transparent  = 3,
    row text     = 5,
    ds           = 6,
    dump         = 7,
    atari st     = 10,
    ibm          = 11;

INT PROC save fetch mode (TEXT CONST reserve string):
  TEXT VAR modus;
  INT CONST p := pos (reserve string, ":");
  IF p = 0
    THEN modus := reserve string
    ELSE modus := subtext (reserve string, 1, p - 1)
  FI;
  modus normieren;
  IF modus = "FILEASCII"
    THEN ascii
  ELIF modus = "FILEASCIIGERMAN"
    THEN asciigerman
  ELIF modus = "FILEATARIST"
    THEN atari st
  ELIF modus = "FILEIBM"
    THEN ibm
  ELIF modus = "FILETRANSPARENT"
    THEN transparent
  ELIF modus = "ROWTEXT"
    THEN row text
  ELIF modus = "DS"
    THEN ds
  ELIF modus = "DUMP"
    THEN dump
    ELSE error stop ("Unzulässige Betriebsart"); -1
  FI.

modus normieren:
  change all (modus, " ", "");
  INT VAR i;
  FOR i FROM 1 UPTO LENGTH modus REP
    INT CONST char code :: code (modus SUB i);
    IF is lower case
      THEN replace (modus, i, upper case char)
    FI
  PER.

is lower case:
  char code > 96 AND char code < 123.

upper case char:
  code (char code - 32).

END PROC save fetch mode;

TEXT PROC path (TEXT CONST reserve string):
  INT CONST p :: pos (reserve string, ":");
  IF p = 0
    THEN ""
    ELSE subtext (reserve string, p + 1)
  FI.

END PROC path;
 
END PACKET fetch save;