! 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