*-----------------------------------------------------------------------
*     BASIC TEXT PRIMITIVE ON VC
*-----------------------------------------------------------------------
*     Copyright (C) 2000-2016 GFD Dennou Club. All rights reserved.
*-----------------------------------------------------------------------
      SUBROUTINE SZTXWV(VX,VY,CHARS)

      CHARACTER CHARS*(*)

      PARAMETER (NCHAR=2048,LEN=6000)
      PARAMETER (WUNIT=24,ZUNIT=24)

      INTEGER   IPOSX(NCHAR)
      REAL      WX1(NCHAR),WX2(NCHAR)
      CHARACTER CKX(LEN)*1,CKY(LEN)*1

      COMMON    /SZBTX1/ QSIZE,CT,ST,ICENTZ
      COMMON    /SZBTX2/ LCNTL,JSUP,JSUB,JRST,SMALL,SHIFT
      LOGICAL   LCNTL, LSYSFNT, LFPROP, LMRKFNT, LMARK
      REAL      IROTA, XRATE, YRATE
      INTEGER   INDEX, IFONT
      CHARACTER FONTNAME*70
      INTEGER   ISUPZ,ISUBZ,IRSTZ
      INTEGER   ISUP,ISUB,IRST
      CHARACTER CSGI*1,CSUP*1,CSUB*1,CRST*1
      INTEGER   IMODE, IDEST, IOCMDE
      CHARACTER CHARZ*(NCHAR),CHARX*(NCHAR)
      LOGICAL   LCNTLZ

      EXTERNAL  LENC,ISGC

      SAVE

      DATA      NCNTZ/0/

      LCNTLZ=LCNTL
      CALL SGIGET('ISUP',ISUP)
      CALL SGIGET('ISUB',ISUB)
      CALL SGIGET('IRST',IRST)
      ISUPZ=29
      ISUBZ=30
      IRSTZ=31
      CSUP=CSGI(ISUPZ)
      CSUB=CSGI(ISUBZ)
      CRST=CSGI(IRSTZ)


*      / START: CODE FOR USING SYSTEN FONTS /
*      / PROCCESS IF NOT MARKER /
      CALL SWLGET("LSYSFNT", LSYSFNT)
      IF(LSYSFNT) THEN
      CALL SZQIDX(INDEX)
      CALL SWCGET("FONTNAME",FONTNAME)
*     / WHEN FONTNAME IS NOT GIVEN /
      IF (LENZ(FONTNAME) == 0) THEN
        CALL SGLGET('LFPROP', LFPROP)
        IF (LFPROP) THEN
          CALL SGIGET('IFONT', IFONT)
          IF (IFONT.EQ.1)THEN
            FONTNAME = 'Sans'
          ELSE IF(IFONT.EQ.2)THEN
            FONTNAME = 'Serif'
          ENDIF
        ELSE
          FONTNAME = 'Monospace'
        END IF
        CALL SWFTFC(FONTNAME)
        CALL SWSFW(MAX(MOD(INDEX,10),1))
      ELSE
        CALL SWFTFC(FONTNAME)
      END IF

      IDX=ISGC(CHARS(1:1))
      CALL SGLGET('LMRKFNT',LMRKFNT)

      IF (IDX.GT.18 .OR. LMRKFNT) THEN
        NCZ = LENC(CHARS)
        CALL STFWTR(VX,VY,WX,WY)
        CALL STQWTR(RXMIN,RXMAX,RYMIN,RYMAX,
     +              WXMIN,WXMAX,WYMIN,WYMAX,IWTRF)
        XRATE = (WXMAX-WXMIN)/(RXMAX - RXMIN)
        YRATE = (WYMAX-WYMIN)/(RYMAX - RYMIN)

        IF (INDEX .GT. 9) THEN
          CALL SWSCLI(INDEX/10,.TRUE.)
        END IF
        IF (IDX.LT.18) THEN
          CALL SWSFW(MAX(MOD(INDEX,10),1))
        END IF

        IROTA = ASIN(ST/QSIZE)
        CALL SWTXT(WX,WY,QSIZE*XRATE,CHARS,NCZ,IROTA,ICENTZ)
        GO TO 30
      END IF

      END IF
*      / END: CODE FOR USING SYSTEN FONTS /



*     / GET FONT INFORMATION /


      CALL SZFINT(NCNT)
      IF (NCNTZ.NE.NCNT) THEN
        CALL SZQFNT(IPOSX,CKX,CKY)
        CALL SZQFNW(WX1,WX2)
        NCNTZ=NCNT
      END IF
*     /REMOVE DCL EXT CHARACTER MARKER */
      NCZ=LENC(CHARS)
      J=0
      DO 999 I=1,NCZ
        IDX0=ISGC(CHARS(I:I))
        IF(IDX0.EQ.92)THEN
           IMODE=1
        END IF
        IF(IMODE.EQ.0 .OR. IMODE.EQ.4)THEN
          J=J+1
          CHARX(J:J)=CHARS(I:I)
          IMODE=0
        END IF
        IF(IMODE.EQ.3)THEN
          IF(IDX0.EQ.120)THEN
            IMODE=2
          ELSE
            J=J+1
            CHARX(J:J)=CSGI(92)
            J=J+1
            CHARX(J:J)=CHARS(I:I)
            IMODE=0
          END IF
        END IF
        IF(IMODE.EQ.1 .OR. IMODE.EQ.2)THEN
          IMODE=IMODE+2
        END IF
  999 CONTINUE

      DO 998 I=J+1,2048
        CHARX(I:I)=CHAR(0)
  998 CONTINUE

      CALL SZTXNO(CHARS,CHARZ,LCNTLZ)
      CALL SZQTXW(CHARS,NC,WXCH,WYCH)

*     / CALCULATE OFFSET VALUES /

      OFFX=-0.5*WXCH*WUNIT*(ICENTZ+1)
      OFFY=0.0
      XC=VX+OFFX*CT-OFFY*ST
      YC=VY+OFFX*ST+OFFY*CT

*     / INITIALIZATION /

      MODE0=0
      MODE=0
      FACTZ=1.0
      VX1=0

*     / PROCESS EACH CHARACTER /
      DO 20 K=1,NCZ

*       / CHARACTER CONVERSION /
        IDX=ISGC(CHARZ(K:K))+1

*       / CHECK CONTROL CHARACTERS /
        IPS=IPOSX(IDX)+1
        IF (LCNTLZ .AND.
     +    (IDX.EQ.ISUBZ+1 .OR. IDX.EQ.ISUPZ+1 .OR. IDX.EQ.IRSTZ+1)) THEN
          IF (IDX.EQ.ISUBZ+1) THEN
            MODE=-1
            FACTZ=SMALL
          ELSE IF (IDX.EQ.ISUPZ+1) THEN
            MODE=+1
            FACTZ=SMALL
          ELSE IF (IDX.EQ.IRSTZ+1) THEN
            MODE=0
            FACTZ=1.0
          END IF
          GO TO 20
        END IF

        VX2=-WX1(IDX)
        IF (MODE0.EQ.MODE) THEN
          IF (MODE.EQ.0) THEN
            FNX=VX1+VX2
          ELSE
            FNX=(VX1+VX2)*SMALL
          END IF
          FNY=0
        ELSE
          IF (MODE0*MODE.EQ.0) THEN
            IF (MODE.EQ.0) THEN
              FNX=VX1*SMALL+VX2
            ELSE
              FNX=VX2+VX1*SMALL
            END IF
          ELSE
*           'IS THIS BLOCK REALLY NECESSARY?'
            FNX=(VX1+VX2)*SMALL
          END IF
          FNY=ZUNIT*SHIFT*(MODE-MODE0)
        END IF
        MODE0=MODE

        XC=XC+FNX*CT-FNY*ST
        YC=YC+FNX*ST+FNY*CT

        VX1=WX2(IDX)

        CALL SZOPSV

        IP=0

   10   CONTINUE

          NX=ICHAR(CKX(IPS))-64
          FNX=+NX*FACTZ
          NY=ICHAR(CKY(IPS))-64
          FNY=-NY*FACTZ

          IF (NX.NE.-64) THEN
            XP=XC+FNX*CT-FNY*ST
            YP=YC+FNX*ST+FNY*CT
            IF (IP.EQ.0) THEN
              CALL SZMVSV(XP,YP)
            ELSE IF (IP.EQ.1) THEN
              CALL SZPLSV(XP,YP)
            END IF
            IP=1
          ELSE
            IP=0
          END IF

          IPS=IPS+1

        IF (.NOT.(NX.EQ.-64 .AND. NY.EQ.-64)) GO TO 10

        CALL SZCLSV

   20 CONTINUE

      CALL SWOCLS('SZTXZ')

   30 CONTINUE

      END
