! 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