From 04e68443040c7abad84d66477e98f93bed701760 Mon Sep 17 00:00:00 2001
From: Lars-Dominik Braun <lars@6xq.net>
Date: Mon, 4 Feb 2019 13:09:03 +0100
Subject: Initial import

---
 system/dos/1.8.7/src/fetch save interface | 70 +++++++++++++++++++++++++++++++
 1 file changed, 70 insertions(+)
 create mode 100644 system/dos/1.8.7/src/fetch save interface

(limited to 'system/dos/1.8.7/src/fetch save interface')

diff --git a/system/dos/1.8.7/src/fetch save interface b/system/dos/1.8.7/src/fetch save interface
new file mode 100644
index 0000000..27b4925
--- /dev/null
+++ b/system/dos/1.8.7/src/fetch save interface	
@@ -0,0 +1,70 @@
+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;
+
-- 
cgit v1.2.3