! 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