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

%external %routine %spec TTMODE (%integer I)
%external %routine %spec TTPUT (%integer CH)
%external %integer %fn %spec TTREAD
%external %routine %spec FLUSH OUTPUT
%external %integer %spec DEVICE
%external %integer %fn %spec INSTREAM

%const %integer CHARLES=2

! 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 %integer TCS = 5; ! True char size.
%own %byte %integer CCS = 1; ! Current colour selected.

%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(K'100' ! ((NBYTES-1)<<3) ! (VAL & 7))
  TTPUT(K'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(K'40' ! (VAL & 31))
  VAL=VAL>>5
  TTPUT(K'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

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

%external %routine END POLY SHEET
   %return %if DEVICE#CHARLES
   CBYTE (6, 2) %if MODE = 3
%end

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

   %return %if DEVICE#CHARLES
   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 (%integer COM, X, Y)
   %switch SW(0:15)

   %routine PUT CHAR
      ! Put out a text character properly.
   
      %return %if VIS # 0
      DON %if CMODE=1
      %if MODE#0 %start
          CBYTE (K'43', 1); ! Move to start of text
          POINT (SX, SY)
          CBYTE (K'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)= K'43', K'44', K'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 (K'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
      %return %unless X=0 %or X=2; ! These are only two supported
      DON %if CMODE=1
      END MODE
      %if X=0 %start
          ! Change Colour
          CCS = Y
          Y = EDWIN COLS(Y) %if COLOUR SELECT MODE = 0
          CBYTE (K'20' ! Y, 2)
      %finish %else %start
          ! Change Character size
          %if Y<7 %then CBYTE(K'40', 2) %and TCS=5 %c
                  %else CBYTE(K'41', 2) %and TCS=10
      %finish
   %end

   %return %if DEVICE#CHARLES %or COM > 11
   -> SW(COM)

SW(0): ! Initialise
       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
       X=0; Y=0
       CHANGE ATTRIBUTE
       RMODE = 2; ! Gives invisable dot at the origin, to fix charles bug.
       DRAW LINE (0, 0, 0, 0, 1)
       X=0; Y=1
       CHANGE ATTRIBUTE; ! Colour to 1
       X=2; Y=6
       CHANGE ATTRIBUTE; ! Char size to small ones
       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)
       X = 0;   Y = CCS;      ! Restore colour.
       CHANGE ATTRIBUTE
       X = 2;   Y = TCS;      ! Restore character size
       CHANGE ATTRIBUTE
       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
       %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
        DON %if CMODE=1
        END MODE
        Y = Y & 255
        X = X & 3
        %if X<3 %then CBYTE (X, 2) %else CBYTE (K'60' ! Y, 2)
        %return

SW(*):
%end

%external %routine C BOX (%integer WX, WY, BX, BY)
   ! Wee X & Y, then Big X & Y
   ! Draw a box using BOX protocol.
   %routine SWAP (%integer%name  A, B)
      %integer C
      C = A;   A = B;   B = C
   %end

   SWAP (WX, BX) %if WX > BX
   SWAP (WY, BY) %if WY > BY

   %return %if WX > XR %or BX < XL %or WY > YT %or BY < YB

   WX = XL %if WX < XL
   WY = YB %if WY < YB
   BX = XR %if BX > XR
   BY = YT %if BY > YT
   ! Box now clipped into the screen.
   DON %if CMODE = 1
   ENDMODE
   RMODE = 4
   CHAS (5, WX, WY)
   CHAS (5, BX, BY)
   RMODE = 1
%end


%routine GET CO (%integer %name X)
   %integer I, J
   
   read symbol(I)
   read symbol(J)
   X = (J&31) <<5 ! (I&31)
%end

%external %routine C BIT PAD POS (%integername X, Y)
   %integer E
   DON %if CMODE = 1
   END MODE
   CBYTE (12, 2)
   CBYTE (10, 2)
   UPDATE
   E = TTREAD %until E=ESC
   GET CO (X)
   GET CO (Y)
   Y = 453 - Y
   E = TTREAD %until E = CR
%end

%external %routine C CURSOR (%integer %name BUT, X, Y)
   %integer E,s

   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 = TTREAD %until BUT=ESC
   s = in stream
   select input (0)
   GET CO (X)
   GET CO (Y)
   read symbol (E)
   read symbol (BUT)
   BUT = (BUT&31) <<5 ! (E&31)
   read symbol(E) %while E>=' '
   select input (s)
%end

%end %of %file