    ! EDWIN driver for the Datatype X5A 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
    from Imp include Ascii

    ! Edwin Colour Map
    const byte array cmap (0:15) = '0', '?', '2', '1', '4', '6', '8', '3',
        '5','9',':',';','<','=','7','>'

    const byte array fmap (1:16) = '0', '8', '9', ':', ';', '<', '=', '>',
        '5', '7', '?', '6', '4', '3', '2', '1'

    own string (17) array Fill Def (8:15) =
       "8??000000??000000",   "98888888888888888",
       ":8844221188442211",   ";1122448811224488",
       "<8855225588552255",   "=??888888??888888",
       ">0042000000004200",   "?55::55::55::55::"

    ! Control characters
    const integer GRAPHMODE = 29
    const integer ALPHAMODE = 31
    const integer ERASE SCREEN = 12
    const integer off = 0,on = 1

    ! Device
    own integer fill = off, filling = off
    own integer wx   = 0
    own integer wy   = 0
    own integer palette = 1
    own integer mask    = 1
    own integer mode change = us
    own integer updated   = off
    own integer xor mode = 0;

    ! Screen information
    own integer MODE = 0;      !0 if alphamode
    own integer SX = 0;        !Current device position
    own integer SY = 0
    own integer XR = 1023;     !Right hand side of device window
    own integer XL = 0, YB = 0 , YT = 760
    own integer VIS = 0;       !0 if CVP inside VW
    own integer OR  = 1;       !Default or color
    own integer xcheck
    own byte integer TCS = 13;    ! True char size.

    routine SWAP (integername  A, B)
       integer C
       c = a; a = b; b = c
    end

    routine num(integer y)
       integer hiy,loy
       hiy = y >> 5
       loy = y - hiy << 5
       hiy = hiy + 32
       loy = loy + 96
       ttput(hiy)
       ttput(loy)
    end

    routine fill on
       integer TO
       fill = on
       TO = Filling
       if TO > 0 start
           ttput(esc)
           ttput('M')
           ttput('P')
           ttput(fmap(to))
       finish
       ttput(esc); ttput('L'); ttput('P'); ttput(gs)
    end

    routine fill off
       fill = off
       ttput(us); ttput(esc); ttput('L'); ttput('E')
       mode = 0
    end

    routine force mode(integer x)
       switch modesw(0:3)

       fill off if mode = 3 and x # 3
        -> modesw(x)
       modesw(0):ttput(us)          ;! Graphics Alpha Mode
                 -> label
       modesw(1):ttput(graphmode)   ;! Graphics Vector mode
                 -> label
       modesw(2):                   ;! Dot Mode
                 ttput(fs)
                 -> label
       modesw(3):                   ;! Polygon Mode
                 if mode # 3 start
                    fill on
                 finish
    label:
       mode = x
    end

    routine xor on
       ttput(esc)
       ttput(nak)
       xor mode = 1
    end

    routine g mode
       if updated = on start
           updated = off
           ttput(gs)
           ttput(mode change) if mode change # 0
       finish
    end

    routinespec reset palettes

    external routine SET COLOUR MAP alias "EDWIN___X_MAP" (integer INDEX, RED, BLUE, GREEN)
       g mode
       force mode(0) if mode # 0
       if index # -1 start
           ttput(esc)
           ttput('$')
           ttput('0'+index)
           ttput(red+'0')
           ttput(green+'0')
           ttput(blue+'0')
       else
           reset palettes
       finish
    end

    !%external %routine SET PALETTE INTENSITY %alias "EDWIN_X5A_SET_PALETTE" (%integer red, blue, green)
    !   g mode
    !   force mode(0) %if mode # 0
    !   ttput (esc)
    !   ttput (']')
    !   ttput ('M')
    !   ttput ('0'+red)
    !   ttput ('0'+green)
    !   ttput ('0'+blue)
    !%end

    routine reset palettes
       set colour map (0, 0, 0, 0)
       set colour map (1, 0, 0, 15)
       set colour map (2, 0, 15, 0)
       set colour map (3, 0, 15, 15)
       set colour map (4, 15, 0, 0)
       set colour map (5, 8, 0, 8)
       set colour map (6, 15, 15, 0)
       set colour map (7, 8, 8, 8)
       set colour map (8, 15, 0, 15)
       set colour map (9, 8, 0, 15)
       set colour map (10, 8, 15, 8)
       set colour map (11, 8, 15, 15)
       set colour map (12, 15, 0, 8)
       set colour map (13, 12, 0, 12)
       set colour map (14, 15, 15, 8)
       set colour map (15, 15, 15, 15)
    end

    routine UPDATE
       switch modes (0:5)

       ->modes(mode)
    modes(0):mode change = us;->modes(5)
    modes(1):mode change = 0 ;->modes(5)
    modes(2):mode change = fs;->modes(5)
    modes(3):mode change = 0 ;->modes(5)
    modes(4):mode change = us
    modes(5):

       updated = on
       TTPUT (ALPHA MODE)
       ttput(can)
       FLUSH OUTPUT
    end

    external routine X5A alias "EDWIN___X" (integer COM, X, Y)
       switch SW(0:MAX COM)

       routine PUT CHAR
          ! Put out a text character properly.
          if MODE#0 START
              TTPUT(us)
              mode = 0; updated = on ; mode change = 0
          finish
          TTPUT (X)
          SX=SX+TCS
          VIS = 1 if SX>XR
       end

       routine GOTO(integer X,Y);   !Code up coordinates and send to TTY
          constinteger HI=32,LY=96,LX=64,ENH=7
          ttput (y>>5&31!hi); ttput (y&31!ly)
          ttput (x>>5&31!hi); ttput (x&31!lx)
       end

       routine write colour(integer palette no)
          ttput(esc)
          ttput('%')
          ttput(cmap(palette no&15))
          if xor mode = off start
              ttput(esc)
              ttput(']')
              ttput('S')
              if or = on then ttput(cmap(palette no & 15)) else ttput('?')
          else
              xor on
          finish
          palette = palette no
       end

       routine or mode (integer on or off)
          integer mode store

          mode store = mode
          force mode(0) if mode # 0
          if on or off>=0 and on or off <= 2 start
              if on or off = 2 then on or off = 1
              ttput(esc)
              ttput('M')
              ttput('S')
              ttput('0'+ on or off)
              if on or off = 1 then or = on else or = off
              xor mode = 0
              write colour(palette)
          else
              xor on
          finish
          force mode(mode store) if mode store # 0
       end

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

    SW(0):                                       ! Change current write colour
              xcheck = 0
              if xor mode = on then or mode(on) and xcheck = 1

              write colour(TO)
              xor on if xcheck = 1
              return

    SW(1):                                       ! Select Line style
              TO = 0 unless 0<=TO<=8
              ttput(esc)
              if TO < 5 start
                  ttput('`'+TO)
              else
                  ttput('M')
                  ttput('V')
                  ttput('`'+TO)
              finish
              return

    SW(2):                                      ! Select Character size
              ttput(esc)
              if TO<=7 start
                  ttput ('9')
              finish else if TO<=11 start
                  ttput ('8')
              finish else if TO <=13 start
                  ttput ('7')
              else
                  ttput ('6')
              finish
              return

    SW(9):                                        ! Select Colour Mode
              or mode (TO)
              return

    SW(10):                                 ! Select Fill Pattern
           Filling = to
           Filling = 1 if Filling > 16
           if Filling > 0 start
               ttput(esc)
               ttput('M')
               ttput('P')
               ttput(fmap(Filling))
           finish
           return

    SW(*):
       end

       routine Clear Screen
           ttput(gs);
           ttput(esc);ttput(']');ttput('S');ttput('?')
           ttput(esc); ttput (ff){;ttput(cr)
           SX=0; SY=0; VIS=0; MODE=0
           change attribute (0, palette)
       end

       g mode unless 4<=com<=6
       -> SW(COM)

    SW(0): ! Initialise
           DEV DATA_NAME = "a Datatype X5A terminal"
           DEV DATA_DVX = 1023
           DEV DATA_DVY = 767
           DEV DATA_MVX = 1023
           DEV DATA_MVY = 767
           DEV DATA_MAX COLOUR = 15
           TTMODE (1)
           Palette = 1
           Clear Screen
           reset palettes
           for Com = 8, 1, 15 cycle
              TTPUT (Esc)
              TTPUT ('M')
              TTPUT ('D')
              TTPUT (Charno(Fill Def(Com), X)) for X = 1, 1, 17
              TTPUT ('E')
           repeat
           return

    SW(1): !Terminate
           UPDATE
           TTPUT (cr)
           TTPUT (10)
           FLUSH OUTPUT
           TTMODE (0)
           return

    SW(2): ! Update
           UPDATE
           return

    SW(3): ! New frame
           Clear Screen
           return

    SW(4): ! Move Abs
           TTPUT (GRAPH MODE)
           GOTO (X,Y)
           SX=X;  SY=Y; VIS=0
           MODE = 1 if mode # 3
           return

    SW(5): ! Line Abs
           if MODE=0 start
               TTPUT (GRAPH MODE)
               GOTO (SX,SY)
           finish
           GOTO (X,Y)
           MODE = 1 if MODE # 3
           SX=X; SY=Y; VIS=0
           return

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

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

    SW(8): ! Lower window bounds settings
           XL = X; YB = Y
           return

    SW(9): ! Upper window bounds
           XR=X; YT = Y
           return

    SW(10):
           force mode (x)
           return

    SW(11):                                ! Colour Change for compatibilty
            change attribute (9, x)
            return

    sw(12): wx=x; wy=y
            return

    sw(13):                                       ! Flash Fill rectangle
           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 filling > 1 start
              fill on
              ttput(graphmode)
              goto(wx,wy)
              goto(wx,y)
              goto(x,y)
              goto(x,wy)
              goto(wx,wy)
              fill off
           else
              ttput(graphmode)
              goto(wx,wy)
              ttput(esc)
              ttput(stx)
              goto(x,y)
              ttput(esc)
              ttput(etx)
              ttput(gs)
           finish
           SX=X; SY=Y; VIS=0; mode = 1
           return

    sw(14):                                            ! Draw Circle
            fill on if Filling # 0
            ttput(esc); ttput('e'); num(x)
            ttput('E');        ! End of data
            if fill = on then fill off
            ttput(gs);              ! Return to graphics mode
            mode = 1
            return

    sw(15):                                            ! Draw Ellipse
            ttput(esc); ttput('e')
            num(wx); num(wy)
            num(x); num(y)
            ttput('E');        ! End of data
            if fill = on then fill off
            ttput(gs);              ! Return to graphics mode
            mode = 1
            return

    SW(*):
    end

    external routine X SAM alias "EDWIN___X_SAM" (integer name BUT, X, Y)
       signal 14, 8
    end

    external routine X REQ alias "EDWIN___X_REQ" (integer name CH, X, Y)
       G MODE
       FLUSH OUTPUT
       TEK INPUT (CH, X, Y, SUB)
       UPDATE
       MODE = 0
    end

    !%externalroutine set fill(%integer what)
    !   %if what<0 %or what>1 %then %signal 14,3 %else X5A(7,11,what)
    !%end

    !%externalroutine f set fill(%integername p)
    !   set fill(p)
    !%end

    !%externalroutine set fill style(%integer type)
    !   %if type<0 %or type>7 %then %signal 14,3 %else X5A(7,10,type)
    !%end

    !%externalroutine f set fill style(%integername type)
    !   set fill style(type)
    !%end

    !%externalroutine set screen mode(%integer type)
    !   %if type<0 %or type>3 %then %signal 14,3 %elsestart
    !       %if updated=on %then gmode
    !       X5A(10,type,0) %if type#mode
    !   %finish
    !%end

    !%externalroutine f set screen mode(%integername type)
    !   set screen mode (type)
    !%end

    !%externalroutine ellipse(%integer xaxis,yaxis,start angle,finish angle,fill)
    !   %if fill=1 %then set fill (1)
    !   X5A(12,xaxis,start angle)
    !   X5A(15,finish angle,yaxis)
    !%end

    !%externalroutine f ellipse(%integername xaxis,yaxis,start angle,finish angle,fill)
    !   ellipse(xaxis,yaxis,startangle,finish angle,fill)
    !%end

    !%externalroutine video blank(%integer i)
    !   %integer flag
    !   flag=0
    !   %if i<0 %or i> 3 %then %signal 14,3 %elsestart
    !       %if updated = on %then g mode  %and flag = 1
    !       ttput(esc);ttput('v');ttput(i)
    !       update
    !       gmode %if flag = 0
    !   %finish
    !%end

    !%externalroutine f videoblank (%integername i)
    !   video blank(i)
    !%end

    end of file