00001 c
00002 c Copyright (c) 1986,1987,1988,1989,1990,1991,1992,1993,
00003 c by Steve McMillan, Drexel University, Philadelphia, PA.
00004 c
00005 c All rights reserved.
00006 c
00007 c Redistribution and use in source and binary forms are permitted
00008 c provided that the above copyright notice and this paragraph are
00009 c duplicated in all such forms and that any documentation,
00010 c advertising materials, and other materials related to such
00011 c distribution and use acknowledge that the software was developed
00012 c by the author named above.
00013 c
00014 c THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
00015 c IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
00016 c WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
00017 c
00018 subroutine mlinec(xarray,yarray,zarray,n,jth,jsymbl,htsym)
00019 save
00020 c
00021 c Plots the n points yarray(xarray), with identifying
00022 c symbols, of height |htsym|, at every |jth|-th point
00023 c for nonzero jth.
00024 c
00025 c This version differs from mline in that the color of the
00026 c plot can be continuously adjusted, according to zarray.
00027 c
00028 c if jth = 0, the points are joined by solid lines only.
00029 c if jth > 0, both lines and symbols are drawn.
00030 c if jth < 0, only the symbols are drawn.
00031 c
00032 c If jsymbl >0 or =0, the symbol is drawn by subroutine ngon.
00033 c
00034 c If jsymbl < 0, the symbol is a centered "simbol" symbol.
00035 c Defining iascii = |jsymbl|, the first font is obtained
00036 c for iascii.le.127, the second for 128.le.iascii.le.223
00037 c and the third for iascii.ge.224, so, for example, 58
00038 c becomes a colon (":"), 58+96=154 is an integral sign ("@:")
00039 c and 58+192=250 is a gothic "z" ("%:").
00040 c
00041 c No lines are drawn outside the box produced by "eframe"
00042 c if mode is nonzero.
00043 c If htsym < 0., the "simbol" symbols will not be centered:
00044 c the symbol will be drawn with the array point at the
00045 c bottom left-hand corner.
00046 c
00047 dimension xarray(1),yarray(1),zarray(1)
00048 c
00049 logical in0
00050 character sim*3
00051 c
00052 common /scales/ xminim,xmax,dxinch,
00053 & yminim,ymax,dyinch,rlen,slen
00054 common /fr bnds/ mode
00055 common /mline on/ imline
00056 c
00057 common /dash/ dpatrn(10),dpat,npatrn,ipat,lpen
00058 c
00059 common /ngon stars/ istar
00060 common /mcpak_colormap/ ncolors
00061 c
00062 cinch(x,x0,dxi) = (x-x0)*dxi
00063 c
00064 call routine id('mlinec')
00065 idline = 0
00066 go to 1
00067 c
00068 entry dlinec(xarray,yarray,zarray,n,jth,jsymbl,htsym)
00069 c
00070 c As for mlinec, but plot dashed lines.
00071 c
00072 call routine id('dlinec')
00073 idline = 1
00074 c
00075 c Reinitialize the dash pattern.
00076 c
00077 dpat = dpatrn(1)
00078 ipat = 1
00079 lpen = 2
00080 c
00081 1 call minmax(zarray,n,zmin,zmax)
00082 if (zmax.le.zmin) then
00083 z0 = 1.
00084 zfac = 1.
00085 else
00086 z0 = .05*ncolors
00087 zfac = .9*(ncolors-1.)/(zmax-zmin)
00088 end if
00089 c
00090 if (jth.ne.0) then
00091 c
00092 c *** plot symbols ***
00093 c
00094 hite = abs(htsym)
00095 c
00096 if(jsymbl.lt.0)then
00097 iascii = -jsymbl
00098 if(iascii.le.127)then
00099 nsym = -1
00100 sim = char(iascii)
00101 else if(iascii.le.223)then
00102 nsym = -2
00103 sim = '@'
00104 else
00105 nsym = -2
00106 sim = '%'
00107 end if
00108 if(htsym.lt.0.)nsym = -nsym
00109 end if
00110 c
00111 int = abs(jth)
00112 do i=1,n,int
00113 x1 = cinch(xarray(i),xminim,dxinch)
00114 y1 = cinch(yarray(i),yminim,dyinch)
00115 call color(nint(z0+(zarray(i)-zmin)*zfac))
00116 if (mode.eq.0
00117 & .or.(x1.ge.0..and.x1.le.rlen
00118 & .and.y1.ge.0..and.y1.le.slen)) then
00119 if(jsymbl.ge.0)then
00120 if(istar.eq.0)then
00121 call ngon(x1,y1,.5*htsym,jsymbl,0.)
00122 else
00123 call ngon(x1,y1,.5*htsym,-jsymbl,0.)
00124 end if
00125 else
00126 if (iascii.le.1) then
00127 c
00128 c Encode the number of the point in sim.
00129 c
00130 ii = i
00131 do while (ii.gt.61)
00132 ii = ii - 61
00133 end do
00134 if (ii.le.9) then
00135 sim = char(48+ii)
00136 else if (ii.le.35) then
00137 sim = char(87+ii)
00138 else
00139 sim = char(29+ii)
00140 end if
00141 end if
00142 call simbol(x1,y1,hite,sim,0.,nsym)
00143 end if
00144 end if
00145 end do
00146 c
00147 if (jth.lt.0) return
00148 end if
00149 c
00150 c *** plot line ***
00151 c
00152 x0 = cinch(xarray(1),xminim,dxinch)
00153 y0 = cinch(yarray(1),yminim,dyinch)
00154 in0 = (x0.ge.0..and.x0.le.rlen
00155 & .and.y0.ge.0..and.y0.le.slen)
00156 c
00157 c The following distinction is necessary to set up "plotin" internally:
00158 c
00159 if (mode.eq.0) then
00160 call plot(x0,y0,3)
00161 else
00162 call plotin(x0,y0,3)
00163 imline = 1
00164 end if
00165 c
00166 do 20 i=2,n
00167 x1 = cinch(xarray(i),xminim,dxinch)
00168 y1 = cinch(yarray(i),yminim,dyinch)
00169 c
00170 call color(nint(z0+(zarray(i)-zmin)*zfac))
00171 c
00172 if (mode.eq.0) then
00173 if (idline.eq.0) then
00174 call plot(x1,y1,2)
00175 else
00176 call dplot(x1,y1,2)
00177 end if
00178 else
00179 c
00180 c Is there anything to plot? (Problems with slow graphics devices.)
00181 c
00182 if (max(x0,x1).ge.0..and.min(x0,x1).le.rlen
00183 & .and.max(y0,y1).ge.0.
00184 & .and.min(y0,y1).le.slen) then
00185 c
00186 if (.not.in0) call plotin(x0,y0,3)
00187 c
00188 if (idline.eq.0) then
00189 call plotin(x1,y1,2)
00190 else
00191 call dplotin(x1,y1,2)
00192 end if
00193 c
00194 in0 = .true.
00195 else
00196 in0 = .false.
00197 end if
00198 x0 = x1
00199 y0 = y1
00200 end if
00201 20 continue
00202 c
00203 c Make sure all pointers are set to the end of the array.
00204 c
00205 if (mode.eq.0) then
00206 call plot(x1,y1,3)
00207 else
00208 call plotin(x1,y1,3)
00209 imline = 0
00210 end if
00211 c
00212 end
