    ! EDWIN driver for Cursor Addressable Terminals and line printers.

    !############################################################################
    !#                                                                          #
    !#  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.                                                            #
    !#                                                                          #
    !############################################################################

    ! For systems where memory is a precious resource, the following constants
    ! can be set to -1, and the driver can still drive most CATs.
    const integer MAX X = 131, MAX Y = 63

    from Edwin include Device
    from Edwin include Icodes
    from Imp   include Ascii

    ! Device configuration data -
    const integer MIN CAT = -3
    const integer Wide LP = -3
    const integer Narr LP = -2
    const integer Video   = -1
    const integer INTERACTS = 0;   ! Terminal >= interacts => terminal has Graphics capabitility.
    const integer Visual 200 = 0
    const integer Bantam 550 = 1
    const integer Soroc  120 = 2
    const integer HazeltineE = 3
    const integer VT52       = 4
    const integer VT100      = 5
    const integer MAX CAT = 5

    const integer array MODELS (MIN CAT:MAX CAT) = 'L',   'H',   'V',   200,   550,   120,   'E',    52,  100
    const byte array    ASPECT (MIN CAT:MAX CAT) =  50,    50,    45,    45,    45,    45,    45,    45,   45
    const integer array MAXSXS (MIN CAT:MAX CAT) = 131,    72,    79,    79,    79,    79,    79,    79,   79
    const integer array MAXSYS (MIN CAT:MAX CAT) =  63,    63,    23,    23,    23,    23,    23,    23,   23
    const integer array ERASES (INTERACTS:MAX CAT) =                    'v',   'K',   '*',    FS,   'J',  'J'
    const integer array CURS U (INTERACTS:MAX CAT) =                    'A',   DEL,    VT,   DEL,   'A',  'A'
    const integer array CURS D (INTERACTS:MAX CAT) =                    'B',    NL,    NL,    NL,   'B',  'B'
    const integer array CURS R (INTERACTS:MAX CAT) =                    'C',   TAB,    FF,   TAB,   'C',  'C'
    const integer array CURS L (INTERACTS:MAX CAT) =                    'D',    BS,    BS,    BS,   'D',  'D'
    const integer array UPS    (INTERACTS:MAX CAT) =                    'A',   'A',    VT,    FF,   'A',  'A'
    const integer array DOWNS  (INTERACTS:MAX CAT) =                    'B',   'B',    NL,    VT,   'B',  'B'
    const integer array RIGHTS (INTERACTS:MAX CAT) =                    'C',   'C',    CR,   DLE,   'C',  'C'
    const integer array LEFTS  (INTERACTS:MAX CAT) =                    'D',   'D',    BS,    BS,   'D',  'D'

    own integer UP, DOWN, LEFT, RIGHT, CUR U, CUR D, CUR R, CUR L
    own integer ERASE, MAX SX, MAX SY
    own integer MODEL = MIN CAT - 1
    own integer WX, WY, XL, YB, YT, XR    ;   ! Current Max Window bound

    ! device information
    own integer MODE = 0          { 0 if alphamode, 1 if Graph mode, -1 if unknown
    own integer SX = 0, SY = 0    { Current device position
    own byte VIS = TRUE           { TRUE if the current position is in the device window
    own byte DIF = TRUE           { TRUE if an UPDATE has just been done
    own byte INIT = FALSE         { Indicates if the driver is initialised
    own byte Had Newframe = False { Screen cleared on Terminate for bad emulators
    own byte CURRENT COLOUR = 15, OVERWRITE MODE = 0, Fill Mode = 0
    const byte array COLOUR (0:15) = ' ', '|', '=', '#', 'o', '$', '0', '@',
                                        '.', ':', '"', '^', '%', '&', '+', '*'
    const byte integer array EDWIN COLS (0:15) = 0, 15, 4, 1, 2, 6, 8, 5, 3, 7, 9, 10, 11, 12, 13, 14
    const integer TCS = 1;       ! True char size.
    record format COLF (byte integer array COL (0:MAXX))
    record format ROWF (record (COLF) array ROW (0:MAXY))
    !$IF ERCC compiler $START
    !%own %record (ROWF) SCREEN
    !$ELSE $IF IMP77 compiler
    own record (ROWF) name SCREEN
    !$FINISH
    const integer Char bit = 16_80
    ! The codes are held in SCREEN in the forms -
    ! 1 + 7 bits of char
    ! 0 - 4 bits of colour info.

    routine ESC PLUS (integer SYM)
       TTPUT (ESC)
       TTPUT ('[') if MODEL=VT100
       TTPUT (SYM)
    end

    routine DO MOVE
       integer I
       switch MS (0:MAX CAT)
       return unless INTERACTS <= MODEL <= MAX CAT
       return unless 0<=SX<=MAX SX and 0<=SY<=MAX SY
       -> MS (MODEL)
    MS(Visual 200):
    MS(VT 52):
    !   GMOFF
       ESC PLUS ('Y');   TTPUT (23-SY+32);   TTPUT (SX+32)
       return
    MS(Bantam 550):
       ESC PLUS ('Y');   TTPUT (SX+32)
       ESC PLUS ('X');   TTPUT (23-SY+32)
       return
    MS(Soroc 120):
       ESC PLUS ('=');   TTPUT (32+23-SY);   TTPUT (SX+32)
       return
    MS(HazeltineE): ESC PLUS (DC1)
       if SX=0 then TTPUT ('`') else TTPUT (SX)
       TTPUT ('w' - SY)
       return
    MS(VT100):
       I = (24-SY)//10
       if I=0 start { Suppress leading 0 }
           ESC PLUS (REM(24-SY,10)+'0')
       else
           ESC PLUS (I+'0')
           TTPUT (REM(24-SY,10)+'0')
       finish
       TTPUT (';')
       I = (SX+1)//10
       TTPUT (I+'0') if I#0 { Suppress leading 0 }
       TTPUT (REM(SX+1,10)+'0');   TTPUT ('H')
    end

    external routine VIDEOS alias "EDWIN___V" (integer COM, X, Y)

       routine UPDATE
          byte integer SP
          integer I, J, K
          ! Draw the screen
          if model < interacts and maxx>=0 and DIF=TRUE start

              for I=YT,-1,0 cycle
                   for J=XR,-1, 0 cycle
                        exit if SCREEN_ROW(I)_COL(J)#0
                   repeat
                   for K=0,1,J cycle
                       SP = SCREEN_ROW(I)_COL(K)
                       if SP&Char Bit # 0 start;   ! Character
                           TTPUT (SP&16_7F)
                       else
                           TTPUT (COLOUR (SP&15))
                       finish
                   repeat
                   TTPUT (13)
                   TTPUT (NL) if I>0
              repeat
              TTPUT (FF) if YT<63 and model=wide LP
          else
              DO MOVE if model >= interacts
          finish
          FLUSH OUTPUT
          MODE= 0
          DIF = FALSE
       end

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

       routine DRAW LINE (integer TX,TY)
          ! This is algorithm 162 in the Collected Algorithms from CACM.
          !
          ! XYMOVE computes the code string required to move the pen of a
          ! digital incremental X-Y plotter from an initial point (XZ,YZ) to
          ! a terminal point (XN,YN) 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.

          const integer LX = -1, RX = 0, UY = 1, DY = -1, Z = 1 {Zero in X}
          integer A,B,D,E,F,T,I,XMOVE,YMOVE,X,Y
          own short array XCODE(1:16) = RX,Z,Z,Z,Z,Z,RX,Z,RX,LX,LX,LX,LX,LX,RX,LX
          own short array YCODE(1:16) = UY,UY,0,UY,0,DY,DY,DY,DY,DY,0,DY,0,UY,UY,UY
          ! PY,PX+PY,PX,PX+PY,PX,PX+NY,NY,PX+NY,NY,NY+NX,NX,NX+NY,NX,NX+PY,PY,NX+PY

          integer fn New Cell (integer old)
             ! Combine the current colour with OLD, under the current overwrite mode
             switch MS (0:4)
             -> MS (Overwrite mode)
          MS (0): result = Current Colour
          MS (1): result = OLD & Current Colour
          MS (2): result = OLD ! Current Colour
          MS (3): result = OLD !! Current Colour
          MS (4): result = ¬OLD
          end

          routine ADD
             byte Old contents
             byte name SP                                  { screen pointer
             if 0<=SX<=MAXX and 0<=SY<=MAXY start
                 SP == SCREEN_ROW(SY)_COL(SX)
                 Old contents = SP
                 return if SP&CHAR BIT#0 and overwrite mode#0 { character already in slot }
                 ! Find out new contents of the screen
                 sp = New cell (sp)
                 return if MODEL<INTERACTS or Old Contents = sp
                 DO MOVE
                 TTPUT (COLOUR(SP))
             finish
          end

          routine MOVE (integer X, Y)
             ADD
             SX = SX + X
             SY = SY + Y
          end

          SWAP (SX, TX) and SWAP (SY, TY) if SX > TX;   ! Optimise direction.
          MOVE (0, 0) and return if SX=TX and SY=TY

          if SY = TY start                             { Horisonal Line }
              MOVE (1, 0) while SX <= TX
              return
          finish else if SX = TX start               { Vertical line }
              if SY > TY start
                  MOVE (0, -1) while SY >= TY
              else { SY < TY }
                  MOVE (0, 1) while SY <= TY
              finish
              return
          finish
          { Otherwise the general line code must be used }

          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
             if B>=0 start
                 E = A
                 F = F - 2
                 MOVE (X, Y)
             else
                 E = E + T
                 F = F - 1
                 MOVE (XMOVE, YMOVE)
             finish
             exit if F<=0
          repeat
          SX = TX;   SY = TY;   ADD
       end

       switch SW(0:MAX COM)
       signal 14, 0 if INIT#TRUE and COM#0
       -> SW(COM)

    SW(0): ! Initialise
           DEV DATA_NAME = "a type ".Itos(X,0)." terminal"
           X = 200 if X=55
           MODEL = MIN CAT - 1
           for COM = MIN CAT, 1, MAX CAT cycle
                MODEL = COM and exit if X=MODELS(COM)
           repeat
           signal 14, 0 if model=MIN CAT - 1
           DEV DATA_DVX = MAX SXS (MODEL)
           DEV DATA_DVY = MAX SYS (MODEL)
           DEV DATA_MVX = MAX SXS (MODEL)
           DEV DATA_MVY = MAX SYS (MODEL)
           DEV DATA_ARF = ASPECT (MODEL)
           DEV DATA_MAX COLOUR = 15
           DEV DATA_NUM CHAR SIZES = 255
           DEV DATA_NUM CHAR ROTS = 255
           MAXSX = MAXSXS (MODEL)
           MAXSY = MAXSYS (MODEL)
           if model>=interacts start
               ERASE = ERASES (MODEL)
               CUR U = CURS U (MODEL)
               CUR D = CURS D (MODEL)
               CUR R = CURS R (MODEL)
               CUR L = CURS L (MODEL)
               UP    = UPS    (MODEL)
               DOWN  = DOWNS  (MODEL)
               RIGHT = RIGHTS (MODEL)
               LEFT  = LEFTS  (MODEL)
           finish
    !$IF IMP77
           SCREEN == NIL
           SCREEN == NEW (SCREEN)
    !$FINISH
           SCREEN = 0
           TTMODE (1) unless model < interacts
           INIT = TRUE
           Had Newframe = False
           return

    SW(1): !Terminate
           Videos (3, 0, 0) if Had Newframe # True
           SX = 0;   SY = 0                                { -> bottom of screen }
           UPDATE
    !$IF IMP77
           DISPOSE (SCREEN)
    !$FINISH
           TTMODE (0) unless MODEL<interacts
           return

    SW(2): ! Update
           UPDATE
           return

    SW(3): ! New frame
           Had Newframe = True
           if MODEL>=INTERACTS start
               TTPUT (RS) if MODEL=SOROC 120
               ESC PLUS ('H') if MODEL=VT52
               if MODEL=VT100 start
                   ESC PLUS ('2') and TTPUT (ERASE)
               else
                   ESC PLUS (ERASE)
                   if MODEL=Bantam550 start
                       TTPUT (0) for Y=0,1,20
                   finish
               finish
               FLUSH OUTPUT
           finish
           SCREEN = 0
           X = 0;   Y = 0
           -> SW(4)

    SW(5): ! Line Abs
           DRAW LINE (X, Y)

    SW(4): ! Move Abs
           SX = X;   SY = Y
           DO MOVE unless MODEL<INTERACTS
           VIS = TRUE
           DIF = TRUE
           return

    SW(6): ! Character
           return unless VIS=TRUE
           TTPUT (X) unless model < interacts and 0<=SX<MAXX
           X = 0 if X = ' '
           SCREEN_ROW(SY)_COL(SX) = X!CHAR BIT if MAX X >= 0
           SX = SX + TCS
           VIS = FALSE if SX>XR
           DIF = TRUE
           return

    SW(7): ! Attribute  Change
           if X=att colour start
               Y = 15 unless 0<=Y<=15
               Current Colour = Edwin Cols (Y)
           finish else if X = Att Colour mode start
               Y = 0 unless 0<=Y<=4
               Overwrite mode = Y
           finish else if X = Att Shade mode start
               Fill Mode = Y
           finish
           return

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

    SW(9): ! Set upper device window bounds
           XR = X
           XR = MAX SX if XR>MAX SX
           YT = Y
           YT = MAX SY if YT>MAX SY
           return

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

    SW(13): ! Upper Box bounds & Draw the 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.
            for COM = Y, -1, WY cycle
                 SX = WX;   SY = COM;   DO MOVE;   Draw line (X, SY)
            repeat
            return
    SW(*):
    end

    external routine V REQ alias "EDWIN___V_REQ" (integer name CH,X,Y)

       routine ESCAPE
          TTPUT (ESC)
          if MODEL=VT100 start
              TTPUT ('[')
              TTPUT ('1')
          finish
       end

       signal 14,8 if MODEL<INTERACTS

       TTPUT (7)
       DO MOVE;   FLUSH OUTPUT;  MODE = 0;   ! Update (in line).
       X = SX;   Y = SY;
       cycle
          CH = TTGET
          exit if CH >= ' ';   ! Key hit, => return
          continue if CH#ESC and MODEL=VISUAL200
          CH = TTGET; ! The significant character of the ESC sequence.
          if MODEL=VT100 start
              CH = TTGET until 'A'<=CH<='D'
          finish
          if CH=CUR U start
            Y =Y+1 if Y<23
             ESCAPE;   TTPUT (UP)
          else
             if CH=CUR R start
                    X =X+1 if X<79
                    ESCAPE;   TTPUT (RIGHT)
             else
                 if CH=CUR L start
                     X =X-1 if X>0
                     ESCAPE;   TTPUT (LEFT)
                 else
                     if CH=CURD start
                         Y =Y-1 if Y>0
                         ESCAPE;   TTPUT (DOWN)
                     finish else continue
                 finish
             finish
         finish
         FLUSH OUTPUT
       repeat
    end

    end of file