! EDWIN driver for Versatec Plotters driven via the Versaplot Library
! 
! Rev 001 AET 18-03-88 Changed 'draw lines' to draw from second co-ord set.
! Rev 002 AET 23-11-88 Made changes for edwin patterns
!

record format Point fm (integer x, y)

from Edwin include Device
from Edwin include Icodes
from Imp   include Lognames, Textutils
            include Versatec
include Iprocs
include Pattern

external routine Versatec alias "EDWIN___K" (integer COM, X, Y)

const string (17) Versatec Options    = "VERSATEC_OPTIONS"
const string (19) Versatec Controller = "VERSATEC_CONTROLLER"
const string (15) Versatec Disk       = "VERSATEC_DISK"
const string (15) Versatec Tape       = "VERSATEC_TAPE"
const string (15) Versatec Memory     = "VERSATEC_MEMORY"
string (255) Temp
own real UPCM = 200

! Screen information
own integer XL = 0
own integer XR = 511
own integer YB = 0
own integer YT = 511
own integer MAX PLOT X, MAX PLOT Y
own byte Active = False, Called = False, Controller = 0
own short Shade Mode = 0
own integer Style = 0
own short Model = 9999
! NB: following table does not include Thermal plotters with fixed paper size
const integer Max Versatec = 37
own short array Models (1:Max Versatec) = 80, 81, 82,
      7222, 7422, 7224, 7424, 7225,
      7425, 7236, 7436, 7244, 7444,
      8122, 8222, 8124, 8224, 8136, 8236, 8142, 8242,
      8244, 8252, 8259, 8172, 8272,
      8242, 9242,
      3224, 3236,
      800, 900, 1100, 1200, 1600, 2000, 2160
own real array Max Ys (1:Max Versatec) = 10.555, 10.230, 10.550,
      21.115, 21.1175, 23.035, 23.0375, 23.515,
      23.5175,35.195,  35.1975,43.035,  43.0375,
      21.110, 21.115,  23.030, 23.035,  35.190, 35.195, 40.950, 40.955,
      43.035, 52.115,  58.475, 71.670,  71.675,
      40.955, 39.995,
      22.555, 34.235,
       7.990,  7.995,  10.230, 10.555,   9.994, 18.550, 17.994

own short Colour Model = False
own integer array Colour Map (0:7) = 1, 1, 5, 7, 6, 3, 4, 2
own integer array On  1 (0:4) = 0, 2, 8, 3, 6 
own integer array Off 1 (0:4) = 0, 6, 3, 5, 2
own integer array On  2 (0:4) = 0, 2, 2, 3, 6
own integer array Off 2 (0:4) = 0, 6, 3, 5, 2

integer array IARG (1:7)
real    array RARG (1:7)
record format Data Fm (record (point fm) p, record (Data Fm) name Next)
own record (Data fm) name Point List == 0
own record (Data fm) name Next point == 0
own real SX, SY, UX, UY
own integer WX, WY, Nlines = 0
switch SW(0:MAX COM)

routine Fault (string (255) S)
   Oper Message ("Fatal Error - ".S)
   stop
end

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

routine draw lines
   record (Data fm) name PP
   real array X, Y (1:Nlines)
   integer i

   return if Point List == Nil
   SX = point list_p_x;   Sy = point list_p_y
   Plot (SX, SY, Move To)
   if nlines <= 2 start
       SX = point list_next_p_x;  SY = point list_next_p_y
       Plot (SX, SY, Draw To)
   else
       X(1) = SX
       Y(1) = SY
       pp == point list_next
       for I = 2, 1, Nlines cycle
          X(i) = PP_p_X;
          Y(i) = PP_p_Y
          Plot (x(i), y(i), Draw To)
          pp == pp_next
       repeat
       NewPen (Izero) if Style # 0
       Tone (X(1), Y(1), NLINES, Ione)
       NewPen (style) if Style # 0
   finish
   Active = True
   nlines = 0
end

routine CHANGE ATTRIBUTE (integer WHAT, TO)
   switch AS (0:ATT MAXIMUM)
   -> AS (WHAT)

AS(att colour):
    if Colour Model = True start
       if TO = 0 start
           TO = 9
       finish
       if TO < 8 start
           TonFlg (Izero)
       else
           TonFlg (Ione)
           TonClr (To)
           To = 1
       finish
       NewPen (Colour Map(To))
    finish
    return

AS(att Line Style):
    NewPen (To) and Style=To if Colour Model # True
    return
    
AS(att Shade mode):  Shade Mode = To
    To = 1 unless 0<=To<=31
    To = 0 if To = 1
    SetPat (To)
    return

AS(*): ! All other attributes ignored
   end

   draw lines if nlines > 1 and (com = 10 or COM < 5)
   -> SW(COM)

SW(0): ! Initialise
       Model = X
       DEV DATA_TYPE = X
       DEV DATA_NAME = "a Versatec model ".Itos(X,0)." plotter"
   
       if Called = False start
          forini
   
          ! If Model is a 9294 or a 3000 or 2000 series then use colour mode
          if Model = 9242 or 2000 < Model < 4000 start
             if 2756 <= Model <= 2766 start
                 Iarg (1) = 3
                 Iarg (2) = 4
                 Iarg (3) = 3
                 Iarg (4) = 2
                 Iarg (5) = 0
                 X = 101 { Initialise for Colour Plotting }
                 Vpopt (X, Iarg(1), Rarg(1), com)
             else
                 Iarg (1) = 4
                 Iarg (2) = 1
                 Iarg (3) = 2
                 Iarg (4) = 3
                 Iarg (5) = 4
                 X = 101 { Initialise for Colour Plotting }
                 Vpopt (X, Iarg(1), Rarg(1), com)
             finish
          finish
   
          ! Set Plotter Model
          Rarg (1) = 200     { Nibs per inch }
          Iarg (2) = 264     { Bytes / Scan  }
          if 2000 < Model < 3000 { New colour models } start
             IArg (1) = 9999 { New Model     }
             if Model = 2558 or Model = 2568 start
                R Arg (1) = 400
             else if Model = 2756 or Model = 2766
                ! We need to find the Bytes/Scan for Thermal <<<<<<<<<
                I Width = 2   { Minimum width, usually 2 }
                R Arg (1) = 300
                if Model = 2756 start
                   I Arg (2) = 400
                else
                   I Arg (2) = 424
                finish
             finish
             X = 1 { Change default plotter Model }
             Vpopt (X, Iarg(1), Rarg(1), com)
             R Arg (1) = 0.0
             R Arg (3) = 0.0
             if Model = 2756 start
                R Arg (2) = 14.83
             else
                R Arg (2) = 14.37
             finish
             R Arg (4) = I Arg (2) * 8 / 300
             X = 2 { Change default paper dimensions }
             Vpopt (X, Iarg(1), Rarg(1), com)
          else
             Iarg (1) = Model
             X = 1 { Change default plotter Model }
             Vpopt (X, Iarg(1), Rarg(1), com)
             if 3000 < Model < 4000 start
                R Arg (1) = 0.0
                R Arg (3) = 0.0
                if Model = 3224 start
                   R Arg (2) = 22.555
                else if Model = 3236
                   R Arg (2) = 34.235
                else { %if Model = 3244
                   I Arg (1) = 3236
                   R Arg (2) = 42.200
                finish
                R Arg (4) = R Arg (2)
                X = 2 { Change default paper dimensions }
                Vpopt (X, Iarg(1), Rarg(1), com)
             else if Model = 80 { Default to A3 length }
                R Arg (1) = 0.0
                R Arg (2) = 16.5
                R Arg (3) = 0.0
                R Arg (4) = 10.555
                X = 2 { Change default paper dimensions }
                Vpopt (X, Iarg(1), Rarg(1), com)
             finish
          finish

          ! Test for Paper size options
          begin
             string (255) Str, temp
             long real MX, MY
             integer I
             on 3,4 start
                Oper Message ("Error in Versatec Plotter Paper size specification")
                signal 14, 1
             finish
      
             Str = "EDWIN_".ItoS(Model,0)."_X"
             Temp = Translate(Str)
             if Temp # Str start
                MX = Stoi (Temp) / 25.4
                signal 4 if MX  < 4
             else
                MX = 0
             finish
             Str = "EDWIN_".ItoS(Model,0)."_Y"
             Temp = Translate (Str)
             if Temp # Str start
                MY = Stoi (Temp) / 25.4
                signal 4 if MY  < 4
             else
                MY = 0
             finish
             if MX#0 start
                R Arg (1) = 0.0
                R Arg (2) = MX
                R Arg (3) = 0.0
                R Arg (4) = MY
                if MY=0 start
                   for I = 1, 1, Max Versatec cycle
                      R Arg (4) = Max Ys (I) if Model = Models (I)
                   repeat
                finish
                X = 2 { Change default paper dimensions }
                Vpopt (X, Iarg(1), Rarg(1), com)
             finish
          end       

          ! Check controller configuration:
          ! a) Is it going to a Tape
          Temp = Translate (Versatec Tape)
          if Temp # Versatec Tape start
              To Upper (Temp)
              if Temp # "N" and Temp # "Y" and Temp # "NO" and Temp # "YE" -
                             and Temp # "YES" and Temp # "430" start
                  Fault ("Unknown setting """.Temp.""" for ".Versatec Tape)
              finish
              if charno(temp,1)='N' start
                 Iarg (1) = 0
              else if temp="430"
                 Iarg (1) = 1
              else
                 Iarg (1) = 2
              finish
              X = 36 { Mag tape output flag }
              Vpopt (X, Iarg(1), Rarg(1), com)
          finish
          ! b) What type of controller
          Temp = Translate (Versatec Controller)
          if Temp # Versatec Controller start
              To Upper (Temp)
              if Temp # "REP" and Temp # "VRC" and Temp # "RPM" start
                  Fault ("Unknown setting """.Temp.""" for ".Versatec Controller)
              finish
              if Temp="REP" start
                 Controller = 1
              else if Temp="VRC"
                 Controller = 3
              else
                 Controller = 4
              finish
              Iarg (1) = Controller
              X = 15 { Specify target output controller }
              Vpopt (X, Iarg(1), Rarg(1), com)
          finish
          ! c) Does it have a disk
          Temp = Translate (Versatec Disk)
          if Temp # Versatec Disk start
              To Upper (Temp)
              if Temp # "N" and Temp # "Y" and Temp # "NO" and Temp # "YE" -
                             and Temp # "YES" start
                  Fault ("Unknown setting """.Temp.""" for ".Versatec Disk)
              finish
              if charno(temp,1)='N' start
                 Iarg (1) = 0                { No disk }
              else
                 if Controller = 4 start
                    Iarg (1) = 2             { RPM with disk }
                 else
                    Iarg (1) = 1             { REP with disk }
                 finish
              finish
              X = 17 { Disk/No Disk flag }
              Vpopt (X, Iarg(1), Rarg(1), com)
              if Controller = 4 start
                 Iarg (1) = 2
                 X = 41 { RPM Disk Usage Flag }
                 Vpopt (X, Iarg(1), Rarg(1), com)
              finish
          finish
          Temp = Translate (Versatec Memory)
          if Temp # Versatec Memory start
             begin
                on * start
                   Fault ("Unknown setting """.Temp.""" for ".Versatec Memory)
                finish
                Rarg(1) = StoR (Temp)
             end
             X = 34 { RPM controller Memory size }
             Vpopt (X, Iarg(1), Rarg(1), com)
          finish
   
          ! Initialise the Versatec package
          X = 0; Y = 0
          X = 1 if Translate (Versatec Options) # Versatec Options
          PLOTS (X, Y, Izero)

          ! Inquire the Units being used
          X = -1;   Iarg(1) = 0
          VPOPT (X, IARG(1), RARG(1), COM)
          UPCM = RArg (1)

          ! Inquire the paper size
          X = -2;   Iarg(1) = 0
          VPOPT (X, IARG(1), RARG(1), COM)
          ! The 0.1 is because the paper size seems just too large (rounding?)
          MAX PLOT X = Trunc ((Rarg(2)-0.1) * Upcm)
          MAX PLOT Y = Trunc ((Rarg(4)-0.1) * Upcm)

          ! Inquire whether it is a colour plotter
          X = -101;   Iarg(1) = 0
          VPOPT (X, IARG(1), RARG(1), COM)
          if Iarg(1)<2 start
             Colour Model = False
             for Com = 0, 1, 4 cycle
                DefPen (Com, Ione, On1(Com), Off1(Com), On2(Com), Off2(Com))
             repeat
          else
             Colour Model = True
             for Com = 1, 1, 7 cycle
                if Iwidth=2 and Com=1 then X = 8 else X=Com
                PenClr (Com, X)
                DefPen (Com, Iwidth, Izero, Izero, Izero, Izero)
             repeat
          finish
          Read Patterns(Int(UPCM*2.54))
          for Com = 1, 1, Max Pat cycle
              Rotate Pattern(Patterns(Com*16),-1) 
          repeat 
          X = 16
          DefPat (Com, Patterns(Com*16), X) for Com = 1, 1, Max Pat
          SetPat (Izero)
          Point List == New (Point List)
          Point List_Next == Nil
          Called = True
       finish
       Active = False
       Dev Data_Max Colour = 255 if Colour Model = True
       Dev Data_Units per CM = UPCM/2.54
       Dev Data_X Units per cm = UPCM/2.54
       Dev Data_Y Units per cm = UPCM/2.54
       Dev Data_DVX = MAX PLOT X
       Dev Data_DVY = MAX PLOT Y
       Dev Data_MVX = Dev Data_DVX
       Dev Data_MVY = Dev Data_DVY
       return

SW(1): !Terminate
       PLOT (Zero, Zero, End Plot and Job)
       Active = False
       return

SW(2): ! Update
       return

SW(3): ! New frame
       if Active # False start
          SX = 0 and SY = 0
          Plot (SX, SY, End Plot)
          Active = False
          if Colour Model = False start
             for Com = 0, 1, 4 cycle
                DefPen (Com, Ione, On1(Com), Off1(Com), On2(Com), Off2(Com))
             repeat
             NewPen (Style)
          else
             for Com = 1, 1, 7 cycle
                PenClr (Com, Com)
                DefPen (Com, Ione, Izero, Izero, Izero, Izero)
             repeat
          finish
          X = 16
          DefPat (Com, Patterns(Com*16), X) for Com = 1, 1, Max Pat
          SetPat (Izero)
          SX = XL;  UX = XR;  SY = YB;  UY = YT
          WINDOW (SX, UX, SY, UY)
          SX = XL / UPCM
          UX = XR / UPCM
          SY = YB / UPCM
          UY = YT / UPCM
          VPORT (SX, UX, SY, UY)
       finish
       return

SW(4): ! Move Abs
       SX = X;   SY = Y
       PLOT (SX, SY, Move to)
       point list_p_x = x;   point list_p_y = y
       Next point == point list
       Nlines = 1
       return

SW(5): ! Line Abs
       if Shade Mode = 0 start
           SX = X;   SY = Y
           PLOT (SX, SY, Draw to)
           Active = True
       else
           return if next point_p_x=x and next point_p_y=y
           Nlines = Nlines + 1
           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
       finish
       return

SW(6): ! Character
       signal 14, 14

SW(7): ! Attribute  Change
       CHANGE ATTRIBUTE (X, Y)
       return

SW(8): ! Set lower window settings
       XL = X;   YB = Y
       return

SW(9): ! Set upper window bounds
       XR = X;   YT = Y
       SX = XL;  UX = XR;  SY = YB;  UY = YT
       WINDOW (SX, UX, SY, UY)
       SX = XL / UPCM
       UX = XR / UPCM
       SY = YB / UPCM
       UY = YT / UPCM
       VPORT (SX, UX, SY, UY)
       return

SW(10): ! Mode change
        return

SW(11): ! Set Colour replacement mode (old entry point)
        change attribute (att colour mode, X)
        return

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

SW(13): ! Upper box bounds, and do box
        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.
        if Shade Mode # 0 start
            SX = WX; SY = WY; UX = X; UY = Y
            NewPen (Izero) if Style # 0
            Rect (SX, UX, SY, UY, Ione)
            NewPen (style) if Style # 0
            Active = True
        else
            Versatec (4, WX, WY)
            Versatec (5, X, WY)
            Versatec (5, X, Y)
            Versatec (5, WX, Y)
            Versatec (5, WX, WY)
        finish
        return

SW(14): ! Circle
        UX = X
        UX = - UX if Shade Mode = 0
        Circle (SX, SY, UX, Ione)
        return

SW(*):
end

!%begin
!   %integer x
!   prompt ("Model: ")
!   read (x)
!   versatec (0, x, 0)
!   print string (Dev Data_name.nl)
!   write (dev data_Units Per Cm,1); newline
!%end
end of file