projects / pdp8.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
A large commit.
[pdp8.git] / sw / rescue / lab8e_goettingen / disk2_11 / rka / paroff / plot2.ft
CommitLineData
81e70d48
PH		 1 SUBROUTINE PLOT(X,Y,IP)\r
2C\r
3C THIS ROUTINE IS THE HEART OF THE PLOTTING SYSTEM\r
4C\r
5C THE CALL IS:\r
6C\r
7C CALL PLOT(XP,YP,IPEN)\r
8C\r
9C WHERE XP IS THE VIRTUAL X COORDANATE OF THE END POINT OF THE DESIRED\r
10C LINE,\r
11C WHERE YP IS THE VIRTUAL Y COORDANATE OF THE END POINT OF THE DESIRED\r
12C LINE,\r
13C AND IPEN IS THE PEN CONTROL PARAMETER.\r
14C\r
15C IF THE ABSOLUTE VALUE OF IPEN IS 2, THE MOVE IS MADE WITH THE PEN DOWN,\r
16C IF THE ABSOLUTE VALUE OF IPEN IS 3, THE MOVE IS MADE WITH THE PEN UP.\r
17C IF THE ABSOLUTE VALUE OF IPEN IS ANYTHING ELSE, NO CHANGE IN THE PEN IS\r
18C MADE.\r
19C IF THE SIGN OF IPEN IS -, THE END POINT OF THE LINE DRAWN IS ASSIGNED TO\r
20C BE THE ORIGIN, (0,0).\r
21C IF THE SIGN OF IPEN IS +, THE ENDPOINT OF THE LINE WILL BE (XP,YP).\r
22C\r
23C PLOT SHOULD BE CALLED ONCE TO INITIALIZE IT.\r
24C THE CALL 'CALL PLOT(0,0,3)' WOULD SUFFICE.\r
25C\r
26 COMMON/PLOTC/SCALE,IDEV,IPEN,XCUR,YCUR\r
27C\r
28C SCALE IS THE SCALE EXPRESSED IN RASTER UNITS PER VIRTUAL UNIT.\r
29C IDEV IS A DEVICE SELECTION FLAG.\r
30C IPEN IS THE CURRENT IPEN PARAMETER\r
31C XCUR IS THE CURRENT VIRTUAL X COORDANATE IN RASTER UNITS.\r
32C YCUR IS THE CURRENT VIRYUAL Y COORDANATE IN RASTER UNITS.\r
33C\r
34 DATA XCUR,YCUR/0.,0./\r
35 DATA IDEV,SCALE/1,200./\r
36C\r
37C DEFAULT VALUES ARE SCALE=1, ANGLE=0, PEN AT (0,0).\r
38C\r
39 XT=IFIX(X*SCALE)\r
40 YT=IFIX(Y*SCALE)\r
41C\r
42C CALCULATIONS ARE DONE IN RASTER UNITS TO AVOID ROUND OFF ERROR\r
43C\r
44 CALL DELTAP(XT-XCUR,YT-YCUR,IABS(IP))\r
45 IF(IP)23,25,25\r
4625 XCUR=XT\r
47 YCUR=YT\r
48C\r
49C IPEN POSATIVE MEANS END POINT AS SPECIFIED PLUS/MINUS ONE RASTER UNIT\r
50C\r
51 RETURN\r
5223 XCUR=0.\r
53 YCUR=0.\r
54C\r
55C IPEN NEGATIVE MEANS END POINT IS NEW ORIGIN\r
56C\r
57 RETURN\r
58 END\r
59\f SUBROUTINE SYMBOL(X,Y,HGT,BCD,ANGD,N)\r
60C\r
61C THIS IS THE SYMBOL DRAWING SUBROUTINE.\r
62C\r
63C X AND Y SPECIFY THE POSITION AT WHICH THE SYMBOL IS TO BE DRAWN.\r
64C HGT IS THE HIGHT OF THE CHARACTERS IN VIRTUAL UNITS\r
65C BCD CONTAINS THE CHARACTERS (S) TO BE PLOTTED\r
66C ANGD IS THE ORIENTAION IN DEGREES RELATIVE TO THE X AXIS\r
67C N IS A CONTROL PARAMETER.\r
68C\r
69C THE CHARACTER AND ITS SPACE FORMS A SQUARE OF WIDTH HGT.\r
70C\r
71C IF N > 0, N CHARACTERS IN H FORMAT ARE PLOTTED.\r
72C IF N = 0, ONE CHARACTER IS PLOTTED WHOSE CODE IS BCD.\r
73C\r
74C IF N >0, OR =0 , X AND Y ARE THE LOWER LEFT POINT OF THE CHARACTER.\r
75C\r
76C IF N < 0, ONE CHARACTER WHOS CODE IS B IS PLOTTED CENTERED AROUND (X,Y\r
77C ).\r
78C\r
79 COMMON/PLOTC/SCALE,IDEV,IPEN,XCUR,YCUR,SINA,COSA,SEG,ANG\r
80 DATA ANG,SINA,COSA/0.,0.,1./\r
81 CALL PLOT(X,Y,3)\r
82C\r
83C FIRST GO TO THE SPECIFIED POINT\r
84C\r
85 IF(ANG-ANGD)10,20,10\r
86C\r
87C IF THE REQUESTED ANGLE IS THE SAME AS THE CURRENT ONE,\r
88C AVOID CALCULATING THE SIN AND COSINE\r
89C\r
9010 ANG=ANGD\r
91 SINA=SIND(ANG)\r
92 COSA=COSD(ANG)\r
9320 SEG=HGT/6.\r
94C\r
95C CHARACTERS ARE ON A 6X6 GRID\r
96C\r
97 IF(N) 60,50,30\r
9830 DO 40 J=1,N\r
99C\r
100C THIS LOOP PLOTS THE N CHARACTERS IN BCD.\r
101C\r
102 CALL CGET(BCD,J,CHAR)\r
10340 CALL CPLOT(CHAR)\r
104 RETURN\r
10550 CALL CPLOT(BCD)\r
106C\r
107C THIS PLOTS ONE CHARACTER WHOS CODE IS BCD\r
108C\r
109 RETURN\r
11060 CALL CPLOT(-BCD)\r
111C\r
112C THIS PRODUCES A CENTERED CHARACTER.\r
113C\r
114 RETURN\r
115 END\r
116\f SUBROUTINE CPLOT(CHAR)\r
117\r
118C\r
119C THIS ROUTINE DRIVES THE CHARACTER GENERATOR.\r
120C THE ANGLE AND HIGHT HAVE ALREADY BE COMPUTED.\r
121C\r
122 COMMON/PLOTC/SCALE,IDEV,IPEN,XCUR,YCUR,SINA,COSA,SEG\r
123 IF(CHAR)50,5,5\r
124C\r
125C CHECK FOR CENTERED OR NORMAL CHARACTER\r
126C\r
1275 CALL WHERE(XLL,YLL)\r
128C\r
129C SET THE LOWER LEFT OF THE CHARACTER AT CURRENT POSITION.\r
130C\r
131 CALL SELCQ(CHAR)\r
132C\r
133C SET UP FOR REQUESTED CHARACTER.\r
134C\r
13510 CALL CQXY(X,Y,IPEN)\r
136C\r
137C CALL FOR A VECTOR\r
138C\r
139 X=X*SEG\r
140 Y=(Y-1.)*SEG\r
141 XP=XLL+X*COSA-Y*SINA\r
142 YP=YLL+X*SINA+Y*COSA\r
143 IF(IPEN-7)25,20,20\r
144C\r
145C CHECK FOR LAST VECTOR\r
146C\r
14725 CALL PLOT(XP,YP,IPEN)\r
148C\r
149C PLOT RELATIVE TO XLL,YLL AND GO BACK FOR MORE\r
150C\r
151 GOTO 10\r
152 20 IF(CHAR)30,40,40\r
153C\r
154C CENTERED CHARACTERS GET FUDGED, SO CHECK FOR THAT\r
155C\r
156 40 CALL PLOT(XP,YP,IPEN)\r
157 RETURN\r
158 30 CALL PLOT(X0,Y0,IPEN)\r
159C\r
160C PLOT TO CENTER OF CHARACTER\r
161C\r
162 RETURN\r
163 50 CALL WHERE(X0,Y0)\r
164C\r
165C FIND OUT WHERE CENTER OF CHARACTER SHOULD BE (IS)\r
166C\r
167 XLL=X0-2.*SEG\r
168 YLL=Y0-3.*SEG\r
169 CALL PLOT(XLL,YLL,3)\r
170C\r
171C CALCULATE THE LOWER LEFT FROM GIVEN CENTER, THEN GO THERE.\r
172C\r
173 CALL SELCQ(-CHAR)\r
174 GOTO 10\r
175C\r
176C SELECT CENTERED CHARACTER, THEN PROCESS NORMALLY\r
177C\r
178 END\r
179\f SUBROUTINE ASSIGN(X,Y)\r
180C\r
181C THIS ROUTINE ASSIGNS THE CURRENT PEN POSITION AS VIRTUAL (X,Y).\r
182C\r
183 COMMON/PLOTC/SCALE,IDEV,IPEN,XCUR,YCUR,SINA,COSA,SEG\r
184 XCUR=IFIX(X*SCALE)\r
185 YCUR=IFIX(Y*SCALE)\r
186C\r
187C XCUR AND YCUR ARE STORED IN RASTER TS\r
188C\r
189 RETURN\r
190 END\r
191\f SUBROUTINE WHERE(X,Y)\r
192C\r
193C THIS ROUTINE RETURNS THE VIRTUAL COORDANADTES OF THE CURRENT\r
194C PEN POSITION\r
195C\r
196 COMMON/PLOTC/SCALE,IDEV,IPEN,XCUR,YCUR,SINA,COSA,SEG\r
197 X=XCUR/SCALE\r
198 Y=YCUR/SCALE\r
199C\r
200C XCUR AND YCUR ARE IN RASTER UNITS\r
201C\r
202 RETURN\r
203 END\r
204\f SUBROUTINE FACTOR(FACT)\r
205C\r
206C THIS ROUTINE ESTABLISHES A NEW SCALE FACTOR\r
207C FACT=1 IS 1 UNIT = 1 INCH\r
208C\r
209 COMMON/PLOTC/SCALE,IDEV,IPEN,XCUR,YCUR,SINA,COSA,SEG,ANG\r
210 SCALE=FACT*200.\r
211C\r
212C MY PLOTTER HAS 200 STEPS PER INCH\r
213C\r
214 RETURN\r
215 END\r
216\f SUBROUTINE NUMBER (XP, YP, HGT, FPN, THETA, ND)\r
217C\r
218C THIS ROUTINE CONVERTS A NUMBER INTO PLOTTED FORM\r
219C\r
220C XP AND YP ARE THE COORDANATES WHERE THE PLOTTED NUMBER SHOULD BEGIN\r
221C HGT IS THE HIGHT IF THE CHARACTERS.\r
222C FPN IS THE NUMBER (FLOATING OR FIXED IN PDP) TO BE CONVERTED\r
223C THETA IS THE ANGLE THE CHARACTERS MAKE WITH THE X AXIS\r
224C\r
225C IF ND>0, IT SPECIFIES THE NUMBER OF DIGITS TO THE RIGHT OF THE DECIMAL\r
226C POINT THAT ARE TO BE CONVERTED AND PLOTTED, AFTER PROPER ROUNDING.\r
227C FOR EXAMBLE, ASSUME AN INTERNAL VALUE OF -0.1234567X10^3. IF\r
228C ND WERE 2, THE PLOTTED NUMBER WOULD BE '-123.46' .\r
229C\r
230C IF ND=0, ONLY THE INTEGER PORTION AND A DECIMAL POINT\r
231C ARE PLOTTED, AFTER ROUNDING.\r
232C\r
233C IF ND=-1, ONLY THE NUMBERS INTEGER PORTION IS PLOTTED, AFTER\r
234C ROUNDING. (THE NUMBER ABOVE WOULD BE PLOTTED AS '-123' W/O DECIMAL POINT\r
235C\r
236C IF ND<-1, ABS(ND)-1 DIGITS ARE TRUNCATED FROM THE INTEGER PORTION,\r
237C AFTER ROUNDING..\r
238C\r
239 COMMON/PLOTC/SCALE,IDEV,IPEN,XCUR,YCUR,SINA,COSA,SEG,ANG\r
240 DATA MAXN/9/\r
241 DATA SINA,COSA,ANG/0.,1.,0./\r
242C MOVE TO REQURSTED LOCATION\r
243 CALL PLOT(XP,YP,3)\r
244C IF THE ANGLE IS THE SAME, SAVE THE SIN-COSIN WORK\r
245 IF(THETA-ANG) 5, 6, 5\r
2465 ANG=THETA SINA=SIND(ANG)\r
247 COSA=COSD(ANG)\r
2486 SEG=HGT/6.\r
249 FPV = FPN\r
250 N = ND\r
251C SET N VALUE TO + OR - MAXN, IF OUT OF RANGE\r
252 IF (N - MAXN) 11, 11, 10\r
253 10 N = MAXN\r
254 11 IF (N + MAXN) 12, 20, 20\r
255 12 N = -MAXN\r
256C INSERT MINUS SIGN IN FRONT OF NUMBER, IF NEGATIVE\r
257 20 IF (FPV) 21, 30, 30\r
258 21 CALL CPLOT(45)\r
259C WHEN SYMBOL IS CALLED WITH SAMEV FOR X AND Y, THE CHARACTER STRING\r
260C CONTINUES FROM THE LAST CHARACTER PLOTTED BY SYMBOL\r
261C MN LOCATES EXPONENT VALUE FOR PROPER ROUNDING OF NUMBER\r
262 30 MN = -N\r
263C IF SCALING IS DONE, MN MUST BE ADJUSTED\r
264 IF (N) 31, 32, 32\r
265 31 MN = MN - 1\r
266C ROUND INPUT NUMBER AND SET TO POSITIVE VALUE\r
267 32 FPV = ABS(FPV) + (0.5 * 10. ** MN)\r
268C DETERMINE CHARACTERISTIC OF FPV AND INCREMENT IT BY 1\r
269 I = ALOG10(FPV) + 1.0\r
270 ILP = I\r
271C IF SCALING IS DONE, ILP MUST BE REDUCED ACCORDING TO SCALING\r
272 IF (N + 1) 40, 41, 41\r
273 40 ILP = ILP + N + 1\r
274C IF NUMBER IS LESS THAN 1 PLOT A ZERO BEFORE DECIMAL (IF ANY)\r
275 41 IF (ILP) 50, 50, 51\r
276 50 CALL CPLOT(48)\r
277 GO TO 61\r
278C ILP IS NUMBER OF DIGITS TO LEFT OF DECIMAL POINT\r
279 51 DO 60 J = 1, ILP\r
280C LOCATE SINGLE LEFTMOST DIGIT OF NUMBER\r
281 K = FPV * 10. ** (J - I)\r
282 CALL CPLOT(K+48)\r
283C SUBTRACT VALUE OF PREVIOUS DIGIT FROM NUMBER TO LOCATE NEXT DIGIT\r
284 60 FPV = FPV - (FLOAT(K) * 10. ** (I - J))\r
285C NO DECIMAL POINT IS PLOTTED IF N IS NEGATIVE, EXIT FROM ROUTINE\r
286 61 IF (N) 99, 70, 70\r
287 70 CALL CPLOT(46)\r
288C PLOT DIGITS TO RIGHT OF DECIMAL IF N GT 0, OTHERWISE EXIT\r
289 IF (N) 99, 99, 80\r
290 80 DO 90 J = 1, N\r
291C SCALE FRACTIONAL REMAINDER TO GIVE INTEGER DIGIT\r
292 K = FPV * 10.\r
293 CALL CPLOT(K+48)\r
294C SUBTRACT INTEGER VALUE TO LOCATE NEXT DIGIT\r
295 90 FPV = FPV * 10. - FLOAT(K)\r
296 99 RETURN\r
297 END\r
298\f SUBROUTINE AXIS(XPAGE,YPAGE,IBCD,NCHAR,AXLEN,ANGLE,FIRSTV,DELTAV)\r
299C..... XPAGE,YPAGE COORDINATES OF STARTING POINT OF AXIS, IN INCHES\r
300C..... IBCD AXIS TITLE.\r
301C..... NCHAR NUMBER OF CHARACTERS IN TITLE. + FOR C.C-W SIDE.\r
302C..... AXLEN FLOATING POINT AXIS LENGTH IN INCHES.\r
303C..... ANGLE ANGLE OF AXIS FROM THE X-DIRECTION, IN DEGREES.\r
304C..... FIRSTV SCALE VALUE AT THE FIRST TIC MARK.\r
305C..... DELTAV CHANGE IN SCALE BETWEEN TIC MARKS ONE INCH APART\r
306 DIMENSION IBCD(2)\r
307 KN=NCHAR\r
308 A=1.0\r
309 IF (KN) 1,2,2\r
310 1 A=-A\r
311 KN=-KN\r
312 2 EX=0.0\r
313 ADX= ABS (DELTAV)\r
314 IF (ADX) 3,7,3\r
315 3 IF (ADX- 99.0) 6,4,4\r
316 4 ADX=ADX/10.0\r
317 EX=EX+1.0\r
318 GO TO 3\r
319 5 ADX=ADX*10.0\r
320 EX=EX-1.0\r
321 6 IF (ADX-0.01) 5,7,7\r
322 7 XVAL=FIRSTV*10.0**(-EX)\r
323 ADX= DELTAV*10.0**(-EX)\r
324 STH=ANGLE*0.0174533\r
325 CTH=COS(STH STH=SIN(STH)\r
326 DXB=-0.1\r
327 DYB=0.15*A-0.05\r
328 XN=XPAGE+DXB*CTH-DYB*STH\r
329 YN=YPAGE+DYB*CTH+DXB*STH\r
330 NTIC=AXLEN+1.0\r
331 NT=NTIC/2\r
332 DO 20 I=1,NTIC\r
333 CALL NUMBER(XN,YN,0.105,XVAL,ANGLE,2)\r
334 XVAL=XVAL+ADX\r
335 XN=XN+CTH\r
336 YN=YN+STH\r
337 IF (NT) 20,11,20\r
338 11 Z=KN\r
339 IF (EX) 12,13,12\r
340 12 Z=Z+7.0\r
341 13 DXB=-.07*Z+AXLEN*0.5\r
342 DYB=0.325*A-0.075\r
343 XT=XPAGE+DXB*CTH-DYB*STH\r
344 YT=YPAGE+DYB*CTH+DXB*STH\r
345 CALL SYMBOL(XT,YT,0.14,IBCD(1),ANGLE,KN)\r
346 IF (EX) 14,20,14\r
347 14 Z=KN+2\r
348 XT=XT+Z*CTH*0.14\r
349 YT=YT+Z*STH*0.14\r
350 CALL SYMBOL(XT,YT,0.14,3H*10,ANGLE,3)\r
351 XT=XT+(3.0*CTH-0.8*STH)*0.14\r
352 YT=YT+(3.0*STH+0.8*CTH)*0.14\r
353 CALL NUMBER(XT,YT,0.07,EX,ANGLE,-1)\r
354 20 NT=NT-1\r
355 CALL PLOT(XPAGE+AXLEN*CTH,YPAGE+AXLEN*STH,3)\r
356 DXB=-0.07*A*STH\r
357 DYB=+0.07*A*CTH\r
358 A=NTIC-1\r
359 XN=XPAGE+A*CTH\r
360 YN=YPAGE+A*STH\r
361 DO 30 I=1,NTIC\r
362 CALL PLOT(XN,YN,2)\r
363 CALL PLOT(XN+DXB,YN+DYB,2)\r
364 CALL PLOT(XN,YN,2)\r
365 XN=XN-CTH\r
366 YN=YN-STH\r
367 30 CONTINUE\r
368 RETURN\r
369 END\r
370\fC\r
371C THIS ROUTINE PRODUCES A SYMBOL TABLE, WHICH SHOWS THE CHARACTERS\r
372C AVAILABLE IN THE SYMBOL ROUTINE.\r
373C\r
374C MAXCHR IS THE INTEGER EQUIVALENT OF THE LAST CHARACTER.\r
375 MAXCHR=63\r
376 CALL PLOT(0,0,3)\r
377 CALL PLOT (0.0,11.0,2)\r
378 CALL PLOT (8.5,11.0,2)\r
379 CALL PLOT (8.5,0.0,2)\r
380 CALL PLOT (0.0,0.0,2)\r
381 CALL SYMBOL(0.75,10.4,.14,49HCHARACTERS AVAILABLE IN SYMBOL ROUTIN\r
382 1E ( PDP 8E ),0.,49)\r
383 CALL PLOT(8.25,10.,3)\r
384 CALL PLOT(0.25,10.,2)\r
385 CALL PLOT(0.25,0.25,2)\r
386 CALL PLOT(8.25,0.25,2)\r
387 CALL PLOT(8.25,10.0,2)\r
388 X=0.5\r
389 K=0\r
390 DO 200 I=1,5\r
391 Y=9.4\r
392 DO 100 J=1,13\r
393 CALL NUMBER(X,Y+0.1,.14,FLOAT (K),0.0,-1)\r
394 4 CALL SYMBOL(X+0.45,Y,0.35,K,0.0,0)\r
395 10 IO1=K/8\r
396 IO2=K-IO1*8\r
397 CALL NUMBER(X+0.90,Y+0.1,0.14,FLOAT (IO1),0.0,-1)\r
398 CALL NUMBER(X+1.04,Y+0.1,0.14,FLOAT (IO2),0.0,-1)\r
399 GO TO 20\r
400 15 CALL SYMBOL(X+1.0,Y+0.1,.14,1H-,0.0,1)\r
401 20 K=K+1\r
402 Y=Y-.7307\r
403 IF(K-MAXCHR) 100,100,300\r
404 100 CONTINUE\r
405 CALL PLOT(X+1.35,0.25,3)\r
406 CALL PLOT(X+1.35,10.,2)\r
407 200 X=X+1.6\r
408300 CALL WAIT\r
409 END\r
410\f`x\1a\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0
My complete PDP-8 universe