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 block data setupvu
00021 save
00022 common /vuopt/ iopt
00023 data iopt/1/
00024 end
00025
00026
00027 subroutine setvu(jopt)
00028 save
00029 common /vuopt/ iopt
00030 iopt = jopt
00031 end
00032
00033
00034 subroutine nxtvu(ic,x,y,n,ier)
00035 save
00036 c
00037 c Plot routine used in conjunction with plt3d - includes hidden
00038 c line removal.
00039 c
00040 c This routine is quite choosy. It MUST traverse the screen from
00041 c left to right, or it loses track of the hidden lines.
00042 c
00043 dimension x(n),y(n)
00044 c
00045 parameter (nn = 2000)
00046 common /nxtv1/ xx(nn),yy(nn),kk,ll
00047 common /vuopt/ iopt
00048 save /vuopt/
00049 c
00050 if (ic.eq.0) then
00051 if (n.gt.nn) then
00052 ier = 1
00053 return
00054 end if
00055 c
00056 ll = nn-n+1
00057 i = ll
00058 xx(i) = x(1)
00059 yy(i) = y(1)
00060 call plot(xx(ll),yy(ll),3)
00061 do 10 j = 2,n
00062 i = i+1
00063 xx(i) = x(j)
00064 yy(i) = y(j)
00065 call plot(xx(i),yy(i),2)
00066 10 continue
00067 ier = 0
00068 return
00069 end if
00070 c
00071 if (ier.ne.0) return
00072 c
00073 ii = 1
00074 jj = ll
00075 kk = 0
00076 ya0 = y(1)
00077 yb0 = yy(ll)
00078 if (x(1).gt.xx(ll)) go to 70
00079 call plot(x(1),ya0,3)
00080 c
00081 40 call outp(x(ii),y(ii),ier)
00082 if (ii.eq.n) go to 360
00083 ii = ii+1
00084 ya0 = y(ii)
00085 if (x(ii).le.xx(ll)) then
00086 call plot(x(ii),ya0,2)
00087 go to 40
00088 end if
00089 c
00090 ii = ii-1
00091 xl = x(ii)
00092 yl = y(ii)
00093 ya0 = alin(x(ii),x(ii+1),y(ii),y(ii+1),xx(ll))
00094 x0 = xx(ll)
00095 if ((iopt.eq.1.and.ya0.gt.yb0)
00096 & .or.(iopt.eq.2.and.ya0.lt.yb0)) then
00097 iov0 = 1
00098 else
00099 call plot(x0,ya0,2)
00100 call outp(x0,ya0, ier)
00101 call outp(x0,yb0, ier)
00102 iov0 = 0
00103 end if
00104 go to 120
00105 c
00106 70 call outp(xx(jj),yy(jj),ier)
00107 if (jj.eq.nn) go to 380
00108 jj = jj+1
00109 yb0 = yy(jj)
00110 if (x(1).ge.xx(jj)) go to 70
00111 c
00112 jj = jj-1
00113 yb0 = alin(xx(jj),xx(jj+1),yy(jj),yy(jj+1),x(1))
00114 x0 = x(1)
00115 if ((iopt.eq.1.and.ya0.le.yb0)
00116 & .or.(iopt.eq.2.and.ya0.ge.yb0)) then
00117 iov0 = 0
00118 else
00119 call outp (x0,yb0,ier)
00120 call outp(x0,ya0,ier)
00121 xl = x0
00122 yl = ya0
00123 iov0 = 1
00124 end if
00125 c
00126 120 if (ii.eq.n) go to 300
00127 if (jj.eq.nn) go to 310
00128 if (x(ii+1).le.xx(jj+1)) then
00129 isw = +1
00130 ii = ii+1
00131 x1 = x(ii)
00132 ya1 = y(ii)
00133 yb1 = alin(xx(jj),xx(jj+1),yy(jj),yy(jj+1),x1)
00134 else
00135 if (xx(jj+1).ge.x(n)) go to 340
00136 isw = -1
00137 jj = jj+1
00138 x1 = xx(jj)
00139 ya1 = alin(x(ii),x(ii+1),y(ii),y(ii+1),x1)
00140 yb1 = yy(jj)
00141 end if
00142 if ((iopt.eq.1.and.ya1.le.yb1)
00143 & .or.(iopt.eq.2.and.ya1.ge.yb1)) go to 160
00144 iov1 = 1
00145 if (iov0.eq.0) go to 170
00146 150 if (isw.eq.-1) go to 200
00147 call outp (x1,ya1,ier)
00148 call plot(xl,yl,3)
00149 call plot(x1,ya1,2)
00150 xl = x1
00151 yl = ya1
00152 go to 200
00153 c
00154 160 iov1 = 0
00155 if (iov0.eq.0) go to 190
00156 170 frac = (yb0-ya0)/(ya1-yb1+yb0-ya0)
00157 xi = (x1-x0)*frac+x0
00158 yi = (ya1-ya0)*frac+ya0
00159 call outp(xi,yi,ier)
00160 if (iov0.eq.0) go to 180
00161 call plot(xl,yl,3)
00162 call plot(xi,yi,2)
00163 xl = xi
00164 yl = yi
00165 go to 190
00166 c
00167 180 xl = xi
00168 yl = yi
00169 go to 150
00170 c
00171 190 if (isw.eq.+1) go to 200
00172 call outp(xx(jj),yy(jj),ier)
00173 200 if (ier.ne.0) return
00174 x0 = x1
00175 ya0 = ya1
00176 yb0 = yb1
00177 iov0 = iov1
00178 go to 120
00179 c
00180 310 x1 = xx(nn)
00181 ya1 = alin(x(ii),x(ii+1),y(ii),y(ii+1),x1)
00182 yb1 = yy(nn)
00183 if ((iopt.eq.1.and.ya1.gt.yb1)
00184 & .or.(iopt.eq.2.and.ya1.lt.yb1)) go to 320
00185 call outp(x1,yb1,ier)
00186 call outp(x1,ya1,ier)
00187 call plot(x1,ya1,3)
00188 go to 330
00189 c
00190 380 ii = 1
00191 320 call plot(x(ii),y(ii),3)
00192 330 if (ii.eq.n) go to 400
00193 ii = ii+1
00194 call outp(x(ii),y(ii),ier)
00195 call plot(x(ii),y(ii),2)
00196 go to 330
00197 c
00198 300 if (jj.eq.nn) go to 400
00199 340 x1 = x(n)
00200 ya1 = y(n)
00201 yb1 = alin(xx(jj),xx(jj+1),yy(jj),yy(jj+1),x1)
00202 if ((iopt.eq.1.and.ya1.le.yb1)
00203 & .or.(iopt.eq.2.and.ya1.ge.yb1)) go to 350
00204 call outp(x1,ya1,ier)
00205 call outp(x1,yb1,ier)
00206 call plot(xl,yl,3)
00207 call plot (x1,ya1,2)
00208 350 if (jj.eq.nn) go to 400
00209 jj = jj+1
00210 call outp(xx(jj),yy(jj),ier)
00211 go to 350
00212 c
00213 360 jj = 0
00214 go to 350
00215 c
00216 400 ll = nn-kk+1
00217 i = ll
00218 do 410 j = 1,kk
00219 xx(i) = xx(j)
00220 yy(i) = yy(j)
00221 i = i+1
00222 410 continue
00223 c
00224 end
