From 724cc003460ec67eda269911da85c9f9e40aa6cf Mon Sep 17 00:00:00 2001
From: Lars-Dominik Braun <lars@6xq.net>
Date: Fri, 30 Sep 2016 16:57:23 +0200
Subject: Add extracted sources from floppy disk images

Some files have no textual representation (yet) and were added as raw
dataspaces.
---
 basic/gen.BASIC | 80 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 80 insertions(+)
 create mode 100644 basic/gen.BASIC

(limited to 'basic/gen.BASIC')

diff --git a/basic/gen.BASIC b/basic/gen.BASIC
new file mode 100644
index 0000000..9690ae6
--- /dev/null
+++ b/basic/gen.BASIC
@@ -0,0 +1,80 @@
+(**************************************************************************)
+(*                                                                        *)
+(*     Generatorprogramm zur Installation des EUMEL-BASIC-Systems         *)
+(*                                                                        *)
+(*     Autor: Heiko Indenbirken                                           *)
+(*     Überarbeitet von: Michael Overdick                                 *)
+(*                                                                        *)
+(*     Stand: 27.08.1987                                                  *)
+(*                                                                        *)
+(**************************************************************************)
+
+LET coder name = "eumel coder 1.8.1";
+
+show headline;
+from archive ("BASIC.1", (coder name & "eumel0 codes") - all);
+from archive ("BASIC.2",
+       ("BASIC.Runtime" & "BASIC.Administration" & "BASIC.Compiler") - all);
+set status;
+insert ("eumel coder 1.8.1");
+insert ("BASIC.Runtime");
+insert ("BASIC.Administration");
+insert ("BASIC.Compiler");
+forget (coder name & "BASIC.Runtime"
+               & "BASIC.Administration" & "BASIC.Compiler" & "gen.BASIC");
+restore status;
+show end .
+
+show headline:
+  page;
+  putline ("                 "15"Einrichten des EUMEL-BASIC-Systems "14"");
+  line  .
+
+set status:
+  BOOL VAR old check := check,
+           old warnings := warnings,
+           old command dialogue := command dialogue;
+  check off;
+  warnings off;
+  command dialogue (FALSE).
+
+restore status:
+  IF old check     THEN do ("check on") ELSE do ("check off") FI;
+  IF old warnings  THEN warnings on                           FI;
+  command dialogue (old command dialogue).
+
+show end:
+  line (2);
+  putline ("                      "15"BASIC-System installiert "14"");
+  line  .
+ 
+PROC from archive (TEXT CONST name, THESAURUS CONST files):
+  IF highest entry (files) > 0
+  THEN ask for archive;
+       archive (name);
+       fetch (files, archive);
+       release (archive);
+       putline ("Archiv abgemeldet !")
+  FI  .
+
+ask for archive:
+  line;
+  IF no ("Archiv """ + name + """ eingelegt")
+  THEN errorstop ("Archive nicht bereit") FI  .
+
+END PROC from archive;
+
+THESAURUS OP & (TEXT CONST left, right):
+  THESAURUS VAR result := empty thesaurus;
+  insert (result, left);
+  insert (result, right);
+  result
+END OP &;
+
+THESAURUS OP & (THESAURUS CONST left, TEXT CONST right):
+  THESAURUS VAR result := left;
+  insert (result, right);
+  result
+END OP &;
+
+
-- 
cgit v1.2.3