    ! 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