! 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