-
Notifications
You must be signed in to change notification settings - Fork 0
/
labeline.f
219 lines (213 loc) · 6.68 KB
/
labeline.f
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
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
C********************************************************************
subroutine labeline(x,y,npts,label,nlabel)
c Draw a polyline with imbedded label of nlabel characters.
c 9 Aug 92.
c If nlabel eq -99, then set the interval between labels to the value of
c x in normalized units, and the ipen (up down) to the value of y.
c If x=0. set it to default, 0.3. If ipen.ne.0 then draw line.
integer npts,nlabel
real x(npts),y(npts)
character*(*) label
character llstr*20
integer i,nlab1
include 'plotcom.h'
c
real nx,ny,cc,cs,theta,nxs,nys
real vlen,dx,dy,cx,cy,plen,flen,dlen
real wx2nx, wy2ny
integer ncmax
parameter (ncmax=100)
real clen(ncmax)
integer lclen(ncmax)
real linlen,curdist
c clen is the arc length in normalized units of the the ith line
c segment. curdist is the starting fractional part of the ith arc.
real wstr
integer j,lstr,iline
c dashlen is the arc length in normalized units of the the ith line
c segment. dashdist is the starting fractional part of the ith arc.
c Segments alternate pen down, pen up.
logical ldash
real dashlen,dashdist
integer MASKNO,dashmask,jmask
parameter (MASKNO=4)
dimension dashmask(MASKNO),dashlen(MASKNO)
common/dashline/ldash,dashlen,dashdist,dashmask,jmask
integer cud
data curdist/0./
data linlen/0.3/iline/1/
save linlen,iline
c write(*,*)npts,label,nlabel
c Speed version with no label.
if(nlabel.eq.0)then
call polyline(x,y,npts)
return
elseif(nlabel.eq.-99)then
if(x(1).eq.0.) then
linlen=0.3
iline=1
else
linlen=x(1)
if(y(1).eq.0)then
iline=0
else
iline=1
endif
return
endif
endif
c Standard version. NLabel non-zero.
c store current character direction.
cc=chrscos
cs=chrssin
lstr=1
nlab1=min(nlabel,ncmax-1)+1
call vecn(wx2nx(x(1)),wy2ny(y(1)),0)
i=1 ! do loop whose index can be internally incremented.
12 if(i.gt.nlab1-1)goto 11
llstr=label(i:i)//char(0)
clen(i)=wstr(llstr)
lclen(i)=1
i=i+1
goto 12
11 continue
clen(nlab1)=linlen
c Start with line.
j=nlab1
c Draw line
do 3 i=2,npts
c We shall bypass vecw and go straight to normal.
nx=wx2nx(x(i))
ny=wy2ny(y(i))
nxs=nx
nys=ny
c Lengths of total vector:
cx= crsrx
cy= crsry
dx=nx-cx
dy=ny-cy
vlen=sqrt(dx*dx+dy*dy)
c Partial length remaining to end of vector:
plen=vlen
c if(vlen.eq.0)return
c Distance to end of segment(or character)
1 dlen=(clen(j)-curdist)
if(plen.gt.dlen)then
c Vector longer than this label segment. Write segment and iterate.
curdist=0.
plen=plen-dlen
theta=atan2(dy,dx)
chrscos=cos(theta)
chrssin=sin(theta)
if(j.ne.nlab1)then
c Character writing:
if(clen(j).gt.0)then
llstr(lstr:lstr)=label(j:j)
llstr(lstr+1:lstr+1)=char(0)
! write(*,*)label,llstr(1:lstr),lstr,j,nlab1
call drcstr(llstr)
lstr=1
else
c Non toggle, just store.
llstr(lstr:lstr)=label(j:j)
lstr=lstr+1
endif
else
if(ldash)then
c Dashline distance to end of segment
c write(*,*)jmask,dashlen(jmask),dashdist,plen
2 dlen=(dashlen(jmask)-dashdist)
if(plen.gt.dlen)then
c Vector longer than this dash segment. Draw segment and iterate.
plen=plen-dlen
flen=dlen/vlen
nx= crsrx+dx*flen
ny= crsry+dy*flen
cud=dashmask(jmask)
call vecn(nx,ny,cud)
dashdist=0
jmask=mod(jmask,MASKNO)+1
goto 2
else
c Vector ends before dash segment. Draw to end of vector and quit.
dashdist=plen+dashdist
c write(*,*)'dashdist',dashdist,plen,dlen
nx=crsrx+dx*plen/vlen
ny=crsry+dy*plen/vlen
cud=dashmask(jmask)
call vecn(nx,ny,cud)
endif
else
c Replaces this undashed line:
flen=dlen/vlen
nx= crsrx+dx*flen
ny= crsry+dy*flen
call vecn(nx,ny,iline)
endif
endif
j=j+1
if(j.gt.nlab1)j=1
goto 1
elseif(j.eq.nlab1)then
c Vector ends before segment. If this is the line segment draw to end
c of vector and quit. Else do nothing.
if(ldash)then
curdist=plen+curdist
c Dashline distance to end of segment
5 dlen=(dashlen(jmask)-dashdist)
if(plen.gt.dlen)then
c Vector longer than this segment. Draw segment and iterate.
plen=plen-dlen
flen=dlen/vlen
nx= crsrx+dx*flen
ny= crsry+dy*flen
cud=dashmask(jmask)
call vecn(nx,ny,cud)
dashdist=0
jmask=mod(jmask,MASKNO)+1
goto 5
else
c Vector ends before segment. Draw to end of vector and quit.
dashdist=plen+dashdist
nx=nxs
ny=nys
cud=dashmask(jmask)
call vecn(nx,ny,cud)
endif
else
c Replaces this:
curdist=plen+curdist
nx=nxs
ny=nys
call vecn(nx,ny,iline)
endif
endif
3 continue
chrscos=cc
chrssin=cs
end
c*********************************************************************
c$$$ program tlabline
c$$$ integer i,imax,nlab
c$$$ parameter (imax=20)
c$$$ real x(imax),y(imax),ymin,ymax
c$$$ character label*(30)
c$$$ external wx2nx,wy2ny
c$$$
c$$$ ymin=0
c$$$ ymax=0
c$$$ do 1 i=1,imax
c$$$ x(i)=i
c$$$ y(i)=sin(3.*i/float(imax))
c$$$ if(y(i).gt.ymax)ymax=y(i)
c$$$ if(y(i).lt.ymin)ymin=y(i)
c$$$ 1 continue
c$$$ 2 write(*,*)'Enter Label (CR)'
c$$$ read(*,'(a)')label
c$$$ nlab=lentrim(label)
c$$$ call pltinit(x(1),x(imax),ymin,ymax)
c$$$ call dashset(5)
c$$$ call axis
c$$$ call labeline(x,y,imax,label,nlab)
c$$$ call pltend()
c$$$ end