    ! EDWIN driver for the DEC GP300 Colour Graphics terminal

    from Edwin include Device
    from Edwin include Icodes
    from Edwin include Iprocs
    !%from Imp %include Predef

    !%system %routine %spec changefilesize(%string(31) file,%integer newsize, %integername flag)
    !%record %format headerf(%integer dataend,datastart,size,filetype,sum,datetime,pstart,start)
    !%record %format recfor(%integer conad,filetype,datastart,dataend)
    !%system %routine %spec connect(%STRING (31) filename, %INTEGER access,
    !   maxbytes,prot, %RECORD (recfor) %NAME r, %INTEGER %NAME flag)
    !%system %routine %spec disconnect(%STRING (31) filename, %INTEGER %NAME flag)

    !%routine compress
    !   %string (255) file name
    !   %constantinteger lf = 10
    !   %record(headerf)%name header
    !   %record(recfor) rec
    !   %integer i,ch,marker,j,newbuff,flag
    !
    !%routine data compression
    !   %constantintegerarray control code(1:3)= 16_1B,16_5B,16_62
    !   %integer numchars, this num, tens, hundreds, units
    !
    !    %if marker#0 %start
    !        %if i-marker>5 %start
    !            byteinteger(newbuff) = byteinteger(marker)
    !            byteinteger(newbuff+1) = control code(1)
    !            byteinteger(newbuff+2) = control code(2)
    !            numchars = i - marker - 1
    !            hundreds = numchars // 100
    !            tens = (numchars - hundreds*100) // 10
    !            units = (numchars - hundreds*100 - tens*10)
    !            this num = 3
    !            %if hundreds # 0 %start
    !                byteinteger(newbuff+this num) = hundreds + 16_30
    !                this num = this num + 1
    !            %finish
    !            %if hundreds # 0 %or tens # 0 %start
    !                byteinteger(newbuff+this num) = tens + 16_30
    !                this num = this num + 1
    !            %finish
    !            byteinteger(newbuff+this num) = units + 16_30
    !            this num = this num + 1
    !            byteinteger(newbuff+this num) = control code(3)
    !            newbuff = newbuff + this num + 1
    !        %else
    !            byteinteger(newbuff+j-marker)=byteinteger(j) %for j=marker,1,i-1
    !            newbuff = newbuff + i -marker
    !        %finish
    !    %else
    !        byteinteger(newbuff) = byteinteger(i-1)
    !        newbuff = newbuff + 1
    !    %finish
    !    marker=0
    !    ch= byteinteger(i)
    !%end
    !
    !I = output stream
    !select output (viewing)
    !filename = output name
    !close output
    !select output (I)
    !select output (0)
    !disconnect (filename,flag)
    !connect(file name,10,0,0,rec,flag)
    !header== record(rec_conad)
    !i = rec_conad + rec_datastart
    !newbuff = i
    !ch = byteinteger(i)
    !marker=0
    !%cycle
    !    i=i+1
    !    %if byteinteger(i)=lf %then data compression %and -> end
    !    %if byteinteger(i)=ch %start
    !        %if marker = 0 %then marker = i - 1
    !    %finishelse data compression
    !end:
    !%repeatuntil i = rec_conad + rec_dataend
    !header_size=newbuff-rec_conad-rec_datastart
    !header_dataend = header_datastart + header_size
    !changefilesize(Filename,newbuff-rec_conad-rec_datastart,flag)
    !%end

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

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

    const integer LF = 10;
    const integer DOTS WIDE = 1190 , DOTS HIGH = 1601
    const integer LINE MAX = DOTS WIDE//8 + 1

    record format LINEF (byte integer array X (0:LINE MAX))
    own record (LINEF) array PAGE (0:DOTS HIGH)

    own byte DRAWN = FALSE
    own integer resolution = 0
    own integer SX = 0, SY = 0
    own integer XL = 0, XR = Dots Wide, YB = 0, YT = Dots High

    routine DRAW PAGE
       const integer LINE BUFF LEN = (DOTS WIDE+5)//6 + 4 + 2
       const integer LIM = LINE MAX // 3 * 3
       string (LINE BUFF LEN) LINE BUFF
       integer P, J, LB, I
       byte name B
       byte array name L
       ! 3-bit inversion table
       constbyteintegerarray  inverse(0:7) =
          2_000, 2_100, 2_010, 2_110,  2_001, 2_101, 2_011, 2_111
       !    0      1      2      3       4      5      6      7

       ! Set up resolution
       ttput(16_1B)
       ttput(16_5B)
       ttput(16_32)
       ttput(16_36+2*resolution)
       ttput(16_68)

       for I = DEV DATA_MVY, -1, 0  cycle
            L == PAGE(I)_X
            LB = ADDR (LINE BUFF)
            for J = ADDR(L(0)), 3, ADDR(L(LIM)) cycle
                 P = (((BYTE INTEGER(J)<< 8) ! BYTE INTEGER(J+1)) << 8) ! BYTE INTEGER (J+2)
                 BYTE INTEGER (LB + 4) = (P&63);   P = P >> 6
                 BYTE INTEGER (LB + 3) = (P&63);   P = P >> 6
                 BYTE INTEGER (LB + 2) = (P&63);   P = P >> 6
                 BYTE INTEGER (LB + 1) = (P&63)
                 LB = LB + 4
            repeat
            LENGTH(LINE BUFF) = LB - ADDR(LINE BUFF)
            if LIM#LINE MAX start
                P = 0
                for J = LIM+1, 1, LINE MAX cycle
                     P = (P<<8)!L(J)
                repeat
                P = P << (8*(3-(LINE MAX - LIM)))
                for J = 18, -6, 0 cycle
                     LINE BUFF = LINE BUFF.TO STRING(((P>>J)&63))
                repeat
            finish
            ! Strip trailing spaces (represented by binary zero)
            B == LENGTH(LINE BUFF)
            B = B-1 while B>0 and CHARNO(LINE BUFF, B)=0

            ! Add various bits and characters required by Printronix printer
            for j = addr(line buff)+1,1,lb cycle
               p = byte integer(j)
               byte integer(j) = inverse(p&7)<<3 ! inverse(p>>3) ! 64
            repeat
            TTPUT (CHARNO(LINE BUFF,J)) for J = 1, 1, LENGTH(LINE BUFF)
            TTPUT (LF)
            FLUSH OUTPUT
       repeat
       DRAWN = FALSE
    end

    routine DRAW LINE (integer TX,TY)
       ! This is algorithm 162 in the Collected Algorithms from CACM.
       ! It computes the code string required to move the pen of a
       ! digital incremental X-Y plotter from an initial point (SX,SY) to
       ! a terminal point (TX,TY) by the "best" approximation to the
       ! straight line between the points. The permitted elemental pen
       ! movement is to an adjacent point in a plane Cartesian point latice,
       ! diagonal moves permitted.

       integer A,B,D,E,F,T,I,XMOVE,YMOVE,X,Y
       const byte integer array XCODE(1:16) = 4,0,0,0,0,0,4,0,4,5,5,5,5,5,4,5
       const byte integer array YCODE(1:16) = 1,1,0,1,0,2,2,2,2,2,0,2,0,1,1,1
       ! PY,PX+PY,PX,PX+PY,PX,PX+NY,NY,PX+NY,NY,NY+NX,NX,NX+NY,NX,NX+PY,PY,NX+PY

       routine MOVE (integer X, Y)
          ! Move incrementaly over the screen.
          SX = SX + 1 if X=0
          SX = SX - 1 if X=5
          SY = SY + 1 if Y=1
          SY = SY - 1 if Y=2
       end

       routine MARK
          ! make mark in line buffer - represented as a linear bit string
          byte integer name B
          B == PAGE(SY)_X(SX>>3)
    A label to avert a compiler bug:
          b = b ! (16_80 >> (sx&7) )
       end

       MARK and return if SX=TX and SY=TY

       A = TX - SX
       B = TY - SY
       D = A + B
       T = B - A

       I = 0
       if B>=0 then I=2
       if D>=0 then I=I+2
       if T>=0 then I=I+2
       if A>=0 then I=8-I else I=I+10

       A =  -A if A<0
       B =  -B if B<0
       F = A + B
       D = B - A
       if D>=0 then T=A and D=-D else T= B
       E = 0

       XMOVE = XCODE (I-1)
       YMOVE = YCODE (I-1)
       X = XCODE (I)
       Y = YCODE (I)
       cycle
          A = D + E
          B = T + E + A
          MARK
          if B>=0 start
              E = A
              F = F - 2
              MOVE (X, Y)
          finish else start
              E = E + T
              F = F - 1
              MOVE (XMOVE,YMOVE)
          finish
          exit if F<=0
       repeat
       MARK
    end

       routine ZERO PAGE
          integer I
          PAGE (I) = 0 for I = 0, 1, DOTS HIGH-1
          SX = 0
          SY = 0
       end

       -> SW (COM)

    SW(0): ! Initialise
           DEV DATA_NAME = "a GP300 printer"
           if X = 30072 start { 72 resolution }
               DEV DATA_DVX = 500
               DEV DATA_DVY = 700
               DEV DATA_MVX = 500
               DEV DATA_MVY = 700
               Resolution = 0
           else { 144 resolution }
               DEV DATA_DVX = 1000
               DEV DATA_DVY = 1400
               DEV DATA_MVX = 1000
               DEV DATA_MVY = 1400
               Resolution = 1
           finish
           if VIEWING = 0 start
              VIEWING = 13
              OPEN OUTPUT (VIEWING, "LP#LIS")
           finish
           ZERO PAGE
           DRAWN = FALSE
           return

    SW(1): ! Terminate
           DRAW PAGE if DRAWN = TRUE
           ttput(27)
           ttput(16_5B)
           ttput(16_32)
           ttput(16_36+resolution*2)
           ttput(16_6C)
           ttput(12)
           ttput(nl)
           flush output
    !       compress
           return

    SW(2): ! Update
           return

    SW(3): ! Newframe
           DRAW PAGE if DRAWN = TRUE
           ZERO PAGE
           DRAWN = TRUE
           return

    SW(4): ! Move
           SX = X
           SY = Y
           return

    SW(5): ! Line
           DRAW LINE (X,Y)
           DRAWN = TRUE
           return

    SW(6): ! Character
           signal 14, 14  { to get it done as a software character }

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

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

    SW(10): ! ??
            return

    SW(11): ! Was overwrite mode
            return

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

    SW(13): ! Upper box bounds
            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.
            for COM = Y, -1, WY cycle
                 SX = WX;   SY = COM;   Draw line (X, SY)
            repeat
            return

    SW(*): ! Ignore all other commands
    end

    end of file