MODULE DDHP7475;
(*
    The driver tells HPINIT that the FORTRAN code for the plotter is
"6". If the plotter is connected straight to the computer and does not
sit in between a terminal and the computer, YOU assign file code "6" to
the device which has the plotter connected. Suppose the plotter is on
port TTG2:, the assign will be:

	$ assign ttg2: for006

Make sure that ttg2: has world read/write perms. Ask your sysmanager if
not so.
    This module takes a Gfile and plots the graphics instructions on
a HP 7475 series  plotters. To use this driver
type 

    $ ddhp7475 gfile

Where gfile is the file containing graphics commands.

	1.  INIT baudrate
	2.  ERAS 
	3.  WIND lowerx,lowery,upperx,uppery
	4.  MAPW xmin,ymin,xmax,ymax
	5.  MOVE x,y
	6.  DRAW x,y
	7.  PLIN pcount,x[1],y[1],...,x[pcount],y[pcount]
	8.  LPAT SOLI|DASH|DOTT
	9.  FONT HARD|ROMA|STIC|SCRI|GOTH
	10. CSIZ cht,cwid,slant,hindex,vindex
	11. COLO BLAC|BLUE|GREE|REDD
	12. LORG 3|6|9
	13. TEXT x,y,rotation,charcount
		 20 words for 80 byte string
        14. *EOG
*)
FROM VMSRTL IMPORT Lib$Get_Foreign;
FROM FileSystem IMPORT File;
FROM GfileManager IMPORT OpenGfile, GetW, GetWords, CloseGfile;
FROM HPISP   IMPORT 
             Buff            , Hpinit          , 
             NewPen          , Plot            ,
             ForSymbol       ;
FROM InOut IMPORT WriteString, WriteLn, Read, ReadLn;

TYPE
    Linepatterns = ( solid, dashed, dotted );

    PROCEDURE MakePrompt( s : ARRAY OF CHAR );
        VAR
           i : CARDINAL;
        BEGIN
            FOR i := 0 TO HIGH( s ) DO
               prompt[i+1] := s[i]
            END;
            prompt[ HIGH(s)+2 ] := 0C
        END MakePrompt;

    PROCEDURE cmp( s, t : ARRAY OF CHAR ) : BOOLEAN;
        VAR
            i : CARDINAL;
        BEGIN
            FOR i := 0 TO HIGH( s ) DO
                IF s[i] # t[i] THEN
                    RETURN FALSE
                END
            END;
            RETURN TRUE
        END cmp;

    PROCEDURE Move( x, y : REAL );
        VAR
            pen : INTEGER;
        BEGIN
            pen := 3;
            Plot( x, y, pen );
        END Move;

    PROCEDURE Draw( x, y : REAL );
        VAR
            pen : INTEGER;
        BEGIN
            pen := 2;
            Plot( x, y, pen );
        END Draw;

    PROCEDURE Csize( cht, cwid, slant : REAL );
        (* Currently, inactive *)
        VAR
                ibuf : ARRAY [1..4] OF INTEGER;
                xbuf : ARRAY [1..2] OF REAL;
                mode, inum : INTEGER;
        BEGIN
                ibuf[1] := INTEGER( ORD( 'S' ) );
                ibuf[2] := INTEGER( ORD( 'I' ) );
                mode := 1; inum := 2;
                Buff( mode, ibuf, xbuf, inum );

                xbuf[1] := cht*2.54;
                xbuf[2] := cwid*2.54;
                IF Fresh THEN
                    mode := 7;     (* Buff will convert float xbuf to ascii *)
                    Fresh := FALSE;
                ELSE
                    mode := 6;
                END;
                inum := 2;
                Buff( mode, ibuf, xbuf, inum );
        END Csize;

    PROCEDURE PolyLine( );
        VAR
            pc, ipen : INTEGER;
            x,y: REAL;
            i  : CARDINAL;
        BEGIN
            ok := GetW( gf, pc );
            IF pc <= 0 THEN
                RETURN
            END;
            ok := GetW( gf, x );
            ok := GetW( gf, y );
            
            Move( x, y );
            FOR i := 2 TO CARDINAL( pc ) DO
                ok := GetW( gf, x );
                ok := GetW( gf, y );
                Draw( x,y );
            END;
        END PolyLine;
    
    PROCEDURE SetLinepattern;
        VAR
            ibuf : ARRAY [1..4] OF INTEGER;
            xbuf : ARRAY [1..1] OF REAL;
            mode, inum : INTEGER;
        BEGIN
            ibuf[1] := INTEGER( ORD( 'L' ) );
            ibuf[2] := INTEGER( ORD( 'T' ) );

            IF linetype = solid THEN
                mode := 1; inum := -2;
                Buff( mode, ibuf, xbuf, inum );
            ELSIF linetype = dashed THEN
                mode := 1; inum := 2;
                Buff( mode, ibuf, xbuf, inum );
                ibuf[1] := 2;
                mode := 4; inum := 1;
                Buff( mode, ibuf, xbuf, inum );
            ELSIF linetype = dotted THEN
                mode := 1; inum := 2;
                Buff( mode, ibuf, xbuf, inum );
                ibuf[1] := 0;
                mode := 4; inum := 1;
                Buff( mode, ibuf, xbuf, inum );
            END
        END SetLinepattern;

    PROCEDURE DisplayText;    

        PROCEDURE Bump( VAR x, y : REAL;
                          cht    : REAL;
                          ccnt   : INTEGER );
            (*
            Move the x,y location so as to justify the character string
            according to the current Lorg setting. The x,y values are then
            set to 999.0 so that ForSymbol starts where the bumped x,y
            are.
            *)
            VAR
                cells : REAL;
                ibuf : ARRAY [1..4] OF INTEGER;
                xbuf : ARRAY [1..2] OF REAL;
                mode, inum : INTEGER;
            BEGIN
                Move( x, y );
                x := 999.0; y := 999.0;
                cells := 0.0;
                IF Lorg = Rightjust THEN
                    cells := FLOAT( -ccnt )
                ELSIF Lorg = Centerjust THEN
                    cells := FLOAT( ( -ccnt ) DIV 2 );
                    IF ODD( ccnt ) THEN
                        cells := cells - 0.5
                    END
                END;
                ibuf[1] := INTEGER( ORD( 'C' ) );
                ibuf[2] := INTEGER( ORD( 'P' ) );
                mode := 1; inum := 2;
                Buff( mode, ibuf, xbuf, inum );

                xbuf[1] := cells;
                xbuf[2] := -0.7;
                mode := 6;     (* Buff will convert float xbuf to ascii *)
                inum := 2;
                Buff( mode, ibuf, xbuf, inum );
            END Bump;
                
        VAR
            storelpat : Linepatterns;
            ccnt      : INTEGER;
        BEGIN
            ok := GetW( gf, x );
            ok := GetW( gf, y );
            ok := GetW( gf, rotation );
            ok := GetW( gf, ccnt );       (* character count *)
            ok := GetWords( gf, argv, 20 );
            storelpat := linetype;
            linetype := solid;
            SetLinepattern;
            Bump( x, y, cht, ccnt );
            ForSymbol( x, y, cht, argv, rotation, ccnt );
            linetype := storelpat;
            SetLinepattern;
        END DisplayText;

    PROCEDURE InitPlotter;
        VAR
            Lio, Lmon, Lchars, Lunit, Ldev : INTEGER;
        BEGIN
            Lio := 0;   (* Primary handshake *)
            Lmon := 0;  (* Invoke receive mode *)
            Lchars := 0; (* character set *)
            Lunit  := 0;  (* Inches *)
            Ldev   := 6;  (* Fortran unit assigned *)
            Hpinit( Lio, Lmon, Lchars, Lunit, Ldev );
        END InitPlotter;

VAR
    argv, prompt   : ARRAY [1..80] OF CHAR;
    status, cmdlen : INTEGER;
    gf             : File;
    ok, Fresh      : BOOLEAN;
    gcmd           : ARRAY [1..4] OF CHAR;
    xv             : ARRAY [1..4] OF REAL;
    pc, I          : CARDINAL;
    BaudRate       : INTEGER;
    
    x, y           : REAL;
    cht, cwid      : REAL;
    Lorg           : ( Leftjust, Centerjust, Rightjust );
    rotation       : REAL;
    slant          : REAL;
    linetype       : Linepatterns;
    hcindex        : INTEGER;
    vcindex        : INTEGER;
    int            : INTEGER;
BEGIN    
    MakePrompt( "Gfile  > " );
    status := Lib$Get_Foreign( argv, prompt, cmdlen );
    IF status # 1 THEN
        WriteString(" Error in processing command line args" );
        WriteLn;
        HALT
    END;
    argv[ cmdlen+1 ] := 0C;

    IF NOT OpenGfile( gf, argv, TRUE ) THEN
        WriteString("Error opening " );
        WriteString( argv );
        WriteLn;
        HALT
    END;

    Lorg := Centerjust;   (* default *)
    Fresh := TRUE;  (* First call to Csize resets after forcing buffer flush *)
    ok := GetW( gf, gcmd );
    WHILE ok DO
        IF cmp( gcmd, "DRAW" ) THEN
            ok := GetW( gf, x );
            ok := GetW( gf, y );
            Draw( x, y )
        ELSIF cmp( gcmd, "MOVE" ) THEN
            ok := GetW( gf, x );
            ok := GetW( gf, y );
            Move( x, y )
        ELSIF cmp( gcmd, "PLIN" ) THEN
            PolyLine;
        ELSIF cmp( gcmd, "TEXT" ) THEN
            DisplayText;
        ELSIF cmp( gcmd, "COLO" ) THEN
            ok := GetW( gf, gcmd );
            IF cmp( gcmd, "BLAC" ) THEN
                int:=1; NewPen( int )
            ELSIF cmp( gcmd, "BLUE" ) THEN
                int:=2; NewPen( int )
            ELSIF cmp( gcmd, "GREE" ) THEN
                int:=3; NewPen( int )
            ELSIF cmp( gcmd, "REDD" ) THEN
                int:=4; NewPen( int )
            END
        ELSIF cmp( gcmd, "LPAT" ) THEN
            ok := GetW( gf, gcmd );
            linetype := solid;
            IF cmp( gcmd, "SOLI" ) THEN
                linetype := solid;
            ELSIF cmp( gcmd, "DASH" ) THEN
                linetype := dashed;
            ELSIF cmp( gcmd, "DOTT" ) THEN
                linetype := dotted
            END;
            SetLinepattern;
        ELSIF cmp( gcmd, "CSIZ" ) THEN
            ok := GetW( gf, cht );
            ok := GetW( gf, cwid );
            ok := GetW( gf, slant );
            ok := GetW( gf, hcindex );
            ok := GetW( gf, vcindex );
            (* Csize( cht, cwid, slant ); *)
            (* to activate the Csize, draw a blank string *)
            (* ForSymbol( 999.0, 999.0, cht, " ", 0.0, 1 ); *)
        ELSIF cmp( gcmd, "LORG" ) THEN
            ok := GetW( gf, int );
            Lorg := Centerjust;
            IF int = 3 THEN
                Lorg := Leftjust
            ELSIF int = 9 THEN
                Lorg := Rightjust
            END
        ELSIF cmp( gcmd, "FONT" ) THEN
            ok := GetW( gf, gcmd );
        ELSIF cmp( gcmd, "WIND" ) THEN
            pc := 4;
            ok := GetWords( gf, xv, pc );
        ELSIF cmp( gcmd, "MAPW" ) THEN
            pc := 4;
            ok := GetWords( gf, xv, pc );
        ELSIF cmp( gcmd, "INIT" ) THEN
            ok := GetW( gf, BaudRate ); (* BaudRate specifies pen speed for HP *)
            InitPlotter;
        ELSIF cmp( gcmd, "ERAS" ) THEN
        ELSIF cmp( gcmd, "*EOG" ) THEN
            ok := FALSE
        END;
        IF ok THEN
            ok := GetW( gf, gcmd )  (* get next command *)
        END
    END; (* WHILE *)

    ok := CloseGfile( gf );
    int := 0;
    NewPen( int );   (* put pen away *)
    int := 999;
    Plot(0.0, 0.0, int )

END DDHP7475.