Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-04 - 43,50353/lan16.bas
There is 1 other file named lan16.bas in the archive. Click here to see a list.
00010 '  LAN16
00020 '  DUANE MOORE    D I G I T A L
00030 '  READS THE FILE YPARAM.LAN AND THE PARAMETERS ARE PLOTTED
00040 '  ON THE TTY.  SCALES ARE LINEAR, NOT LOG.  SCALING
00050 '  IS AUTOMATIC.
00060 '
00070 FILES YPARAM.LAN,LAN.BAK
00080 SCRATCH #2
00090 PRINT "TYPE A '1' FOR AUTOMATIC SCALING";
00100 INPUT P
00110 PRINT
00120 FOR J0=1 TO 7 STEP 2
00130 IF END#1 GOTO 210
00140 INPUT #1,F
00150 FOR I=1 TO 8
00160 INPUT #1,Y(I)
00170 NEXT I
00180 LET T0=Y(J0+1)*3.141592654/180
00190 PRINT #2,Y(J0)*COS(T0),Y(J0)*SIN(T0)
00200 GOTO 130
00210 IF J0=1 GOTO 260
00220 IF J0=3 GOTO 280
00230 IF J0=5 GOTO 300
00240 LET D$="Y(2,2)"
00250 GOTO 310
00260 LET D$="Y(1,1)"
00270 GOTO 310
00280 LET D$="Y(1,2)"
00290 GOTO 310
00300 LET D$="Y(2,1)"
00310 RESTORE #2
00320 GOSUB 460
00330 RESTORE #2
00340 SCRATCH #2
00350 RESTORE #1
00360 NEXT J0
00370 PRINT "ANY SCALE CHANGES";
00380 INPUT Z9$
00390 IF Z9$="1" GOTO 430
00400 IF Z9$="Y" GOTO 430
00410 IF Z9$="YES" GOTO 430
00420 CHAIN LAN,200
00430 LET P=0
00440 RESTORE #1
00450 GOTO 120
00460 RESTORE #2
00470 ' COMPUTE MIN AND MAX OF ABCISSA AND ORDINATE DATA
00480 LET I=K=1E36
00490 LET H=J=1E-36
00500 IF END#2 GOTO 1770
00510 INPUT #2,A,D
00520 IF A>=I GOTO 540
00530 LET I=A
00540 IF A<=H GOTO 560
00550 LET H=A
00560 IF D>=K GOTO 580
00570 LET K=D
00580 IF D<=J GOTO 600
00590 LET J=D
00600 GOTO 500
00610 RESTORE #2
00620 IF P=1 GOTO 730
00630 PRINT "***"D$"***"
00640 PRINT "RE VALUES RANGE FROM "I"TO "H
00650 PRINT "IM VALUES RANGE FROM "K"TO "J
00660 PRINT "DO YOU WANT TO KEEP THESE LIMITS";
00670 INPUT Z9$
00680 IF Z9$="N" GOTO 710
00690 IF Z9$="NO" GOTO 710
00700 IF Z9$<>"0" GOTO 730
00710 PRINT "ENTER VALUES OF X(MIN),X(MAX),JY(MIN),JY(MAX)";
00720 INPUT I,H,K,J
00730 IF H<>I GOTO 750
00740 LET H=0
00750 IF H>I GOTO 790
00760 LET Z9=H
00770 LET H=I
00780 LET I=Z9
00790 IF J<>K GOTO 810
00800 LET J=0
00810 IF J>K GOTO 850
00820 LET Z9=J
00830 LET J=K
00840 LET K=Z9
00850 ' COMPUTE ORDINATE CURSOR
00860 LET Z1=INT(40*I/(I-H)+.5)
00870 ' COMPUTE ABSCISSA CURSOR
00880 LET Z2=INT(24*K/(K-J)+.5)
00890 DIM B(25,41)
00900 FOR I0=0 TO 25
00910 LET B(I0,0)=0
00920 LET B(0,I0)=0
00930 NEXT I0
00940 FOR I0=26 TO 41
00950 LET B(0,I0)=0
00960 NEXT I0
00970 MAT B=ZER
00980 ' ENTER ZERO-ONE DATA IN MATRIX B
00990 IF END #2 GOTO 1090
01000 INPUT #2,A,D
01010 LET N=INT(40*(A-I)/(H-I)+.5)
01020 LET M=24-INT(24*(D-K)/(J-K)+.5)
01030 IF M>25 GOTO 1080
01040 IF M<0 GOTO 1080
01050 IF N>41 GOTO 1080
01060 IF N<0 GOTO 1080
01070 LET B(M,N)=1
01080 GOTO 990
01090 RESTORE #2
01100 GOSUB 1730
01110 PRINT,,,"***"D$"***"
01120 PRINT
01130 ' COMPUTE ABSCISSA SCALE FACTOR
01140 IF(H-I)/40<.001 THEN 1180
01150 LET F=(H-I)/40
01160 LET W=1
01170 GOTO 1220
01180 LET F=25*(H-I)
01190 LET W=1E3
01200 PRINT TAB(29);"SCALE FACTOR X1000"
01210 PRINT
01220 PRINT " ",
01230 FOR Z=0 TO 40 STEP 10
01240 PRINT TAB(13+Z);.001*INT(1E3*(I*W+F*Z)+.5);
01250 NEXT Z
01260 PRINT " "
01270 PRINT " IM",
01280 GOSUB 1600
01290 PRINT "I ";
01300 PRINT "RE"
01310 ' PRINT COMPOSITE DATA
01320 FOR M=0 TO 24
01330 IF M=24-Z2 THEN 1400
01340 LET F=(J-K)/24
01350 IF F<.001 THEN 1380
01360 PRINT .001*INT(1E3*(J-M*F)+.5),
01370 GOTO 1410
01380 PRINT J-M*F,
01390 GOTO 1410
01400 PRINT .001*INT(1E3*(0)+.5),
01410 FOR N=0 TO 40
01420 IF B(M,N)=1 THEN 1470
01430 IF M=24-Z2 THEN 1490
01440 IF N=Z1  THEN 1510
01450 PRINT " ";
01460 GOTO 1520
01470 PRINT "*";
01480 GOTO 1520
01490 PRINT "-";
01500 GOTO 1520
01510 PRINT  ":";
01520 NEXT N
01530 PRINT " "
01540 NEXT M
01550  PRINT  TAB(14);
01560 GOSUB 1600
01570 PRINT "I"
01580 GOSUB 1730
01590 RETURN
01600 FOR Z=0 TO 35 STEP 5
01610 PRINT "I";
01620 FOR E=0 TO 3
01630 PRINT ".";
01640 NEXT E
01650 NEXT Z
01660 RETURN
01670 PRINT "ANY MORE SCALE CHANGES";
01680 INPUT Z9$
01690 IF Z9$="0" GOTO 1590
01700 IF Z9$="NO" GOTO 1590
01710 IF Z9$="N" GOTO 1590
01720 GOTO 710
01730 PRINT
01740 PRINT
01750 PRINT
01760 RETURN
01770 ' THIS SECTION ELIMINATES PROBLEMS CAUSED BY A CONSTANT
01780 ' AND ALSO ROUNDS TO 3 SIGNIFICANT DIGITS
01790 IF I<>H GOTO 1870
01800 IF I=0 GOTO 1840
01810 IF I>0 GOTO 1860
01820 LET H=0
01830 GOTO 1870
01840 LET H=1
01850 GOTO 1870
01860 LET I=0
01870 IF K<>J GOTO 1950
01880 IF K=0 GOTO 1920
01890 IF K>0 GOTO 1940
01900 LET J=0
01910 GOTO 1950
01920 LET J=1
01930 GOTO 1950
01940 LET K=0
01950 IF H=0 GOTO 1990
01960 LET M3=ABS(H)
01970 LET M1=10^(INT(LOG(M3)/LOG(10)))
01980 LET H=INT(100*H/M1+.5)*M1/100
01990 IF I=0 GOTO 2030
02000 LET M3=ABS(I)
02010 LET M1=10^(INT(LOG(M3)/LOG(10)))
02020 LET I=INT(100*I/M1+.5)*M1/100
02030 IF J=0 GOTO 2070
02040 LET M3=ABS(J)
02050 LET M1=10^(INT(LOG(M3)/LOG(10)))
02060 LET J=INT(100*J/M1+.5)*M1/100
02070 IF K=0 GOTO 2110
02080 LET M3=ABS(K)
02090 LET M1=10^(INT(LOG(M3)/LOG(10)))
02100 LET K=INT(100*K/M1+.5)*M1/100
02110 GOTO 610
02120 END