    ! EDWIN driver for the HP plotter range.

    from Edwin include Device
    from Edwin include Icodes
    !%from Imp %include Predef              { On non-Lattice systems }
    from Imp include Maths

    ! Control characters
    const integer ETX = 3
    const integer ESC =27
    const integer DEL = 127
    ! The following should be an external integer spec to the UTILITY module.
    const integer BUFF SIZE = 251

    ! Screen information
    own integer PLOT ACTIVE = FALSE;    ! FALSE => using terminal, TRUE => PLOTTER active
    own integer LAST COM = 0;     ! Used to optimise lines in the HP protocol
    own integer SX = 0;           ! Current device position
    own integer SY = 0
    own integer XL = 0, YB = 0;   ! Lower window bounds.
    own integer YT = 25 * 400;    ! Upper device window bound.
    own integer XR = 40 * 400;    ! Right hand side of device window
    own byte CUR COL = 1;         ! Current colour.
    own byte PM = FALSE;          ! Pending move.
    own byte PC = FALSE;          ! Pending colour change.
    own byte LOW QUAL = TRUE;     ! Character Quality, FALSE => proportional spaced sets
    own byte NEWFRAMED = FALSE;   ! TRUE => NEW FRAME done
    own byte TEXT MODE = FALSE;   ! TRUE while in text mode
    own integer INBUFF = 32;      ! This is the initialisation code

    ! Configuration parameters -

    const integer MAX ATTRIBUTE = 8
    const integer MAX COLOUR = 16
    const integer MAX LINE = 6
    const integer NUM HP = 7
    const    byte NUM PENS =    8
    const integer   X BASE =    0
    const integer   Y BASE =  500
    const integer  MAX X = 16000
    const integer  MAX Y = 10900 { Having lost 500 for JCL
    own string (15) array COLOUR NAME (1:MAX COLOUR) =
       "black", "blue", "green", "red", "purple", "orange", "lime green", "brown",
       "turquoise", "gold", "pen 11", "pen 12", "pen 13", "pen 14", "pen 15", "pen 16"
    own byte array          SLOT USED (0:MAX COLOUR) = 0, 1, 3, 4, 2, 5, 6, 8, 7, 1(*)
    const byte array  LINE STYLE MAP  (0:MAX LINE)   = '0', '1', '5', '2', '3', '4', '6'
    const real array  LINE STYLE LEN  (0:MAX LINE)   = 0.0, 0.4, 2.5, 1.0, 1.5, 2.0, 2.0

    routine ADD (integer ONE, TWO)
       TTPUT (';')
       TTPUT (ONE)
       TTPUT (TWO)
    end

    routine ADD STR (string (255) STR)
       integer I
       TTPUT (CHARNO(STR,I)) for I = 1, 1, LENGTH(STR)
    end

    routine HP OUT NUM (integer I)
       ADD STR (ITOS (I, 0))
    end

    routine HP LINE (integer X, Y);       ! Go the the current X Y point
       own byte PATH COUNT = 0
       if LAST COM = DEV LINE then TTPUT (',') else start
           ADD ('P', 'D')
           return if SX=X and SY=Y;    ! Just a point
           ADD ('P', 'R')
           PATH COUNT = 0
       finish
       PATH COUNT = (PATH COUNT + 1) & 7
       TTPUT (NL) if PATH COUNT = 0
       HP OUT NUM (X - SX)
       TTPUT (',')
       HP OUT NUM (Y - SY)
       LAST COM = DEV LINE
    end

    ! Protocol Handling routines

    routine HP INSTRUCTION (integer WHICH)
       TTPUT (ESC);   TTPUT ('.');   TTPUT (WHICH)
    end

    routine END TEXT MODE
       TTPUT (ETX)
       TEXT MODE = FALSE
    end

    routine RESERVE (integer N)
       ! Test to see if N chars. will fit in the buffer
       TTPUT (NL)
    end

    routine POF
       RESERVE (BUFF SIZE); ! force out anything which is present.
       TTPUT (';')
       HP INSTRUCTION (')')
       TTPUT (13)
       FLUSH OUTPUT
       PLOT ACTIVE = FALSE
    end

    routine CHECK PLOTTING AND NO TEXT
       END TEXT MODE if TEXT MODE = TRUE
    end

    routine SET GRAPHICS LIMITS (integer LX, LY, HX, HY)
       CHECK PLOTTING and NO TEXT
       ADD ('I', 'P')
       HP OUT NUM (LX);   TTPUT (',');   HP OUT NUM (LY);   TTPUT (',')
       HP OUT NUM (HX);   TTPUT (',');   HP OUT NUM (HY)
       ADD ('S', 'C')
       TTPUT ('0');   TTPUT (',');   HP OUT NUM (HX-LX);   TTPUT (',')
       TTPUT ('0');   TTPUT (',');   HP OUT NUM (HY-LY)
       ADD ('I', 'W')
       HP OUT NUM (LX);   TTPUT (',');   HP OUT NUM (LY);   TTPUT (',')
       HP OUT NUM (HX);   TTPUT (',');   HP OUT NUM (HY)
    end

    routine FULL GRAPHICS LIMITS
       SET GRAPHICS LIMITS (XBASE, YBASE, MAX X+XBASE, MAX Y+YBASE)
    end

    routine CHECK FOR PENDING COLOURS AND MOVES
       integer I

       routine COLOUR (integer I)
          I = I - NUM PENS while I > NUM PENS
          ADD ('S', 'P');   TTPUT (I + '0')
       end

       if PC=TRUE or PM=TRUE start
           TTPUT (NL)
           ADD ('P', 'U')
           COLOUR (SLOT USED (CUR COL)) if PC=TRUE
           ADD ('P', 'A');   HP OUT NUM (SX)
           TTPUT (',');   HP OUT NUM (SY)
       finish
       PC = FALSE
       PM = FALSE
    end

    routine UPDATE
       if PLOT ACTIVE=TRUE start
           RESERVE (10)
           PC = TRUE
           PM = TRUE
           CHECK FOR PENDING COLOURS AND MOVES
           POF
       finish
    end

    routine NEW FRAME
       integer OLD COL, SYM

       on 9 start
           CUR COL = OLD COL;   SX = XL;   SY = YB;   PM = TRUE;   PC = TRUE
           signal 9
       finish

       SX = XR;   SY = YT;   PM = TRUE; ! Goto the edge.
       OLD COL = CUR COL;               ! remember current colour.
       PC = TRUE;  CUR COL = 0;         ! Drop pen
       NEW FRAMED = TRUE
       ! Restore default state after newframe.
       CUR COL = OLD COL;   SX = XL;   SY = YB;   PM = TRUE;   PC = TRUE
    end

    external routine HPPLOT alias "EDWIN___O" (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

       routine NEW HP ATTRIBUTE (integer X, Y)
          const string (5) array ANGLE (0: 7) =  "1,0",  "1,1",   "0,1", "-1,1", "-1,0", "-1,-1", "0,-1", "1,-1"
          switch AS (0:MAX ATTRIBUTE)

          -> AS (X)

       AS(0): ! Colour
              Y = 1 unless 0<=Y<=MAX COLOUR
              CUR COL = Y
              PC = TRUE
              return

       AS(1): ! Line style
              ADD ('L', 'T')
              if 0<Y<=MAX LINE start
                  TTPUT (LINE STYLE MAP (Y))
                  TTPUT (',')
                  ADD STR (RtoS(LINE STYLE LEN (Y), 0, 3))
              finish
              return

       AS(2): ! Char size
              ADD ('S', 'I');   ADD STR (Rtos(Y/600,0,3).",".RtoS (Y/450,0,3))
              return

       AS(3): ! Char rot
              ADD ('D', 'I');   ADD STR (ANGLE(((Y+22)//45)&7))
              return

       AS(4): ! Char Quality   (<2 => low quality, 5' tolerance, >2 => highest quality.
              return

       AS(5): ! Char Font
              Y = 0 unless 0 <= Y <= 5
              ADD ('C', 'A')
              TTPUT ('1') if LOW QUAL # TRUE
              TTPUT (Y + '0')
              ADD ('C', 'S')
              TTPUT ('1') if LOW QUAL # TRUE
              TTPUT (Y + '0')
              return

       AS(6): ! Char slant
              ADD ('S', 'L')
              TTPUT ('-') if Y<0
              ADD STR (RtoS(TAN(|Y| / DtoR), 0, 3)) if Y#0
              return

       AS(7): ! Intensity
              return

       AS(8): ! Speed
              Y = 36 unless 1<=Y<=36
              ADD ('V', 'S');   HP OUT NUM (Y)
       end

       END TEXT MODE if LAST COM = DEV CHAR and COM#DEV CHAR
       LAST COM = COM if COM # DEV LINE
    !   select output (0); write (com,1); write (x,1); write (y,1); newline
       -> SW (COM)

    SW(0): ! Initialise
           DEV DATA_NAME = "a network HP plotter"
           DEV DATA_DVX = 40*400
           DEV DATA_DVY = 28*400
           DEV DATA_MVX = 40*400
           DEV DATA_MVY = 28*400
           DEV DATA_UNITS PER CM = 400
           DEV DATA_MAX COLOUR = 8
           DEV DATA_NUM CHAR SIZES = 255
           if VIEWING=0 start
               VIEWING = NON TERMINAL DEFAULT
               Open Output (viewing, "DRAWING.HP")
           finish
           ADD STR ("HP7220T-".UINFS(1)."00".UINFS(1)."  2
    ")
           ADD ('P', 'U');    ADD ('I', 'N')
           SET GRAPHICS LIMITS (0, 0, 40*400, 28*400)
           ADD STR ("
    ;PU;SP1;PU;PA0,600;PD;PR0,-100,100,0;SI0.2,0.3;PU;PA0,300;")
           ! Black pen, Move abs (0, 0), char size 0.2 cm, and draw start mark.
           ADD STR ("
    LB ".DATE." ".TIME." ".UINFS(1)." (".UINFS(10).")   ".UINFS(2))
           TTPUT (ETX)
           INBUFF = 32
           SX = XL;   SY = YB;   PM = TRUE
           NEW FRAMED = FALSE
           return

    SW(1): ! Terminate
           FULL GRAPHICS LIMITS
           ADD STR (";PU;PA16000,0;")
           TTPUT (NL)
           FLUSH OUTPUT
           CLOSE OUTPUT
           return

    SW(2): ! Update
           UPDATE
           return

    SW(3): ! Newframe
           NEWFRAME
           return

    SW(4): ! Move Abs
           NEW FRAME if NEW FRAMED # TRUE
           SX = X - XL;   SY = Y - YB;   PM = TRUE
           return

    SW(5): ! Line Abs
           NEW FRAME if NEW FRAMED # TRUE
           CHECK FOR PENDING COLOURS AND MOVES
           X = X - XL;   Y = Y - YB
           HP LINE (X, Y)
           SX = X;   SY = Y
           return

    SW(6): ! Character
           NEW FRAME if NEWFRAMED # TRUE
           if TEXT MODE # TRUE start
               CHECK FOR PENDING COLOURS AND MOVES
               ADD ('L', 'B')
               TEXT MODE = TRUE
           finish
           TTPUT (X)
           return

    SW(7): ! New attribute
           return if X > MAX ATTRIBUTE
           NEW HP ATTRIBUTE (X, Y)
           return

    SW(8): ! Lower window bounds
           X = 0 if X<0
           XL = X
           Y = 0 if Y<0
           YB = Y
           return

    SW(9): ! Upper window bounds
           X = MAXX if X > MAXX
           XR = X
           Y = MAXY if Y > MAXY
           YT = Y
           TTPUT (NL)
           SET GRAPHICS LIMITS (XL+XBASE, YB+YBASE, X+XBASE, Y+YBASE)
           TTPUT (NL)
           return

    SW(10): SW(11): return { ignore mode settings }

    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.
            ! DO IT<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
            return

    SW(14): { Hardware circles }
            { X is the Radius, and Y is used as a temp }
            RESERVE (20)
            CHECK FOR PENDING COLOURS AND MOVES
            ADD ('C', 'I');   HP OUT NUM (X)
            return

    SW(15): return
    end

    external routine HP C ARC alias "EDWIN_NHP_C_ARC" (integer RAD, integer IA, FA)
       integer OX, OY
       RESERVE (20)
       OX = SX;   OY = SY
       SX = SX + INT (RAD * COS (IA / DtoR));  SY = SY + INT (RAD * SIN (IA / DtoR));   PM = TRUE
       NEWFRAME if NEWFRAMED # TRUE
       CHECK PLOTTING AND NO TEXT
       CHECK FOR PENDING COLOURS AND MOVES
       ADD ('P', 'D')
       ADD ('A', 'R')
       HP OUT NUM (OX-SX);   TTPUT (',');   HP OUT NUM (OY-SY);   TTPUT (',')
       FA = FA - 360 if FA > IA
       HP OUT NUM (FA-IA)
       ADD ('P', 'U')
       SX = OX;   SY = OY;   PM = TRUE
    end

    external routine HP AC ARC alias "EDWIN_NHP_AC_ARC" (integer RAD, integer IA, FA)
       integer OX, OY
       RESERVE (20)
       OX = SX;   OY = SY
       SX = SX + INT (RAD * COS (IA / DtoR));  SY = SY + INT ( RAD * SIN (IA / DtoR));   PM = TRUE
       NEWFRAME if NEWFRAMED # TRUE
       CHECK PLOTTING AND NO TEXT
       CHECK FOR PENDING COLOURS AND MOVES
       ADD ('P', 'D')
       ADD ('A', 'R')
       HP OUT NUM (OX-SX);   TTPUT (',');   HP OUT NUM (OY-SY);   TTPUT (',')
       FA = FA + 360 if FA<IA
       HP OUT NUM (FA-IA)
       ADD ('P', 'U')
       SX = OX;   SY = OY;   PM = TRUE
    end

    end of file