From 98cab31fc3659e33aef260efca55bf9f1753164c Mon Sep 17 00:00:00 2001
From: Lars-Dominik Braun <lars@6xq.net>
Date: Mon, 11 Feb 2019 11:49:19 +0100
Subject: Add source files from Michael

---
 system/dos/1986/src/name conversion | 77 +++++++++++++++++++++++++++++++++++++
 1 file changed, 77 insertions(+)
 create mode 100644 system/dos/1986/src/name conversion

(limited to 'system/dos/1986/src/name conversion')

diff --git a/system/dos/1986/src/name conversion b/system/dos/1986/src/name conversion
new file mode 100644
index 0000000..1f9a797
--- /dev/null
+++ b/system/dos/1986/src/name conversion	
@@ -0,0 +1,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;
-- 
cgit v1.2.3