Conference bgsdev::gksnotes

2724.0. "GKS 6.4 Character height and precision do not propagate correctly in metafile." by COMICS::EDWARDSN (Dulce et decorum est pro PDP program) Thu Feb 13 1997 08:13

I have a couple of programs. One which generates a DECGKSM metafile and the other one
which reads the metafile and displays the output.
Somewhere in the translations, the text style and such is getting changed and 
the result is that what is viewed when playing back the metafile is not the same
as the direct output.
The direct output is produced by changing the PARAMETER CATMO from 2 to 231.

Could someone have a look at these and tell me if there is something that I've 
missed.

I guess I'll probably have to escalate this formally, but in the meantime, here's 
the code.

This is on OpenVMS VAX 6.2 with GKS 6.4 compiled with  Fortran 6.4-165

any answers please,

Neil.

$ CREATE CLIPTEXT.FOR 
      PROGRAM GKSMTEST
      INTEGER WKID,DEFCID,CATMO
      PARAMETER (WKID=1,DEFCID=0,CATMO=2)
C To obtain visual output change to CATMO=231
      INTEGER ASF(13)
      DATA ASF /1,1,1,1,1,1,1,1,1,1,1,0,1/
      CALL GOPKS (6)
      CALL GOPWK (WKID,DEFCID,CATMO)
      CALL GACWK (WKID)
      CALL GSASF (ASF)
C Text.  N.B. Without the call TEXT, the problem does not appear.
      CALL TEXT
      CALL CLIP
      CALL GDAWK (WKID)
      CALL GCLWK (WKID)
      CALL GCLKS ()
      END
C
      SUBROUTINE TEXT
      REAL CHH
      PARAMETER (CHH=0.012)
      INCLUDE 'SYS$LIBRARY:GKS.F'
      CALL GSCHH (CHH)
      CALL GSTXFP (1,GCHARP)
      CALL TXUPVS
      RETURN
      END

      SUBROUTINE TXUPVS
      REAL Y
      PARAMETER (Y=0.45)
      CALL GSELNT (0)
      CALL TXUP (0.4,Y)
      RETURN
      END
C
      SUBROUTINE TXUP (X,Y)
      REAL X,Y
      INTEGER NANGLS
      PARAMETER (NANGLS=6)
      INTEGER I
      REAL ANGLES(NANGLS)
      CHARACTER*8 ANGTXT
      INCLUDE 'SYS$LIBRARY:GKS.F'
      DATA ANGLES /45.0,90.0,150.0,180.0,270.0,0.0/
      DATA ANGTXT /'     DEG'/

      CALL GSTXAL (GALEFT,GAHALF)
      DO 10 I=nangls,NANGLS
            CALL GSCHUP (COSD(ANGLES(I)+90.),SIND(ANGLES(I)+90.))
            WRITE (ANGTXT(1:4),9000) NINT(ANGLES(I))
            CALL GTX (X,Y,ANGTXT)
   10 CONTINUE
      RETURN
 9000 FORMAT (I4)
      END
C
      SUBROUTINE CLIP
      INTEGER NPLPTS
      PARAMETER (NPLPTS=2)
      REAL XWIN(5),YWIN(5),XC(NPLPTS),YC(NPLPTS),YU(NPLPTS)
      INCLUDE 'SYS$LIBRARY:GKS.F'
      DATA XWIN /0.1,0.3,0.3,0.1,0.1/
      DATA YWIN /0.5,0.5,0.7,0.7,0.5/
      DATA XC /0.0,0.4/
      DATA YC /0.59,0.59/
      DATA YU /0.61,0.61/
      CALL GSLN (GLDOT)
      CALL GSLWSC (2.0)
      CALL GPL (5,XWIN,YWIN)
      CALL GSWN (4,XWIN(1),XWIN(3),YWIN(1),YWIN(3))
      CALL GSVP (4,XWIN(1),XWIN(3),YWIN(1),YWIN(3))
      CALL GSCLIP (GCLIP)
      CALL GSELNT (4)
      CALL GSCHH (0.02)
      CALL GSTXAL (GAHNOR,GAVNOR)
      CALL GTX (0.167,0.56,'CLIPPED OUTPUT')
C
      CALL GSLN (GLSOLI)
      CALL GPL (NPLPTS,XC,YC)
      CALL GSELNT (0)
      CALL GTX (0.167,0.62,'UNCLIPPED OUTPUT')
      CALL GPL (NPLPTS,XC,YU)
      RETURN
      END

$ FORT CLIPTEXT
$ LINK CLIPTEXT,SYS$LIBRARY:GKSFORBND/LIB
$      DEFINE/USER_MODE GKS$CONID CLIPTEXT.DECGKSM
$      DEFINE/USER_MODE GKS$METAFILE_TYPE GKSM
$      RUN CLIPTEXT
$ WRITE SYS$OUTPUT "DECGKSM file produced"
$ CREATE GKSMVIEW.FOR
      PROGRAM GKSMVIEW
      INTEGER ERRFLG
      INCLUDE 'GKSMVIEW.INC/LIST'
      ERRFLG = 0
      OPEN (ERRORF,STATUS='NEW')
      CALL GOPKS (ERRORF)
      CALL SETUPW (ERRFLG)
      IF ( ERRFLG .EQ. 0 ) THEN
            CALL META (ERRFLG)
            CALL GDAWK (OUTWID)
            CALL GCLWK (OUTWID)
      END IF
      CALL GCLKS ()
      IF ( ERRFLG .EQ. 0 ) STOP 'OK'
      IF ( ERRFLG .GT. 0 ) STOP 'ER'
      STOP 'ZZ'
      END

      SUBROUTINE SETUPW (ERRFLG)
      INTEGER ERRFLG
      INTEGER ERRIND
      INCLUDE 'GKSMVIEW.INC'
      INCLUDE 'SYS$LIBRARY:GKS.F'
    5 WRITE (*,9000)
      READ (*,*,ERR=5,END=900) WKTYPE
      CALL GQWKCA (WKTYPE,ERRIND,WKCAT)
      IF ( ERRIND .EQ. 0 ) THEN
            IF ( WKCAT .NE. GOUTPT  .AND.  WKCAT .NE. GOUTIN ) THEN
                  WRITE (*,9010) WKTYPE
                  GO TO 5
            END IF
      ELSE
            WRITE (*,9020) ERRIND
            GO TO 5
      END IF
      CALL GOPWK (OUTWID,0,WKTYPE)
      CALL GACWK (OUTWID)
      RETURN
  900 ERRFLG = 1
      RETURN
 9000 FORMAT (/' Enter workstation type for metafile display: ',$)
 9010 FORMAT ( ' ERROR: workstation type',I10,' cannot display output.')
 9020 FORMAT ( ' ERROR: from GQWKCA, value =',I10)
      END
C
      SUBROUTINE META (ERRFLG)
      INTEGER ERRFLG
      INTEGER MITYPE,METFIL,MAXDR
      PARAMETER (MITYPE=3,METFIL=4,MAXDR=65535)
      INTEGER ITYPE,LENDR
      CHARACTER DR*(MAXDR)
      INCLUDE 'GKSMVIEW.INC'
      OPEN (METFIL,STATUS='OLD',READONLY,ERR=999)
      CALL GOPWK (METWID,METFIL,MITYPE)
   10 CALL GGTITM (METWID,ITYPE,LENDR)
      IF ( LENDR .GT. MAXDR ) THEN
            WRITE (ERRORF,9000) LENDR
            ERRFLG = 1
            LENDR = MAXDR
      END IF
      IF ( ITYPE .NE. 0  .AND.  ITYPE .LT. 100 ) THEN
            CALL GRDITM (METWID,LENDR,MAXDR,DR)
            IF ( ITYPE .EQ. 1 ) THEN
                  CALL NEWFRA ()
            END IF
            CALL GIITM (ITYPE,LENDR,MAXDR,DR)
            GO TO 10
      ELSE IF ( ITYPE .GT. 100 ) THEN
            CALL GRDITM (METWID,LENDR,0,DR)
            GO TO 10
      END IF
      CALL NEWFRA ()
      CALL LIB$WAIT (10)
      CALL GCLWK (METWID)
      CLOSE (METFIL,ERR=999)
      RETURN
  999 WRITE (ERRORF,9010)
      ERRFLG = -1
      RETURN
 9000 FORMAT ('0WARNING - ITEM OF LENGTH',I9,' IS LARGER THAN THE',
     *        ' DATA RECORD BUFFER AVAILABLE - ITEM TRUNCATED')
 9010 FORMAT ('0ERROR OPENING OR CLOSING THE METAFILE')
      END
C
      SUBROUTINE NEWFRA ()
      INTEGER STRDEV,MLDR
      PARAMETER (STRDEV=1,MLDR=9)
      INTEGER ERRIND,MBUFF,OL,PET,BUFLEN,LDR
      INTEGER STAT,LOSTR
      REAL EAREA(4)
      CHARACTER STR*32,DATREC(MLDR)*80
      INCLUDE 'GKSMVIEW.INC'
      INCLUDE 'SYS$LIBRARY:GKS.F'
      IF ( WKCAT .EQ. GOUTIN ) THEN
            CALL GQDST (WKTYPE,STRDEV,1,MLDR,
     *                  ERRIND,MBUFF,OL,PET,EAREA(4),BUFLEN,LDR,DATREC)
            IF ( ERRIND .NE. 0 ) PRINT *,'GQDST: ERRIND was ',ERRIND
            EAREA(2) = 0.20
            EAREA(4) = 0.01
            STR = 'Press RETURN to continue ...'
            CALL GINST (OUTWID,STRDEV,29,STR,
     *                  PET,EAREA(1),EAREA(2),EAREA(3),EAREA(4),
     *                  32,30,LDR,DATREC)
            CALL GRQST (OUTWID,STRDEV,STAT,LOSTR,STR)
      END IF
      END

$ FORT GKSMVIEW
$ LINK GKSMVIEW,SYS$LIBRARY:GKSFORBND/LIB
$ WRITE SYS$OUTPUT "End of Executable production ."
$ WRITE SYS$OUTPUT "Generate GKSMVIEW.COM and execute GKSMVIEW from there"

GKSMVIEW is invoked using a command procedure:

$! GKSMVIEW.COM
$      IF  P1 .NES. ""  .AND.  P1 .NES. "?"  THEN GOTO MET_GIVEN
$      CREATE SYS$OUTPUT

GKSMVIEW.COM - outputs a DEC GKS metafile to a GOUTPT or GOUTIN workstation.

P1  MANDATORY  The name of the GKS metafile.  Default file type is .DECGKSM

$      EXIT %X10000000
$MET_GIVEN:
$!
$!      Check the metafile name, adding the .DECGKSM file type if necessary.
$!
$      METFIL = F$PARSE(P1,".DECGKSM")
$      IF METFIL .NES. ""  THEN GOTO MET_VALID
$      WRITE SYS$OUTPUT "Invalid GKS metafile name specified: ",P1
$      EXIT %X10000002
$MET_VALID:
$!
$!      Check that the metafile exists.
$!
$      IF F$SEARCH(METFIL) .NES. ""  THEN GOTO MET_FOUND
$      WRITE SYS$OUTPUT "GKS metafile not found: ",METFIL
$      EXIT %X10000002
$MET_FOUND:
$      ERRFIL := 'F$PARSE(METFIL,,,"NAME")'.ERR
$!
$!      Set up an output file name just in case.
$!
$      OUTFIL := 'F$PARSE(METFIL,,,"NAME")'.OUT
$!
$      DEFINE/USER_MODE GKS$CONID 'OUTFIL'
$      DEFINE/USER_MODE SYS$INPUT SYS$COMMAND
$      DEFINE/USER_MODE FOR004 'METFIL'
$      DEFINE/USER_MODE FOR007 'ERRFIL'
$      RUN GKSMVIEW
$!
$!      Display the error file produced.
$!
$      IF F$SEARCH(ERRFIL) .NES. ""
$      THEN
$            TYPE 'ERRFIL'
$            IF F$FILE_ATTRIBUTES(ERRFIL,"EOF") .EQ. 0
$            THEN DELETE 'ERRFIL';
$            ELSE DELETE/CONFIRM 'ERRFIL';
$            ENDIF
$      ENDIF
$!
$! Inform of any output file produced.
$!
$      IF F$SEARCH(OUTFIL) .NES. "" THEN DIRECTORY/DATE/SIZE 'OUTFIL'
$!
$      EXIT