    !  EDWIN Device Driver for HP 2686A Laserjet Printer

    !############################################################################
    !#                                                                          #
    !#  This is a module from the EDWIN Graphics Package, which was developed   #
    !#  in the Department of Computer Science, at Edinburgh University, from    #
    !#  1978 to the present day, release 5 of EDWIN in October 1984.            #
    !#                                                                          #
    !#  The principal author of the EDWIN Graphics Package was J Gordon Hughes, #
    !#  while working for the Edinburgh University Computer Sceince Department. #
    !#  Parts of EDWIN have been produced by many different people, too many    #
    !#  too mention, working for different departments of Edinburgh and Leeds   #
    !#  Universities.                                                           #
    !#                                                                          #
    !#  This module is regarded as being in the public domain, and the authors  #
    !#  and accept no responsibility regarding the uses to which the software   #
    !#  will be put.                                                            #
    !#                                                                          #
    !############################################################################

    !       Neil Bergmann; January, 1985

    from Edwin include Device
    from Edwin include Icodes
    from Edwin include Consts
    from Imp   include Lognames

    const integer Max Styles = 15

    const integer HBytes = 72, VBytes = 96
    const integer HRes = (HBytes * 8-1), VRes = (VBytes * 8-1)

    record format HLineFm(byte array Byte(0:HBytes - 1))
    record format BitmapFm(record (HLineFm) array Line(0:VRes))
    record format PointFm(integer x,y)
    record format DataFm(record(PointFm) p, record(DataFm) name Next)

    own record(BitmapFm) name Bitmap
    own record(DataFm) name First Point == 0
    own record(DataFm) name Next Point == 0

    own integer SX = 0, SY = 0, Drawn = False, Colour = 1
    own integer LX = 0, LY = 0, Max X = 0, Max Y = 0
    own integer WLX = 0, WLY = 0, WHX = HRes, WHY = VRes
    own integer Start X = 864, Start Y = 1260
    own integer Shade Mode = Solid
    own integer Colour Mode = Or Mode
    own integer Res = 100
    own integer i

    own integer NPts = 0

    own string(255) Temp = ""

    const byte Escape = 27, FF = 12, CR = 13

    own byte array Style Map(0:8 * Max Styles + 7) = -
         {outline} 0(8),
         {solid}   2_11111111(8),
         {horizontal}
                2_11111111,
                2_00000000,
                2_00000000,
                2_00000000,
                2_11111111,
                2_00000000,
                2_00000000,
                2_00000000,
         {vertical}
                2_10001000,
                2_10001000,
                2_10001000,
                2_10001000,
                2_10001000,
                2_10001000,
                2_10001000,
                2_10001000,
          {/diagonal}
                2_00010001,
                2_00100010,
                2_01000100,
                2_10001000,
                2_00010001,
                2_00100010,
                2_01000100,
                2_10001000,
          {¬diagonal}
                2_10001000,
                2_01000100,
                2_00100010,
                2_00010001,
                2_10001000,
                2_01000100,
                2_00100010,
                2_00010001,
          {cross hatch}
                2_10001000,
                2_01010100,
                2_00100010,
                2_01010001,
                2_10001000,
                2_01000101,
                2_00100010,
                2_00010101,
          {grid hatch}
                2_11111111,
                2_10001000,
                2_10001000,
                2_10001000,
                2_11111111,
                2_10001000,
                2_10001000,
                2_10001000,
          {Light Stipple}
                2_00000000,
                2_01000010,
                0(4),
                2_01000010,
                2_00000000,
          {checker board}
                2_11110000,
                2_11110000,
                2_11110000,
                2_11110000,
                2_00001111,
                2_00001111,
                2_00001111,
                2_00001111,
          {bricks}
                2_11111111,
                2_01000000,
                2_01000000,
                2_01000000,
                2_11111111,
                2_00000010,
                2_00000010,
                2_00000010,
          {lime}
                2_11000011,
                2_10000001,
                0(4),
                2_10000001,
                2_11000011,
          {brown}
                2_10011001(8),
          {turquoise}
                2_11111111,0,
                2_11111111,0,
                2_11111111,0,
                2_11111111,0,
          {user defined styles 14-15 }
                0(16)

    routine Esc(string(255) S)
       integer I
       TTPut(Escape)
       TTPut(Charno(s,i)) for i = 1, 1, Length(s)
    end

    routine Raster Resolution(integer i)
       Esc("*t".ItoS(i,0)."R")
    end

    routine Start Raster Graphics
       Esc("&a".ItoS(Start X,0)."H")
       Esc("&a".ItoS(Start Y,0)."V")
       Esc("*r1A")
    end

    routine Transfer Raster Graphics(integer i)

       routine Dummy Newline
          TTPut(CR)
          TTPut(NL)
          Esc("&a-1R")
       end
       Dummy Newline
       Esc("*b".ItoS(i,0)."W")
    end

    routine End Raster Graphics
       Esc("*rB")
    end

    routine Check(integer X,Y)
       if X > Max X then Max X = X
       if Y > Max Y then Max Y = Y
    end

    routine Draw Line(integer TX,TY)
       ! This is algorithm 162 in the Collected Algorithms from CACM.
       ! It computes the code string required to move the pen of a
       ! digital incremental X-Y plotter from an initial point (SX,SY) to
       ! a terminal point (TX,TY) by the "best" approximation to the
       ! straight line between the points. The permitted elemental pen
       ! movement is to an adjacent point in a plane Cartesian point latice,
       ! diagonal moves permitted.

       integer A, B, D, E, F, T, I, XMove, YMove, X, Y
       const short array XCode(1:16) = 0,1,1,1,1,1,0,1,0,-1,-1,-1,-1,-1,0,-1
       const short array YCode(1:16) = 1,1,0,1,0,-1,-1,-1,-1,-1,0,-1,0,1,1,1
       ! PY,PX+PY,PX,PX+PY,PX,PX+NY,NY,PX+NY,NY,NY+NX,NX,NX+NY,NX,NX+PY,PY,NX+PY

       routine Mark
          ! make mark in line buffer - represented as a linear bit string
          byte integer name B
          byte Bit
          B == Bitmap_Line(SY)_Byte(SX//8)
          Bit = 16_80 >> (SX&7)
          B = B ! Bit
          if Colour = 0 then B = B !! Bit
          Check(SX,SY)
       end

       Drawn = True
       Mark and return if SX = TX and SY = TY

       if SX < WLX then SX = WLX
       if SY < WLY then SY = WLY
       if TX > WHX then TX = WHX
       if TY > WHY then TY = WLY

       A = TX - SX
       B = TY - SY
       D = A + B
       T = B - A

       I = 0
       if B >= 0 then I = 2
       if D >= 0 then I = I + 2
       if T >= 0 then I = I + 2
       if A >= 0 then I = 8 - I else I = I + 10

       A = -A if A < 0
       B = -B if B < 0
       F = A + B
       D = B - A
       if D >= 0 then T = A and D = -D else T = B
       E = 0

       XMove = XCode(I - 1)
       YMove = YCode(I - 1)
       X = XCode(I)
       Y = YCode(I)
       cycle
          A = D + E
          B = T + E + A
          Mark
          if B >= 0 start
              E = A
              F = F - 2
              SX = SX + X
              SY = SY + Y
          else
              E = E + T
              F = F - 1
              SX = SX + XMove
              SY = SY + YMove
          finish
          exit if F <= 0
       repeat
       Mark
    end

    routine Clrbitmap
       Bitmap = 0
       Drawn = False
       Max X = 0
       Max Y = 0
    end

    routine Outpage
       record(HLineFm) name Thisline
       integer X, Y, Right
       Raster Resolution(Res)
       Start Raster Graphics
       for Y = WHY, -1, 0 cycle
          Thisline == Bitmap_Line(Y)
          Right = Max X//8
          Right = Right - 1 while Right > 1 and Thisline_Byte(Right) = 0
          Transfer Raster Graphics(1 + Right)
          TTPut(Thisline_Byte(X)) for X = 0, 1, Right
       repeat
       End Raster Graphics
       TTPut(CR)
       TTPut(FF)
       TTPut(NL)
       Flush Output
       Clrbitmap
    end

    routine Draw Box(integer LX, LY, UX, UY)
       integer SSX, SSY, X, Y, Highbyte, Lowbyte
       byte B, BB
       byte name Thisbyte
       record(HLineFm) name Thisline

       routine Test(integer name Low, High)
          integer i
          if Low > High start
             i = Low
             Low = High
             High = i
          finish
       end

       Test(LX,UX)
       Test(LY,UY)
       LX = LX + 1
       return if UX <= LX {%or UY = LY
       UX = UX - 1
       UY = UY - 1 if UY # LY
       return if LX > WHX or LY > WHY or UX < WLX or UY < WLY
       if LX < WLX then LX = WLX
       if LY < WLY then LY = WLY
       if UX > WHX then UX = WHX
       if UY > WHY then UY = WHY
       Drawn = True
       Check(UX,UY)

       { This is a solid box, outline boxes are filtered out by EDWIN before driver }
       Lowbyte = LX//8
       Highbyte = UX//8
       for Y = LY, 1, UY cycle
          Thisline == Bitmap_Line(Y)
          for X = Lowbyte, 1, Highbyte cycle
             Thisbyte == Thisline_Byte(X)
             B = 2_11111111
             BB = B
             if X = Lowbyte then B = B>>(LX&7)
             if X = Highbyte then B = (B<<(7 - (UX&7)))&2_11111111
             if Colour Mode = Replace Mode then BB = BB!!B
             B = Style Map((Y&2_111)!(Shade Mode<<3))&B
             Thisbyte = (Thisbyte&BB)!B
          repeat
       repeat
    end

    include "polyfill.hpl"

    routine Draw Polygon
       integer i
       record(DataFm) name pp
       record(PointFm) array Pts(1:NPts + 1)
       pp == First Point
       for i = 1, 1, NPts cycle
          Pts(i)_x = pp_p_x
          Pts(i)_y = pp_p_y
          if i = 1 start
             SX = pp_p_x
             SY = pp_p_y
          else
             Draw Line(pp_p_x, pp_p_y)
          finish
          pp == pp_Next
       repeat
       Pts(NPts + 1) = Pts(1)
       Draw Line(Pts(1)_x, Pts(1)_y)
       Polyfill(NPts + 1,Pts)
       NPts = 0
    end

    routine Append(integer X, Y)
       if NPts = 0 start
          First Point_p_x = X
          First Point_p_y = Y
          Next Point == First Point
          NPts = 1
       finish
       return if X = SX and Y = SY
       if Next Point_Next == nil start
          Next Point_Next == new(Next Point)
          Next Point == Next Point_Next
          Next Point_Next == nil
       else
          Next Point == Next Point_Next
       finish
       Next Point_p_x = X
       Next Point_p_y = Y
       NPts = NPts + 1
       SX = X
       SY = Y
    end

    routine Initialise
       First Point == new(Next Point)
       First Point_Next == nil
       Bitmap == new(Bitmap)
       Clrbitmap
       Dev Data_Name = "HP 2686A Laserjet Printer"
       Dev Data_Type = 2686
       Dev Data_ARF = 100
       Dev Data_DVX = HRes
       Dev Data_DVY = VRes
       Dev Data_MVX = HRes
       Dev Data_MVY = VRes
       Dev Data_Num Char Sizes = 255
       Dev Data_Units Per CM = Res/2.54
       if Viewing = 0 start
          Temp = "EDWIN_".ItoS(Dev Data_Type,0)
          if Translate(Temp) # Temp and Viewing = 0 start
             Set Device(Temp)
          finish
          TTMode(1)
       finish
    end

    external routine dd2686 alias "EDWIN___Z" (integer Com, X, Y)
       switch Command(0:Max Com)
       switch Att(0:Att Maximum)

       routine Swap(integer name  A, B)
          integer C
          C = A;   A = B;   B = C
       end

       Draw Polygon if NPts # 0 and (Com = 10 or Com < 5)

       -> Command(Com)

       Command(Dev Initialise):
         if X = 2686300 start
             Res = 300
         finish else if X = 2686150 start
             Res = 150
         else
             Res = 100
         finish
         Initialise
         return

       Command(Dev Terminate):
         Outpage if Drawn = True
         dispose(Bitmap)
         return

       Command(Dev Update):
         return

       Command(Dev Newframe):
         Outpage if Drawn = True
         return

       Command(Dev Move):
         SX = X
         SY = Y
         return

       Command(Dev Line):
         if Shade Mode = 0 start
            Draw Line(X,Y)
         else
            Append(X,Y)
         finish
         return

       Command(Dev Char):
         signal 14, 14

       Command(Dev Attribute):
         if 0 <= X <= Att Maximum then -> Att(X) else return
         Att(Att Colour):
           Y = 1 if Y # 0
           Colour = Y
           return
         Att(Att Colour Mode):
           if Y = Replace Mode or Y = Or Mode then Colour Mode = Y
           return
         Att(Att Shade Mode):
           Y = Solid unless 0 <= Y <=15
           Shade Mode = Y
         Att(*): return

       Command(Dev Low WB):
         WLX = X
         WLY = Y
         return

       Command(Dev High WB):
         WHX = X
         WHY = Y
        return

       Command(Dev Low Box):
         LX = X
         LY = Y
         return

       Command(Dev High Box):
         Swap(LX, X) if LX > X
         Swap(LY, Y) if LY > Y
         return if LX > WHX or X < WLX or LY > WHY or Y < WLY
         LX = WLX if LX < WLX
         LY = WLY if LY < WLY
         X = WHX if X > WHX
         Y = WHY if Y > WHY
         ! Box now clipped into the screen.
         Draw Box(LX, LY, X, Y)
         ! Now outline it
         return if Colour = 0
         SX = LX
         SY = LY
         Draw Line(X,LY)
         Draw Line(X,Y)
         Draw Line(LX,Y)
         Draw Line(LX,LY)
         return

       Command(*):

    end

    !%external %routine Set Laser Position %alias "EDWIN_LASER_POSITION" (%integer X,Y)
    !  Start X = X
    !  Start Y = Y
    !%end
    !
    !%external %routine Set Laser Resolution %alias "EDWIN_LASER_RESOLUTION" (%integer i)
    !  %if i = 75 %or i = 100 %or i = 150 %or i = 300 %then Res = i
    !%end

    endoffile