    ! EDWIN device driver for Calcomp plotters connected via a 906 controller
    ! J. Gordon Hughes  for  Lattice Logic   September 1982

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

    external routine CALCOMP alias "EDWIN___L" (integer COM, X, Y)

    const string (15) HOST TERM = "EDWIN_CALCOMP"

    const integer stx = 2, etx = 3
    const integer fela = true    { True => dont use controller codes 11-14

    ! Configuration parameters
    const integer double synch = false           { A switch setting on controller }
    const integer check summing = true         { " }
    const integer bias char = ' '
    const integer threshold = 100               { When EDWIN flushes its buffer }
    const integer radix = 126 - bias char
    const integer synch = stx
    const integer end mess = etx
    const byte good mess str = '0'
    const byte bad mess str = '1'
    own byte array response request str (0:2) = 2, 13, 10

    ! Command codes
    const integer No Op            = 0
    const integer pen down         = 2
    const integer pen up           = 3
    const integer select pen       = 4
    const integer do text          = 5
    const integer char type        = 6
    const integer radix def        = 7
    const integer escape           = 8
    const integer scale            = 9
    const integer pause            = 10
    const integer end of plot      = 15

    ! Escape sub-codes
    const integer double buffer    = 1
    const integer delay            = 3
    const integer good mess        = 4
    const integer bad mess         = 5
    const integer response request = 6

    ! Pens
    const integer max colour = 15
    own byte array slots (0:max colour) = 0, 3, 4, 2, 1, 4, 1, 2, 3, 1 (*)
    own byte array slots to use (0:max colour) = 1, 3, 4, 2, 1, 4, 1, 2, 3, 1 (*)
    own string (15) array COLOUR NAME (0:MAX COLOUR) = "black",
       "black", "blue", "green", "red", "purple", "orange", "lime green", "brown",
       "turquoise", "gold", "pen 11", "pen 12", "pen 13", "pen 14", "pen 15"
    own byte current colour = 0

    const integer max buffer size = 128
    own integer max buffer                 { Max buffer size - size of stx/etx seq. }
    own integer buffer count = 0
    own integer check sum = 0
    own integer pen state = pen up
    own integer pending move = false
    own integer pending colour = 1   { =0 => no pending colour, #0 => we want pen n }
    own integer text mode = false
    own string (63) text = ""
    own integer sx = 0, sy = 0          { Logical position on plotter }
    own integer ax = 0, ay = 0          { Actual position on plotter }
    own integer wx, wy
    own integer xl, xr, yb, yt
    own byte new framed = false

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

    routine flush
       integer i
       checksum = 64+32-(checksum & 16_1F)
       ttput (checksum) if check summing = true
       ttput (end mess)
       ttput (response request str (I)) for I = 1, 1, response request str(0)
       flush output
       Buffer Count = 0
       return if VIEWING # 0
       I = ttget until I = good mess str or I = bad mess str
       signal 14, 4 if i = bad mess str
    end

    routine put (integer i)
       if Buffer Count = 0 start
          buffer count = 2
          ttput (synch)
          ttput (synch) and buffer count = buffer count + 1 if double synch = true
          ttput (bias char)
          checksum = 0
       finish
       buffer count = buffer count + 1
       check sum <- check sum + i
       ttput (i + bias char)
    end

    routine put str (string (7) wee str)
       integer I
       put (length(wee str))
       put (charno(wee str,i)>>4&15) and put (charno(wee str,i)&15) for I = 1,1,length(wee str)
    end

    routine delta (integer x, y)
       ! Output a delta move.
       const byte array dmap (1:49) = { As table 3-23 in the manual }
         8_21, 8_51, 8_55, 8_34, 8_54, 8_50, 8_20,
         8_61, 8_25, 8_71, 8_40, 8_70, 8_24, 8_60,
         8_65, 8_75, 8_31, 8_44, 8_30, 8_74, 8_64,
         8_35, 8_41, 8_45,    0, 8_46, 8_42, 8_36,
         8_67, 8_77, 8_33, 8_47, 8_32, 8_76, 8_66,
         8_63, 8_27, 8_73, 8_43, 8_72, 8_26, 8_62,
         8_23, 8_53, 8_57, 8_37, 8_56, 8_52, 8_22
       integer hx, mx, lx, hy, my, ly, xn, yn, xs, ys

       return if x=0 and y=0
       XS = 1 ; XS = -1 if X < 0 ; X = |X|
       YS = 1 ; YS = -1 if Y < 0 ; Y = |Y|

       HX = (X//radix) // radix
       MX = X//radix - HX*radix
       LX = X - MX * radix - HX*radix*radix
       HY = (Y//radix) // radix
       MY = Y//radix - HY*radix
       LY = Y - MY * radix - HY*radix*radix

       if HX=0 start
           if MX = 0 start
               if LX=0 then XN = 0 else XN = 1
           finish else XN = 2
       finish else XN = 3

       if HY=0 start
           if MY=0 start
               if LY=0 then YN = 0 else YN = 1
           finish else YN = 2
       finish else YN = 3

       put (dmap((3-YN*YS)*7 + (XN*XS+4)))
       put (hx) if xn=3
       put (mx) if xn>=2
       put (lx) if xn>=1
       put (hy) if yn=3
       put (my) if yn>=2
       put (ly) if yn>=1
       flush if buffer count > threshold
    end

    routine Goto ( integer Sx, Sy )
       integer Dx, Dy, Ex, Ey
       Dx = Sx - Ax ; Dy = Sy - Ay
       cycle
          Ex = Dx ; Ey = Dy
          while |Ex| > 16000 or |Ey| > 16000 cycle
             Ex = Ex // 2
             Ey = Ey // 2
          repeat
          Delta(Ex,Ey)
          Dx = Dx-Ex
          Dy = Dy-Ey
       repeat until Dx = 0 = Dy
       Ax = Sx ; Ay = Sy
    end

    routine do move
       return if Pending Move = False
       return if SX=AX and SY=AY
       pending move = false
       put (pen up)
       pen state = pen up
       goto (sx, sy)
    end

    routine do colour
       if slots(pending colour)=0 and viewing=0 start
           Do Move
           put (pause)
           flush
           oper message ("Enter new ".colourname(pending colour)." pen in slot ". c
                          itos(slots to use (pending colour),0)." and press TEST on the plotter")
           slots (current colour) = 0
           slots (pending colour) = slots to use (pending colour)
           current colour = pending colour
       finish
       put (select pen)
       put (slots(pending colour))
       pending colour = 0
       flush if buffer count > threshold
    end

    routine do new frame
        sx = 0;   sy = 0;   pending move = true
        sx = xr if new framed = true
        do move
        ax = 0;   ay = 0
        new framed = true
    end

    routine flush text
       integer i
       do newframe if newframed # true
       do move
       put (do text)
       put (length(text))
       ttput (charno(text,i)) and buffer count=buffer count + 1 for I=1,1,length(text)
       flush
       text mode = false
    end

    routine change attribute (integer what, to)
       own integer char size = 0,   char rot = 0
       integer dash, gap
       switch as (0:att maximum)
       -> as (what)

    as(att colour):
           pending colour = to if to#current colour
           return

    as(att line style):
           return if Fela=true
           put (13)
           unless 0<to<5 and to#2 {no chain} then put (1) else start
               if to=1 then DASH=3 and GAP=10
               if to=3 then DASH=25 and GAP=10
               if to=4 then DASH=45 and GAP=10
               put (2)
               delta (-dash, gap)
               flush if buffer count > threshold
           finish
           return

    as(att Char size):
           return if Fela=true
           char size = int ((to * 20)/12)
           put (char type)
           delta (char rot, char size)
           return

    as(att Char rot):
           return if Fela=true
           char rot = to
           put (char type)
           delta (char rot, char size)
           return

    as(att Char font):
           return if Fela=true
           to = 0 unless 0<=to<=4
           put (14);   put (to)
           return

    as(*): ! All other attributes ignored
    end

    switch sw (0:MAX COM)
    flush text if text mode = true and com#6
    -> sw (com)

    sw(0): ! Initialise
           DEV DATA_NAME = "a Calcomp plotter"
           DEV DATA_DVX = 1500
           DEV DATA_DVY = 1500
           DEV DATA_MVX = 32000
           DEV DATA_MVY = 32000
           DEV DATA_UNITS PER CM = 200
           if TRANSLATE (HOST TERM)#HOST TERM start
               SET DEVICE (HOST TERM)
           finish
           put (radix def); put (radix)
           put (escape);    put (good mess);   put str (tostring(good mess str))
           put (escape);    put (bad mess);    put str (tostring(bad mess str))
           put (escape);    put (response request)
           put str (string(addr(response request str(0))))
           put (escape);    put (double buffer)       { Enable double buffering }
           put (escape);    put (delay);   put (0)    { Turn-around delay }
           put (select pen); put (1)
           put (pen up)
           pen state = pen up
           max buffer = max buffer size - response request str (0) - 2 { EXT + PEN UP }
           max buffer = max buffer - 1 if checksumming = true
           flush
           pending move = true
           SX = 0;   SY = 0
           return

    sw(1): ! Terminate
           SX = xr;   SY = 0;   pending move = true;  Do Move
           Put(End Of Plot)
           flush
           return

    sw(2): ! Update
           Do Move
           flush
           return

    sw(3): ! Newframe
           do newframe
           return

    sw(4): ! Move abs
           sx = x;   sy = y;   pending move = true
           return

    sw(5): ! Line abs
           do newframe if newframed#true
           do move
           do colour if pending colour # 0
           put (pen down) and pen state = pen down if pen state # pen down
           goto (x, y)
           sx = x;   sy = y
           return

    sw(6): ! Character
           signal 14, 14 if Fela=True
           if text mode # true start
               text mode = true
               text = ""
           finish
           text = text.to string(x)
           flush text if length(text)=63 or buffer count + length(text) + 3 >= max buffer
           return

    sw(7): ! Attribute change
           do move if pending move = true
           change attribute (x, y)
           return

    sw(8): ! Lower viewport bounds
           xl = x;   yb = y
           return

    sw(9): ! Upper viewport bounds
           xr = x;   yt = y
           return

    SW(12): ! Lower box bounds
            WX = X;   WY = Y
            return

    SW(13): ! Upper box bounds
            swap (wx, x) if wx > x
            swap (wy, y) if wy > y
            return if WX > XR or X < XL or WY > YT or Y < YB
            WX = XL if WX < XL
            WY = YB if WY < YB
            X = XR if X > XR
            Y = YT if Y > YT
            ! Box now clipped into the screen.
            Calcomp (4, Wx, Wy)
            Calcomp (5, Wx, y)
            Calcomp (5, x,y)
            Calcomp (5, x, Wy)
            Calcomp (5, Wx, wy)
            return

    sw(*):
    end

    end of file