00001
00002 c
00003 c Copyright (c) 1986,1987,1988,1989,1990,1991,1992,1993,
00004 c by Steve McMillan, Drexel University, Philadelphia, PA.
00005 c
00006 c All rights reserved.
00007 c
00008 c Redistribution and use in source and binary forms are permitted
00009 c provided that the above copyright notice and this paragraph are
00010 c duplicated in all such forms and that any documentation,
00011 c advertising materials, and other materials related to such
00012 c distribution and use acknowledge that the software was developed
00013 c by the author named above.
00014 c
00015 c THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
00016 c IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
00017 c WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
00018 c
00019
00020
00021 subroutine dplot(x,y,ipen)
00022 save
00023 c
00024 c Draw a setpat-defined dashed line to (r,s).
00025 c
00026 common/dash/dpatrn(10),dpat,npatrn,ipat,lpen
00027 data tol/0.002/
00028 c
00029 r = x
00030 s = y
00031 go to 10
00032 c
00033 entry udplot(x,y,ipen)
00034 entry userdplot(x,y,ipen)
00035 c
00036 call fr inches(x,y,r,s)
00037 c
00038 10 if(abs(ipen).eq.3)then
00039 call plot(r,s,ipen)
00040 return
00041 end if
00042 c
00043 if(kount.eq.0)then
00044 kount=1
00045 if(dpat.eq.0.)call setpat(0,0,0,0)
00046 end if
00047 c
00048 call lastp(rl,sl)
00049 dr=r-rl
00050 ds=s-sl
00051 travl=sqrt(dr**2+ds**2)
00052 if(travl.gt.1.e6*dpat)stop 'warning: (d)line length >1.e6*dpat.'
00053 c
00054 if(travl.eq.0.)then
00055 drdl=0.
00056 dsdl=0.
00057 go to 1
00058 end if
00059 c
00060 drdl=dr/travl
00061 dsdl=ds/travl
00062 1 do 2 i=ipat,npatrn
00063 iplast=i
00064 step=min(travl,dpat)
00065 rl=rl+step*drdl
00066 sl=sl+step*dsdl
00067 call plot(rl,sl,lpen)
00068 travl=travl-step
00069 if(travl.le.tol) go to 4
00070 dpat=dpatrn(i+1)
00071 2 lpen=5-lpen
00072 3 dpat=dpatrn(1)
00073 ipat=1
00074 lpen=2
00075 if(travl.gt.tol) go to 1
00076 return
00077 c
00078 4 ipat=iplast
00079 dpat=dpat-step
00080 if(dpat.gt.tol) return
00081 ipat=ipat+1
00082 if(ipat.gt.npatrn) go to 3
00083 dpat=dpatrn(ipat)
00084 lpen=5-lpen
00085 c
00086 end
