1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
|
*DECK PSTEXT
SUBROUTINE PSTEXT(ISPSP,NBCAR,TEXT,XYPOS,HEIGHT,JUST,ANGL)
C
C--------------------------- PSTEXT ---------------------------------
C
C 1- PROGRAMME STATISTICS:
C NAME : PSTEXT
C USE : PRINT POSTSCRIPT TEXT
C ADAPTED FROM PSPLOT ROUTINE KELSYMC
C
C 2- ROUTINE PARAMETERS:
C INPUT/OUTPUT
C ISPSP : PSP FILE UNIT I
C NBCAR : NUMBER OF CHARACTER TO PRINT I
C TEXT : TEXT TO PRINT C*(*)
C YXPOS : POSITION OF TEXT R(2)
C HEIGHT : TEXT HEIGHT R
C JUST : JUSTIFICATION I
C = 0 CENTER
C = 1 LEFT
C = 2 RIGHT
C ANGL : TEXT ROTATION ANGLE R
C LOCAL
C IBSL : ASCII REPRESENTATION OF BACKSLASH I
C
C--------------------------- PSTEXT --------------------------------
C
IMPLICIT NONE
INTEGER ISPSP,NBCAR,JUST
CHARACTER TEXT*(*)
REAL XYPOS(2),HEIGHT,ANGL
C----
C LOCAL VARIABLES
C----
INTEGER IBSL,MXCHAR
CHARACTER NAMSBR*6
REAL CONVER,SZRAT,PI
PARAMETER (IBSL=92,MXCHAR=80,NAMSBR='PSTEXT',
> CONVER=72.0,SZRAT=0.6,PI=3.1415926535897932)
INTEGER IHT,ICHAR,NRCHAR,LJUST
CHARACTER CBSL*1,CMDSTR*132,LINE*(MXCHAR),
> CADD*16,CBDD*16
REAL STRLEN,ANGD,XYROT(2)
C----
C STROKE PREVIOUS PATHS BEFORE THIS WRITE
C----
CBSL=CHAR(IBSL)
CMDSTR='S'
CALL PSCPUT(ISPSP,CMDSTR)
C----
C SET CURRENT CHARACTER SIZE
C----
IHT=INT(HEIGHT*CONVER/SZRAT)
IF(IHT .NE. 12) THEN
CMDSTR=' '
WRITE(CMDSTR,'(I3,1X,A4)') IHT,'Setf'
CALL PSCPUT(ISPSP,CMDSTR)
ENDIF
C----
C CHECK IF TEXT CONTAINS ( OR ) OR "Backslash".
C THESE CHARACTERS ARE TREATED BY PRECEDING THEM WITH A "Backslash".
c DO THIS TO ( AND ) EVEN THOU
C THEY MIGHT BE BALANCED, I.E. () WITHIN A STRING, WHICH CAN BE TREATED
C NORMALLY.
C----
NRCHAR=1
LINE='('
DO 100 ICHAR=1,NBCAR
IF(TEXT(ICHAR:ICHAR).EQ.'(' .OR.
> TEXT(ICHAR:ICHAR).EQ.')' .OR.
> TEXT(ICHAR:ICHAR).EQ.CBSL ) THEN
IF(NRCHAR .EQ. MXCHAR-6) THEN
GO TO 105
ENDIF
NRCHAR=NRCHAR+1
LINE(NRCHAR:NRCHAR)=CBSL
ENDIF
IF(NRCHAR .EQ. MXCHAR-6) THEN
GO TO 105
ENDIF
NRCHAR=NRCHAR+1
LINE(NRCHAR:NRCHAR)=TEXT(ICHAR:ICHAR)
100 CONTINUE
105 CONTINUE
NRCHAR=NRCHAR+1
LINE(NRCHAR:NRCHAR+5)=') Lend'
C----
C CHARACTER SPACE HEIGHT IS 2.0 X CHAR HEIGHT
C CHARACTER SPACE WIDTH IS 1.5 X CHAR WIDTH
C ACTUAL TEXT LENGTH IS NRCHAR-2
C ACTUAL STRING LENGTH IS (NRCHAR-3)*1.5*CHAR WIDTH + CHAR WIDTH
C OR CHAR WIDHT*(1.5*NRCHAR-4.5+1)=CHAR WIDHT*(1.5*NRCHAR-3.5)
C----
STRLEN=(HEIGHT*SZRAT)*(1.5*NRCHAR-3.5)
ANGD=ANGL*PI/180.0
CMDSTR=' '
WRITE(CMDSTR,'(F8.2,1X,A5)') XYPOS(1)*CONVER,'Xposd'
CALL PSCPUT(ISPSP,CMDSTR)
CMDSTR=' '
WRITE(CMDSTR,'(F8.2,1X,A5)') XYPOS(2)*CONVER,'Yposd'
CALL PSCPUT(ISPSP,CMDSTR)
C----
C CHECH FOR VALID JUSTIFICATION.
C IF NOT VALID SET TO CENTERED
C----
LJUST=JUST
IF(LJUST .LT. 0 .AND. LJUST .GT. 2) THEN
LJUST=0
ENDIF
XYROT(1)=COS(ANGD)*LJUST/2.
XYROT(2)=SIN(ANGD)*LJUST/2.
CADD=' '
CBDD=' '
IF(XYROT(1) .NE. 0.0 ) THEN
WRITE(CADD,'(1X,F7.3,1X,A6)') XYROT(1),'Xposjd'
ENDIF
IF(XYROT(2) .NE. 0.0 ) THEN
WRITE(CBDD,'(1X,F7.3,1X,A6)') XYROT(2),'Yposjd'
ENDIF
CMDSTR=LINE(1:NRCHAR+5)//CADD//CBDD
CALL PSCPUT(ISPSP,CMDSTR)
LINE(NRCHAR:NRCHAR+5)=') show'
CADD=' '
CBDD=' '
IF(ANGL.NE.0.) THEN
WRITE(CADD,'(1X,F7.1,1X,A7)') ANGL,'rotate '
WRITE(CBDD,'(1X,F7.1,1X,A7)') -ANGL,'rotate '
ENDIF
CMDSTR='xydef mover'//CADD//LINE(1:NRCHAR+5)//CBDD
CALL PSCPUT(ISPSP,CMDSTR)
CMDSTR=' '
WRITE(CMDSTR,'(F6.1,1X,A7)') ANGL,'Xyprset'
CALL PSCPUT(ISPSP,CMDSTR)
RETURN
END
|
