summaryrefslogtreecommitdiff
path: root/app/mpg/1987/src/matrix printer
blob: e5821ffbc83d5a394d1ec4be39983ff9db19faee (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
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;