![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to g2.e CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Research Unix] / researchv10no / cmd / view2d|
Return to g2.e CVS log | Up to [Research Unix] / researchv10no / cmd / view2d |
1.1 root 1: procedure g2sc(s,x,n)
2: integer n, i, j
3: real s(6), x(2,n), denom, xmin(2), xmax(2)
4: do i=1,2{
5: xmin(i)=x(i,1)
6: xmax(i)=x(i,1)
7: do j=2,n{
8: xmin(i)=amin1(xmin(i),x(i,j))
9: xmax(i)=amax1(xmax(i),x(i,j))
10: }
11: denom=xmax(i)-xmin(i)+1.0e-4*(abs(xmax(i))+abs(xmin(i)))+1.0e-12
12: s(i)=1.0e0/denom
13: s(i+4)=-s(i)*xmin(i)
14: }
15: s(4)=s(2)
16: s(2)=0
17: s(3)=0
18: end
19: #-------------------------------------------------------------------
20: procedure g2sce(s,x,n)
21: integer n, i, j
22: real s(6), x(2,n), denom, xmin(2), xmax(2)
23: denom=1.0e-20
24: do i=1,2{
25: xmin(i)=x(i,1)
26: xmax(i)=x(i,1)
27: do j=2,n{
28: xmin(i)=amin1(xmin(i),x(i,j))
29: xmax(i)=amax1(xmax(i),x(i,j))
30: }
31: denom=amax1(denom,
32: xmax(i)-xmin(i)+1.0e-4*(abs(xmax(i))+abs(xmin(i)))+1.0e-12)
33: }
34: s(1)=1/denom
35: s(2)=0
36: s(3)=0
37: s(4)=1/denom
38: s(5)=0.5-0.5*s(1)*(xmax(1)+xmin(1))
39: s(6)=0.5-0.5*s(4)*(xmax(2)+xmin(2))
40: end
41: #------------------------------------------------------------------
42: procedure g2box(s,d)
43: real box(2,5), s(6), d(2,2)
44: box(1,1)=d(1,1)
45: box(2,1)=d(2,1)
46: box(1,2)=d(1,2)
47: box(2,2)=d(2,1)
48: box(1,3)=d(1,2)
49: box(2,3)=d(2,2)
50: box(1,4)=d(1,1)
51: box(2,4)=d(2,2)
52: box(1,5)=d(1,1)
53: box(2,5)=d(2,1)
54: g2li(s,box,5)
55: end
56: #------------------------------------------------------------------
57: procedure g2gr(s,n1,n2)
58: integer n1,n2,j1,j2
59: real s(6),x(2,1)
60: do j2=1,n2{
61: x(2,1)=j2
62: do j1=1,n1{
63: x(1,1)=j1
64: g2sy(s,x,1,'+')
65: }
66: }
67: end
68: #------------------------------------------------------------------
69: procedure g2ti(s,d)
70: integer i, lab1, nlab, labk
71: integer ifloor
72: real s(6), p(2,2), tic1(2), tic2(2)
73: real d(2,2), l, h
74: l=d(1,1)
75: h=d(1,2)
76: labk=ifloor(alog10((h-l)/2.0001))
77: lab1=ifloor(0.0001+l*10.0**(-labk))
78: nlab=ifloor(0.0001+h*10.0**(-labk))-lab1+1
79: tic1(1)=lab1*10.0**labk
80: tic1(2)=(lab1+nlab-1)*10.0**labk
81: do i=1,nlab{
82: p(2,1)=d(2,1)-0.01*(d(2,2)-d(2,1))
83: p(1,1)=(lab1+i-1)*10.0**labk
84: p(2,2)=d(2,1)
85: p(1,2)=p(1,1)
86: g2li(s,p,2)
87: }
88: l=d(2,1)
89: h=d(2,2)
90: labk=ifloor(alog10((h-l)/2.0001))
91: lab1=ifloor(0.0001+l*10.0**(-labk))
92: nlab=ifloor(0.0001+h*10.0**(-labk))-lab1+1
93: tic2(1)=lab1*10.0**labk
94: tic2(2)=(lab1+nlab-1)*10.0**labk
95: do i=1,nlab{
96: p(1,1)=d(1,1)-0.01*(d(1,2)-d(1,1))
97: p(2,1)=(lab1+i-1)*10.0**labk
98: p(1,2)=d(1,1)
99: p(2,2)=p(2,1)
100: g2li(s,p,2)
101: }
102: #write(,{" tics ":c,tic1:e(15,5)," to ":c,tic2:e(15,5)})
103: end
104: #------------------------------------------------------------------
105: procedure number ( s, q, i )
106: real q(2)
107: integer i, digits(10)
108: real s(6)
109: initial digits = ("0","1","2","3","4","5","6","7","8","9")
110: g2sy(s,q,1,digits(1+mod(i,10)))
111: end
112: #------------------------------------------------------------------
113: integer function ifloor(x)
114: real x
115: ifloor=int(x)
116: if(x<ifloor){ifloor=ifloor-1}
117: end
118: #------------------------------------------------------------------
119: procedure g2ca(s,d,n1,n2,f)
120: integer n1, n2, j1, j2
121: real s(6), d(2,2), f(n1,n2), c(5)
122: real fmax, fmin
123: fmax=-1e30
124: fmin=-fmax
125: #write(,{" n1,n2=",n1:i(10),n2:i(10)})
126: do j1=1,n1{
127: do j2=1,n2{
128: fmax=amax1(fmax,f(j1,j2))
129: fmin=amin1(fmin,f(j1,j2))
130: }}
131: #write(,{"fmax, fmin=":c,fmax:e(15,3),fmin:e(15,3)})
132: do j1=1,5{
133: c(j1)= fmin+j1*(fmax-fmin)/6
134: #write(,{" contour ":c,c(j1):e(15,7)})
135: }
136: g2co(s,d,n1,n2,f,5,c)
137: end
138: # g2 a simple plot package
139: # NPLOT VERSION
140: # (ehg 30 aug 84)
141: #
142: # g2open initialize system.
143: # g2ff start a picture.
144: # g2clos finish up plotting.
145: # g2sc(s,x,n) set up coordinate transform
146: # where x is a collection of points dimensioned (2,n)
147: # and on output s is a coordinate transform
148: # [ w(1) ] [ s(1) s(2) ] [ x(1) ] [ s(5) ]
149: # [ ] = [ ] [ ] + [ ]
150: # [ w(2) ] [ s(3) s(4) ] [ x(2) ] [ s(6) ].
151: # g2sce(s,x,n) does the same, but forces s(1)=s(4)
152: # (so that circles come out as circles and not ellipses)
153: # g2li(s,x,n) draws lines between the points x.
154: # g2lit(j) sets the line type.
155: # where j=0 solid, =1 dash, =2 dots.
156: # g2sy(s,x,n,'+') puts a '+' at each of the points x.
157: # g2arc(s,center,start,stop) draws a circular arc counterclockwise from start
158: # to stop, about specified center
159: # g2ti(s,d) draws tic marks around a rectangle where d is dimensioned (2,2),
160: # d(,1)=lower left corner, and d(,2)=upper right corner.
161: # g2box(s,d) draws the rectangle d
162: # g2co(s,d,n1,n2,f,nc,c) draws contours at levels c(j), 1<=j<=nc
163: # for function values f given on a n1 by n2 array corresponding
164: # to rectangle d.
165: #
166: #------------------------------------------------------------------
167: procedure g2open
168: write(,"..o")
169: write(,"..ra -0.1 -0.1 1.1 1.1")
170: end
171: #------------------------------------------------------------------
172: procedure g2ff
173: integer frame
174: initial frame = 0
175: frame=frame+1
176: if ( frame > 1 ) { write(,"..pau"); write(,"..e") }
177: end
178: #------------------------------------------------------------------
179: procedure g2clos
180: write(,"..cl")
181: end
182: #------------------------------------------------------------------
183: procedure g2tx(s,x,n,char)
184: # write n characters at x
185: integer n, i, j
186: real char(1), s(6), x(2), xp, yp
187: xp=s(1)*x(1)+s(2)*x(2)+s(5)
188: yp=s(3)*x(1)+s(4)*x(2)+s(6)
189: write(,"..m ",xp:f(10,7),yp:f(10,7))
190: write(,"..t ",char:c(4))
191: end
192: #------------------------------------------------------------------
193: procedure g2li(s,x,n)
194: integer n, j
195: real s(6), x(2,n), x1, y1
196: j=1
197: x1=s(1)*x(1,j)+s(2)*x(2,j)+s(5)
198: y1=s(3)*x(1,j)+s(4)*x(2,j)+s(6)
199: write(,"..m ",x1:f(10,7),y1:f(10,7))
200: do j=2,n{
201: x1=s(1)*x(1,j)+s(2)*x(2,j)+s(5)
202: y1=s(3)*x(1,j)+s(4)*x(2,j)+s(6)
203: write(,"..v ",x1:f(10,7),y1:f(10,7))
204: }
205: end
206: #------------------------------------------------------------------
207: procedure g2la(s,x,n)
208: # (like g2li, but only connect pairs of points)
209: integer n, j
210: real s(6), x(2,n), xb, xf, yb, yf
211: do j=1,n/2{
212: xb=s(1)*x(1,2*j-1)+s(2)*x(2,2*j-1)+s(5)
213: yb=s(3)*x(1,2*j-1)+s(4)*x(2,2*j-1)+s(6)
214: xf=s(1)*x(1,2*j) +s(2)*x(2,2*j) +s(5)
215: yf=s(3)*x(1,2*j) +s(4)*x(2,2*j) +s(6)
216: write(,"..li ",xb:f(10,7),yb:f(10,7),xf:f(10,7),yf:f(10,7))
217: }
218: end
219: #------------------------------------------------------------------
220: procedure g2lit(l)
221: integer l
222: if(l==0){
223: write(,"..co white/solid/H*")
224: }
225: else if(l==1){
226: write(,"..co red/longdashed/H#")
227: }
228: else if(l==2){
229: write(,"..co green/dotdashed/H$")
230: }
231: end
232: #------------------------------------------------------------------
233: procedure g2sy(s,x,n,char)
234: integer n, j
235: real char
236: real s(6), x(2,n), xp, yp
237: do j=1,n{
238: xp=s(1)*x(1,j)+s(2)*x(2,j)+s(5)
239: yp=s(3)*x(1,j)+s(4)*x(2,j)+s(6)
240: write(,"..m ",xp:f(10,7),yp:f(10,7))
241: write(,"..t ",char:c(1))
242: }
243: end
244: #------------------------------------------------------------------
245: procedure g2arc ( s, c, a, b )
246: real s(6), c(2), a(2), b(2), radius, start
247: real finish, pi, x(2), y(2), z(2)
248: pi=4*atan(1.0e0)
249: x(1)=s(1)*c(1)+s(2)*c(2)+s(5)
250: x(2)=s(3)*c(1)+s(4)*c(2)+s(6)
251: y(1)=s(1)*a(1)+s(2)*a(2)+s(5)
252: y(2)=s(3)*a(1)+s(4)*a(2)+s(6)
253: z(1)=s(1)*b(1)+s(2)*b(2)+s(5)
254: z(2)=s(3)*b(1)+s(4)*b(2)+s(6)
255: radius=sqrt((x(1)-y(1))**2+(x(2)-y(2))**2)
256: if ( radius > 5. ) {
257: write(,"..li ",y(1):f(10,7),y(2):f(10,7),z(1):f(10,7),z(2):f(10,7))
258: }
259: else {
260: start=atan2(y(2)-x(2),y(1)-x(1))
261: finish=atan2(z(2)-x(2),z(1)-x(1))
262: write(,"..a ",y:f(10,7),z:f(10,7),x:f(13,7),radius:f(13,7))
263: }
264: end
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.