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

---
 lang/basic/1.8.7/src/gen.BASIC | 80 ++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 80 insertions(+)
 create mode 100644 lang/basic/1.8.7/src/gen.BASIC

(limited to 'lang/basic/1.8.7/src/gen.BASIC')

diff --git a/lang/basic/1.8.7/src/gen.BASIC b/lang/basic/1.8.7/src/gen.BASIC
new file mode 100644
index 0000000..9690ae6
--- /dev/null
+++ b/lang/basic/1.8.7/src/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