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/std.zusatz/1.7.3/src/crypt | 139 ++++++++++++++++++++++++++++++++++++++
 1 file changed, 139 insertions(+)
 create mode 100644 system/std.zusatz/1.7.3/src/crypt

(limited to 'system/std.zusatz/1.7.3/src/crypt')

diff --git a/system/std.zusatz/1.7.3/src/crypt b/system/std.zusatz/1.7.3/src/crypt
new file mode 100644
index 0000000..f6711fa
--- /dev/null
+++ b/system/std.zusatz/1.7.3/src/crypt
@@ -0,0 +1,139 @@
+PACKET cryptograf DEFINES                            (* Autor: J.Liedtke *)
+                                                     (* Stand: 01.10.80  *)
+  crypt ,
+  decrypt :
+ 
+TEXT VAR char , in buffer, out buffer ;
+INT VAR in pos , key index ;
+DATASPACE VAR scratch space := nilspace ;
+FILE VAR in, out;
+ 
+PROC crypt (TEXT CONST file, key) :
+ 
+  open (file) ;
+  initialize crypt (key) ;
+  WHILE NOT eof REP
+    read char ;
+    crypt char ;
+    write char
+  PER ;
+  close (file) .
+ 
+crypt char :
+  char := code (( character + random char + key char ) MOD 250) ;
+  IF key index = LENGTH key
+    THEN key index := 1
+    ELSE key index INCR 1
+  FI .
+ 
+character   : code (char) .
+ 
+random char : random (0,250).
+ 
+key char    : code (key SUB key index) .
+ 
+ENDPROC crypt ;
+ 
+PROC decrypt (TEXT CONST file, key) :
+ 
+  open (file) ;
+  initialize crypt (key) ;
+  WHILE NOT eof REP
+    read char ;
+    decrypt char ;
+    write char
+  PER ;
+  close (file) .
+ 
+decrypt char :
+  char := code (( character - random char - key char ) MOD 250) ;
+  IF key index = LENGTH key
+    THEN key index := 1
+    ELSE key index INCR 1
+  FI .
+ 
+character   : code (char) .
+ 
+random char : random (0,250) .
+ 
+key char    : code (key SUB key index) .
+ 
+ENDPROC decrypt ;
+ 
+PROC initialize crypt (TEXT CONST key) :
+ 
+  INT VAR random key := 0 ;
+  FOR key index FROM 1 UPTO LENGTH key REP
+    random key := (random key + code (key SUB key index)) MOD 32000
+  PER ;
+  initialize random (random key) ;
+  key index := 1
+ 
+ENDPROC initialize crypt ;
+ 
+PROC open (TEXT CONST source file) :
+ 
+  in := sequential file (input, source file) ;
+  getline (in, in buffer) ;
+  in pos := 1 ;
+  out := sequential file (output, scratch space) ;
+  out buffer := "" .
+ 
+ENDPROC open ;
+ 
+PROC close (TEXT CONST source file) :
+ 
+  IF out buffer <> ""
+    THEN putline (out, out buffer)
+  FI ;
+  forget (source file, quiet) ;
+  copy (scratch space, source file) ;
+  forget (scratch space) .
+ 
+ENDPROC close ;
+ 
+BOOL PROC eof :
+ 
+  IF in pos > LENGTH in buffer
+    THEN eof (in)
+    ELSE FALSE
+  FI
+ 
+ENDPROC eof ;
+ 
+PROC read char :
+ 
+  IF in pos > 250
+    THEN getline (in, in buffer) ;
+         in pos := 1 ;
+         read char
+  ELIF in pos > LENGTH in buffer
+    THEN in pos := 1 ;
+         getline (in, in buffer) ;
+         char := ""13""
+    ELSE char := in buffer SUB in pos ;
+         in pos INCR 1
+  FI .
+ 
+ENDPROC read char ;
+ 
+PROC write char :
+ 
+  IF char = ""13""
+    THEN putline (out, out buffer) ;
+         out buffer := ""
+    ELSE out buffer CAT char
+  FI ;
+  IF LENGTH out buffer = 250
+    THEN putline (out, out buffer) ;
+         out buffer := ""
+  FI .
+ 
+ENDPROC write char ;
+ 
+ENDPACKET cryptograf ;
+
+
+
+
+
-- 
cgit v1.2.3