(* 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;