    ! EDWIN driver for the CHARLES (Minter) Colour Graphics terminal

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

    from Edwin include Device
    from Edwin include Icodes

    ! Control characters
    const integer ETX =  3
    const integer ESC = 27
    const integer CR  = 13
    const byte integer array EDWIN COLS (0:15) = 0, 15, 4, 1, 2, 6, 8, 5, 3, 7, 9, 10, 11, 12, 13, 14

    ! Screen information
    own integer COLOUR SELECT MODE = 0   { 0 => EDWIN colours, #0 => actual regs.
    own integer CMODE = 0    { 0=>display, 1=> Console active
    own integer RMODE = 0    { 0 text, 1 lines, 2 dots, 3 sheets
    own integer MODE = -1    { 0 if alphamode
    own integer SX = 0       { Current device position
    own integer SY = 0
    own integer XL = 0
    own integer XR = 511     { Right hand side of device window
    own integer YB = 0
    own integer YT = 511
    own integer VIS = 0      { 0 if CVP inside VW
    own byte TCS = 5         { True char size.
    own byte CCS = 1         { Current colour selected.
    own byte CCM = 0         { Current Colour mode

    routine DON
       ! Display on
       TTPUT (ESC);   TTPUT ('*');   CMODE = 0
    end

    routine cbyte(integer val, nbytes)
      ! Charles control byte protocol - 1 to 4 bytes, but only 2 for now.
      TTPUT(8_100 ! ((NBYTES-1)<<3) ! (VAL & 7))
      TTPUT(8_40 + (VAL>>3 & 63)) if NBYTES>1
      TTPUT(0)
    end

    routine DBYTE (integer VAL, NBYTES)
      ! Charles data byte protocol - 1 to 4 bytes
      integer I
      TTPUT(8_40 ! (VAL & 31))
      VAL=VAL>>5
      TTPUT(8_40 + (VAL & 63)) and VAL=VAL>>6 for I = 1, 1, N BYTES - 1
      TTPUT(0)
    end

    routine POINT (integer X, Y)
       DBYTE(X, 2);   DBYTE(Y, 2)
    end

    routine UPDATE
       if CMODE=0 start
           TTPUT (ETX) if MODE=0
           CBYTE (7, 2) if MODE=3
           TTPUT (13)
           FLUSH OUTPUT
       finish
       MODE = -1
       CMODE = 1
    end

    routine END MODE
       ! End to Text or Poly modes
       TTPUT (ETX) if MODE=0
       CBYTE (7, 2) if MODE=3
       MODE = -1
    end

    external routine END POLY SHEET alias "EDWIN_CHARLES_END_SHEET"
       CBYTE (6, 2) if MODE = 3
    end

    external routine SET COLOUR MAP alias "EDWIN___C_MAP" (integer ADR, RED, BLUE, GREEN)
       ! red, blue, green combination for this address in color map

       ADR = EDWIN COLS(ADR) if COLOUR SELECT MODE = 0
       DON if CMODE=1
       END MODE
       CBYTE (3, 2);! load colormap command
       DBYTE ((BLUE<<12) ! (GREEN<<8) ! (RED<<4) ! ADR, 3); ! 3 bytes of data
    end

    external routine CHAS alias "EDWIN___C" (integer COM, X, Y)
       own integer WX, WY
       switch SW(0:MAX COM)

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

       routine PUT CHAR
          ! Put out a text character properly.

          return if VIS # 0
          DON if CMODE=1
          if MODE#0 start
              CBYTE (8_43, 1); ! Move to start of text
              POINT (SX, SY)
              CBYTE (8_46, 1); ! Enter text mode
              MODE=0
          finish
          TTPUT (X)
          SX = SX + TCS
          VIS = 1 if SX>XR
       end

       routine DRAW LINE(integer FX, FY, TX, TY, V)
          !Draw visible line from virtual coordinates (FX, FY) to (TX, TY).
          !But if V = 0 just move to (TX, TY).
          const integer array CODE(0:4)= 8_43, 8_44, 8_45, 5, 4
          const integer array LC(0:4) = 1, 1, 1, 2, 2
          ! Command codes for TEXT, LINE, DOT, POLY, BOX modes respectivly.

          DON if CMODE=1
          TTPUT (ETX) if MODE=0;  ! ETX to end text mode
          CBYTE (7, 2) if MODE=3 and RMODE#3

          if V#0 start
              if MODE#RMODE start
                  CBYTE (8_43, 1) and POINT (FX, FY) if RMODE=1 and MODE#1
                  ! Above line fixes bug in Charles which causes move to be drawn.
                  CBYTE (CODE(RMODE), LC(RMODE))
                  POINT (FX, FY) if  0 < RMODE < 4
              finish
              if MODE = 3 start;   ! Possible need to clip polygons
              finish
              POINT (TX, TY)
              MODE = RMODE
          finish else MODE=-1
          SX=TX; SY=TY;   !Remember new position
       end

       routine CHANGE ATTRIBUTE (integer WHAT, TO)
          switch AS (0:ATT MAXIMUM)
          DON if CMODE=1
          END MODE
          -> AS (WHAT)

    AS(att colour):
           CCS = TO
           TO = EDWIN COLS(TO) if COLOUR SELECT MODE = 0
           CBYTE (8_20 ! TO, 2)
           return

    AS(att char size):
           if TO<7 start
               CBYTE(8_40, 2) and TCS=5
           finish else if TO<11 start
               CBYTE(8_41, 2) and TCS=10
           else
               CBYTE(8_42, 2) and TCS=15
           finish
           return

    AS(att colour mode):
           CBYTE (to, 2) and ccm=to if 0<=to<=3
           return

    AS(*): ! All other attributes ignored
       end

       -> SW(COM)

    SW(0): ! Initialise
           DEV DATA_NAME = "a Charles Terminal"
           DEV DATA_DVX = 511
           DEV DATA_DVY = 511
           DEV DATA_MVX = 511
           DEV DATA_MVY = 511
           DEV DATA_ARF = 125
           DEV DATA_MAX COLOUR = 15
           TTMODE (1)
           DON
           COLOUR SELECT MODE = -1; ! This sets the true device registers
           SET COLOUR MAP (0, 0, 0, 0)
           SET COLOUR MAP (1, 0, 0, 10)
           SET COLOUR MAP (2, 10, 0, 0)
           SET COLOUR MAP (3, 6, 0, 6)
           SET COLOUR MAP (4, 0, 10, 0)
           SET COLOUR MAP (5, 0, 8, 6)
           SET COLOUR MAP (6, 5, 8, 0)
           SET COLOUR MAP (7, 3, 5, 5)
           SET COLOUR MAP (8, 14, 0, 14)
           SET COLOUR MAP (9, 0, 0, 15)
           SET COLOUR MAP (10, 15, 0, 0)
           SET COLOUR MAP (11, 10, 1, 10)
           SET COLOUR MAP (12, 3, 15, 3)
           SET COLOUR MAP (13, 6, 10, 12)
           SET COLOUR MAP (14, 12, 10, 6)
           SET COLOUR MAP (15, 15, 15, 15)
           COLOUR SELECT MODE = Y
           CHANGE ATTRIBUTE (att colour, 0)
           RMODE = 2; ! Gives invisable dot at the origin, to fix charles bug.
           DRAW LINE (0, 0, 0, 0, 1)
           CHANGE ATTRIBUTE (att colour, 1)
           CHANGE ATTRIBUTE (att Char size, 6)
           RMODE = 1       ; ! Line mode by default.
           return

    SW(1): !Terminate
           UPDATE
           TTMODE (0)
           return

    SW(2): ! Update
           UPDATE
           return

    SW(3): ! New frame
           DON if CMODE=1
           END MODE
           CBYTE (1, 1)
           CHANGE ATTRIBUTE (att colour, ccs)      { Restore colour }
           CHANGE ATTRIBUTE (att char size, tcs)   { Restore character size }
           CHANGE ATTRIBUTE (att colour mode, ccm) { Restore colour mode }
           SX = 0;   SY = 0;   MODE = -1;   VIS  =  0
           return

    SW(4): ! Move Abs
           VIS = 0
           if MODE#3 then DRAW LINE (SX, SY, X, Y, 0) else DRAW LINE (SX, SY, X, Y,1)
           return

    SW(5): ! Line Abs
           VIS = 0
           DRAW LINE (SX, SY, X, Y, 1)
           return

    SW(6): ! Character
           PUT CHAR if VIS=0
           return

    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
           return

    SW(10): ! Mode change
            END MODE
            RMODE = X if 0<=X<=4
            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.
            DON if CMODE = 1
            ENDMODE
            RMODE = 4
            CHAS (5, WX, WY)
            CHAS (5, X, Y)
            RMODE = 1
            return

    SW(*):
    end

    routine GET CO (integer name X)
       integer I, J

       I = TTGET
       J = TTGET
       X = (J&31) <<5 ! (I&31)
    end

    external routine C SAM alias "EDWIN___C_SAM" (integer name BUT, X, Y)
       integer E

       DON if CMODE=1
       CBYTE (12, 2)                 { Flush the Queue   }
       CBYTE (10, 2)                 { Get the state     }
       UPDATE
       ! now get data back.
       BUT = TTGET until BUT=ESC
       GET CO (X)
       GET CO (Y)
       BUT = TTGET&31
       E = TTGET until E=CR
    end

    external routine C REQ alias "EDWIN___C_REQ" (integer name BUT, X, Y)
       integer E

       DON if CMODE = 1
       END MODE
       CBYTE (13, 2); ! Set the mouse position
       POINT (SX, SY)
       CBYTE (12, 2); ! Flush the Queue
       CBYTE (11, 2); ! Get the button change.
       UPDATE
       ! now get cursor back.
       BUT = TTGET until BUT=ESC
       GET CO (X)
       GET CO (Y)
       BUT = TTGET&31
       E = TTGET until E=CR
    end

    end of file