Trailing-Edge
-
PDP-10 Archives
-
decuslib20-03
-
decus/20-0087/lan10.bas
There is 1 other file named lan10.bas in the archive. Click here to see a list.
00010 ' LAN10
00020 ' DUANE MOORE D I G I T A L
00030 ' READS THE FILE YPARAM.LAN AND THE PARAMETERS ARE PLOTTED
00040 ' IN A FILE: XYPARM.LAN. SCALES ARE LINEAR, NOT LOG. SCALING
00050 ' IS AUTOMATIC.
00060 '
00070 PRINT "OUTPUT FILE: XYPARM.LAN"
00080 PRINT
00090 FILES YPARAM.LAN,LAN.BAK,XYPARM.LAN
00100 MARGIN #3,110
00110 SCRATCH #2,#3
00120 PRINT "TYPE A '1' FOR AUTOMATIC SCALING";
00130 INPUT P
00140 PRINT
00150 FOR J0=1 TO 7 STEP 2
00160 IF END#1 GOTO 240
00170 INPUT #1,F
00180 FOR I=1 TO 8
00190 INPUT #1,Y(I)
00200 NEXT I
00210 LET T0=Y(J0+1)*3.141592654/180
00220 PRINT #2,Y(J0)*COS(T0),Y(J0)*SIN(T0)
00230 GOTO 160
00240 IF J0=1 GOTO 290
00250 IF J0=3 GOTO 310
00260 IF J0=5 GOTO 330
00270 LET D$="Y(2,2)"
00280 GOTO 340
00290 LET D$="Y(1,1)"
00300 GOTO 340
00310 LET D$="Y(2,1)"
00320 GOTO 340
00330 LET D$="Y(2,2)"
00340 RESTORE #2
00350 GOSUB 490
00360 RESTORE #2
00370 SCRATCH #2
00380 RESTORE #1
00390 NEXT J0
00400 PRINT "ANY SCALE CHANGES";
00410 INPUT Z9$
00420 IF Z9$="1" GOTO 460
00430 IF Z9$="Y" GOTO 460
00440 IF Z9$="YES" GOTO 460
00450 CHAIN LAN,200
00460 LET P=0
00470 RESTORE #1
00480 GOTO 150
00490 RESTORE #2
00500 ' COMPUTE MIN AND MAX OF ABCISSA AND ORDINATE DATA
00510 LET I=K=1E36
00520 LET H=J=1E-36
00530 IF END#2 GOTO 1760
00540 INPUT #2,A,D
00550 IF A>=I GOTO 570
00560 LET I=A
00570 IF A<=H GOTO 590
00580 LET H=A
00590 IF D>=K GOTO 610
00600 LET K=D
00610 IF D<=J GOTO 630
00620 LET J=D
00630 GOTO 530
00640 RESTORE #2
00650 IF P=1 GOTO 760
00660 PRINT "***"D$"***"
00670 PRINT "RE VALUES RANGE FROM "I"TO "H
00680 PRINT "IM VALUES RANGE FROM "K"TO "J
00690 PRINT "DO YOU WANT TO KEEP THESE LIMITS";
00700 INPUT Z9$
00710 IF Z9$="N" GOTO 740
00720 IF Z9$="NO" GOTO 740
00730 IF Z9$<>"0" GOTO 760
00740 PRINT "ENTER VALUES OF X(MIN),X(MAX),JY(MIN),JY(MAX)";
00750 INPUT I,H,K,J
00760 IF H<>I GOTO 780
00770 LET H=0
00780 IF H>I GOTO 820
00790 LET Z9=H
00800 LET H=I
00810 LET I=Z9
00820 IF J<>K GOTO 840
00830 LET J=0
00840 IF J>K GOTO 880
00850 LET Z9=J
00860 LET J=K
00870 LET K=Z9
00880 ' COMPUTE ORDINATE CURSOR
00890 LET Z1=INT(40*I/(I-H)+.5)
00900 ' COMPUTE ABSCISSA CURSOR
00910 LET Z2=INT(24*K/(K-J)+.5)
00920 DIM B(25,41)
00930 FOR I0=0 TO 25
00940 LET B(I0,0)=0
00950 LET B(0,I0)=0
00960 NEXT I0
00970 FOR I0=26 TO 41
00980 LET B(0,I0)=0
00990 NEXT I0
01000 MAT B=ZER
01010 ' ENTER ZERO-ONE DATA IN MATRIX B
01020 IF END #2 GOTO 1120
01030 INPUT #2,A,D
01040 LET N=INT(40*(A-I)/(H-I)+.5)
01050 LET M=24-INT(24*(D-K)/(J-K)+.5)
01060 IF M>25 GOTO 1110
01070 IF M<0 GOTO 1110
01080 IF N>41 GOTO 1110
01090 IF N<0 GOTO 1110
01100 LET B(M,N)=1
01110 GOTO 1020
01120 RESTORE #2
01130 PRINT#3,<PA>
01140 PRINT#3 TAB(27) "***"D$"***"
01150 PRINT#3,
01160 ' COMPUTE ABSCISSA SCALE FACTOR
01170 IF(H-I)/40<.001 THEN 1210
01180 LET F=(H-I)/40
01190 LET W=1
01200 GOTO 1250
01210 LET F=25*(H-I)
01220 LET W=1E3
01230 PRINT#3, TAB(29);"SCALE FACTOR X1000"
01240 PRINT#3,
01250 PRINT #3," ",
01260 FOR Z=0 TO 40 STEP 10
01270 PRINT#3, TAB(13+Z);.001*INT(1E3*(I*W+F*Z)+.5);
01280 NEXT Z
01290 PRINT#3, " "
01300 PRINT#3, " IM",
01310 GOSUB 1630
01320 PRINT#3, "I ";
01330 PRINT#3, "RE"
01340 ' PRINT COMPOSITE DATA
01350 FOR M=0 TO 24
01360 IF M=24-Z2 THEN 1430
01370 LET F=(J-K)/24
01380 IF F<.001 THEN 1410
01390 PRINT#3, .001*INT(1E3*(J-M*F)+.5),
01400 GOTO 1440
01410 PRINT#3, J-M*F,
01420 GOTO 1440
01430 PRINT #3,0,
01440 FOR N=0 TO 40
01450 IF B(M,N)=1 THEN 1500
01460 IF M=24-Z2 THEN 1520
01470 IF N=Z1 THEN 1540
01480 PRINT#3, " ";
01490 GOTO 1550
01500 PRINT#3, "*";
01510 GOTO 1550
01520 PRINT#3, "-";
01530 GOTO 1550
01540 PRINT #3, ":";
01550 NEXT N
01560 PRINT#3, " "
01570 NEXT M
01580 PRINT #3 TAB(14);
01590 GOSUB 1630
01600 PRINT #3,"I"
01610 PRINT #3,<PA>
01620 RETURN
01630 FOR Z=0 TO 35 STEP 5
01640 PRINT#3, "I";
01650 FOR E=0 TO 3
01660 PRINT#3, ".";
01670 NEXT E
01680 NEXT Z
01690 RETURN
01700 PRINT "ANY MORE SCALE CHANGES";
01710 INPUT Z9$
01720 IF Z9$="0" GOTO 1620
01730 IF Z9$="NO" GOTO 1620
01740 IF Z9$="N" GOTO 1620
01750 GOTO 740
01760 ' THIS SECTION ELIMINATES PROBLEMS CAUSED BY A CONSTANT
01770 ' AND ALSO ROUNDS TO 3 SIGNIFICANT DIGITS
01780 IF I<>H GOTO 1860
01790 IF I=0 GOTO 1830
01800 IF I>0 GOTO 1850
01810 LET H=0
01820 GOTO 1860
01830 LET H=1
01840 GOTO 1860
01850 LET I=0
01860 IF K<>J GOTO 1940
01870 IF K=0 GOTO 1910
01880 IF K>0 GOTO 1930
01890 LET J=0
01900 GOTO 1940
01910 LET J=1
01920 GOTO 1940
01930 LET K=0
01940 IF H=0 GOTO 1980
01950 LET M3=ABS(H)
01960 LET M1=10^(INT(LOG(M3)/LOG(10)))
01970 LET H=INT(100*H/M1+.5)*M1/100
01980 IF I=0 GOTO 2020
01990 LET M3=ABS(I)
02000 LET M1=10^(INT(LOG(M3)/LOG(10)))
02010 LET I=INT(100*I/M1+.5)*M1/100
02020 IF J=0 GOTO 2060
02030 LET M3=ABS(J)
02040 LET M1=10^(INT(LOG(M3)/LOG(10)))
02050 LET J=INT(100*J/M1+.5)*M1/100
02060 IF K=0 GOTO 2100
02070 LET M3=ABS(K)
02080 LET M1=10^(INT(LOG(M3)/LOG(10)))
02090 LET K=INT(100*K/M1+.5)*M1/100
02100 GOTO 640
02110 END