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

---
 app/mpg/1987/src/matrix printer | 129 ++++++++++++++++++++++++++++++++++++++++
 1 file changed, 129 insertions(+)
 create mode 100644 app/mpg/1987/src/matrix printer

(limited to 'app/mpg/1987/src/matrix printer')

diff --git a/app/mpg/1987/src/matrix printer b/app/mpg/1987/src/matrix printer
new file mode 100644
index 0000000..e5821ff
--- /dev/null
+++ b/app/mpg/1987/src/matrix printer	
@@ -0,0 +1,129 @@
+(* Version vom 21.10.87 BJ *) 
+(* Standardoperationen *) 
+(*   printer line - Linienalgorithmus *) 
+(*   printer fill - Fuellalgorithmus *) 
+ 
+PROC printer line (INT CONST x1,y1,x2,y2,
+                   PROC (INT CONST, INT CONST) p set pixel): 
+  INT VAR x,y,z,             
+          a,b,d, 
+          dx :: abs(x2-x1), 
+          dy :: abs(y2-y1), 
+          dp,dq; 
+  IF dx <> 0 AND dy <> 0 
+    THEN IF dy <= dx 
+           THEN draw line 1 
+           ELSE draw line 2 
+         FI 
+    ELSE IF dx = 0 AND dy <> 0 
+            THEN draw vertical line 
+            ELSE draw horizontal line 
+         FI 
+  FI. 
+ 
+  draw line 1: 
+    x := x1;
+    y := y1; 
+    z := x2; 
+    a := sign(x2-x1); 
+    b := sign(y2-y1);
+    dp := dy * 2; 
+    d := dp - dx; 
+    dq := dp - 2 * dx; 
+    setpoint; 
+    WHILE x <> z REP 
+      x := x + a;
+      IF d < 0 
+        THEN d := d + dp 
+        ELSE y := y + b; 
+             d := d + dq
+      FI; 
+      setpoint 
+    PER. 
+ 
+  draw line 2: 
+    x := x1;
+    y := y1; 
+    z := y2; 
+    b := sign(x2-x1); 
+    a := sign(y2-y1);
+    dp := dx * 2; 
+    d := dp - dy; 
+    dq := dp - 2 * dy; 
+    setpoint; 
+    WHILE y <> z REP 
+      y := y + a;
+      IF d < 0 
+        THEN d := d + dp 
+        ELSE x := x + b; 
+             d := d + dq
+      FI; 
+      setpoint 
+    PER. 
+
+  draw vertical line: 
+    a := sign(y2-y1); 
+    x := x1; 
+    y := y1; 
+    z := y2; 
+    setpoint; 
+    WHILE y <> z REP 
+      y := y + a; 
+      setpoint 
+    PER. 
+ 
+  draw horizontal line: 
+    a := sign(x2-x1); 
+    x := x1; 
+    y := y1; 
+    z := x2; 
+    setpoint; 
+    WHILE x <> z REP 
+      x := x + a; 
+      setpoint 
+    PER. 
+ 
+  setpoint: 
+    p set pixel (x,y) 
+END PROC printer line; 
+ 
+PROC printer fill (INT CONST xl, xr, y, dir,
+                   BOOL PROC (INT CONST, INT CONST) point,
+                   PROC (INT CONST, INT CONST) pset):
+  INT VAR xl1 :: xl; 
+  WHILE point(xl1,y) REP 
+    xl1 INCR 1;
+    IF xl1 >= xr
+      THEN LEAVE printer fill
+    FI
+  PER;
+  INT VAR xrn :: xl1+1, 
+          xln :: xl1; 
+  WHILE NOT point(xrn,y) REP 
+    pset(xrn,y); 
+    xrn INCR 1 
+  PER;
+  WHILE NOT point(xln,y) REP 
+    pset(xln,y); 
+    xln DECR 1 
+  PER; 
+  IF xrn > xr 
+    THEN printer fill (xr, xrn-1,y-dir,-dir, 
+                       BOOL PROC (INT CONST, INT CONST) point,
+                       PROC (INT CONST, INT CONST) pset)
+    ELSE printer fill (xrn, xr, y, dir, 
+                       BOOL PROC (INT CONST, INT CONST) point,
+                       PROC (INT CONST, INT CONST) pset)
+  FI; 
+  IF xln < xl 
+    THEN printer fill (xln+1,xl, y-dir,-dir, 
+                       BOOL PROC (INT CONST, INT CONST) point,
+                       PROC (INT CONST, INT CONST) pset)
+    ELSE printer fill (xl,xln, y, dir, 
+                       BOOL PROC (INT CONST, INT CONST) point,
+                       PROC (INT CONST, INT CONST) pset)
+  FI; 
+  printer fill(xln+1, xrn-1, y+dir, dir, 
+               BOOL PROC (INT CONST, INT CONST) point,
+               PROC (INT CONST, INT CONST) pset)
+END PROC printer fill;
-- 
cgit v1.2.3