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 subroutine plotin(rcall,scall,ipen)
00021 save
00022 c
00023 c Move pen from the last point to a new point, drawing only that
00024 c segment of the line lying within the "eframe" boundaries.
00025 c
00026 common /scales/ x1,x2,dix,y1,y2,diy,rlen,slen
00027 common /fr sord/ idash
00028 common /last point/ rl,sl
00029 c
00030 c Note: a "plotin" session should start with a "plotin(.,.,3)"
00031 c call (to initialize il, etc.), not with "plot(.,.,3)"
00032 c
00033 integer MOVE, DRAW
00034 parameter (MOVE = 3, DRAW = 2)
00035 c
00036 save il,jl,kl,inl
00037 c
00038 c-----------------------------------------------------------------------------
00039 c
00040 c Alternate entry points:
00041 c ----------------------
00042 c
00043 idash = 0
00044 r = rcall
00045 s = scall
00046 go to 1
00047 c
00048 entry uplotin(rcall,scall,ipen)
00049 entry userplotin(rcall,scall,ipen)
00050 idash = 0
00051 call fr inches(rcall,scall,r,s)
00052 go to 1
00053 c
00054 entry dplotin(rcall,scall,ipen)
00055 idash = 1
00056 r = rcall
00057 s = scall
00058 go to 1
00059 c
00060 entry udplotin(rcall,scall,ipen)
00061 entry userdplotin(rcall,scall,ipen)
00062 idash = 1
00063 call fr inches(rcall,scall,r,s)
00064 c
00065 c-----------------------------------------------------------------------------
00066 c
00067 c Locate the ends of the line relative to the current box:
00068 c
00069 c ! !
00070 c (1,3) --> 7 ! (2,3) --> 8 ! (3,3) --> 9
00071 c ! !
00072 c - - - - - - - - +---------------+ - - - - - - - -
00073 c | |
00074 c | EFRAME box |
00075 c (1,2) --> 4 | | (3,2) --> 6
00076 c | (2,2) --> 5 |
00077 c | |
00078 c - - - - - - - - +---------------+ - - - - - - - -
00079 c ! !
00080 c (1,1) --> 1 ! (1,2) --> 2 ! (1,3) --> 3
00081 c ! !
00082 c
00083 1 in = 0
00084 i = 2
00085 j = 2
00086 if (r.lt.0.) i = 1
00087 if (r.gt.rlen) i = 3
00088 if (s.lt.0.) j = 1
00089 if (s.gt.slen) j = 3
00090 c
00091 k = i + 3*(j-1)
00092 if (k.eq.5) in = 1
00093 if (ipen.eq.MOVE) go to 99
00094 c
00095 if (r.eq.rl.and.s.eq.sl) then
00096 if (in.eq.1) call plot(r,s,DRAW)
00097 go to 99
00098 end if
00099 c
00100 rp = r
00101 sp = s
00102 c
00103 c *** both in ***
00104 c
00105 if (in+inl.eq.2) go to 98
00106 c
00107 c *** both out ***
00108 c
00109 if (in+inl.eq.0) go to 20
00110 c
00111 c *** 1 in, 1 out ***
00112 c
00113 if (in.eq.1) go to 3
00114 c
00115 c Last point in.
00116 c
00117 rin = rl
00118 sin = sl
00119 2 rout = r
00120 sout = s
00121 iout = i
00122 kout = k
00123 go to 5
00124 c
00125 c Current point in.
00126 c
00127 3 rin = r
00128 sin = s
00129 4 rout = rl
00130 sout = sl
00131 iout = il
00132 kout = kl
00133 c
00134 c Move from (rin,sin) to (rout,sout).
00135 c
00136 5 call fr plt(rin,sin,MOVE)
00137 if (kout.eq.2) go to 11
00138 if (kout.eq.8) go to 12
00139 if (kout.eq.6) go to 14
00140 if (kout.eq.4) go to 15
00141 c
00142 c Exit to corner square; find exit side.
00143 c
00144 rp = 0.
00145 if (iout.eq.3) rp = rlen
00146 sp = sin + (rp-rin)*(sout-sin)/(rout-rin)
00147 if (sp.lt.0.) go to 11
00148 if (sp.gt.slen) go to 12
00149 go to 98
00150 c
00151 c Exit side known...
00152 c
00153 c ...through bottom.
00154 c
00155 11 sp = 0.
00156 go to 13
00157 c
00158 c ...through top.
00159 c
00160 12 sp = slen
00161 13 rp = rin + (sp-sin)*(rout-rin)/(sout-sin)
00162 go to 98
00163 c
00164 c ...through right.
00165 c
00166 14 rp = rlen
00167 go to 16
00168 c
00169 c ...through left.
00170 c
00171 15 rp = 0.
00172 16 sp = sin + (rp-rin)*(sout-sin)/(rout-rin)
00173 go to 98
00174 c
00175 c Both points outside -- look for any intersection with the frame.
00176 c
00177 c First dispose of points in same square, or in same outside row or column.
00178 c
00179 20 if (k.eq.kl) go to 99
00180 if (j+jl.eq.2) go to 99
00181 if (j+jl.eq.6) go to 99
00182 if (i+il.eq.2) go to 99
00183 if (i+il.eq.6) go to 99
00184 c
00185 c Is any square on a side of the frame?
00186 c
00187 kout = kl
00188 if (k.eq.2) go to 21
00189 if (k.eq.8) go to 22
00190 if (k.eq.6) go to 24
00191 if (k.eq.4) go to 25
00192 c
00193 kout = k
00194 if (kl.eq.2) go to 21
00195 if (kl.eq.8) go to 22
00196 if (kl.eq.6) go to 24
00197 if (kl.eq.4) go to 25
00198 go to 27
00199 c
00200 c Through bottom.
00201 c
00202 21 sin = 0.
00203 go to 23
00204 c
00205 c Through top.
00206 c
00207 22 sin = slen
00208 23 rin = r + (sin-s)*(rl-r)/(sl-s)
00209 if (rin.le.0.) go to 99
00210 if (rin.ge.rlen) go to 99
00211 if (kout.eq.kl) go to 4
00212 go to 2
00213 c
00214 c Through right side.
00215 c
00216 24 rin = rlen
00217 go to 26
00218 25 rin = 0.
00219 26 sin = s + (rin-r)*(sl-s)/(rl-r)
00220 if (sin.le.0.) go to 99
00221 if (sin.ge.slen) go to 99
00222 if (kout.eq.kl) go to 4
00223 go to 2
00224 c
00225 c Connect diagonally opposite corner squares.
00226 c
00227 27 ip = MOVE
00228 sin = 0.
00229 rin = r + (sin-s)*(rl-r)/(sl-s)
00230 if (rin.le.rlen.and.rin.ge.0.) then
00231 call fr plt(rin,sin,ip)
00232 ip = DRAW
00233 end if
00234 c
00235 sin = slen
00236 rin = r + (sin-s)*(rl-r)/(sl-s)
00237 if (rin.le.rlen.and.rin.ge.0.) then
00238 call fr plt(rin,sin,ip)
00239 if (ip.eq.DRAW) go to 99
00240 ip = DRAW
00241 end if
00242 c
00243 rin = 0.
00244 sin = s + (rin-r)*(sl-s)/(rl-r)
00245 if (sin.le.slen.and.sin.ge.0.) then
00246 call fr plt(rin,sin,ip)
00247 if (ip.eq.DRAW) go to 99
00248 ip = DRAW
00249 end if
00250 c
00251 rin = rlen
00252 sin = s + (rin-r)*(sl-s)/(rl-r)
00253 if (sin.le.slen.and.sin.ge.0.) call fr plt(rin,sin,ip)
00254 go to 99
00255 c
00256 c Plot final segment, then terminate on last point.
00257 c
00258 98 call fr plt(rp,sp,DRAW)
00259 99 call fr plt(r,s,MOVE)
00260 rl = r
00261 sl = s
00262 il = i
00263 jl = j
00264 kl = k
00265 inl = in
00266 c
00267 end
