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/std.graphik/1.8.7/src/GRAPHIK.Server | 97 +++++++++++++++++++++++++++++
 1 file changed, 97 insertions(+)
 create mode 100644 system/std.graphik/1.8.7/src/GRAPHIK.Server

(limited to 'system/std.graphik/1.8.7/src/GRAPHIK.Server')

diff --git a/system/std.graphik/1.8.7/src/GRAPHIK.Server b/system/std.graphik/1.8.7/src/GRAPHIK.Server
new file mode 100644
index 0000000..dfe5f62
--- /dev/null
+++ b/system/std.graphik/1.8.7/src/GRAPHIK.Server
@@ -0,0 +1,97 @@
+PACKET multi user plotter:                       (* Autor : Rudolf Ruland  *)
+                                                 (* Stand : 24.03.86       *)
+                                              (*Änderung: 09.09.86/15:32 *)
+ 
+INT VAR c;
+put ("gib Plotterkanal : "); get (c);
+
+  server channel (c);
+  station only (FALSE) ;
+  spool duty ("Ausgabe mit dem Plotter");
+  spool control task (myself);
+ 
+LET ack              = 0 ,
+ 
+    fetch code       = 11 ,
+    param fetch code = 21 ,
+    picfile type     = 1103 ;
+
+INT VAR reply, old heap size, sender station;
+TEXT VAR picfile name, userid, password, sendername;
+PICFILE VAR picfile ;
+
+DATASPACE VAR ds, picfile ds;
+ 
+BOUND STRUCT (TEXT picfile name, userid, password, sendername, INT station) VAR msg;
+BOUND TEXT VAR error msg ;
+ 
+spool manager (PROC plotter);
+ 
+PROC plotter :
+
+  disable stop ;
+  command dialogue (FALSE);
+  ds := nilspace; picfile ds := nilspace; 
+  continue (server channel) ;
+    check error ("Kanal belegt");
+ 
+  old heap size := heap size ;
+  REP
+    execute plot ;
+ 
+    IF is error
+      THEN put error;
+           clear error;
+    FI ;
+ 
+    IF heap size > old heap size + 4
+      THEN collect heap garbage ;
+           old heap size := heap size
+    FI
+  PER 
+ 
+ENDPROC plotter ;
+
+ 
+PROC execute plot :
+
+  enable stop ;
+  forget (picfile ds) ; picfile ds := nilspace ;
+  call (father, fetch code, picfile ds, reply) ;
+  IF reply = ack CAND type (picfile ds) = picfile type
+     THEN get picfile params;
+          plot picfile
+  FI ;
+ 
+. get picfile params :
+    forget (ds); ds := nilspace;
+    call (father, param fetch code, ds, reply);
+    IF reply <> ack
+       THEN error msg := ds; errorstop (error msg);
+       ELSE msg := ds;
+            picfile name   := msg. picfile name;
+            userid         := msg. userid;
+            password       := msg. password;
+            sendername     := msg. sender name;
+            sender station := msg. station;
+    FI;
+ 
+. plot picfile :
+    picfile := picfile ds;
+    plotter (picfile)  .
+
+ENDPROC execute plot ;
+ 
+ 
+PROC check error (TEXT CONST message) :
+    IF is error
+       THEN clear error;
+            rename myself (message);
+            IF is error THEN clear error; end (myself) FI;
+            pause (18000);
+            end (myself);
+    FI;
+END PROC check error;
+ 
+ENDPACKET multi user plotter ;
+
-- 
cgit v1.2.3