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/base/1.7.5/src/command dialogue | 123 +++++++++++++++++++++++++++++++++
 1 file changed, 123 insertions(+)
 create mode 100644 system/base/1.7.5/src/command dialogue

(limited to 'system/base/1.7.5/src/command dialogue')

diff --git a/system/base/1.7.5/src/command dialogue b/system/base/1.7.5/src/command dialogue
new file mode 100644
index 0000000..3011187
--- /dev/null
+++ b/system/base/1.7.5/src/command dialogue	
@@ -0,0 +1,123 @@
+
+PACKET command dialogue DEFINES                (* Autor: J.Liedtke *)
+                                               (* Stand:  25.11.83 *)
+       command dialogue ,
+       say ,
+       yes ,
+       no ,
+       param position ,
+       last param ,
+       std ,
+       QUIET ,
+       quiet :
+ 
+
+LET up      = ""3"" ,
+    right   = ""2"" ,
+    cr lf   = ""13""10"" ,
+    param pre  = " (""" ,
+    param post = """)"13""10"" ;
+ 
+
+TEXT VAR std param := "" ;
+ 
+BOOL VAR dialogue flag := TRUE ;
+
+INT VAR param x := 0 ;
+
+
+TYPE QUIET = INT ;
+
+QUIET PROC quiet :
+  QUIET:(0)
+ENDPROC quiet ;
+
+ 
+BOOL PROC command dialogue :
+  dialogue flag
+ENDPROC command dialogue ;
+ 
+PROC command dialogue (BOOL CONST status) :
+  dialogue flag := status
+ENDPROC command dialogue ;
+ 
+ 
+BOOL PROC yes (TEXT CONST question) :
+ 
+  IF dialogue flag
+    THEN ask question
+    ELSE TRUE
+  FI .
+ 
+ask question :
+  out (question) ;
+  skip previous input chars ;
+  out (" (j/n) ? ") ;
+  get answer ;
+  IF correct answer
+    THEN out (answer) ;
+         out (cr lf) ;
+         positive answer
+    ELSE out (""7"") ;
+         LENGTH question + 9 TIMESOUT ""8"" ;
+         yes (question)
+  FI .
+ 
+get answer :
+  TEXT VAR answer ;
+  inchar (answer) .
+ 
+correct answer :
+  pos ("jnyJNY", answer) > 0 .
+ 
+positive answer :
+  pos ("jyJY", answer) > 0 .
+
+skip previous input chars :
+  REP UNTIL incharety = "" PER .
+ 
+ENDPROC yes ;
+ 
+BOOL PROC no (TEXT CONST question) :
+ 
+  NOT yes (question)
+ 
+ENDPROC no ;
+ 
+PROC say (TEXT CONST message) :
+ 
+  IF dialogue flag
+    THEN out (message)
+  FI
+ 
+ENDPROC say ;
+ 
+PROC param position (INT CONST x) :
+ 
+  param x := x
+
+ENDPROC param position ;
+
+TEXT PROC last param :
+ 
+  IF param x > 0 AND online
+    THEN out (up) ;
+         param x TIMESOUT right ;
+         out (param pre) ;
+         out (std param) ;
+         out (param post)
+  FI ;
+  std param .
+ 
+ENDPROC last param ;
+ 
+PROC last param (TEXT CONST new) :
+  std param := new
+ENDPROC last param ;
+
+TEXT PROC std :
+  std param
+ENDPROC std ;
+
+ENDPACKET command dialogue ;
+
-- 
cgit v1.2.3