    ! EDWIN driver for the BBC Macro (native mode)

    from Edwin include Device
    from Edwin include Icodes

    record format Point fm (integer x, y)

    const integer MAX IN BUF = 35

    own integer BBC MODE = 2
    ! Mode 0 = 640 x 256  @  2 cols
    ! Mode 1 = 320 x 256  @  4 cols
    ! Mode 2 = 160 x 256  @ 16 cols

    ! Screen information
    own integer SX = 0
    own integer SY = 0
    own integer XL = 0
    own integer XR = 1279;     !Right hand side of device window
    own integer YB = 0
    own integer YT = 1023
    own integer VIS = 0;       !0 if CVP inside VW
    own integer OMODE = 0    { Overwrite mode
    own integer CCOL = 7     { White as Current Colour

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

    routine COORDS (integer X, Y)
       TTPUT (X&255)
       TTPUT ((X>>8)&255)
       TTPUT (Y&255)
       TTPUT ((Y>>8)&255)
    end

    routine PLOT (integer COM, X, Y)
       TTPUT (25)
       TTPUT (COM)
       COORDS (X, Y)
    end

    routine DO COLOUR
       TTPUT (18)
       TTPUT (OMODE)
       CCol = 1 if BBC Mode = 0 and CCol > 1
       TTPUT (CCOL)
    end

    external routine Set Mode alias "EDWIN_BBC_MODE" (integer MODE)
       BBC MODE = MODE & 7
    end

    routine spec initialise cursor    ;  ! the thing that starts up the trackerball
    routine spec reset interrupt vector

    constant integer dev call = 1, cursor call = 2
    own integer last call = dev call

    routine set xor
       ttput(18) ; ttput(3) ; ttput(7)
    end

    routine XOR Cursor(integer X,Y)
       const short array X Arm ( 1: 4 ) = -30, 30,   0,   0
       const short array Y Arm ( 1: 4 ) =   0,  0, -30,  30
       integer I

       for I = 1, 1, 4 cycle
          Plot(4,X,Y)
          Plot(1,X Arm(I),Y Arm(I))
       repeat
       Flush Output
    end

    own integer last x = -1, last y = -1

    routine line (integer x1, y1, x2, y2)
       plot (4, x1, y1);   plot (5, x2, y2)
    end

    routine triangle (integer x1, y1, x2, y2, x3, y3)
       PLOT (84, x1, y1)
       PLOT (84, x2, y2)
       PLOT (85, x3, y3)
    end

    routine FILL (integer xl, yb, xr, yt)
       SWAP (xl, xr) if xl > xr
       SWAP (yb, yt) if yb > yt
       xr = xr + 1 if xr = xl
       yt = yt + 1 if yt = yb
       TTPUT (24);   COORDS (xl, yb);      COORDS (xr, yt)
       TTPUT (18);   TTPUT (OMODE);   TTPUT (128 + CCOL)
       TTPUT (16)    { Clear }
       DO COLOUR
       TTPUT (26)
    end

    external routine BBC alias "EDWIN___B" (integer COM, X, Y)
       const integer array COLMAP (0:7) = 0   { black }   ,
                                             7   { white }   ,
                                             4   { blue }    ,
                                             2   { green }   ,
                                             1   { red }     ,
                                             5   { magenta } ,
                                             3   { yellow }  ,
                                             6   { cyan }
       own integer WX, WY, Nlines = 0, Lmode=0
       record format Data Fm (record (point fm) p, record (Data Fm) name Next)
       own record (Data fm) name Point List == 0
       own record (Data fm) name Next point == 0
       switch SW (0:MAX COM)

       include "Polyfill.abc"

       routine draw lines
          record (Data fm) name PP
          record (point fm) array pts (1:nlines+1)
          integer i
          return if Point List == Nil
          if nlines <= 1 start
              Line (point list_p_x, point list_p_y,
                    point list_p_x, point list_p_y)
          else if nlines = 2
              Line (point list_p_x, point list_p_y,
                    point list_next_p_x, point list_next_p_y)
          else
              pp == point list
              for I = 1, 1, Nlines cycle
                 pts(i) = pp_p
                 pp == pp_next
              repeat
              nlines = nlines + 1
              pts(nlines) = pts(1)
              POLY fill (nlines, Pts)
          finish
          nlines = 0
       end

       routine circle(integer x, y, r)
          integer d, e, s, da, db, dda, ddb, odb, odda, oddb
          e = 1
          s = 0
          while e<r cycle
             e = e<<1
             s = s+1
          repeat
          d = e>>1
          da = r<<s-d
          dda = r
          db = d
          ddb = 0
          cycle
             odda = dda
             oddb = ddb
             cycle
                odb = db
                db = db+da>>s
                da = da-odb>>s
                dda = da>>s
             repeat until odda#dda
             ddb = db>>s
             line(x-ddb,y+odda,x+ddb,y+odda)
             fill(x-odda,y+oddb,x+odda,y+ddb)
             fill(x-odda,y-oddb,x+odda,y-ddb)
             line(x-ddb,y-odda,x+ddb,y-odda)
          repeat until db>=da
       end

       constant integer char com = 6
       own integer last com = 0

       if last call = cursor call start
          xor cursor(last x,last y)
          do colour
          last call = dev call
       finish
       draw lines if nlines # 0 and (com = 10 or COM < 5)
       if last com = char com and com # char com start
          last com = com
          plot(4, SX, SY)
          ttput(4)
          ! restore cursor to correct position
       else if com # char com
          last com = com
       finish

       -> SW(COM)

    SW(0): ! Initialise
           ! Valid numbers are 16_BBC, 16_BBC0, 16_BBC1, 16_BBC2
           BBC MODE = X & 15
           BBC MODE = 0 unless 0<=BBC MODE<=2
           Point List == New (point list)
           point List_next == Nil
           DEV DATA_NAME = "an Acorn workstation"
           DEV DATA_DVX = 1279
           DEV DATA_DVY = 1023
           DEV DATA_MVX = 1279
           DEV DATA_MVY = 1023
           DEV DATA_MAX COLOUR = 7
           TTPUT (22);    TTPUT (BBC MODE)
           TTPUT (23); TTPUT(1); TTPUT(0); TTPUT(0); TTPUT(0); TTPUT(0); TTPUT(0);
           TTPUT (0); TTPUT(0); TTPUT(0)  ; !turn cursor off  (IGF)
           CCOL = 7
           OMODE = 0
           LMODE = 0
           DO COLOUR
           initialise cursor
           return

    SW(1): ! Terminate
           TTPUT (22)
           TTPUT (0)
           TTPUT (23); TTPUT(1); TTPUT(1); TTPUT(0); TTPUT(0); TTPUT(0); TTPUT(0);
           TTPUT (0); TTPUT(0); TTPUT(0)  ; !turn cursor back on again  (IGF)
           FLUSH OUTPUT
           reset interrupt vector
           return

    SW(2): ! Update
           FLUSH OUTPUT
           return

    SW(3): ! Newframe
           TTPUT (22);   TTPUT (BBC MODE)
           return

    SW(4): ! Move
           PLOT (COM, X, Y)
           SX = X;   SY = Y
           return

    SW(5): ! Line
           if Lmode >= 0 start
               PLOT (COM+LMODE, X, Y)
           else
               if Nlines = 0 start
                   point list_p_x = sx;   point list_p_y = sy
                   Next point == point list
                   Nlines = 1
               finish
               return if x=sx and y=sy
               Nlines = Nlines + 1
               if Next point_next == Nil start
                   Next point_next == New (Next point)
                   Next point      == Next point_next
                   Next point_next == Nil
               else
                   Next point == next point_next
               finish
               next point_p_x = x;   next point_p_y = y
           finish
           SX = X;   SY = Y
           return

    SW(6): ! Char
           ! Move to the bottom of the character by adding 32 to Y
           plot (4, sx, sy+32)
           ttput (5);   ttput (x);   ttput(4)
           sx = sx + 16
           plot (4, sx, sy)
           return

    SW(7): ! Attribute
           if x=att colour start
               if 0<=Y<=7 start
                   CCOL = COL MAP (Y)
               else
                   CCOL = 7
               finish
               DO COLOUR
           finish else if x=att line style start
               if y=1 start
                   LMODE = 16
               else
                   LMODE = 0
               finish
           finish else if x=att colour mode start
               ! y=0 => Replace
               ! y=1 => Or    { EDWIN Uses 2 }
               ! y=2 => And   { EDWIN Uses 1 }
               ! y=3 => Xor
               ! y=4 => Invert
               if 0<=y<=4 start
                   if y=1 or y=2 start
                       y = y !! 3  { swap 1 & 2 }
                   finish
                   OMODE = y
               else
                   OMODE = 0
               finish
               DO COLOUR
           finish
           return

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

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

    SW(10): ! Line modes
            if X=2 start { Point plot only }
                LMODE = 64
            else if X=3
                LMODE = -1
            else
                LMODE = 0
            finish
            return

    SW(11): ! Overwrite mode (old entry point)
            Y = X;        X = att colour mode;        -> sw(7)

    SW(12): ! Remember lower box bounds
            WX = X;   WY = Y
            return

    SW(13): ! Upper box bounds & do the box
            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.
            Fill (wx, wy, x, y)
            return

    SW(14): ! Circle
            circle (sx, sy, x)
            return

    SW(15): ! Area fill
             triangle (integer (y),    integer (y+4),
                       integer (y+8),  integer (y+12),
                       integer (y+16), integer (y+20))
             if x=4 start
                 triangle (integer (y+16), integer (y+20),
                           integer (y+24), integer (y+28),
                           integer (y),    integer (y+4))
             finish
    !          %for com = 1, 1, x*2 %cycle
    !               write (integer(y), 1)
    !               y = y + 4
    !          %repeat
    !          newline

    SW(*):
    end

    !**************************************************************************
    ! The above bit is host independent, the following is for networked hosts,
    ! using the BBC as a terminal, and then follows the code for using the BBC
    ! when a 32016 processor is connected.
    !
    !**************************************************************************
    !
    ! REMOTE HOST SPECS:
    !%external %routine Sample %alias "EDWIN___B_SAM" (%integer %name i,x,y)
    !   %signal 14, 8
    !%end
    !
    !%external %routine Cursor %alias "EDWIN___B_REQ" ( %integername Char, X, Y )
    !   %signal 14, 8
    !%end
    !%end %of %file
    !**************************************************************************
    !
    ! 32016 SPECS:

    external routine draw dots alias "EDWIN_DRAW_DOTS" (integer lx,ly,hx,hy,gap)
       integer dummy omode = omode, dummy ccol = ccol
       integer i,j,k,lx1,ly1,hx1,hy1
       from edwin include specs

       routine draw vertical lines
          lx1 = lx ; ly1 = ly
          map to device coords(lx1,ly1)
          hx1 = hx ; hy1 = hy
          map to device coords(hx1,hy1)
          i = lx
          while i <= hx cycle
             j = i ; ly1 = ly
             map to device coords(j,ly1)
             line(j,ly1,j,hy1)
             i = i + gap
          repeat
       end

       ! do vertical lines
       ccol = 1
       omode = 0
       do colour
       draw vertical lines
       !
       ! now do horizontal lines in black
       !
       i = ly
       ccol = 0
       do colour
       while i <= hy cycle
          j = i ; lx1 = lx
          map to device coords(lx1,j)
          line(lx1,j,hx1,j)
          i = i + gap
    !      j = i + 1 ; lx1 = lx
    !      map to device coords(lx1,j)
    !      i = i + gap
    !      k = i - 1 ; hx1 = hx
    !      map to device coords(hx1,k)
    !      k = k - 1; j = j + 1
    !      fill(lx1,j,hx1,k)
       repeat
       !
       ! now invert the vertical lines
       !
       omode = 4
       do colour
       draw vertical lines
       omode = dummy omode
       ccol = dummy ccol
       do colour
    end

    constant integer tkbyte = 6
    constant integer TK word = 7
    record format iop fm (integer ad,byte v)
    constant integer assemble address = 16_2F00
    constant integer reset address = 16_2FA1
    constant integer max 6502 = 179
    constant integer array code 6502 (0 : 179) = -
    {2F00} 16_4C,  16_C,  16_2F,  16_0,  16_0,  16_0,  16_0,  16_7,  16_0,
    {2F09} 16_0,  16_0,  16_0,  16_78,  16_AD,  16_5,  16_2,  16_C9,
    {2F11} 16_C0,  16_90,  16_1D,  16_8D,  16_9,  16_2F,  16_AD,  16_4,
    {2F19} 16_2,  16_8D,  16_8,  16_2F,  16_A9,  16_33,  16_8D,  16_4,
    {2F21} 16_2,  16_A9,  16_2F,  16_8D,  16_5,  16_2,  16_A9,  16_98,
    {2F29} 16_8D,  16_6E,  16_FE,  16_A9,  16_0,  16_8D,  16_62,  16_FE,
    {2F31} 16_58,  16_60,  16_8A,  16_48,  16_AD,  16_6D,  16_FE,  16_29,
    {2F39} 16_18,  16_D0,  16_6,  16_68,  16_A5,  16_FC,  16_6C,  16_8,
    {2F41} 16_2F,  16_AE,  16_60,  16_FE,  16_48,  16_29,  16_10,  16_F0,
    {2F49} 16_1D,  16_8A,  16_29,  16_8,  16_F0,  16_B,  16_EE,  16_3,
    {2F51} 16_2F,  16_D0,  16_13,  16_EE,  16_4,  16_2F,  16_4C,  16_67,
    {2F59} 16_2F,  16_CE,  16_3,  16_2F,  16_AD,  16_3,  16_2F,  16_C9,
    {2F61} 16_FF,  16_D0,  16_3,  16_CE,  16_4,  16_2F,  16_68,  16_29,
    {2F69} 16_8,  16_F0,  16_1D,  16_8A,  16_29,  16_10,  16_F0,  16_B,
    {2F71} 16_EE,  16_5,  16_2F,  16_D0,  16_13,  16_EE,  16_6,  16_2F,
    {2F79} 16_4C,  16_89,  16_2F,  16_CE,  16_5,  16_2F,  16_AD,  16_5,
    {2F81} 16_2F,  16_C9,  16_FF,  16_D0,  16_3,  16_CE,  16_6,  16_2F,
    {2F89} 16_68,  16_AA,  16_A5,  16_FC,  16_40,  16_48,  16_8,  16_C9,
    {2F91} 16_4,  16_D0,  16_8,  16_AD,  16_60,  16_FE,  16_29,  16_7,
    {2F99} 16_8D,  16_7,  16_2F,  16_28,  16_68,  16_6C,  16_A,  16_2F,
    {2FA1} 16_A9,  16_0,  16_8D,  16_6E,  16_FE,  16_AD,  16_8,  16_2F,
    {2FA9} 16_8D,  16_4,  16_2,  16_AD,  16_9,  16_2F,  16_8D,  16_5,
    {2FB1} 16_2,  16_60,  16_0

    byte fn read io(integer ad)
       record(iop fm) io

       io_ad = ad
       * addr   _ io,2
       * movqd  _ #5,1
       * svc    _ #TK word
       result = io_v
    end

    routine write io(integer ad,byte v)
       record(iop fm) io

       io_ad = ad
       io_v = v
       * addr   _ io,2
       * movqd  _ #6,1
       * svc    _ #TK word
    end

    routine osbyte  {Call OB2 With R} ( integer Which, integer name X, Y )
       * MovD _ Which, 1
       * MovD _ 0(X),  2
       * MovD _ 0(Y),  3

       * Svc  _ #TK Byte

       * MovZBD _ 2, 0(X)
       * MovZBD _ 3, 0(Y)
    end

    own integer char = 0
    !
    ! >> Try <<
    !
    ! Try and extract a character from the given buffer
    !
    predicate Try ( integer Buff )
       integer z
       ! zero for the keyboard
       * MovD   _ # 16_91, 1
       * MovD   _ Buff,    2
    {H}* MovQD  _ #0,      3
       * SVC    _ # TK BYTE
    !H!* BCS    _ No
       * MOVZBD _ 3, z
       char = z
    {H}false if Char = 0
       Char = Char&127 if Buff # 0
       true
    end

    routine dump 6502 code
       integer i

       for i = 0,1,max 6502 cycle
          write io(assemble address + i,code 6502(i))
       repeat
    end

    routine initialise cursor
       integer i = 0,j = 0

       dump 6502 code
       write io(16_0200,assemble address & 16_FF)
       write io(16_0201,(assemble address >> 8) & 16_FF)  {set up user vector to
                                                          {point to init code
       osbyte(16_88,i,j)       {execute initialise code in BBC micro}
    end

    routine reset interrupt vector
       integer i = 0, j = 0

       write io(16_0200,reset address & 16_FF)
       write io(16_0201,(reset address >> 8) & 16_FF)
       osbyte (16_88,i,j)      {execute reset code in BBC micro}
    end

    own integer joy stick = 1

    external routine joystick present alias "BBC_JOYSTICK" ( integer joy)
       joy stick = joy if 0 <= joy <= 1
    end

    constant integer x addr = 16_2F03,
                       y addr = 16_2F05,
                       button addr = 16_FE60   {user VIA Port B}

    routine cursor keys(integer name i,x,y)
       const byte array X Inc {offset by 1} ( 16_88: 16_8B ) = 0, 2, 1, 1
       const byte array Y Inc {offset by 1} ( 16_88: 16_8B ) = 1, 1, 0, 2
       integer Scaler

       scaler = 2                            ;! slow movement unless the cursor is down
       if try(0) and char <= 127 then i = char
       if 16_98+4 <= Char <= 16_9B+4 then Char = Char-4
       if 16_98 <= Char <= 16_9B start
          Scaler = 15 ; Char = Char-16
       finish
       if 16_88+4 <= Char <= 16_8B+4 then Char = Char-4
       if 16_88 <= Char <= 16_8B start
          X = X + (X Inc(Char) - 1)*Scaler
          Y = Y + (Y Inc(Char) - 1)*Scaler
          x = rem(x + 1280,1280) ; y = rem(y + 1032,1032)
          if joystick = 1 start
             write io(x addr,x & 255)
             write io(x addr + 1,(x >> 8) & 255)
             write io(y addr,y & 255)
             write io(y addr + 1,(y >> 8) & 255)
          finish
       finish
       !
       ! draw the cross
       !
       if last call = dev call start
          set xor
          last call = cursor call
          xor cursor(last x,last y)          ;! draw in the original position
       finish
       if last x # x or last y # y start
          ! refresh only if necessary
          xor cursor(last x,last y)          ;! draw off the old position
          xor cursor(x,y)                    ;! draw on the new position
          last x = x ; last y = y
       finish
    end

    external routine cursor alias "EDWIN___B_SAM" (integer name i,x,y)
       byte b,b1
       constant integer array convert buttons(1:4) = 4,1,3,2
       short a

       if joystick = 1 start
          !
          ! get the cursor position
          !
          select output(0)
          b = read io(x addr)
          b1 = read io(x addr + 1)
          a = (b1 << 8) ! b
          x = a    ;! convert from short to long integer
          !
          ! Do wrap round stuff
          !
          if x > 1280 start
             write io (x addr,0)
             write io (x addr+1,0)
             x = 0
          finish
          if x < 0 start
             write io (x addr,16_FF)
             write io (x addr+1,16_04)
             x=1279
          finish
          b = read io(y addr)
          b1 = read io(y addr + 1)
          a = (b1 << 8) ! b
          y = a
          if y > 1024 start
             write io (y addr,0)
             write io (y addr+1,0)
             y = 0
          finish
          if y < 0 start
             write io (y addr,16_FF)
             write io (y addr+1,16_03)
             y=1024
          finish
          !
          ! get buttons
          !
          b = ¬(read io(button addr)) & 7
          i = b
          i = convert buttons(i) if 1 <= i <= 4   ; ! change value from acorn to wc no
       finish

       cursor keys(i,x,y)
    end

    external routine BC alias "EDWIN___B_REQ" ( integername Char, X, Y )
       X = SX;   Y = SY
       BBC (4, SX, SY)
       Flush OUTPUT
       char = 0
       cycle
          if joystick = 1 start
             cursor(char,x,y)
          else
             cursor keys(char,x,y)
          finish
          exit if 0 < Char <= 127
       repeat
       SX = X ; SY = Y ; last x = x ; last y = y
    end

    end of file