! EDWIN driver for the LEEDS SIGMA terminal.

from Edwin include Device
from Edwin include Icodes
from Imp include Ascii

const integer s        =  1
const integer l        = -1
const integer GRAPHICS =  1
const integer IN TEXT  = -1
const integer UP       =  1
const integer DOWN     = -1
const integer array C SIZE(1:28) = 5,7,10,14,15,20,21,25,28,30,35,40,42,45,
                                      49,50,55,56,60,63,65,70,75,77,88,91,98,105
const integer array C TYPE(1:28) = s, l, s, l, s, s, l, s, l, s, s, s, l,s,
                                      l, s, s, l, s, l, s, s, s, l, l, l, l,l
const integer array C SCALE(1:28) =1,1,2,2,3,4,3,5,4,6,7,8,6,9,7,10,
                                      11,8,12,9,13,14,15,11,12,13,14,15
const string(4) array LINE STYLES(0:4) = "FFFF","8888","F93F","C3C3","F00F"

own short Model = 5680               { Options 5680, 5684, 5688 }
own short Graph Mode = False
own integer char scale = 1
own integer MODE       = GRAPHICS   
own integer omode      = 0     { Colour Overwrite mode }
own integer curcol     = 1     { Current EDWIN colour number }
own integer last x     = 0
own integer last y     = 0
own integer X MIN      = 0
own integer Y MIN      = 0
own integer X MAX      = 511
own integer Y MAX      = 767
own integer VIS        = 0
own integer TCS        = 5
own integer PEN        = UP
own integer move pending = FALSE
own integer TYPE C = s
own integer Shade mode = 0
own string (7) Init = "+-*/"

routine Hex (integer N)
   const byte array H(0:15) = '0', '1', '2', '3', '4', '5', '6', '7',
                                 '8', '9', 'A', 'B', 'C', 'D', 'E', 'F'
   if Model = 5688 start
       TTput (H(N>>4&15))
   finish
   TTput (H(N&15))
end

routine Add (integer A, B)
   TTput (a);   TTput (b)
end

routine ADD STR (string(255) CMD)
   integer I
   TTput (Charno(CMD,I)) for I = 1, 1, Length(CMD)
end

routine PEN UP
    ADD ('G','I') 
    PEN = UP
end

routine PEN DOWN
    ADD ('G','J') 
    PEN = DOWN
end

routine TEXT ON
    short s, t
    t = char scale
    if char scale > 9 start
        s = 1
        t = t - 10
    else
        s = 0
    finish
    ADD ('D','E');   TTput(s+'0');   TTput(t+'0');   Add ('B','A')
    mode = IN TEXT
end

routine TEXT OFF
    ADD STR ("+-*/")
    mode = GRAPHICS
end

routine NUM(integer x)
    integer d1, d2, d3
    d1 = x//100
    x  = x - d1*100
    d2 = x//10
    d3 = x - d2*10
    TTput (d1 + '0');   TTput (d2 + '0');   TTput (d3 + '0')
end

routine GOTO(integer X,Y); 
    NUM(x+100)
    NUM(y+100)
end
   
routine do move
    TEXT OFF if mode = IN TEXT
    pen up
    goto(last x,last y)
    move pending = FALSE
end

external routine SET COLOUR MAP alias "EDWIN___S_MAP" (integer REG, RED,  BLUE, GREEN) 
    TEXT OFF IF MODE = IN TEXT
    if 0 <= reg  <= 255 and 0 <= red   <= 255 and    c
        0 <= blue <= 255 and 0 <= green <= 255 start
        Add Str (init)
        Add ('J', 'G')
        hex(reg);   hex(red);   hex(green);   hex(blue);   hex(0)
        TTput (nl)
        Flush Output
        Graph mode = False
    finish  
end

routine SET COLOURS
   integer i
   if Model#5688 start
       SET COLOUR MAP(0,0,0,0)
       SET COLOUR MAP(1,0,0,15)
       SET COLOUR MAP(2,15,0,0)
       SET COLOUR MAP(3,15,0,8)
       SET COLOUR MAP(4,0,15,0)
       SET COLOUR MAP(5,0,15,15)
       SET COLOUR MAP(6,15,15,0)
       SET COLOUR MAP(7,10,10,10)
       SET COLOUR MAP(8,15,0,15)
       SET COLOUR MAP(9,10,10,15)
       SET COLOUR MAP(10,15,0,8)
       SET COLOUR MAP(11,15,10,10)
       SET COLOUR MAP(12,0,0,10)
       SET COLOUR MAP(13,8,8,15)
       SET COLOUR MAP(14,10,0,0)
       SET COLOUR MAP(15,15,15,15)
   else
       SET COLOUR MAP(0,0,0,0)
       SET COLOUR MAP(1,0,0,255)
       SET COLOUR MAP(2,0,255,0)
       SET COLOUR MAP(3,0,255,255)
       SET COLOUR MAP(4,255,0,0)
       SET COLOUR MAP(5,255,0,127)
       SET COLOUR MAP(6,255,255,0)
       SET COLOUR MAP(7,192,192,192)
       SET COLOUR MAP(8,255,0,255)
       SET COLOUR MAP(9,160,160,255)
       SET COLOUR MAP(10,0,0,160)
       SET COLOUR MAP(11,160,160,255)
       SET COLOUR MAP(12,255,0,127)
       SET COLOUR MAP(13,255,160,160)
       SET COLOUR MAP(14,160,0,0)
       SET COLOUR MAP(15,200,200,200)
       SET COLOUR MAP(16,127,127,127)
       SET COLOUR MAP(17,127,127,255)
       SET COLOUR MAP(18,127,255,127)
       SET COLOUR MAP(19,127,255,255)
       SET COLOUR MAP(20,255,127,127)
       SET COLOUR MAP(21,255,127,180)
       SET COLOUR MAP(22,255,220,127)
       SET COLOUR MAP(23,225,225,225)
       SET COLOUR MAP(24,127,127,127)
       SET COLOUR MAP(25,127,127,255)
       SET COLOUR MAP(26,127,255,127)
       SET COLOUR MAP(27,127,255,255)
       SET COLOUR MAP(28,255,127,127)
       SET COLOUR MAP(29,255,127,180)
       SET COLOUR MAP(30,255,220,127)
       SET COLOUR MAP(31,225,225,225)
       SET COLOUR MAP(32,70,70,70)
       for i = 33,1,63 cycle
          SET COLOUR MAP(i,0,0,0)
       repeat
       for i = 64,1,127 cycle
          SET COLOUR MAP(i,255,255,255)
       repeat
       for i = 128,1,255 cycle
          SET COLOUR MAP(i,255,255,255)
       repeat
   finish
end
 
routine NEW FRAME
    ADD ('H', 'J');   Hex (16_FF)   { Enable all planes }
    Add ('D', 'A')                  { Zero all enabled planes }
    Add ('J', 'A');   Hex (16_FF)   { Display all planes }
    last x = 0
    last y = 0
    vis    = 0
end

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

   routine PUT CHAR
       do move if move pending = TRUE
       pen down if pen = UP
       TEXT ON if MODE = GRAPHICS
       last x=last x+TCS
       if last x > X MAX start
           vis = 1
       else
           TTput (x)
       finish
   end

   routine CHANGE ATTRIBUTE (integer WHAT, TO)
      const byte array CMAP (0:15) = 0, 15, 4, 1, 2, 6, 8, 5, 10, 3, 7, 9, 11, 12, 13, 14
      { Map EDWIN colours onto sigma colour map }
      integer i
      switch as(0:att maximum)
      -> AS(What)
   
AS(att colour):
       return unless 0<=to<=255
       to = to & 15 if Model # 5688
       cur col = to
       add ('H','I')
       if Model # 5688 start
           HEX(CMAP(to))
       else
           HEX (to)
       finish
       if omode = 2 start { OR mode }
           add ('H','J')
           if Model # 5688 start
               HEX(CMAP(to))
           else
               HEX (to)
           finish
       else
           add ('H','J');  Hex (16_FF)
       finish
       return

AS(att line style):
       TO = 0 unless 0<=TO<=4
       if to = 0 start
           ADD str ("FAFC") 
       else
           ADD str ("FAFDDL".line styles(to))
       finish
       return

AS(att char size):
       return if to = TCS
       for i =28,-1,1 cycle
           exit if to >= C SIZE(i)
       repeat
       if C TYPE(i) # TYPE C start
           if C TYPE(i) = s start
               ADD str ("EIIH006II010")
           else
               ADD ('E','N')
           finish
       finish
       char scale = C SCALE(i)
       TYPE C = C TYPE(i)
       TCS = C SIZE(i)
       return

AS(att shade mode):
       Shade mode = to
       return

AS(att colour mode):
       ! Mode 0 = Overwrite,  Mode 2 = OR mode, others ignored
       omode = to
       to = CurCol
       -> AS (att colour)

AS(*): ! All other attributes ignored
   end

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

   !  Main body of routine starts here.
   if graph mode = False and Com#0 and Com#2 start
       Add Str (init)
       Graph Mode = True
   finish
   TEXT OFF if MODE = IN TEXT and COM # 6
   -> SW(COM)

SW(0): !                              Initialise
       Model = X
       DEV DATA_NAME = "a Sigma terminal"
       DEV DATA_DVX = 767
       DEV DATA_DVY = 511
       DEV DATA_MVX = 767
       DEV DATA_MVY = 511
       if Model=5688 start
           DEV DATA_MAX COLOUR = 255
       else
           DEV DATA_MAX COLOUR = 15
       finish
       TTMODE (1)
       Init = snl."+-*/"
       Add Str (init."GADD000DF019DG017")
       Add ('C', 'M')
       if Model = 5688 start
           TTPUT ('1')   { 8 plane operation }
       else
           TTPUT ('0')   { 4 plane operation }
       finish
       Add ('H', 'N')
       ! Set up the function keys to enable/disable planes
       if Model#5688 start
           Add Str (init."HK10#".init."JA1#".snl)
           Add Str (init."HK11#".init."JA2#".snl)
           Add Str (init."HK12#".init."JA3#".snl)
           Add Str (init."HK13#".init."JA4#".snl)
           Add Str (init."HK14#".init."JA5#".snl)
           Add Str (init."HK15#".init."JA6#".snl)
           Add Str (init."HK16#".init."JA7#".snl)
           Add Str (init."HK17#".init."JA8#".snl)
           Flush Output   { Sigma seems to like break after NL for these }
           Add Str (init."HK18#".init."JA9#".snl)
           Add Str (init."HK19#".init."JAA#".snl)
           Add Str (init."HK20#".init."JAB#".snl)
           Add Str (init."HK21#".init."JAC#".snl)
           Add Str (init."HK22#".init."JAD#".snl)
           Add Str (init."HK23#".init."JAE#".snl)
           Add Str (init."HK24#".init."JAF#".snl)
       else
           Add Str (init."HK10#".init."HP$PL NI".tostring(13)."$#".init)
           Add Str (init."HK11#".init."HP$PL ND".tostring(CR)."$#".init)
           Add Str (init."HK12#".init."HP$PL NP".tostring(CR)."$#".init)
           Add Str (init."HK13#".init."HP$PL NB".tostring(CR)."$#".init)
           Add Str (init."HK14#".init."HP$PL NM".tostring(CR)."$#".init)
           Add Str (init."HK15#".init."HP$PL NC".tostring(CR)."$#".init)
           Add Str (init."HK16#".init."HP$PL NT".tostring(CR)."$#".init)
           Add Str (init."HK17#".init."HP$PL NV".tostring(CR)."$#".init)
           Add Str (init."HK18#".init."HP$PL NI ND NP NB NM NC NG NT NV".tostring(CR)."$#".init)
           Add Str (init."HK24#".init."HP$PL -NI".tostring(CR)."$#".init)
           Add Str (init."HK25#".init."HP$PL -ND".tostring(CR)."$#".init)
           Add Str (init."HK26#".init."HP$PL -NP".tostring(CR)."$#".init)
           Add Str (init."HK27#".init."HP$PL -NB".tostring(CR)."$#".init)
           Add Str (init."HK28#".init."HP$PL -NM".tostring(CR)."$#".init)
           Add Str (init."HK29#".init."HP$PL -NC".tostring(CR)."$#".init)
           Add Str (init."HK30#".init."HP$PL -NT".tostring(CR)."$#".init)
           Add Str (init."HK31#".init."HP$PL -NV".tostring(CR)."$#".init)
           Add Str (init."HK32#".init."HP$PL -NI -ND NP -NB -NM -NC -NG -NT -NV".tostring(CR)."$#".init)
       finish
       Add Str (init)
       NEW FRAME
       Flush Output
       SET COLOURS
       return

SW(1): ! Terminate
       Add ('H', 'N')
       TTput (NL)
       Graph Mode = False
       Flush Output
       TTMODE (0)
       return

SW(3): ! New frame
       NEW FRAME

SW(2): ! UPDATE
       return if Graph Mode = False
       TTput (NL)
       Graph Mode = False
       Flush Output
       return

SW(4): ! Move Abs
       move pending = TRUE
       last x=X;  last y=Y
       return

SW(5):  ! Line Abs
        do move if move pending = TRUE 
        pen down  if pen = UP 
        GOTO (X,Y)
        MODE = GRAPHICS
        last x=X; last y=Y
        VIS=0
        return

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

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

SW(8):  ! Ignore lower window bounds settings
        X MIN = X; Y MIN = Y
        return

SW(9):  ! Upper window bounds
        X MAX = X; Y MAX = Y
        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 > xmax or X < xmin or WY > ymax or Y < ymin
        WX = xmin if WX < xmin
        WY = ymin if WY < ymin
        X = xmax if X > xmax
        Y = ymax if Y > ymax
        ! Box now clipped into the screen.
        TEXT OFF if MODE = IN TEXT
        Add ('F','H');   Add('B','G')
        sigma(4, WX, WY)
        sigma(5, X, Y)
        Add ('F','G')
        return

SW(14): ! Circle fill
        Do move
        if Shade mode = 0 start
            Add ('J', 'M')
        else
            Add ('J', 'N')
        finish
        Num (x+100)
        TTput ('0')
        return 

SW(*): ! Other device commands ignored
end

external routine S REQ alias "EDWIN___S_REQ" (integer name STATE, X, Y)
    integer T

    integer function GET NUM
        result = (TTGET - '0')*100 + (TTGET - '0')*10 + (TTGET - '0')
    end

    TEXT OFF if mode = IN TEXT
    Add Str (init) if Graph Mode = False
    Add ('C','A');   Add ('H','F')
    TTput (nl);   Flush Output
    STATE = TTGET
    X = get num
    T = TTGET
    Y = get num
    T = TTGET
    Add Str (Init)
    Add ('C','B')
    Graph Mode = True
end

endoffile