Bottom
Previous
Contents
5 Complete Listings
5.1 Level Three Programs
0 REM Graphs and Charts Pack
1 REM Copyright (C) Acornsoft 1982
10 : REM L3-BAR
20 £M%=5 : W=.7:off=.1
40 ON ERROR GOTO 700
90 MODE4:VDU19 128,4,0,0,0
100 K%=0:REPEAT PROCh(1)
110 £M%=FNp(K%,4,"Mode for chart",£M%)
120 PROC£INIT(£M%):£XL=0:£YL=0
130 PROCc(6)
140 K%=1:UNTIL FNe
150 REM
160 CLS:K%=0:REPEAT PROCh(2)
170 PRINT TAB(2,4) "Horizontal axis:"
180 £XL=FNp(K%,5,"Left end",£XL)
190 £XH=FNp(K%,6,"Right end",£XH)
200 PRINT TAB(2,8) "Vertical axis:"
210 £YL=FNp(K%,9,"Low end",£YL)
220 £YH=FNp(K%,10,"High end",£YH)
230 off=FNp(K%,12,"Offset",off)
240 W=FNp(K%,13,"Bar width",W)
250 K%=1:UNTIL FNe
260 REM
300 PROCh(3)
310 PRINT TAB(2,4)"READY TO DRAW CHART"
320 PRINT TAB(2,6)"After axes drawn, use keys:"
330 PRINT TAB(2,8)"SPACE: next X,Y"
340 PRINT" C : colour "
342 PRINT" L : change logical colours"
350 PRINT" B : bar base"
360 PRINT" O : offset"
370 PRINT" W : width"
375 PRINT" T : title"
378 PRINT" ? : list of prompt keys"
380 PRINTTAB(2,29)"press";:GOSUB 1270
390 A$=GET$:IF NOT(A$=" ")THEN380
400 REM
500 X=£CH%MOD1E3:£YB%=3*X:£YS%=1023-4*X
510 REM
520 MODE £M%
530 PROC£AXES(0):PROC£co(£XC%,2)
540 YB=£SYO
550 PRINTTAB(0,29)SPC(1280DIV(£CH%MOD1E3))TAB(0,29);
560 A$=GET$
570 IF A$=" "THENINPUT"X,Y " ,X,Y : PROC£BAR(0,X+off,YB,Y,W)
580 IF A$="C"THENINPUT"Colour ",X:GCOL0,X
582 IF A$="L"THENINPUT"logical , actual col " ,A%,B%:
VDU19 A%,B%,0,0,0
590 IF A$="O"THENINPUT"Offset " ,off
600 IF A$="W"THENINPUT"Bar width ",W
610 IF A$="B"THENINPUT"Bar base ",YE
620 IF A$="T"THENINPUT"Title,X,Y",A$,X,Y:PROC£MOVE
(X,Y):VDU5:PRINTA$:VDU4
630 IF A$="?"THENPRINT"SPACE,C,L,O,W,B,T":A$=INKEY$(500)
640 GOTO 550
690 REM error branch
700 MODE7:IF ERR=17 THEN900ELSESTOP
900 PRINTTAB(0,10)"Stop or repeat? (S/R)";
910 A$=GET$
920 IF A$="S" THENPRINT:END
930 IF A$="R" THEN 90
940 GOTO910
950 REM
1000 DEF FNp(M%,L%,P$,V):LOCAL P%,V$
1010 PRINT TAB(2,L%);P$;" =";V;
1020 IF M%>0 THEN PRINT" ? ";:P%=POS
1030 PRINT SPC(39-P%);:IF M%=0 THEN =V
1040 INPUT TAB(P%,L%) V$
1050 IF LEN(V$)>0 THEN V=VAL(V$) ELSE M%=0
1060 GOTO1010
1100 DEF PROCh(N%):CLS
1120 PRINT TAB(2,2);"BAR CHART UTILITY";SPC(5); "PAGE ";N%
1130 ENDPROC
1200 DEF FNe:LOCAL A$
1210 PRINT TAB(0,29)"Type C to change data,";:GOSUB 1270
1220 A$=GET$
1230 IF A$=" " THEN =TRUE
1240 IF A$="C" THEN =FALSE
1250 GOTO 1220
1260 REM
1270 PRINT" SPACE to continue":RETURN
1300 DEF PROCc(L%)
1302 PRINTTAB(2,L%)"Logical colours for:"
1304 IF FN£pr(£XC%,6)=0 THEN A%=1:B%=1:C%=1:GOTOl330
1310 A%=FN£pr(£XC%,4):B%=FN£pr(£XC%,2)
1320 C%=FN£pr(£XC%,0)
1330 A%=FNp(K%,L%+2,"axes ",A%)
1340 B%=FNp(K%,L%+3,"pips ",B%)
1350 C%=FNp(K%,L%+4,"labels",C%)
1360 £XC%=((100+A%)*100+B%)*100+C%
1370 PRINTTAB(2,L%+6)"Actual colours may be changed later."
1380 ENDPROC
10040 REM
10050 REM Initialisation
10060 DEF PROC£INIT(M%): £M%=M%
10070 £XL=-10:£XH=10:£YL=-10:£YH=10:£ZL=-10:£ZH=10
10080 £XO=0:£YO=0:£ZO=0:£XI%=7:£YI%=7:£ZI%=7
10090 £XN%=1: £YN%=1: £SN%=1
10100 IF M%=2 OR M%=5 THEN £CH%=64 ELSE £CH%=32
10110 £YB%=0:£YS%=1023:£XB%=3*£CH%:£XS%=1279-£XB%
10120 £VM%=64064:£HM%=2*(1000*£CH%+£CH%):£CH%=1000*£CH%+32
10130 £XP%=484040225:£YP%=504040225:£ZP%=540040225
10140 IF M%=1 OR M%=2 OR M%=5 THEN £XC%=1010203 ELSE £XC%=0
10150 £YC%=0:£ZC%=0
10160 £TH=1.3:£PH=-1.3
10170 ENDPROC
10180 REM
10190 REM Interval chooser
10200 DEF FN£I(N%,LO,HI):LOCAL A,B,C
10210 IF0>=N%THENPROC£er("Bad no. of intervals")
10220 C=(HI-LO)/N%:IF0>=C THENPROC£er("Bad axis range")
10230 C=FNmax(C,FNmax(ABS(LO),ABS(HI))/1E6)
10240 REM normalise interval size ^10
10250 A=10^INT(LOG(C)):B=C/A
10260 REM select nearest round interval
10270 IFB>7.1THENB=10ELSEIFB>3.2THENB=5ELSEIFB>1.4 THENB=2ELSEB=1
10280 =A*B
10290 REM
10300 REM calc secondary origin, lo, hi
10310 DEF PROC£ax(O,LO,HI,I)
10320 REM if axes wld cross out range,
10330 REM set sec pars so cross at lo,
10340 REM and ensure orig at integer*intvl
10350 IF LO-I/2>=O OR O>=HI THEN O=INT(LO/I-.1)*I:LO=O
10360 REM anyway make ends at intg*intvl
10370 LO=O+I*INT((LO-O)/I+.1)
10380 HI=O-I*INT((O-HI)/I+.1)
10390 REM return value in £0,£1,£2
10400 £0=O:£1=LO:£2=HI:ENDPROC
10410 REM
10420 REM set up sector
10430 DEF PROC£se:LOCAL S%
10440 S%=(£SN%-1)MOD(£XN%*£YN%)
10450 £SXS%=£XS% DIV £XN%: £SYS%=£YS% DIV £YN%
10460 £SXB%=£XB%+S%MOD£XN%*£SXS%
10470 £SYB%=£YB%+S%DIV£XN%*£SYS%:ENDPROC
10480 REM
10490 DEF FN£fa(S%,M%,HI,LO):£0=HI-LO:=(S%-(M%MOD1000)
-(M%DIV1000))/£0
10500 REM
10510 DEF FN£pp(L,M%)
10520 £0=FN£pr(M%,0)*L/100
10530 ON 1+(FN£pr(M%,2) MOD 3) GOTO 10540,10550,10560
10540 =0.
10550 =-£0
10560 =-£0/2
10570 REM
10580 REM Extract colour
10590 DEF PROC£co(C%,N%):IF FN£pr(C%,6)>0 THEN GCOL 0,FN£pr(C%,N%)
10600 ENDPROC
10610 REM
10620 REM scale or unscale labels
10630 DEF FN£su(lo,hi,I,f%):LOCAL i%,j%,c%,d%,s%,p%
10640 i%=INT(LOG(I)+.01):j%=INT(LOG(FNmax(ABS(lo),ABS(hi)))+.01)
10650 REM digits needed c% before, d% after
10660 IF j%>0 THEN c%=j%+1:ELSE c%=1
10670 IF NOT i%<0 THEN d%=0:p%=0: ELSE d%=-i%:p%=1
10680 REM is sign needed
10690 IF lo<0 OR hi<0 THEN s%=1 ELSEs%=0
10700 REM decide scaled/unscaled
10710 IF NOT(f%<p%+s%+c%+d%) THEN £0=0 ELSE d%=0:
p%=0:£0=FNmin(-i%,f%-j%-s%-1)
10720 REM format; geN if integer el fix
10730 IF d%=0 THEN i%=&10000+f% ELSE i%=&10200+d%
10740 =f%+&100*i%
10750 REM
10760 DEF FNmax(a,b):IFb>a THEN=b ELSE=a
10770 DEF FNmin(a,b):IFb<a THEN=b ELSE=a
10780 DEF FN£pr(n%,d%)=(n%DIV(10^d%))MOD100
10790 DEF PROC£er(a$):PRINT "Graphics package error"
10800 PRINT a$:STOP:ENDPROC
10810 REM
12000 REM ----- TWO DIM ROUTINES -----
12010 DEF PROC£MOVE(X,Y):PLOT 4,FN£x(X),FN£y(Y):ENDPROC
12020 DEF PROC£DRAW(X,Y):PLOT 5,FN£x(X) ,FN£y(Y):ENDPROC
12030 DEF PROC£PLOT(K%,X,Y):LOCAL x,y
12040 IF K%MOD8<4 THEN x=£XFA*X:y=£YFA*Y:£XSC%=£XSC%+x:£YSC%=£YSC%+y:ELSE x=FN£x(X):y=FN£y(Y)
12050 PLOT K%,x,y:ENDPROC
12060 DEF FN£POINT(X,Y)=POINT FN£x(X),FN£y(Y)
12070 DEF FN£x(X):£XSC%=£XCR%+£XFA*(X-£SXO):=£XSC%
12080 DEF FN£y(Y):£YSC%=£YCR%+£YFA*(Y-£SYO):=£YSC%
12090 REM two dim scales & axes
12100 DEF PROC£AXES(M%):LOCAL A,B,f%,d%,a%,l%,w%,L$,y%
12110 IF M%=1 THEN GOSUB 12140 ELSE IF M%=2 THEN GOSUB 12300 ELSE IF M%=3 THEN GOSUB 12400 ELSE GOSUB 12140:GOSUB 12300:GOSUB 12400
12120 ENDPROC
12130 REM set intervals & ends
12140 £SXI=FN£I(£XI%,£XL,£XH):£SYI=FN£I(£YI%,£YL,£YH)
12150 PROC£ax(£XO,£XL,£XH,£SXI):£SXO=£0:£SXL=£1:£SXH=£2
12160 PROC£ax(£YO,£YL,£YH,£SYI):£SYO=£0:£SYL=£1:£SYH=£2
12170 REM set sector
12180 PROC£se
12190 REM scale factors, allow margins
12200 £XFA=FN£fa(£SXS%,£HM%,£SXH,£SXL):A=£0*£XFA
12210 £YFA=FN£fa(£SYS%,£VM%,£SYH,£SYL):B=£0*£YFA
12220 REM equalise if within 30%
12230 £0=ABS((£XFA-£YFA)/(£XFA+£YFA))
12240 IF ABS((£XFA-£YFA)/(£XFA+£YFA))<.15 THEN £XFA=FNmin(£XFA,£YFA):£YFA=£XFA
12250 REM position the axes cross
12260 £XCR%=£SXB%+(£HM% DIV 1000)+£XFA*(£SXO-£SXL)+(A-£XFA*(£SXH-£SXL))/2
12270 £YCR%=£SYB%+(£VM%DIV1000)+£YFA*(£SYO-£SYL)+(B-£YFA*(£SYH-£SYL))/2
12280 RETURN
12290 REM draw & mark off axes
12300 PROC£co(£XC%,4):PROC£MOVE(£SXL, £SYO):PROC£DRAW(£SXH,£SYO)
12310 PROC£co(£YC%,4):PROC£MOVE(£SXO,£SYL):PROC£DRAW(£SXO,£SYH)
12320 B=FN£pp(£SYI,£XP%):PROC£co(£XC%,2)
12330 FOR A=£SXL TO £SXH+£SXI/2 STEP £SXI
12340 PROC£MOVE(A,£SYO+B):PROC£DRAW(A, £SYO+B+£0):NEXT
12350 A=FN£pp(£SXI,£YP%):PROC£co(£YC%,2)
12360 FOR B=£SYL TO £SYH+£SYI/2 STEP £SYI
12370 PROC£MOVE(£SXO+A,B):PROC£PLOT(1,£0,0):NEXT
12380 RETURN
12390 REM label axes
12400 f%=FN£pr(£XP%,4):w%=£CH%DIV1E3
12410 REM decide scaled or unscaled
12420 a%=@%:@%=FN£su(£SXL,£SXH,£SXI,f%)
12430 REM decide if OK to label all pts
12440 IF£XFA*£SXI>(1+f%)*w%ANDNOT(£M%=2OR£M%=5)THEN l%=TRUE ELSEl%=FALSE
12450 REM now label
12460 VDU 5:PROC£co(£XC%,0):A=£SXH
12470 IF£0<>0THENL$="E"+STR$(-£0)ELSEL$=""
12480 d%=£SXB%+£SXS%:y%=FN£y(£SYO)+(£XP%DIV1E6)-500
12490 REPEATIFABS(A)<£SXI/2THENA=0
12500 L$=STR$(A*10^£0)+L$:B=LEN(L$)*w%
12510 d%=FNmin(FN£x(A)-B/2,d%-B-w%DIV2)
12520 PLOT4,d%,y%:PRINTL$:L$=""
12530 IFl%THENA=A-£SXI ELSEA=£SXL:l%=TRUE
12540 UNTILA<£SXL-£SXI/2
12550 REM now label Y-axis
12560 f%=FN£pr(£YP%,4):y%=£CH%MOD1E3:d%=y%+£YP%DIV1E6-500
12570 @%=FN£su(£SYL,£SYH,£SYI,f%)
12580 IF£YFA*£SYI>2*y%ANDNOT(£M%=2OR£M%=5)THENl%=lELSEl%=0
12590 PROC£co(£YC%,0):B=£SYL
12600 REPEAT PROC£MOVE(£SXO,B)
12610 IF ABS(B)<£SYI/2 THEN B=0
12620 REMIFB>£SYH-£SYI/2THENl%=2:d%=y%+( £YP%DIV1E6)-500
12630 PLOT0,-w%DIV2,d%:FORA=1TOf%:VDU8:NEXT:PRINTB*10^£0;
12640 IFl%=1THENB=B+£SYI ELSE B=£SYH:l%=1
12650 UNTILB>£SYH +£SYI/2
12660 IF £0<>0 THEN PRINT"E";-£0
12670 VDU 4:@%=a%:RETURN
15050 REM ----- Histogram bar ----
15060 DEF PROC£BAR(K%,X,Y0,Y ,W):LOCAL x,y0
15070 REM K%=0 left of bar at X
15080 REM K%=l bar centered on X
15090 REM YO is base, Y is top, W width
15100 REM all in user units.
15110 IF ABS(Y0-Y)*£YFA<5 THEN ENDPROC
15120 IF Y0=£SYO THEN y0=Y0+SGN(Y-Y0)*10/£YFA ELSE y0=Y0
15130 IF K%=0 THEN x=X ELSE x=X-W/2
15140 PROC£PLOT(84,x,Y):PROC£PLOT(84,x,y0)
15150 PROC£PLOT(85,x+W,Y):PROC£PLOT( 85,x+W,y0)
15160 ENDPROC
15170 REM
0 REM Graphs and Charts Pack
1 REM Copyright (C) Acornsoft 1982
10 :REM L3-GRA
20 £M%=5:F$="0"
40 ON ERROR GOTO700
90 MODE4:VDU19 128,4,0,0,0
100 K%=0:REPEAT PROCh(1)
110 £M%=FNp(K%,4,"Mode for graph",£M%)
120 PROC£INIT(£M%)
130 PROCC(6)
140 K%=1:UNTIL FNe
150 REM
160 CLS:K%=0:REPEAT PROCh(2)
170 PRINT TAB(2,4)"Horizontal axis:"
180 £XL=FNp(K%,5,"Left end ",£XL)
190 £XH=FNp(K%,6,"Right end",£XH)
200 PRINT TAB(2,8)"Vertical axis:"
210 £YL=FNp(K%,9,"Low end",£YL)
220 £YH=FNp(K%,10,"High end",£YH)
250 K%=1:UNTIL FNe
260 REM
300 PROCh(3)
310 PRINT TAB(2,4)"READY TO PLOT GRAPH"
320 PRINT TAB(2,6)"After axes drawn,use keys:"
330 PRINT TAB(2,8)"M: move to X,Y"
332 PRINT" D: draw to X,Y"
340 PRINT" C: colour"
342 PRINT" L: change logical colours"
350 PRINT" F: input function(X)"
360 PRINT" P: range to plot,no. of points"
370 PRINT" U: display function at X,Y"
375 PRINT" T: title"
378 PRINT" ?: list of prompt keys"
380 PRINTTAB(2,29)"press";:GOSUB 1270
390 A$=GET$:IF NOT(A$=" ")THEN380
400 REM
500 X=£CH%MOD1E3:£YB%=3 *X:£YS%=1023-4*X
510 REM
520 MODE £M%
530 PROC£AXES(0):PROC£co(£XC%,2)
550 PRINTTAB(0,29)SPC(1280DIV(£CH%MOD1E3))TAB(0,29);
560 A$=GET$
570 IF A$="M"THENINPUT"Move to X,Y ",X,Y:PROC£MOVE(X,Y)
572 IF A$="D"THENINPUT"Draw to X,Y ",X,Y:PROC£DRAW(X,Y)
580 IF A$="C"THENINPUT"Colour ",X:GCOL0,X
582 IF A$="L"THENINPUT"logical,actual col",A%,B%:VDU19 A%,B%,0,0,0
590 IF A$="F"THENINPUT "Function",F$
600 IF A$="P"THENINPUT"X1,X2,N",X1,X2,N%:PROCplot
610 IF A$="U"THENINPUT"function at X,Y",X,Y:PROC£MOVE(X,Y):VDU5:PRINTF$:VDU4
620 IF A$="T"THENINPUT"Ti tle,X,Y",A$,X,Y:PROC£MOVE(X,Y):VDU5:PRINTA$:VDU4
630 IF A$="?"THENPRINT"M,D,C,L,T,F,P,U":X=INKEY(500)
640 GOTO 550
690 REM error branch
700 MODE7:IF ERR=17 THEN 900
710 REPORT
900 PRINTTAB(0,10)"Stop or repeat?(S/R)";
910 A$=GET$
920 IF A$="S" THENPRINT:END
930 IF A$="R " THEN 90
940 GOTO 910
950 REM
1000 DEF FNp(M%,L%,P$,V):LOCAL P%,V$
1010 PRINT TAB(2,L%);P$;" =";V;
1020 IF M%>0 THEN PRINT" ? ";:P%=POS
1030 PRINT SPC(39-P%);:IF M%=0 THEN =V
1040 INPUT TAB(P%,L%)V$
1050 IF LEN(V$)>0 THEN V=VAL(V$)ELSE M%=0
1060 GOTO1010
1100 DEF PROCh(N%):CLS
1120 PRINT TAB(2,2);"GRAPH PLOTTING UTILITY";SPC(5);"PAGE ";N%
1130 ENDPROC
1200 DEF FNe:LOCAL A$
1210 PRINT TAB(0,29)"Type C to change data,";:GOSUB1270
1220 A$=GET$
1230 IF A$=" " THEN =TRUE
1240 IF A$="C" THEN =FALSE
1250 GOTO 1220
1260 REM
1270 PRINT" SPACE to continue":RETURN
1300 DEF PROCC(L%)
1302 PRINTTAB(2,L%)"Logical colours for:"
1304 IF FN£pr(£XC%,6)=0 THEN A%=1:B%=1:C%=1:GOTOl330
1310 A%=FN£pr(£XC%,4):B%=FN£pr(£XC%,2)
1320 C%=FN£pr(£XC%,0)
1330 A%=FNp(K%,L%+2,"axes ",A%)
1340 B%=FNp(K%,L%+3,"pips ",B%)
1350 C%=FNp(K%,L%+4,"labels",C%)
1360 £XC%=((100+A%)*100+B%)*100+C%
1370 PRINTTAB(2,L%+6)"Actual colours may be changed later."
1380 ENDPROC
2000 DEF PROCplot:LOCAL D
2005 D=(X2-X1)/N%:X=X1
2010 PROC£MOVE(X1,EVAL(F$))
2020 FOR X=X1 TO X2+D/2 STEP D
2030 PROC£DRAW(X,EVAL(F$)):NEXT
2040 ENDPROC
10040 REM
10050 REM Initialisation
10060 DEF PROC£INIT(M%):£M%=M%
10070 £XL=-10:£XH=10:£YL=-10:£YH=10:£ZL=-10:£ZH=10
10080 £XO=0:£YO=0:£ZO=0:£XI%=7:£YI%=7:£ZI%=7
10090 £XN%=1:£YN%=1:£SN%=1
10100 IF M%=2 OR M%=5 THEN £CH%=64 ELSE £CH%=32
10110 £YB%=0:£YS%=1023:£XB%=3*£CH%:£XS%=1279-£XB%
10120 £VM%=64064:£HM%=2*(1000*£CH%+£CH%):£CH%=1000*£CH%+32
10130 £XP%=484040225:£YP%=504040225:£ZP%=540040225
10140 IF M%=1 OR M%=2 OR M%=5 THEN £XC%=1010203 ELSE £XC%=0
10150 £YC%=0:£ZC%=0
10160 £TH=1.3:£PH=-1.3
10170 ENDPROC
10180 REM
10190 REM Interval chooser
10200 DEF FN£I(N%,LO,HI):LOCAL A,B,C
10210 IF0>=N%THENPROC£er("Bad no. of intervals")
10220 C=(HI-LO)/N%:IF0>=C THENPROC£er("Bad axis range")
10230 C=FNmax(C,FNmax(ABS(LO),ABS(HI))/1E6)
10240 REM normalise interval size ^10
10250 A=10^INT(LOG(C)):B=C/A
10260 REM select nearest round interval
10270 IFB>7.1THENB=10ELSEIFB>3.2THENB=5ELSEIFB>1.4 THENB=2ELSEB=1
10280 =A*B
10290 REM
10300 REM calc secondary origin,lo,hi
10310 DEF PROC£ax(O,LO,HI,I)
10320 REM if axes wld cross out range,
10330 REM set sec pars so cross at lo,
10340 REM and ensure orig at integer*intvl
10350 IF LO-I/2>=O OR O>=HI THEN O=INT(LO/I-.1)*I:LO=O
10360 REM anyway make ends at intg*intvl
10370 LO=O+I*INT((LO-O)/I+.1)
10380 HI=O-I*INT((O-HI)/I+.1)
10390 REM return value in £0,£1,£2
10400 £0=O:£1=LO:£2=HI:ENDPROC
10410 REM
10420 REM set up sector
10430 DEF PROC£se:LOCAL S%
10440 S%=(£SN%-1)MOD(£XN%*£YN%)
10450 £SXS%=£XS% DIV £XN%:£SYS%=£YS% DIV £YN%
10460 £SXB%=£XB%+S%MOD£XN%*£SXS%
10470 £SYB%=£YB%+S%DIV£XN%*£SYS%:ENDPROC
10480 REM
10490 DEF FN£fa(S%,M%,HI,LO):£0=HI-LO:=(S%-(M%MOD1000)-(M%DIV1000))/£0
10500 REM
10510 DEF FN£pp(L,M%)
10520 £0=FN£pr(M%,0)*L/100
10530 ON 1+(FN£pr(M%,2)MOD 3)GOTO 10540,10550,10560
10540 =0.
10550 =-£0
10560 =-£0/2
10570 REM
10580 REM Extract colour
10590 DEF PROC£co(C%,N%):IF FN£pr(C%,6)>0 THEN GCOL 0,FN£pr(C%,N%)
10600 ENDPROC
10610 REM
10620 REM scale or unscale labels
10630 DEF FN£su(lo,hi,I,£%):LOCAL i%,j%,c%,d%,s%,p%
10640 i%=INT(LOG(I)+.01):j%=INT(LOG(FNmax(ABS(lo),ABS(hi)))+.01)
10650 REM digits needed c% before,d% after
10660 IF j%>0 THEN c%=j%+1:ELSE c%=1
10670 IF NOT i%<0 THEN d%=0:p%=0:ELSE d%=-i%:p%=1
10680 REM is sign needed
10690 IF lo<0 OR hi <0 THEN s%=1 ELSEs%=0
10700 REM decide scaled/unscaled
10710 IF NOT(f%<p%+s%+c%+d%)THEN £0=0 ELSE d%=0:p%=0:£0=FNmin(-i %,f%-j%-s%-1)
10720 REM format; gen if integer el fix
10730 IF d%=0 THEN i%=&10000+f% ELSE i%=&10200+d%
10740 =f%+&100*i%
10750 REM '
10760 DEF FNmax(a,b):IFb>a THEN=b ELSE=a
10770 DEF FNmin(a,b):IFb<a THEN=b ELSE=a
10780 DEF FN£pr(n%,d%)=(n%DIV(10^d%))MOD100
10790 DEF PROC£er(a$):PRINT "Graphics package error"
10800 PRINT a$:STOP:ENDPROC
10810 REM
12000 REM ------ TWO DIM ROUTINES ------
12010 DEF PROC£MOVE(X,Y):PLOT 4,FN£x(X),FN£y(Y):ENDPROC
12020 DEF PROC£DRAW(X,Y):PLOT 5,FN£x(X),FN£y(Y):ENDPROC
12030 DEF PROC£PLOT(K%,X,Y):LOCAL x,y
12040 IF K%MOD8<4 THEN x=£XFA*X:y=£YFA*Y:£XSC%=£XSC%+x:£YSC%=£YSC%+y:ELSE x=FN£x(X):y=FN£y(Y)
12050 PLOT K%,x,y:ENDPROC
12060 DEF FN£POINT(X,Y)=POINT FN£x(X),FN£y(Y)
12070 DEF FN£x(X):£XSC%=£XCR%+£XFA*(X-£SXO):=£XSC%
12080 DEF FN£y(Y):£YSC%=£YCR%+£YFA*(Y-£SYO):=£YSC%
12090 REM two dim scales & axes
12100 DEF PROC£AXES(M%):LOCAL A,B,f%,d%,a%,I%,w%,L$,y%
12110 IF M%=1 THEN GOSUB 12140 ELSE IF M%=2 THEN GOSUB 12300 ELSE IF M%=3 THEN GOSUB 12400 ELSE GOSUB 12140:GOSUB 12300:GOSUB 12400
12120 ENDPROC
12130 REM set intervals & ends
12140 £SXI=FN£I(£XI%,£XL,£XH):£SYI=FN£I(£YI%,£YL,£YH)
12150 PROC£ax(£XO,£XL,£XH,£SXI):£SXO=£0:£SXL=£1:£SXH=£2
12160 PROC£ax(£YO,£YL,£YH,£SYI):£SYO=£0:£SYL=£1:£SYH=£2
12170 REM set sector
12180 PROC£se
12190 REM scale factors,allow margins
12200 £XFA=FN£fa(£SXS%,£HM%,£SXH,£SXL):A=£0*£XFA
12210 £YFA=FN£fa(£SYS%,£VM%,£SYH,£SYL):B=£0*£YFA
12220 REM equalise if within 30%
12230 £0=ABS((£XFA-£YFA)/(£XFA+£YFA))
12240 IF ABS((£XFA-£YFA)/(£XFA+£YFA))<.15 THEN £XFA=FNmin(£XFA,£YFA):£YFA=£XFA
12250 REM position the axes cross
12260 £XCR%=£SXB%+(£HM% DIV 1000)+£XFA*(£SXO-£SXL)+(A-£XFA*(£SXH-£SXL))/2
12270 £YCR%=£SYB%+(£VM%DIV1000)+£YFA*(£SYO-£SYL)+(B-£YFA*(£SYH-£SYL))/2
12280 RETURN
12290 REM draw & mark off axes
12300 PROC£co(£XC%,4):PROC£MOVE(£SXL,£SYO):PROC£DRAW(£SXH,£SYO)
12310 PROC£co(£YC%,4):PROC£MOVE(£SXO,£SYL):PROC£DRAW(£SXO,£SYH)
12320 B=FN£pp(£SYI,£XP%):PROC£co(£XC%,2)
12330 FOR A=£SXL TO £SXH+£SXI/2 STEP £SXI
12340 PROC£MOVE(A,£SYO+B):PROC£DRAW(A,£SYO+B+£0):NEXT
12350 A=FN£pp(£SXI,£YP%):PROC£co(£YC%,2)
12360 FOR B=£SYL TO £SYH+£SYI/2 STEP £SYI
12370 PROC£MOVE(£SXO+A,B):PROC£PLOT(1,£0,0):NEXT
12380 RETURN
12390 REM label axes
12400 f%=FN£pr(£XP%,4):w%=£CH%DIV1E3
12410 REM decide scaled or unscaled
12420 a%=@%:@%=FN£su(£SXL,£SXH,£SXI,f%)
12430 REM decide if OK to label all pts
12440 IF£XFA*£SXI>(1+f%)*w%ANDNOT(£M%=2OR£M%=5)THENl%=TRUE ELSEl%=FALSE
12450 REM now label
12460 VDU 5:PROC£co(£XC%,0):A=£SXH
12470 IF£0<>0THENL$="E"+STR$(-£0)ELSEL$=""
12480 d%=£SXB%+£SXS%:y%=FN£y(£SYO)+(£XP%DIV1E6)-500
12490 REPEATIFABS(A)<£SXI/2THENA=0
12500 L$=STR$(A*10^£0)+L$:B=LEN(L$)*w%
12510 d%=FNmin(FN£x(A)-B/2,d%-B-w%DIV2)
12520 PLOT 4,d%,y%:PRINTL$:L$=""
12530 IFl%THENA=A-£SXI ELSEA=£SXL:l%=TRUE
12540 UNTILA<£SXL-£SXI/2
12550 REM now label Y-axis
12560 f%=FN£pr(£YP%,4):y%=£CH%MOD1E3:d%=y%+£YP%DIV1E6-500
12570 @%=FN£su(£SYL,£SYH,£SYI,f%)
12580 IF£YFA*£SYI>2*y%ANDNOT(£M%=2OR£M%=5)THENl%=1ELSEl%=0
12590 PROC£co(£YC%,0):B=£SYL
12600 REPEAT PROC£MOVE(£SXO,B)
12610 IF ABS(B)<£SYI/2 THEN B=0
12630 PLOT0,-w%DIV2,d%:FORA=1TOf%:VDU8:NEXT:PRINTB*10^£0;
12640 IFl%=1THENB=B+£SYI ELSE B=£SYH:l%=1
12650 UNTILB>£SYH+£SYI/2
12660 IF £0<>0 THEN PRINT"E";-£0
12670 VDU 4:@%=a%:RETURN
0 REM Graphs and Charts Pack
1 REM Copyright (C) Acornsoft 1982
10 : REM L3-CUR
20 £M%=5:X$="0":Y$="0"
40 ON ERROR GOTO700
90 MODE4:VDU19 128,4,0,0,0
100 K%=0:REPEAT PROCh(1)
110 £M%=FNp(K%,4,"Mode for graph",£M%)
120 PROC£INIT(£M%)
130 PROCc(6)
140 K%=1:UNTIL FNe
150 REM
160 CLS:K%=0:REPEAT PROCh(2)
170 PRINT TAB(2,4)"Horizontal axis:"
180 £XL=FNp(K%,5,"Left end",£XL)
190 £XH=FNp(K%,6,"Right end ",£XH)
200 PRINT TAB(2,8)"Vertical axis:"
210 £YL=FNp(K%,9,"Low end ",£YL)
220 £YH=FNp(K%,10,"High end ",£YH)
250 K%=1:UNTIL FNe
260 REM
300 PROCh(3)
310 PRINT TAB(2,4)"READY TO PLOT GRAPH"
320 PRINT TAB(2,6)"After axes drawn,use keys:"
330 PRINT TAB(2,8)"M: move to X,Y"
332 PRINT" D: draw to X,Y"
340 PRINT" C: colour"
342 PRINT" L: change logical colours"
350 PRINT" X: input function X(T)"
352 PRINT" Y: input function Y(T)"
354 PRINT" U: display X(T)at X,Y"
356 PRINT" V: display Y(T)at X,Y"
360 PRINT" P: T-range to plot,no. of points"
375 PRINT" T:title"
380 PRINTTAB(2,29)"press";:GOSUB 1270
390 A$=GET$:IF NOT(A$=" ")THEN380
400 REM
500 X=£CH%MOD1E3:£YB%=3*X:£YS%=1023-4*X
510 REM
520 MODE £M%
530 PROC£AXES(0):PROC£co(£XC%,2)
550 PRINTTAB(0,29)SPC(1280DIV(£CH%MOD1E3))TAB(0,29);
560 A$=GET$
570 IF A$="M"THENINPUT"Move to X,Y ",X,Y:PROC£MOVE(X,Y)
572 IF A$="D"THENINPUT"Draw to X,Y ",X,Y:PROC£DRAW(X,Y)
580 IF A$="C"THENINPUT"Colour ",X:GCOL0,X
582 IF A$="L"THENINPUT"logical,actual col",A%,B%:VDU19 A%,B%,0,0,0
590 IFA$="X"THENINPUT "Function X(T)",X$
592 IFA$="Y "THENINPUT"Function Y(T)",Y$
600 IF A$="P"THENINPUT"T1,T2,N",T1,T2,N%:PROCplot
610 IF A$="U"THENINPUT"X(T)at X,Y",X,Y:PROC£MOVE(X,Y):VDU5:PRINT"X(T)=";X$:VDU4
615 IF A$="V"THENINPUT"Y(T)at X,Y",X,Y:PROC£MOVE(X,Y):VDU5:PRINT"Y(T)=";Y$:VDU 4
620 IF A$="T"THENINPUT"Title,X,Y",A$,X,Y:PROC£MOVE(X,Y):VDU5:PRINTA$:VDU 4
630 IF A$=" ? "THENPRINT "M,D,C,L,X,Y,U,V,P,T":X=INKEY(500)
640 GOTO 550
690 REM error branch
700 MODE 7:IF ERR=17 THEN 900
710 REPORT
900 PRINTTAB(0,10)"Stop or repeat ?(S/R)";
910 A$=GET$
920 IF A$="S" THENPRINT:END
930 IF A$="R" THEN90
940 GOTO 910
950 REM
1000 DEF FNp(M%,L%,P$,V):LOCAL P%,V$
1010 PRINT TAB(2,L%);P$;" =" ;V;
1020 IF M%>0 THEN PRINT" ? " ;:P%=POS
1030 PRINT SPC(39-P%);:IF M%=0 THEN =V
1040 INPUT TAB(P%,L%)V$
1050 IF LEN(V$)>0 THEN V=VAL(V$)ELSE M%=0
1060 GOTO 1010
1100 DEF PROCh(N%):CLS
1120 PRINT TAB(2,2);"CURVE PLOTTING UTILITY";SPC(5);"PAGE ";N%
1130 ENDPROC
1200 DEF FNe:LOCAL A$
1210 PRINT TAB(0,29)"Type C to change data,";:GOSUB 1270
1220 A$=GET$
1230 IF A$=" " THEN =TRUE
1240 IF A$="C" THEN =FALSE
1250 GOTO 1220
1260 REM
1270 PRINT" SPACE to continue":RETURN
1300 DEF PROCc(L%)
1302 PRINTTAB(2,L%)"Logical colours for:"
1304 IF FN£pr(£XC%,6)=0 THEN A%=1:B%=1:C%=1:GOTO1330
1310 A%=FN£pr(£XC%,4):B%=FN£pr(£XC%,2)
1320 C%=FN£pr(£XC%,0)
1330 A%=FNp(K%,L%+2,"axes ",A%)
1340 B%=FNp(K%,L%+3,"pips ",B%)
1350 C%=FNp(K%,L%+4,"labels",C%)
1360 £XC%=((100+A%)*100+B%)*100+C%
1370 PRINTTAB(2,L%+6)"Actual colours may be changed later."
1380 ENDPROC
2000 DEF PROCplot:LOCAL D
2005 D=(T2-T1)/N%:T=T1
2010 PROC£MOVE(EVAL(X$),EVAL(Y$))
2020 FOR T=T1 TO T2+D/2 STEP D
2030 PROC£DRAW(EVAL(X$),EVAL(Y$)):NEXT
2040 ENDPROC
10040 REM
10050 REM Initialisation
10060 DEF PROC£INIT(M%):£M%=M%
10070 £XL=-10:£XH=10:£YL=-10:£YH=10:£ZL=-10:£ZH=10
10080 £XO=0:£YO=0:£ZO=0:£XI%=7:£YI%=7:£ZI%=7
10090 £XN%=1:£YN%=1:£SN%=1
10100 IF M%=2 OR M%=5 THEN £CH%=64 ELSE £CH%=32
10110 £YB%=0:£YS%=1023:£XB%=3*£CH%:£XS%=1279-£XB%
10120 £VM%=64064:£HM%=2*(1000*£CH%+£CH%):£CH%=1000*£CH%+32
10130 £XP%=484040225:£YP%=504040225:£ZP%=540040225
10140 IF M%=1 OR M%=2 OR M%=5 THEN £XC%=1010203 ELSE £XC%=0
10150 £YC%=0:£ZC%=0
10160 £TH=1.3:£PH=-1.3
10170 ENDPROC
10180 REM
10190 REM Interval chooser
10200 DEF FN£I(N%,LO,HI):LOCAL A,B,C
10210 IF0>=N%THENPROC£er("Bad no. of intervals")
10220 C=(HI-LO)/N%:IF0>=C THENPROC£er("Bad axis range")
10230 C=FNmax(C,FNmax(ABS(LO),ABS(HI))/1E6)
10240 REM normalise interval size ^10
10250 A=10^INT(LOG(C)):B=C/A
10260 REM select nearest round interval
10270 IFB>7.1THENB=10ELSEIFB>3.2THENB=5ELSEIFB>1.4THENB=2ELSEB=1
10280 =A*B
10290 REM
10300 REM calc secondary origin,lo,hi
10310 DEF PROC£ax(O,LO,HI,I)
10320 REM if axes wld cross out range,
10330 REM set sec pars so cross at lo,
10340 REM and ensure orig at integer*intvl
10350 IF LO-I/2>=O OR O>=HI THEN O=INT(LO/I-.1)*I:LO=O
10360 REM anyway make ends at intg*intvl
10370 LO=O+I*INT((LO-O)/I+.1)
10380 HI=O-I*INT((O-HI)/I+.1)
10390 REM return value in £0,£1,£2
10400 £0=O:£1=LO:£2=HI:ENDPROC
10410 REM
10420 REM set up sector
10430 DEF PROC£se:LOCAL S%
10440 S%=(£SN%-1)MOD(£XN%*£YN%)
10450 £SXS%=£XS% DIV £XN%:£SYS%=£YS% DIV £YN%
10460 £SXB%=£XB%+S%MOD£XN%*£SXS%
10470 £SYB%=£YB%+S%DIV£XN%*£SYS%:ENDPROC
10480 REM
10490 DEF FN£fa(S%,M%,HI,LO):£0=HI-LO:=(S%-(M%MOD1000)-(M%DIV1000))/£0
10500 REM
10510 DEF FN£pp(L,M%)
10520 £0=FN£pr(M%,0)*L/100
10530 ON 1+(FN£pr(M%,2)MOD 3)GOTO 10540,10550,10560
10540 =0.
10550 =-£0
10560 =-£0/2
10570 REM
10580 REM Extract colour
10590 DEF PROC£co(C%,N%):IF FN£pr(C%,6)>0 THEN GCOL 0,FN£pr(C%,N%)
10600 ENDPROC
10610 REM
10620 REM scale or unscale labels
10630 DEF FN£su(lo,hi,I,f%):LOCAL i%,j%,c%,d%,s%,p%
10640 i%=INT(LOG(I)+.01):j%=INT(LOG(FNmax(ABS(lo),ABS(hi)))+.01)
10650 REM digits needed c% before,d% after
10660 IF j%>0 THEN c%=j%+1:ELSE c%=1
10670 IF NOT i%<0 THEN d%=0:p%=0:ELSE d%=-i%:p%=1
10680 REM is sign needed
10690 IF lo<0 OR hi <0 THEN s%=1 ELSEs%=0
10700 REM decide scaled/unscaled
10710 IF NOT(f%<p%+s%+c%+d%)THEN £0=0 ELSE d%=0:p%=0:£0=FNmin(-i%,f%-j%-s%-1)
10720 REM format; gen if integer el fix
10730 IF d%=0 THEN i%=&10000+f% ELSE i%=&10200+d%
10740 =f%+&100*i%
10750 REM
10760 DEF FNmax(a,b):IFb>a THEN=b ELSE=a
10770 DEF FNmin(a,b):IFb<a THEN=b ELSE=a
10780 DEF FN£pr(n%,d%)=(n%DIV(10^d%))MOD100
10790 DEF PROC£er(a$):PRINT "Graphics package error"
10800 PRINT a$:STOP:ENDPROC
10810 REM
12000 REM ------ TWO DIM ROUTINES -------
12010 DEF PROC£MOVE(X,Y):PLOT 4,FN£x(X),FN£y(Y):ENDPROC
12020 DEF PROC£DRAW(X,Y):PLOT 5,FN£x(X),FN£y(Y):ENDPROC
12030 DEF PROC£PLOT(K%,X,Y):LOCAL x,y
12040 IF K%MOD8<4 THEN x=£XFA*X:y=£YFA*Y:£XSC%=£XSC%+x:£YSC%=£YSC%+y:ELSE x=FN£x(X):y=FN£y(Y)
12050 PLOT K%,x,y:ENDPROC
12060 DEF FN£PQ£NT(X,Y)=POINT FN£x(X),FN£y(Y)
12070 DEF FN£x(X):£XSC%=£XCR%+£XFA*(X-£SXO):=£XSC%
12080 DEF FN£y(Y):£YSC%=£YCR%+£YFA*(Y-£SYO):=£YSC%
12090 REM two dim scales & axes
12100 DEF PROC£AXES(M%):LOCAL A,B,f%,d%,a%,l%,w%,L$,y%
12110 IF M%=1 THEN GOSUB 12140 ELSE IF M%=2 THEN GOSUB 12300 ELSE IF M%=3 THEN GOSUB 12400 ELSE GOSUB 12140:GOSUB 12300:GOSUB 12400
12120 ENDPROC
12130 REM set intervals & ends
12140 £SXI=FN£I(£XI%,£XL,£XH):£SYI=FN£I(£YI%,£YL,£YH)
12150 PROC£ax(£XO,£XL,£XH,£SXI):£SXO=£0:£SXL=£1:£SXH=£2
12160 PROC£ax(£YO,£YL,£YH,£SYI):£SYO=£0:£SYL=£1:£SYH=£2
12170 REM set sector
12180 PROC£se
12190 REM scale factors,allow margins
12200 £XFA=FN£fa(£SXS%,£HM%,£SXH,£SXL):A=£0*£XFA
12210 £YFA=FN£fa(£SYS%,£VM%,£SYH,£SYL):B=£0*£YFA
12220 REM equalise if within 30%
12240 IF ABS((£XFA-£YFA)/(£XFA+£YFA))<.15 THEN £XFA=FNmin(£XFA,£YFA):£YFA=£XFA
12250 REM position the axes cross
12260 £XCR%=£SXB%+(£HM% DIV 1000)+£XFA*(£SXO-£SXL)+(A-£XFA*(£SXH-£SXL))/ 2
12270 £YCR%=£SYB%+(£VM%DIV1000)+£YFA*(£SYO-£SYL)+(B-£YFA*(£SYH-£SYL))/2
12280 RETURN
12290 REM draw & mark off axes
12300 PROC£co(£XC%,4):PROC£MOVE(£SXL,£SYO):PROC£DRAW(£SXH,£SYO)
12310 PROC£co(£YC%,4):PROC£MOVE(£SXO,£SYL):PROC£DRAW(£SXO,£SYH)
12320 B=FN£pp(£SYI,£XP%):PROC£co(£XC%,2)
12330 FOR A=£SXL TO £SXH+£SXI/2 STEP £SXI
12340 PROC£MOVE(A,£SYO+B):PROC£DRAW(A,£SYO+B+£0):NEXT
12350 A=FN£pp(£SXI,£YP%):PROC£co(£YC%,2)
12360 FOR B=£SYL TO £SYH+£SYI/2 STEP £SYI
12370 PROC£MOVE(£SXO+A,B):PROC£PLOT(1,£0,0):NEXT
12380 RETURN
12390 REM label axes
12400 f%=FN£pr(£XP%,4):w%=£CH%DIV1E3
12410 REM decide scaled or unscaled
12420 a%=@%:@%=FN£su(£SXL,£SXH,£SXI,f%)
12430 REM decide if OK to label all pts
12440 IF£XFA*£SXI>(1+f%)*w%ANDNOT(£M%=2OR£M%=5)THENl%=TRUE ELSEl%=FALSE
12450 REM now label
12460 VDU 5:PROC£co(£XC%,0):A=£SXH
12470 IF£0<>0THENL$="E"+STR$(-£0)ELSEL$=""
12480 d%=£SXB%+£SXS%:y%=FN£y(£SYO)+(£XP%DIV1E6)-500
12490 REPEATIFABS(A)<£SXI/2THENA=0
12500 L$=STR$(A*10^£0)+L$:B=LEN(L$)*w%
12510 d%=FNmin(FN£x(A)-B/2,d%-B-w%DIV2)
12520 PLOT4,d%,y%:PRINTL$:L$=""
12530 IFl%THENA=A-£SXI ELSEA=£SXL:l%=TRUE
12540 UNTILA<£SXL-£SXI/2
12550 REM now label Y-axis
12560 f%=FN£pr(£YP%,4):y%=£CH%MOD1E3:d%=y%+£YP%DIV1E6-500
12570 @%=FN£su(£SYL,£SYH,£SYI,f%)
12580 IF£YFA*£SYI>2*y%ANDNOT(£M%=2OR£M%=5)THENl%=1ELSEl%=0
12590 PROC£co(£YC%,0):B=£SYL
12600 REPEAT PROC£MOVE(£SXO,B)
12610 IF ABS(B)<£SYI/2 THEN B=0
12620 REMIFB>£SYH-£SYI/2THENl%=2:d%=y%+(£YP%DIV1E6)-500
12630 PLOT0,-w%DIV2,d%:FORA=1TOf%:VDU8:NEXT:PRINTB*10^£0;
12640 IFl%=1THENB=B+£SYI ELSE B=£SYH:l%=1
12650 UNTILB>£SYH+£SYI/2
12660 IF £0<>0 THEN PRINT"E";-£0
12670 VDU 4:@%=a%:RETURN
0 REM Graphs and Charts Pack
1 REM Copyright (C) Acornsoft 1982
10 :REM L3-PIE
20 £M%=5
40 ON ERROR GOTO 700
90 MODE4: VDU19 128,4,0,0,0
100 K%=0:REPEAT PROCh(1)
110 £M%=FNp(K%,4,"Mode for chart",£M%)
120 PROC£INIT(£M%)
140 K%=1:UNTIL FNe
150 REM
260 REM
300 PROCh(2)
310 PRINT TAB(2,4)"READY TO DRAW CHART"
320 PRINT TAB(2,6)"After screen cleared,use keys to set:"
330 PRINT TAB(2,8)"S: starting angle for next sector"
332 PRINT" D: draw next sector,size in %"
340 PRINT" C: colour"
342 PRINT" L: change logical colours"
375 PRINT" T: title"
378 PRINT" W: write sector size in colour 0"
379 PRINT" of the last sector drawn."
382 PRINT" ?: display list of prompt keys"
388 PRINTTAB(2,17)"For pie charts,axes are not drawn,"
390 PRINT" but the screen is addressed as if"
400 PRINT" there were axes with origin at the"
410 PRINT" centre of the screen. "
415 PRINT" Each axis spans from -10 to +10."
420 PRINT" The pie radius is 8 in these units."
428 PRINT
430 PRINT" Angles must be given in percent,"
440 PRINT" where 100% gives a full circle. "
445 PRINT" The starting angle is 0 initially."
450 PRINTTAB(2,29)"press";:GOSUB 1270
460 A$=GET$:IF NOT(A$=" ")THEN450
500 X=£CH%MOD1E3:£YB%=3*X:£YS%=1023-4*X
510 REM
520 MODE £M%
530 PROC£AXES(1):A=0:C%=1:GCOL0,1
550 PRINTTAB(0,29)SPC(1280DIV(£CH%MOD1E3))TAB(0,29);
560 A$=GET$
570 IF A$="S"THENINPUT"Starting angle",A
572 IF A$="D"THENINPUT"Draw sector of %",P:B=A+P:PROC£SEC(11,0,0,8,A/100,B/100):A=B
580 IF A$="C"THENINPUT"Colour ",C%:GCOL0,C%
582 IF A$="L"THENINPUT"logical,actual col",A%,B%:VDU19 A%,B%,0,0,0
590 IF A$="W"THEN PROCw
620 IF A$="T"THENINPUT"Title,X,Y",A$,X,Y:PROC£MOVE(X,Y):VDU5:PRINTA$:VDU4
630 IF A$="?"THENPRINT"S,D,C,L,W,T" :X=INKEY(500)
640 GOTO 550
690 REM error branch
700 MODE7:IF ERR=17 THEN900
710 REPORT
900 PRINTTAB(0,10)"Stop or repeat?(S/R)";
910 A$=GET$
920 IF A$="S" THENPRINT:END
930 IF A$="R " THEN 90
940 GOTO 910
950 REM
1000 DEF FNp(M%,L%,P$,V):LOCAL P%,V$
1010 PRINT TAB(2,L%);P$;" =";V;
1020 IF M%>0 THEN PRINT" ? ";:P%=POS
1030 PRINT SPC(39-P%);:IF M%=0 THEN =V
1040 INPUT TAB(P%,L%)V$
1050 IF LEN(V$)>0 THEN V=VAL(V$)ELSE M%=0
1060 GOTO1010
1100 DEF PROCh(N%):CLS
1120 PRINT TAB(2,2);"PIE CHART UTILITY";SPC(5); "PAGE ";N%
1130 ENDPROC
1200 DEF FNe:LOCAL A$
1210 PRINT TAB(0,29)"Type C to change data,";:GOSUB 1270
1220 A$=GET$
1230 IF A$=" " THEN =TRUE
1240 IF A$="C" THEN =£
1250 GOTO 1220
1260 REM
1270 PRINT" SPACE to continue":RETURN
2000 DEF PROCw
2010 A%=@%:@%=&01000202
2020 GCOLO,0:VDU5:VDU8:PRINT P:VDU 4
2030 @%=A%:GCOL0,C%:ENDPROC
10040 REM
10050 REM Initialisation
10060 DEF PROC£INIT(M%): £M%=M%
10070 £XL=-10:£XH=10:£YL=-10:£YH=10 :£ZL=-10:£ZH=10
10080 £XO=0:£YO=0:£ZO=0: £XI%=7:£YI%=7:£ZI%=7
10090 £XN%=1:£YN%=1:£SN%=1
10100 IF M%=2 OR M%=5 THEN £CH%=64 ELSE £CH%=32
10110 £YB%=0:£YS%=1023:£XB%=3*£CH%: £XS%=1279-£XB%
10120 £VM%=64064:£HM%=2*(1000*£CH%+£CH%):£CH%=1000*£CH%+32
10130 £XP%=484040225:£YP%=504040225:£ZP%=540040225
10140 IF M%=1 OR M%=2 OR M%=5 THEN £XC%=1010203 ELSE £XC%=
10150 £YC%=0:£ZC%=0
10160 £TH=1.3:£PH=-1.3
10170 ENDPROC
10180 REM
10190 REM Interval chooser
10200 DEF FN£I(N%,LO,HI):LOCAL A,B,C
10210 IF0>=N%THENPROC£er("Bad no. of intervals")
10220 C=(HI-LO)/N%:IF0>=C THENPROC£er("Bad axis range")
10230 C=FNmax(C,FNmax(ABS(LO),ABS(HI))/1E6)
10240 REM normalise interval size ''10
10250 A=10^INT(LOG(C)):B=C/A
10260 REM select nearest round interval
10270 IFB>7.1THENB=10ELSEIFB>3.2THENB=5ELSEIFB>1.4THENB=2ELSEB=1
10280 =A*B
10290 REM
10300 REM calc secondary origin,lo,hi
10310 DEF PROC£ax(O,LO,HI,I)
10320 REM if axes wld cross out range,
10330 REM set sec pars so cross at lo,
10340 REM and ensure orig at integer*intvl
10350 IF LO-I/2>=O OR O>=HI THEN O=INT(LO/I-.1)*I:LO=O
10360 REM anyway make ends at intg*intvl
10370 LO=O+I*INT((LO-O)/I+.1)
10380 HI=O-I*INT((O-HI)/I+.1)
10390 REM return value in £0,£1,£2
10400 £0=O:£1=LO:£2=HI:ENDPROC
10410 REM
10420 REM set up sector
10430 DEF PROC£se:LOCAL S%
10440 S%=(£SN%-1)MOD(£XN%*£YN%)
10450 £SXS%=£XS% DIV £XN%:£SYS%=£YS% DIV £YN%
10460 £SXB%=£XB%+S%MOD£XN%*£SXS%
10470 £SYB%=£YB%+S%DIV £XN%*£SYS%:ENDPROC
10480 REM
10490 DEF FN£fa(S%,M%,HI,LO):£0=HI-LO:=(S%-(M%MOD1000)-(M%DIV1000))/£0
10500 REM
10510 DEF FN£pp(L,M%)
10520 £0=FN£pr(M%,0)*L/100
10530 ON 1+(FN£pr(M%,2)MOD 3)GOTO 10540,10550,10560
10540 =0.
10550 =-£0
10560 =-£0/2
10570 REM
10580 REM Extract colour
10590 DEF PROC£co(C%,N%): IF FN£pr(C%,6)>0 THEN GCOL 0,FN£pr(C%,N%)
10600 ENDPROC
10610 REM
10620 REM scale or unscale labels
10630 DEF FN£su(lo,hi,I,£%):LOCAL i%,j%,c%,d%,s%,p%
10640 i%=INT(LOG(I)+.01):j%=INT(LOG(FNmax(ABS(lo),ABS(hi)))+.01)
10650 REM digits needed c% before,d% after
10660 IF j%>0 THEN c%=j%+1: ELSE c%=1
10670 IF NOT i%<0 THEN d%=0:p%=0: ELSE d%=-i%:p%=1
10680 REM is sign needed
10690 IF lo<0 OR hi <0 THEN s%=1 ELSEs%=0
10700 REM decide scaled/unscaled
10710 IF NOT(f%<p%+s%+c%+d%)THEN £0=0 ELSE d%=0:p%=0:£0=FNmin(-i%,f%-j%-s%-1)
10720 REM format; gen if integer el fix
10730 IF d%=0 THEN i%=&10000+f% ELSE i%=&10200+d%
10740 =f%+&100*i %
10750 REM
10760 DEF FNmax(a,b):IFb>a THEN=b ELSE=a
10770 DEF FNmin(a,b):IFb<a THEN=b ELSE=a
10780 DEF FN£pr(n%,d%)=(n%DIV(10''d%))MODIOO
10790 DEF PROC£er(a$):PRINT "Graphics package error"
10800 PRINT a$:STOP:ENDPROC
10810 REM
12000 REM ------ TWO DIM ROUTINES -------
12010 DEF PROC£MOVE(X,Y):PLOT 4,FN£x(X),FN£y(Y):ENDPROC
12020 DEF PROC£DRAW(X,Y):PLOT 5,FN£x(X),FN£y(Y):ENDPROC
12030 DEF PROC£PLOT(K%,X,Y):LOCAL x,y
12040 IF K%MOD8<4 THEN x=£XFA*X:y=£YFA*Y :£XSC%=£XSC%+x:£YSC%=£YSC%+y:ELSE x=FN£x(X):y=FN£y(Y)
12050 PLOT K%,x,y:ENDPROC
12060 DEF FN£POINT(X,Y)=POINT FN£x(X),FN£y(Y)
12070 DEF FN£x(X):£XSC%=£XCR%+£XFA*(X-£SXO):=£XSC%
12080 DEF FN£y(Y):£YSC%=£YCR%+£YFA*(Y-£SYO):=£YSC%
12090 REM two dim scales & axes
12100 DEF PROC£AXES(M%):LOCAL A,B,f%,d%,a%,l%,w%,L$,y%
12110 IF M%=1 THEN GOSUB 12140 ELSE IF M%=2 THEN GOSUB 12300 ELSE IF M%=3 THEN GOSUB 12400 ELSE GOSUB 12140:GOSUB 12300:GOSUB 12400
12120 ENDPROC
12130 REM set intervals & ends
12140 £SXI=FN£I(£XI%,£XL,£XH): £SYI=FN£I(£YI%,£YL,£YH)
12150 PROC£ax(£XO,£XL,£XH,£SXI):£SXO=£0: £SXL=£1:£SXH=£2
12160 PROC£ax(£YO,£YL,£YH,£SYI): £SYO=£0:£SYL=£1: £SYH=£2
12170 REM set sector
12180 PROC£se
12190 REM scale factors,allow margins
12200 £XFA=FN£fa(£SXS%,£HM%,£SXH,£SXL):A=£0*£XFA
12210 £YFA=FN£fa(£SYS%,£VM%,£SYH,£SYL):B=£0*£YFA
12220 REM equalise if within 30%
12230 £0=ABS((£XFA-£YFA)/(£XFA+£YFA))
12240 IF ABS((£XFA-£YFA)/(£XFA+£YFA))<.15 THEN £XFA=FNmin(£XFA,£YFA):£YFA=£XFA
12250 REM position the axes cross
12260 £XCR%=£SXB%+(£HM% DIV 1000)+£XFA*(£SXO-£SXL)+(A-£XFA*(£SXH-£SXL))/2
12270 £YCR%=£SYB%+(£VM%DIV1000)+£YFA*(£SYO-£SYL)+(B-£YFA*(£SYH-£SYL))/ 2
12280 RETURN
12290 REM draw & mark off axes
12300 PROC£co(£XC%,4):PROC£MOVE(£SXL,£SYO):PROC£DRAW(£SXH,£SYO)
12310 PROC£co(£YC%,4):PROC£MOVE(£SXO,£SYL):PROC£DRAW(£SXO,£SYH)
12320 B=FN£pp(£SYI,£XP%):PROC£co(£XC%,2)
12330 FOR A=£SXL TO £SXH+£SXI/2 STEP £SXI
12340 PROC£MOVE(A,£SYO+B):PROC£DRAW(A,£SYO+B+£0):NEXT
12350 A=FN£pp(£SKI,£YP%): PROC£co(£YC%,2)
12360 FOR B=£SYL TO £SYH+£SYI/2 STEP £SYI
12370 PROC£MOVE(£SXO+A,BJ):PROCF-PLOT(1,£0,0):NEXT
12380 RETURN
12390 RE& label axes
12400 f%=FN£pr(£XP%,4):w%=£CH%DIV1E3
12410 REM decide scaled or unscaled
12420 a%=@%:@%=FN£su(£SXL,£SXH,£SXI,f%)
12430 REM decide if OK to label all pts
12440 IF£XFA*£SXI>(1+f%)*w%ANDNOT(£M%=2OR£M%=5)THENl%=TRUEELSEl%=£
12450 REM now label
12460 VDU 5:PROC£co(£XC%,0):A=£SXH
12470 IF£0<>0THENL$="E"+STR$(-£0)ELSEL$=""
12480 d%=£SXB%+£SXS% :y%=FN£y(£SYO)+(£XP%DIV1E6)-500
12490 REPEATIFABS(A)<£SXI/2THENA=0
12500 L$=STR$(A*10^£0)+L$:B=LEN(L$)*w%
12510 d%=FNmin(FN£x(A)-B/2,d%-B-w%DIV2)
12520 PLOT4,d%,y%:PRINTL$:L$=""
12530 IFl%THENA=A-£SXI ELSEA=£SXL:l%=TRUE
12540 UNTILA<£SXL-£SXI/2
12550 REM now label Y-axis
12560 f%=FN£pr(£YP%,4):y%=£CH%MOD1E3: d%=y%+£YP%DIV1E6-500
12570 @%=FN£su(£SYL,£SYH,£SYI,f%)
12580 IF£YFA*£SYI>2*y%ANDNOT(£M%=2OR£M%=5)THENl%=1ELSEl%=0
12590 PROC£co(£YC%,0):B=£SYL
12600 REPEAT PROC£MOVE(£SXO,B)
12610 IF ABS(B)<£SYI/2 THEN B=0
12630 PLOT0,-w%DIV2,d%:FORA=1TOf%:VDU8:NEXT:PRINTB*10^£0;
12640 IFl%=1THENB=B+£SYI ELSE B=£SYH:l%=l
12650 UNTILB>£SYH+£SYI/2
12660 IF £0<>0 THEN PRINT"E";-£0
12670 VDU 4:@%=a%:RETURN
15180 REM -------- Circular sector ---
15190 DEF PROC£SEC(M%,X,Y,R,A,B):LOCAL a,b,I%
15200 REM tens digit of M%: center
15210 REM 0=screen,1-user
15220 IF M%DIV10=1 THEN X=FN£x(X):Y=FN£y(Y)
15230 REM ones digit of M%: radius
15240 IF M%MOD10=1 THEN R=R*£YFA
15250 M%=1+50*ABS(B-A):b=(B-A)*2*PI/M%
15260 A=2*PI*A:PLOT 84,X+R*COS(A),Y+R*SIN(A)
15270 FOR I%=1 TO M%:a=A+I%*b:PLOT 84,X,Y
15280 PLOT 81,R*COS(a),R*SIN(a):NEXT
15290 a=A+M%*b/2:MOVE X+R*COS(a)*.7,Y+R*SIN(a)*.7
15300 ENDPROC
15310 REM -----------------------------
0 REM Graphs and Charts Pack
1 REM Copyright (C) Acornsoft 1982
10 :REM L3-CV3D
20 £M%=5:X$="0":Y$="0":Z$="0"
40 ON ERROR GOTO 700
90 MODE4:VDU19 128,4,0,0,0
100 K%=0:REPEAT PROCh(1)
110 £M%=FNp(K%,4,"Mode for graph",£M%)
120 PROC£INIT(£M%)
130 PROCC(6)
140 K%=1:UNTIL FNe
150 REM
160 CLS:K%=0:REPEAT PROCh(2)
170 PRINTTAB(2,4)"X-axis:"
180 £XL=FNp(K%,5,"Low end",£XL)
190 £XH=FNp(K%,6,"High end",£XH)
200 PRINTTAB(2,8)"Y-axis:"
210 £YL=FNp(K%,9,"Low end ",£YL)
220 £YH=FNp(K%,10,"High end",£YH)
230 PRINTTAB(2,12)"Z-axis:"
235 £ZL=FNp(K%,13,"Low end ",£ZL)
240 £ZH=FNp(K%,14,"High end",£ZH)
260 PRINTTAB(2,16)"Viewing angles in degrees:"
270 £TH=PI*FNp(K%,17,"Theta",180*£TH/PI)/180
272 £PH=PI*FNp(K%,18,"Phi ",180*£PH/PI)/180
280 K%=1:UNTIL FNe
290 REM
300 PROCh(3)
310 PRINT TAB(2,4)"READY TO PLOT GRAPH"
320 PRINTTAB(2,6)"After axes drawn,use keys:"
325 PRINTTAB(2,8)"A:change viewing angles"
330 PRINT" M: move to X,Y,Z"
332 PRINT" D: draw to X,Y,Z"
340 PRINT" C: colour"
342 PRINT" L: change logical colours"
350 PRINT" X: input function X(T)"
352 PRINT" Y: input function Y(T)"
354 PRINT" Z: input function Z(T)"
360 PRINT" P: T-range to plot,no. of points"
375 PRINT" T: title"
376 PRINT" U: print X(T)at X,Y,Z"
377 PRINT" V: print Y(t)"
378 PRINT" W: print Z(t)"
379 PRINT" ?:list of prompts"
380 PRINTTAB(2,29)"press";:GOSUB 1270
390 A$=GET$:IF NOT(A$=" ")THEN380
400 REM
500 X=£CH%MOD1E3:£YB%=3 *X:£YS%=1023-4*X
510 REM
520 MODE £M%
530 PROC£AX3(0):PROC£co(£XC%,2)
550 PRINTTAB(0,29)SPC(1280DIV(£CH%MOD1E3))TAB(0,29);
560 A$=GET$
570 IF A$="M"THENINPUT"Move to X,Y,Z ",X,Y,Z:PROC£MV3(X,Y,Z)
572 IF A$="D"THENINPUT"Draw to X,Y,Z ",X,Y,Z:PROC£DR3(X,Y,Z)
580 IF A$="C"THENINPUT"Colour ",X:GCOL0,X
582 IF A$="L"THENINPUT"logical,actual col",A%,B%:VDU19 A%,B%,0,0,0
590 IFA$="X"THENINPUT "Function X(T)",X$
592 IFA$="Y"THENINPUT "Function Y(T)",Y$
594 IFA$="Z "THENINPUT"Function Z(T)",Z$
600 IF A$="P"THENINPUT"T1,T2,N",T1,T2,N%:PROCplot
620 IF A$="T"THENINPUT"Ti tle,X,Y,Z",A$,X,Y,Z:PROC£MV3(X,Y,Z):VDU5:PRINTA$:VDU4
630 IF A$="U"THEN PROCfn("X")
640 IF A$="V"THEN PROCfn("Y")
650 IF A$="W"THEN PROCfn("Z")
660 IF A$="A"THENINPUT"Theta,Phi(deg)",X,Y:£TH=PI*X/180:£PH=PI*Y/180:CLG:PROC£AX3(0)
670 IF A$="?"THENPRINT" A,M,D,C,L,P,T,U,V,W,X,Y,Z":A$=INKEY$(500)
680 GOTO 550
690 REM error branch
700 MODE 7:IF ERR=17 THEN 900
710 REPORT
900 PRINTTAB(0,10)"Stop or repeat?(S/R)";
910 A$=GET$
920 IF A$="S" THENPRINT:END
930 IF A$="R" THEN 90
940 GOTO910
950 REM
1000 DEF FNp(M%,L%,P$,V):LOCAL P%,V$
1010 PRINT TAB(2,L%);P$;" =";V;
1020 IF M%>0 THEN PRINT" ? ";:P%=POS
1030 PRINT SPC(39-P%);:IF M%=0 THEN =V
1040 INPUT TAB(P%,L%)V$
1050 IF LEN(V$)>0 THEN V=VAL(V$)ELSE M%=0
1060 GOTO1010
1100 DEF PROCh(N%):CLS
1120 PRINT TAB(2,2);"3-D CURVE PLOTTER";SPC(5); "PAGE ";N%
1130 ENDPROC
1200 DEF FNe:LOCAL A$
1210 PRINT TAB(0,29)"Type C to change data,";:GOSUB 1270
1220 A$=GET$
1230 IF A$=" " THEN =TRUE
1240 IF A$="C" THEN =£
1250 GOTO 1220
1260 REM
1270 PRINT" SPACE to continue":RETURN
1300 DEF PROCC(L%)
1302 PRINTTAB(2,L%)"Logical colours for:"
1304 IF FN£pr(£XC%,6)=0 THEN A%=1:B%=1:C%=1:GOTO1330
1310 A%=FN£pr(£XC%,4):B%=FN£pr(£XC%,2)
1320 C%=FN£pr(£XC%,0)
1330 A%=FNp(K%,L%+2,"axes ",A%)
1340 B%=FNp(K%,L%+3,"pips ",B%)
1350 C%=FNp(K%,L%+4,"labels",C%)
1360 £XC%=((100+A%)*100+B%)*100+C%
1370 PRINTTAB(2,L%+6)"Actual colours may be changed later."
1380 ENDPROC
1400 DEF PROCfn(F$)
1410 PRINTF$;"(T)at X,Y,Z";:INPUT,X,Y,Z
1420 PROC£MV3(X,Y,Z):VDU5
1430 PRINTF$; "(T)=";EVAL(F$+"$")
1440 VDU4:ENDPROC
2000 DEF PROCplot:LOCAL D
2005 D=(T2-T1)/N%:T=T1
2010 PROC£MV3(EVAL(X$),EVAL(Y$),EVAL(Z$))
2020 FOR T=T1 TO T2+D/2 STEP D
2030 PROC£DR3(EVAL(X$),EVAL(Y$),EVAL(Z$)):NEXT
2040 ENDPROC
10060 DEFPROC£INIT(M%):£M%=M%
10070 £XL=-10:£XH=10:£YL=-10:£YH=10:£ZL=-10:£ZH=10
10080 £XO=0:£YO=0:£ZO=0:£XI%=7:£YI%=7:£ZI%=7
10090 £XN%=1:£YN%=1:£SN%=1
10100 IFM%=2ORM%=5THEN£CH%=64ELSE£CH%=32
10110 £YB%=0:£YS%=1023:£XB%=3*£CH%:£XS%=1279-£XB%
10120 £VM%=64064:£HM%=2*(1000*£CH%+£CH%):£CH%=1000*£CH%+32
10130 £XP%=484040225:£YP%=504040225:£ZP%=540040225
10140 IFM%=1ORM%=2ORM%=5THEN£XC%=1010203ELSE£XC%=0
10150 £YC%=0:£ZC%=0
10160 £TH=1.3:£PH=-1.3
10170 ENDPROC
10200 DEFFN£I(N%,LO,HI):LOCALA,B,C
10210 IF0>=N%THENPROC£er("Bad no. of intervals")
10220 C=(HI-LO)/N%:IF0>=C THENPROC£er("Bad axis range")
10230 C=FNmax(C,FNmax(ABS(LO),ABS(HI))/1E6)
10250 A=10^INT(LOG(C)):B=C/A
10270 IFB>7.1THENB=1 0ELSEIFB>3.2THENB=5ELSEIFB>1.4THENB=2ELSEB=1
10280 =A*B
10310 DEF PROC£ax(O,LO,HI,I)
10350 IFLO-I/2>=O ORO>=HI THENO=INT(LO/I-.1)*I:LO=O
10370 LO=O+I*INT((LO-O)/I+.1)
10380 HI=O-I*INT((O-HI)/I+.1)
10400 £0=O:£1=LO:£2=HI:ENDPROC
10430 DEF PROC£se:LOCAL S%
10440 S%=(£SN%-1)MOD(£XN%*£YN%)
10450 £SXS%=£XS%DIV£XN%:£SYS%=£YS%DIV£YN%
10460 £SXB%=£XB%+S%MOD£XN%*£SXS%
10470 £SYB%=£YB%+S%DIV£XN%*£SYS%:ENDPROC
10490 DEFFN£fa(S%,M%,HI,LO):£0=HI-LO:=(S%-(M%MOD1000)(M%DIV1000))/£0
10510 DEF FN£pp(L,M%)
10520 £0=FN£pr(M%,0)*L/100
10530 ON1+(FN£pr(M%,2)MOD3)GOTO10540,10550,10560
10540 =0.
10550 =-£0
10560 =-£0/2
10590 DEFPROC£co(C%,N%):IFFN£pr(C%,6)>0THENGCOL0,FN£pr(C%,N%)
10600 ENDPROC
10630 DEFFN£su(lo,hi,I,f%):LOCALi%,j%,c%,d%,s%,p%
10640 i%=INT(LOG(I)+.01):j%=INT(LOG(FNmax(ABS(lo),ABS(hi)))+.01)
10660 IFj%>0THENc%=j%+1:ELSEc%=1
10670 IFNOTi%<0THENd%=0:p%=0:ELSEd%=-i%:p%=1
10690 IFlo<0ORhi <0THENs%=1ELSEs%=0
10710 IFNOT(f%<p%+s%+c%+d%)THEN£0=0ELSEd%=0:p%=0:£0=FNmin(-i%,f%-j%-s%-1)
10730 IFd%=0THENi%=&10000 +f%ELSEi%=&10200+d%
10740 =f%+&100*i%
10760 DEFFNmax(a,b):IFb>a THEN=b ELSE=a
10770 DEFFNmin(a,b):IFb<a THEN=b ELSE=a
10780 DEFFN£pr(n%,d%)=(n%DIV(10^d%))MOD100
10790 DEFPROC£er(a$):PRINT"Graphics package error"
10800 PRINTa$:STOP:ENDPROC
13010 DEFPROC£MV3(X,Y,Z):PROC£PL3(4,X,Y,Z):ENDPROC
13020 DEFPROC£DR3(X,Y,Z):PROC£PL3(5,X,Y,Z):ENDPROC
13030 DEFPROC£PL3(K%,X,Y,Z):LOCAL RX,RY,RZ,x%,y%
13040 IF3<K%MOD8THENRX=£SXO:RY=£SYO:£RZ =£SZO:x%=£XCR%:y%=£YCR%:£XSC%=0:£YSC%=0
13050 RX=(X-RX)*£XFA:RY=(Y-RY)*£YFA:RZ=(Z-RZ)*£ZFA
13060 x%=x%+£P11*RX+£P12*RY
13070 y%=y%+£P21 *RX+£P22*RY+£P23*RZ
13080 £XSC%=£XSC%+x%:£YSC%=£YSC%+y%
13090 PLOTK%,x%,y%:ENDPROC
13100 DEFFN£PT3(X,Y,Z):PROC£PL3(4,X,Y,Z):=POINT(£XSC%,£YSC%)
13130 DEFPROC£AX3(M%):LOCALP1,P2,P3,P4,P5,P6,LM%,DM%,a%
13140 IFM%=1THENGOSUB13170ELSEIFM%=2 THENGOSUB13560ELSEIFM%=3 THENGOSUB13700ELSEGOSUB13170:GOSUB13560:GOSUB13700
13150 ENDPROC
13170 £SXI=FN£I(£XI%,£XL,£XH):£SYI=FN£I(£YI%,£YL,£YH):£SZI=FN£I(£ZI%,£ZL,£ZH)
13180 PROC£ax(£XO,£XL,£XH,£SXI):£SXO=£0:£SXL=£1:£SXH=£2
13190 PROC£ax(£YO,£YL,£YH,£SYI):£SYO=£0:£SYL=£1:£SYH=£2
13200 PROC£ax(£ZO,£ZL,£ZH,£SZI):£SZO=£0:£SZL=£1:£SZH=£2
13220 PROC£se
13240 P4=£SXH-£SXL:P5=£SYH-£SYL:P6=£SZH-£SZL
13260 LM%=£HM%DIV1E3:DM%=£VM%DIV1E3
13270 £1=£SXS%-LM%-£HM%MOD1E3:P1=£1/P4:P2=£1/P5
13280 £2=£SYS%-DM%-£VM%MOD1E3:P3=£2/P6
13300 IFABS((P1-P2)/(P1+P2))<.4THENP1=FNmin(P1,P2):P2=P1
13310 IFABS((P1-P3)/(P1+P3))>.2THEN13340
13320 IFPI <P3 THENP3=P1 ELSE£0=P1:P1=P3:IF£0=P2 THENP2=P3
13340 £0=COS(£TH):£P11=-SIN(£PH):£P22=£0*£P11
13350 £P12=COS(£PH):£P21=-£0*£P12:£P23=SIN(£TH)
13370 P6=P1*P4*ABS(£P21)+P2*P5*ABS(£P22)+P3*P6*ABS(£P23)
13380 P5=P1*P4*ABS(£P11)+P2*P5*ABS(£P12)
13400 £0=FNmin(£1/P5,£2/P6)
13410 £XFA=£0*P1:£YFA=£0 *P2:£ZFA=£0*P3:P5=£0*P5:P6=£0*P6
13430 IF£P11<0THENP1=£SXH ELSEP1=£SXL
13440 IF£P12<0THENP2=£SYH ELSEP2=£SYL
13450 P3=(P2-£SYO)*£YFA*£P12+(P1-£SXO)*£XFA*£P11
13470 IF£P21<0THENP1=£SXH ELSEP1=£SXL
13480 IF£P22<0THENP2=£SYH ELSEP2=£SYL
13490 IF£P23<0THENP4=£SZH ELSEP4=£SZL
13500 P4=(P1-£SXO)*£XFA*£P21+(P2-£SYO)*£YFA*£P22+(P4-£SZO)*£ZFA*£P23
13520 £XCR%=£SXB%+LM%+(£1-P5)/2-P3
13530 £YCR%=£SYB%+DM%+(£2-P6)/2-P4
13540 RETURN
13560 PROC£co(£XC%,4):PROC£MV3(£SXL,£SYO,£SZO):PROC£DR3(£SXH,£SYO,£SZO)
13570 PROC£co(£YC%,4):PROC£MV3(£SXO,£SYL,£SZO):PROC£DR3(£SXO,£SYH,£SZO)
13580 PROC£co(£ZC%,4):PROC£MV3(£SXO,£SYO,£SZL):PROC£DR3(£SXO,£SYO,£SZH)
13590 B=FN£pp(£SZI,£XP%):PROC£co(£XC%,2)
13600 FORA=£SXL TO£SXH+£SXI/2STEP£SXI
13610 PROC£MV3(A,£SYO,£SZO+B):PROC£DR3(A,£SYO,£SZO+B+£0):NEXT
13620 B=FN£pp(£SXI,£YP%):PROC£co(£YC%,2)
13630 FORA=£SYL TO£SYH+£SYI/2STEP£SYI
13640 PROC£MV3(£SXO+B,A,£SZO):PROC£DR3(£SXO+B+£0,A,£SZO):NEXT
13650 B=FN£pp(£SXI,£ZP%):PROC£co(£ZC%,2)
13660 FORA=£SZL TO£SZH+£SZI/2STEP£SZI
13670 PROC£MV3(£SXO+B,£SYO,A):PROC£DR3(£SXO+B+£0,£SYO,A):NEXT
13680 RETURN
13700 P1=FN£pr(£XP%,4):P2=(£XP%DIV1E6)-500:P3=£CH%DIV1E3
13720 a%=@%:@%=FN£su(£SXL,£SXH,£SXI,P1)
13740 VDU5:PROC£co(£XC%,0):PROC£MV3(£SXH,£SYO,£SZO)
13750 PLOTO,0,P2:FORP4=1TOP1 DIV2:VDU8:NEXT:PRINT£SXH*10^£0:IF£0 <>0THENPRINT"E";-£0
13760 P1=FN£pr(£YP%,4):F2=(£YP%DIV1E6)-500
13770 @%=FN£su(£SYL,£SYH,£SYI,P1)
13780 PROC£co(£YC%,0):PROC£MV3(£SXO,£SYH,£SZO)
13790 PLOT0,0,P2:PRINT£SYH*10''£0:IF£0<>0THENPRINT"E";-£0
13800 P1=FN£pr(£ZP%,4):P2=(£ZP%DIV1E6)-500
13810 @%=FN£su(£SZL,£SZH,£SZI,P1)
13820 PROC£co(£ZC%,0):PROC£MV3(£SXO,£SYO,£SZH)
13830 PLOT 0,0,P2:FORP4=1TOP1 DIV2:VDU8:NEXT:PRINT£SZH*10^£0:IF£0<>0THENPRINT"E";-£0
13840 VDU4:@%=a%:RETURN
0 REM Graphs and Charts Pack
1 REM Copyright (C) Acornsoft 1982
10 :REM L3-CO2D
20 £M%=5:IM%=10:JM%=10
30 F$="0":DIM £W(IM%,JM%)
40 ON ERROR GOTO 700
90 MODE4:VDU19 128,4,0,0,0
100 K%=0:REPEAT PROCh(1)
110 £M%=FNp(K%,4,"Mode for graph",£M%)
112 IF £M%<4 THEN PRINTTAB(2,5)"No room for MODE";£M%:GOTO 110
120 PROC£INIT(£M%)
130 PROCc(6)
140 K%=1:UNTIL FNe
150 REM
160 CLS:K%=0:REPEAT PROCh(2)
170 PRINTTAB(2,4)"Horizontal axis:"
180 £XL=FNp(K%,5,"Left end",£XL)
190 £XH=FNp(K%,6,"Right end",£XH)
200 PRINTTAB(2,8)"Vertical axis:"
210 £YL=FNp(K%,9,"Low end",£YL)
220 £YH=FNp(K%,10,"High end",£YH)
250 K%=1:UNTIL FNe
260 REM
300 PROCh(3)
310 PRINT TAB(2,4)"READY TO PLOT GRAPH"
320 PRINTTAB(2,6)"After axes drawn,use keys:"
342 PRINT" L: change logical colours"
350 PRINT" F: input function F(X,Y)"
360 PRINT" P: plot contours"
375 PRINT" T: title "
377 PRINT" U: print fn at X,Y"
379 PRINT" ?: list of prompts"
380 PRINTTAB(2,29)"press";:GOSUB 1270
390 A$=GET$:IF NOT(A$=" ")THEN380
400 REM
500 X=£CH%MOD1E3:£YB%=3 *X:£YS%=1023-4*X
510 REM
520 MODE £M%
530 PROC£AXES(0):PROC£co(£XC%,2)
550 PRINTTAB(0,29)SPC(1280DIV(£CH%MOD1E3))TAB(0,29);
560 A$=GET$
580 IF A$="C"THENINPUT"Colour ",X:GCOL0,X
582 IF A$="L"THENINPUT"logical,actual col",A%,B%:VDU19 A%,B%,0,0,0
590 IF A$="F"THENINPUT "Function F(X,Y)",F$:PROCw
600 IF A$="P "THENINPUT"Z1, Z2, N ",HI,B2,N%:PROCplot
620 IF A$="T"THENINPUT"Title,X,Y,Z",A$,X,Y,Z:PROC£MV3(X,Y,Z):VDU5:PRINTA$:VDU4
630 IF A$="?"THENPRINT"C,L,P,T,F,U":A$=INKEY$(300)
680 GOTO550
690 REM error branch
700 MODE7:IF ERR=17 THEN900
710 REPORT
900 PRINTTAB(0,10)"Stop or repeat? (S/R)";
910 A$=GET$
920 IF A$="S" THENPRINT:END
930 IF A$="R " THEN 90
940 GOTO910
950 REM
1000 DEF FNp(M%,L%,P$,V):LOCAL P%,V$
1010 PRINT TAB(2,L%);P$;" =";V;
1020 IF M%>0 THEN PRINT" ? ";:P%=POS
1030 PRINT SPC(39-P%);:IF M%=0 THEN =V
1040 INPUT TAB(P%,L%)V$
1050 IF LEN(V$)>0 THEN V=VAL(V$)ELSE M%=0
1060 GOTO1010
1100 DEF PROCh(N%):CLS
1120 PRINT TAB(2,2);"3-D CONTOURS";SPC(5); "PAGE ";N%
1130 ENDPROC
1200 DEF FNe:LOCAL A$
1210 PRINT TAB(0,29)"Type C to change data,";:GOSUB 1270
1220 A$=GET$
1230 IF A$=" " THEN =TRUE
1240 IF A$="C" THEN =FALSE
1250 GOTO 1220
1260 REM
1270 PRINT" SPACE to continue":RETURN
1300 DEF PROCc(L%)
1302 PRINTTAB(2,L%)"Logical colours for:"
1304 IF FN£pr(£XC%,6)=0 THEN A%=1:B%=1:C%=1:GOTO1330
1310 A%=FN£pr(£XC%,4):B%=FN£pr(£XC%,2)
1320 C%=FN£pr(£XC%,0)
1330 A%=FNp(K%,L%+2,"axes ",A%)
1340 B%=FNp(K%,L%+3,"pips ",B%)
1350 C%=FNp(K%,L%+4,"labels",C%)
1360 £XC%=((100+A%)*100+B%)*100+C%
1370 PRINTTAB(2,L%+6)"Actual colours may be changed later."
1380 ENDPROC
2000 DEF PROCeval
2010 d=(£XH-£XL)/IM%:e=(£YH-£YL)/JM%
2020 FOR J%=0 TO JM%:Y=£YL+e*J%
2030 FOR I%=0 TO IM%:X=£XL+d*I%
2040 £W(I%,J%)=EVAL(F$)
2050 NEXT:NEXT
2060 ENDPROC
2070 REN
2100 DEF PROC£PLOTCON(K%,I,J)
2110 PROC£PL3(K%,£XL+I*d,£YL+J*e,z)
2120 ENDPROC
2200 DEF PROCplot:LOCAL DZ
2210 DZ=(H2-H1)/N%
2220 FOR z=H1 TO H2+DZ/2 STEP DZ
2230 PROC£CNTR(Z,IM%,JM%):
2240 NEXT
2250 ENDPROC
10060 DEFPROC£INIT(M%): £M%=M%
10070 £XL=-10:£XH=10:£YL=-10:£YH=10:£ZL=-10:£ZH=10
10080 £XO=0:£YO=0:£ZO=0:£XI%=7:£YI%=7:£ZI%=7
10090 £XN%=1:£YN%=1:£SN%=1
10100 IF M%=2 O RM%=5 THEN £CH%=64 ELSE £CH%=32
10110 £YB%=0:£YS%=1023:£XB%=3*£CH%:£XS%=1279-£XB%
10120 £VM%=64064:£HM%=2*(1000*£CH%+£CH%):£CH%=1000*£CH%+32
10130 £XP%=484040225:£YP%=504040225:£ZP%=540040225
10140 IF M%=1 OR M%=2 OR M%=5 THEN £XC%=1010203 ELSE £XC%=0
10150 £YC%=0:£ZC%=0
10160 £TH=1.3:£PH=-1.3
10170 ENDPROC
10200 DEFFN£I(N%,LO,HI):LOCALA,B,C
10220 C=(HI-LO)/N%:IF0>=C THENPROC£er("Bad axis range")
10230 C=FNmax(C,FNmax(ABS(LO),ABS(HI))/1E6)
10250 A=10^INT(LOG(C)):B=C/A
10270 IFB>7.1THENB=10ELSEIFB>3.2THENB=5ELSEIFB>1.4THENB=2ELSEB=1
10280 =A*B
10310 DEF PROC£ax(O,LO,HI,I)
10350 IFLO-I/2>=O ORO>=HI THENO=INT(LO/I-.1)*I:LO=O
10370 LO=O+I*INT((LO-O)/I+.1)
10380 HI=O-I*INT((O-HI)/I+.1)
10400 £0=O:£1=LO:£2=HI:ENDPROC
10430 DEF PROC£se:LOCAL S%
10440 S%=(£SN%-1)MOD(£XN%*£YN%)
10450 £SXS%=£XS% DIV £XN%:£SYS%=£YS% DIV £YN%
10460 £SXB%=£XB%+S%MOD£XN%*£SXS%
10470 £SYB%=£YB%+S%DIV£XN%*£SYS%:ENDPROC
10490 DEFFN£fa(S%,M%,HI,LO):£0=HI-LO:=(S%-(M%MOD1000)-(M%DIV1000))/£0
10510 DEF FN£pp(L,M%)
10520 £0=FN£pr(M%,0)*L/100
10530 ON 1+(FN£pr(M%,2) MOD 3) GOTO 10540,10550,10560
10540 =0.
10550 =-£0
10560 =-£0/2
10590 DEFPROC£co(C%,N%):IFFN£pr(C%,6)>0THENGCOL0,FN£pr(C%,N%)
10600 ENDPROC
10630 DEFFN£su(lo,hi,I,f%):LOCALi%,j%,c%,d%,s%,p%
10640 i%=INT(LOG(I)+.01):j%=INT(LOG(FNmax(ABS(lo),ABS(hi)))+.01)
10660 IFj%>0THENc%=j%+1:ELSEc%=1
10670 IFNOTi%<0THENd%=0:p%=0:ELSEd%=-i%:p%=1
10690 IFlo<0ORhi<0THENs%=1ELSEs%=0
10710 IFNOT(f%<p%+s%+c%+d%)THEN£0=0ELSEd%=0:p%=0:£0=FNmin(-i%,f%-j%-s%-1)
10730 IFd%=0THENi%=&10000+f%ELSEi%=&10200+d%
10740 =f%+&100*i%
10760 DEFFNmax(a,b):IFb>a THEN=b ELSE=a
10770 DEFFNmin(a,b):IFb<a THEN=b ELSE=a
10780 DEFFN£pr(n%,d%)=(n%DIV(10^d%))MOD100
10790 DEFPROC£er(a$):PRINT"Graphics package error"
10800 PRINTa$:STOP:ENDPROC
12010 DEF PROC£MOVE(X,Y):PLOT 4,FN£x(X),FN£y(Y):ENDPROC
12020 DEF PROC£DRAW(X,Y):PLOT 5,FN£x(X),FN£y(Y):ENDPROC
12030 DEF PROC£PLOT(K%,X,Y) :LOCAL x,y
12040 IF K%MOD8<4 THEN x=£XFA*X:y=£YFA*Y :£XSC%=£XSC%+x:£YSC%=£YSC%+y:ELSE x=FN£x(X):y=FN£y(Y)
12050 PLOT K%,x,y:ENDPROC
12060 DEF FN£POINT(X,Y)=POINT FN£x(X),FN£y(Y)
12070 DEF FN£x(X):£XSC%=£XCR%+£XFA*(X-£SXO):=£XSC%
12080 DEF FN£y(Y):£YSC%=£YCR%+£YFA*(Y-£SYO):=£YSC%
12100 DEF PROC£AXES(M%):LOCAL A,B,f%,d%,a%,l%,w%,L$,y%
12110 IF M%=1 THEN GOSUB 12140 ELSE IF M%=2 THEN GOSUB 12300 ELSE IF M%=3 THEN GOSUB 12400 ELSE GOSUB 12140:GOSUB 12300:GOSUB 12400
12120 ENDPROC
12140 £SXI=FN£I(£XI%, £XL,£XH):£SYI=FN£I (£YI%,£YL,£YH)
12150 PROC£ax(£XO,£XL,£XH,£SXI):£SXO=£0:£SXL=£1:£SXH=£2
12160 PROC£ax(£YO,£YL,£YH,£SYI):£SYO=£0:£SYL=£1:£SYH=£2
12180 PROC£se
12200 £XFA=FN£fa(£SXS%,£HM%,£SXH,£SXL):A=£0*£XFA
12210 £YFA=FN£fa(£SYS%,£VM%,£SYH,£SYL):B=£0*£YFA
12230 £0=ABS((£XFA-£YFA)/(£XFA+£YFA))
12240 IF ABS((£XFA-£YFA)/(£XFA+£YFA))<.15 THEN £XFA=FNmin(£XFA,£YFA):£YFA=£XFA
12260 £XCR%=£SXB%+(£HM% DIV 1000)+£XFA*(£SXO-£SXL)+(A-£XFA*(£SXH-£SXL))/2
12270 £YCR%=£SYB%+(£VM%DIV1000)+£YFA*(£SYO-£SYL)+(B-£YFA*(£SYH-£SYL))/2
12280 RETURN
12300 PROC£co(£XC%,4):PROC£MOVE(£SXL,£SYO) :PROC£DRAW(£SXH,£SYO)
12310 PROC£co(£YC%,4):PROC£MOVE(£SXO,£SYL) :PROC£DRAW(£SXO,£SYH)
12320 B=FN£pp(£SYI,£XP%) :PROC£co(£XC%,2)
12330 FOR A=£SXL TO £SXH+£SXI/2 STEP £SXI
12340 PROC£MOVE(A,£SYO+B):PROC£DRAW(A,£SYO+B+£0):NEXT
12350 A=FN£pp(£SXI,£YP%):PROC£co(£YC%,2)
12360 FOR B=£SYL TO £SYH+£SYI/2 STEP £SYI
12370 PROC£MOVE(£SXO+A,B):PROC£PLOT(1,£0,0):NEXT
12380 RETURN
12400 f%=FN£pr(£XP%,4):w%=£CH%DIV1E3
12420 a%=@%:@%=FN£su(£SXL,£SXH,£SXI,f%)
12440 IF£XFA*£SXI>(1+f%)*w%ANDNOT(£M%=2OR£M%=5 )THENl%=TRUEELSEl%=£
12460 VDU 5:PROC£co(£XC%,0):A=£SXH
12470 IF£0<>0THENL$="E"+STR$(-£0)ELSEL$=""
12480 d%=£SXB%+£SXS%:y%=FN£y(£SYO)+(£XP%DIV1E6)-500
12490 REPEATIFABS(A)<£SXI/2THENA=0
12500 L$=STR$(A*10^£0)+L$:B=LEN(L$)*w%
12510 d%=FNmin(FN£x(A)-B/2,d%-B-w%DIV2)
12520 PLOT4,d%,y%:PRINTL$:L$=""
12530 IFl%THENA=A-£SXI ELSEA=£SXL:l%=TRUE
12540 UNTILA<£SXL-£SXI/2
12560 f%=FN£pr(£YP%,4):y%=£CH%MOD1E3:d%=y%+£YP%DIV1E6-500
12570 @%=FN£su(£SYL,£SYH,£SYI,f%)
12580 IF£YFA*£SYI>2*y%ANDNOT(£M%=2OR£M%=5)THENl%=lELSEl%=0
12590 PROC£co(£YC%,0 ):B=£SYL
12600 REPEAT PROC£MOVE(£SXO,B)
12610 IF ABS(B)<£SYI/2 THEN B=0
12630 PLOT0,-w%DIV2, d%:FORA=1TOf%:VDU8: NEXT:PRINTB*10^£0;
12640 IFl%=1THENB=B+£SYI ELSE B=£SYH:l%=1
12650 UNTILB>£SYH+£SYI/2
12660 IF £0<>0 THEN PRINT"E";-£0
12670 VDU 4:@%=a%:RETURN
14000 REM
14020 DEFPROC£CNTR(Z,NI%,NJ%):LOCALK%,X,Y,F%,I%,J%,Z0,Z1
14070 FORJ%=0TONJ%-1:FORI%=0TONI%-1:K%=1
14080 Z0=£W(I%,J%):Z1=£W(I%+1,J%):GOSUB14180
14090 IFF%=1THENX=I%+D:Y=J%:GOSUB14210
14100 Z0=Z1:Z1=£W(I%+1,J%+1):GOSUB14180
14110 IFF%=1THENX=I%+1:Y=J%+D:GOSUB14210
14120 Z0=Z1:Z1=£W(I%,J%+1):GOSUB14180
14130 IFF%=1THENX=I%+1-D:Y=J%+1:GOSUB14210
14140 Z0=Z1:Z1=£W(I%,J%):GOSUB14180
14150 IFF%=1THENX=I%:Y=J%+1-D:GOSUB14210
14160 NEXT:NEXT:ENDPROC
14180 IFZ0=Z THEND=0:K%=1-K%:F%=1:RETURN
14190 IF(ZO-Z)*(Z1-Z)<OTHEND=(Z-Z0)/(Z1-Z0):K%=1-K%:F%=1:RETURN ELSEF%=0:RETURN
14210 PROC£PLOTCON(K%+4,X,Y):RETURN
0 REM Graphs and Charts Pack
1 REM Copyright (C) Acornsoft 1982
10 :REM L3-CO3D
20 £M%=5:IM%=10:JM%=10
30 F$="0":DIM £W(IM%,JM%)
40 ON ERROR GOTO 700
90 MODE4:VDU19 128,4,0,0,0
100 K%=0:REPEAT PROCh(1)
110 £M%=FNp(K%,4,"Mode for graph",£M%)
112 IF £M%<4 THEN PRINTTAB(2,5)"No room for MODE";£M%:GOTO110
120 PROC£INIT(£M%)
130 PROCc(6)
140 K%=1:UNTIL FNe
150 REM
160 CLS:K%=0:REPEAT PROCh(2)
170 PRINTTAB(2,4)"X-axis:"
180 £XL=FNp(K%,5,"Low end",£XL)
190 £XH=FNp(K%,6,"High end",£XH)
200 PRINTTAB(2,8)"Y-axis:"
210 £YL=FNp(K%,9,"Low end ",£YL)
220 £YH=FNp(K%,10,"High end",£YH)
230 PRINTTAB(2,12)"Z-axis:"
235 £ZL=FNp(K%,13,"Low end",£ZL)
240 £ZH=FNp(K%,14,"High end",£ZH)
260 PRINTTAB(2,16)"Viewing angles in degrees:"
270 PROCth(17):PROCph(18)
280 K%=1:UNTIL FNe
290 REM
300 PROCh(3)
310 PRINT TAB(2,4)"READY TO PLOT GRAPH"
320 PRINTTAB(2,6)"After axes drawn,use keys:"
325 PRINTTAB(2,8)"A:change view angles"
330 PRINT" M: move to X,Y,Z"
332 PRINT" D: draw to X,Y,Z"
340 PRINT" C: colour "
342 PRINT" L: change logical colours"
350 PRINT" F: input function F(X,Y)"
360 PRINT" P: plot contours"
375 PRINT" T: title"
376 PRINT" U: print F(X,Y) at X,Y,Z"
379 PRINT" ?: list of prompts"
380 PRINTTAB(2,29)"press";:GOSUB 1270
390 A$=GET$:IF NOT(A$=" ")THEN380
400 REM
500 X=£CH%MOD1E3:£YB%=3*X:£YS%=1023-4*X
510 REM
520 MODE £M%
530 PROC£AX3(0):PROC£co(£XC%,2)
550 PRINTTAB(0,29)SPC(1280DIV(£CH%MOD1E3))TAB(0,29);
560 A$=GET$
570 IF A$="M"THENINPUT"Move to X,Y,Z ",X,Y,Z:PROC£MV3(X,Y,Z)
572 IF A$="D"THENINPUT"Draw to X,Y,Z ",X,Y,Z:PROC£DR3(X,Y,Z)
580 IF A$="C"THENINPUT"Colour ",X:GCOL0,X
582 IF A$="L"THENINPUT"logical, actual col",A%,B%:VDU19 A%,B%,0,0,0
590 IFA$="F"THENINPUT "Function F(X,Y)",F$:PROCw
600 IF A$="P "THENINPUT"Z1, Z2, N ",HI,B2,N%:PROCplot
620 IF A$="T"THENINPUT"Ti tle,X,Y,Z",A$,X,Y,Z:PROC£MV3(X,Y,Z):VDU5:PRINTA$:VDU4
630 IF A$="U"THEN PROCfn
640 IF A$="A"THENINPUT"Theta,Phi ",X,Y:£TH=PI*X/180:£PH=PI*Y/180:CLG:PROC£AX3(0):PROC£co(£XC%,2)
670 IF A$="?"THENPRINT"A,M,D,C,L,P,T,F,U":A$=INKEY$(500)
680 GOTO550
690 REM error branch
700 MODE7:IF ERR=17 THEN900
710 REPORT
900 PRINTTAB(0,10)"Stop or repeat?(S/R)";
910 A$=GET$
920 IF A$="S" THENPRINT:END
930 IF A$="R" THEN 90
940 GOTO910
950 REM
1000 DEF FNp(M%,L%,P$,V):LOCAL P%,V$
1010 PRINT TAB(2,L%);P$;" =";V;
1020 IF M%>0 THEN PRINT" ? ";:P%=POS
1030 PRINT SPC(39-P%);:IF M%=0 THEN =V
1040 INPUT TAB(P%,L%)V$
1050 IF LEN(V$)>0 THEN V=VAL(V$)ELSE M%=0
1060 GOTO1010
1100 DEF PROCh(N%):CLS
1120 PRINT TAB(2,2);"3-D CONTOURS";SPC(5); "PAGE ";N%
1130 ENDPROC
1200 DEF FNe:LOCAL A$
1210 PRINT TAB(0,29)"Type C to change data,";:GOSUB 1270
1220 A$=GET$
1230 IF A$=" " THEN =TRUE
1240 IF A$="C" THEN =FALSE
1250 GOTO 1220
1260 REM
1270 PRINT" SPACE to continue":RETURN
1300 DEF PROCc(L%)
1302 PRINTTAB(2,L%)"Logical colours for:"
1304 IF FN£pr(£XC%,6)=0 THEN A%=1:B%=1:C%=1:GOTO1330
1310 A%=FN£pr(£XC%,4):B%=FN£pr(£XC%,2)
1320 C%=FN£pr(£XC%,0)
1330 A%=FNp(K%,L%+2,"axes ",A%)
1340 B%=FNp(K%,L%+3,"pips ",B%)
1350 C%=FNp(K%,L%+4,"labels",C%)
1360 £XC%=((100+A%)*100+B%)*100+C%
1370 PRINTTAB(2,L%+6)"Actual colours may be changed later."
1380 ENDPROC
1400 DEF PROCfn
1410 INPUT"F(X,Y)at X,Y,Z",X,Y,Z
1420 PROC£MV3(X,Y,Z):VDU5
1430 PRINT"F(X,Y)=";F$
1440 VDU 4:ENDPROC
1500 DEF PROCth(l%)
1510 £TH=PI*FNp(K%,l%,"Theta",180*£TH/PI)/180:ENDPROC
1520 DEF PROCph(l%)
1530 £PH=PI*FNp(K%,18,"Phi ",180*£PH/PI)/180:ENDPROC
2000 DEF PROCplot:LOCAL DZ
2010 DZ=(H2-H1)/N%
2020 FOR z=H1 TO H2+DZ/2 STEP DZ
2030 PROC£CNTR(z,IM%,JM%):NEXT:ENDPROC
2040 DEF PROC£PLOTCON(K%,I,J)
2050 PROC£PL3(K%,£XL+I*d,£YL+J*e,z)
2060 ENDPROC
2070 DEF PROCw
2080 d=(£XH-£XL)/IM%:e=(£YH-£YL)/JM%
2090 FOR I%=0 TO IM%:X=£XL+I%*d
2100 FOR J%=0 TO JM%:Y=£YL+J%*e
2110 £W(I%,J%)=EVAL(F$):NEXT:NEXT
2120 ENDPROC
10060 DEFPROC£INIT(M%):£M%=M%
10070 £XL=-10:£XH=10:£YL=-10:£YH=10:£ZL=-10:£ZH=10
10080 £XO=0:£YO=0:£ZO=0:£XI%=7:£YI%=7:£ZI%=7
10090 £XN%=1:£YN%=1:£SN%=1
10100 IFM%=2ORM%=5THEN£CH%=64ELSE£CH%=32
10110 £YB%=0:£YS%=1023:£XB%=3*£CH%:£XS%=1279-£XB%
10120 £VM%=64064:£HM%=2*(1000*£CH%+£CH%):£CH%=1000*£CH%+32
10130 £XP%=484040225:£YP%=504040225:£ZP%=540040225
10140 IFM%=1ORM%=2ORM%=5THEN£XC%=1010203ELSE£XC%=0
10150 £YC%=0:£ZC%=0
10160 £TH=1.3:£PH=-1.3
10170 ENDPROC
10200 DEFFN£I(N%,LO,HI):LOCALA,B,C
10210 IF0>=N%THENPROC£er("Bad no. of intervals")
10220 C=(HI-LO)/N%:IF0>=C THENPROC£er("Bad axis range")
10230 C=FNmax(C,FNmax(ABS(LO),ABS(HI))/1E6)
10250 A=10^INT(LOG(C)):B=C/A
10270 IFB>7.1THENB=10ELSEIFB>3.2THENB=5ELSEIFB>1.4THENB=2ELSEB=1
10280 =A*B
10310 DEF PROC£ax(O,LO,HI,I)
10350 IFLO-I/2>=O ORO>=HI THENO=INT(LO/I-.1)*I:LO=O
10370 LO=O+I*INT((LO-O)/I+.1)
10380 HI=O-I*INT((O-HI)/I+.1)
10400 £0=O:£1=LO:£2=HI:ENDPROC
10430 DEF PROC£se:LOCAL S%
10440 S%=(£SN%-1)MOD(£XN%*£YN%)
10450 £SXS%=£XS%DIV£XN%:£SYS%=£YS%DIV£YN%
10460 £SXB%=£XB%+S%MOD£XN%*£SXS%
10470 £SYB%=£YB%+S%DIV£XN%*£SYS%:ENDPROC
10490 DEFFN£fa(S%,M%,HI,LO):£0=HI-LO:=(S%-(M%MOD1000)(M%DIV1000))/£0
10510 DEF FN£pp(L,M%)
10520 £0=FN£pr(M%,0)*L/100
10530 ON1+(FN£pr(M%,2)MOD3)GOTO10540,10550,10560
10540 =0.
10550 =-£0
10560 =-£0/2
10590 DEFPROC£co(C%,N%):IFFN£pr(C%,6)>0THENGCOL0,FN£pr(C%,N%)
10600 ENDPROC
10630 DEFFN£su(lo,hi,I,f%):LOCALi%,j%,c%,d%,s%,p%
10640 i%=INT(LOG(I)+.01):j%=INT(LOG(FNmax(ABS(lo),ABS(hi)))+.01)
10660 IFj%>0THENc%=j%+1:ELSEc%=1
10670 IFNOTi%<0THENd%=0:p%=0:ELSEd%=-i%:p%=1
10690 IFlo<0ORhi<0THENs%=1ELSEs%=0
10710 IFNOT(f%<p%+s%+c%+d%)THEN£0=0ELSEd%=0:p%=6:£0=FNmin(-i%,f%-j%-s%-1)
10730 IFd%=0THENi%=&10000+f%ELSEi%=&10200+d%
10740 =f%+&100*i%
10760 DEFFNmax(a,b):IFb>a THEN=b ELSE=a
10770 DEFFNmin(a,b):IFb<a THEN=b ELSE=a
10780 DEFFN£pr(n%,d%)=(n%DIV(10^d%))MOD100
10790 DEFPROC£er(a$):PRINT"Graphics package error"
10800 PRINTa$:STOP:ENDPROC
13010 DEFPROC£MV3(X,Y,Z):PROC£PL3(4,X,Y,Z):ENDPROC
13020 DEFPROC£DR3(X,Y,Z):PROC£PL3(5,X,Y,Z):ENDPROC
13030 DEFPROC£PL3(K%,X,Y,Z):LOCAL RX,RY,RZ,x%,y%
13040 IF3<K%MOD8THENRX=£SXO:RY=£SYO:£RZ=£SZO:x%=£XCR%:y%=£YCR%:£XSC%=0:£YSC%=0
13050 RX=(X-RX)*£XFA:RY=(Y-RY)*£YFA:RZ=(Z-RZ)*£ZFA
13060 x%=x%+£P11*RX+£P12*RY
13070 y%=y%+£P21*RX+£P22*RY+£P23*RZ
13080 £XSC%=£XSC%+x%:£YSC%=£YSC%+y%
13090 PLOTK%,x%,y%:ENDPROC
13100 DEFFN£PT3(X,Y,Z):PROC£PL3(4,X,Y,Z):=POINT(£XSC%,£YSC%)
13130 DEFPROC£AX3(M%):LOCALP1,P2,P3,P4,P5,P6,LM%,DM%,a%
13140 IFM%=1THENGOSUB13170ELSEIFM%=2THENGOSUB13560ELSEIFM%=3THENGOSUB13700ELSEGOSUB13170:GOSUB13560:GOSUB13700
13150 ENDPROC
13170 £SXI=FN£I(£XI%,£XL,£XH):£SYI=FN£I(£YI%,£YL,£YH):£SZI=FN£I(£ZI%,£ZL,£ZH)
13180 PROC£ax(£XO,£XL,£XH,£SXI):£SXO=£0:£SXL=£1:£SXH=£2
13190 PROC£ax(£YO,£YL,£YH,£SYI):£SYO=£0:£SYL=£1:£SYH=£2
13200 PROC£ax(£ZO,£ZL,£ZH,£SZI):£SZO=£0:£SZL=£1:£SZH=£2
13220 PROC£se
13240 P4=£SXH-£SXL:P5=£SYH-£SYL:P6=£SZH-£SZL
13260 LM%=£HM%DIV1E3:DM%=£VM%DIV1E3
13270 £1=£SXS%-LM%-£HM%MOD1E3:P1=£1/P4:P2=£1/P5
13280 £2=£SYS%-DM%-£VM%MOD1E3:P3=£2/P6
13300 IFABS((P1-P2)/(P1+P2))<.4THENP1=FNmin(P1,P2):P2=P1
13310 IFABS((P1-P3)/(P1+P3))>.2THEN13340
13320 IFP1<P3 THENP3=P1 ELSE£0=P1:P1=P3:IF£0=P2 THENP2=P3
13340 £0=COS(£TH):£P11=-SIN(£PH):£P22=£0*£P11
13350 £P12=COS(£PH):£P21=-£0*£P12:£P23=SIN(£TH)
13370 P6=P1*P4*ABS(£P21)+P2*P5*ABS(£P22)+P3*P6*ABS(£P23)
13380 P5=P1*P4*ABS(£P11)+P2*P5*ABS(£P12)
13400 £0=FNmin(£1/P5,£2/P6)
13410 £XFA=£0*P1:£YFA=£0 *P2:£ZFA=£0*P3:P5=£0*P5:P6=£0*P6
13430 IF£P11<0THENP1=£SXH ELSEP1=£SXL
13440 IF£P12<0THENP2=£SYH ELSEP2=£SYL
13450 P3=(P2-£SYO)*£YFA*£P12+(P1-£SXO)*£XFA*£P11
13470 IF£P21<0THENP1=£SXH ELSEP1=£SXL
13480 IF£P22<0THENP2=£SYH ELSEP2=£SYL
13490 IF£P23<0THENP4=£SZH ELSEP4=£SZL
13500 P4=(P1-£SXO)*£XFA*£P21+(P2-£SYO)*£YFA*£P22+(P4-£SZO)*£ZFA*£P23
13520 £XCR%=£SXB%+LM%+(£1-P5)/2-P3
13530 £YCR%=£SYB%+DM%+(£2-P6)/2-P4
13540 RETURN
13560 PROC£co(£XC%,4):PROC£MV3(£SXL,£SYO,£SZO):PROC£DR3(£SXH,£SYO,£SZO)
13570 PROC£co(£YC%,4):PROC£MV3(£SXO,£SYL,£SZO):PROC£DR3(£SXO,£SYH,£SZO)
13580 PROC£co(£ZC%,4):PROC£MV3(£SXO,£SYO,£SZL):PROC£DR3(£SXO,£SYO,£SZH)
13590 B=FN£pp(£SZI,£XP%):PROC£co(£XC%,2)
13600 FORA=£SXL TO£SXH+£SXI/2STEP£SXI
13610 PROC£MV3(A,£SYO,£SZO+B):PROC£DR3(A,£SYO,£SZO+B+£0):NEXT
13620 B=FN£pp(£SXI,£YP%):PROC£co(£YC%,2)
13630 FORA=£SYL TO£SYH+£SYI/2STEP£SYI
13640 PROC£MV3(£SXO+B,A,£SZO):PROC£DR3(£SXO+B+£0,A,£SZO):NEXT
13650 B=FN£pp(£SXI,£ZP%):PROC£co(£ZC%,2)
13660 FORA=£SZL TO£SZH+£SZI/2STEP£SZI
13670 PROC£MV3(£SXO+B,£SYO,A):PROC£DR3(£SXO+B+£0,£SYO,A):NEXT
13680 RETURN
13700 P1=FN£pr(£XP%,4):P2=(£XP%DIV1E6)-500:P3=£CH%DIV1E3
13720 a%=@%:@%=FN£su(£SXL,£SXH,£SXI,P1)
13740 VDU5:PROC£co(£XC%,0):PROC£MV3(£SXH,£SYO,£SZO)
13750 PLOT0,0,P2:FORP4=1TOP1 DIV2:VDU8:NEXT:PRINT£SXH*10^£0:IF£0<> 0THENPRINT"E";-£0
13760 P1=FN£pr(£YP%,4):P2=(£YP%DIV1E6)-500
13770 @%=FN£su(£SYL,£SYH,£SYI,P1)
13780 PROC£co(£YC%,0):PROC£MV3(£SXO,£SYH,£SZO)
13790 PLOT0,0,P2:PRINT£SYH*10^£0:IF£0<>0THENPRINT"E";-£0
13800 P1=FN£pr(£ZP%,4):P2=(£ZP%DIV1E6)-500
13810 @%=FN£su(£SZL,£SZH,£SZI,P1)
13820 PROC£co(£ZC%,0):PROC£MV3(£SXO,£SYO,£SZH)
13830 PLOT0,0,P2:FORP4=1TOP1 DIV2:VDU8:NEXT:PRINT£SZH*10^£0:IF£0<>0THENPRINT"E";-£0
13840 VDU4:@%=a%:RETURN
14020 DEFPROC£CNTR(Z,NI%,NJ%):LOCALK%,X,Y,F%,I%,J%,Z0,Z1
14070 FORJ%=0TONJ%-1:FORI%=0TONI%-1:K%=1
14080 Z0=£W(I%,J%):Z1=£W(I%+1,J%):GOSUB14180
14090 IFF%=1THENX=I%+D:Y=J%:GOSUB14210
14100 Z0=Z1:Z1=£W(I%+1,J%+1):GOSUB14180
14110 IFF%=1THENX=I%+1:Y=J%+D:GOSUB14210
14120 Z0=Z1:Z1=£W(I%,J%+1):GOSUB14180
14130 IFF%=1THENX=I%+1-D:Y=J%+1:GOSUB14210
14140 Z0=Z1:Z1=£W(I%,J%):GOSUB14180
14150 IFF%=1THENX=I%:Y=J%+1-D:GOSUB14210
14160 NEXT:NEXT:ENDPROC
14180 IFZ0=Z THEND=0:K%=1-K%:F%=1:RETURN
14190 IF(ZO-Z)*(Z1-Z)<OTHEND=(Z-Z0)/(Z1-Z0):K%=1-K%:F%=1:RETURN ELSEF%=0:RETURN
14210 PROC£PLOTCON(K%+4,X,Y):RETURN
0 REM Graphs and Charts Pack
1 REM Copyright(C)Acornsoft 1982
10 :REM L3-SURF
20 £M%=5:F$="0"
40 ON ERROR GOTO 700
90 MODE4:VDU19 128,4,0,0,0
100 K%=0:REPEAT PROCh(1)
110 £M%=FNp(K%,4,"Mode for graph",£M%)
120 PROC£INIT(£M%)
130 PROCc(6)
140 K%=1:UNTIL FNe
150 REM
160 CLS:K%=0:REPEAT PROCh(2)
170 PRINTTAB(2,4)"X-axis:"
180 £XL=FNp(K%,5,"Low end",£XL)
190 £XH=FNp(K%,6,"High end",£XH)
200 PRINTTAB(2,8)"Y-axis:"
210 £YL=FNp(K%,9,"Low end",£YL)
220 £YH=FNp(K%,10,"High end",£YH)
230 PRINTTAB(2,12)"Z-axis:"
235 £ZL=FNp(K%,13,"Low end",£ZL)
240 £ZH=FNp(K%,14,"High end",£ZH)
260 PRINTTAB(2,16)"Viewing angles in degees:"
270 PROCth(17):PROCph(18)
280 K%=1:UNTIL FNe
290 REM
300 PROCh(3)
310 PRINT TAB(2,4)"READY TO PLOT GRAPH"
320 PRINTTAB(2,6)"After axes drawn,use keys:"
325 PRINTTAB(2,8)"A:change view angles"
330 PRINT" M: move to X,Y,Z"
332 PRINT" D: draw to X,Y,Z"
340 PRINT" C: colour"
342 PRINT" L: change logical colours"
350 PRINT" F: input function F(X,Y)"
360 PRINT" P: plot"
375 PRINT" T: title"
376 PRINT" U: print F(X,Y)at X,Y,Z"
379 PRINT" ?: list of prompts"
380 PRINTTAB(2,29)"press";:GOSUB 1270
390 A$=GET$:IF NOT(A$=" ")THEN380
400 REM
500 X=£CH%MOD1E3:£YB%=3*X:£YS%=1023-4*X
510 REM
520 MODE £M%
530 PROC£AX3(0):PROC£co(£XC%,2)
550 PRINTTAB(0,29)SPC(1280DIV(£CH%MOD1E3))TAB(0,29);
560 A$=GET$
570 IF A$="M"THENINPUT"Move to X,Y,Z ",X,Y,Z:PROC£MV3(X,Y,Z)
572 IF A$="D "THENINPUT"Draw to X,Y,Z ",X,Y,Z:PROC£DR3(X,Y,Z)
580 IF A$="C"THENINPUT"Colour ",X:GCOL0,X
582 IF A$="L"THENINPUT"logical,actual col",A%,B%:VDU19 A%,B%,0,0,0
590 IFA$="F "THENINPUT"Function F(X,Y)",F$
600 IF A$="P"THENINPUT"No. intervals NX,NY "NX%,NY%:PROCplot
620 IF A$="T"THENINPUT"Ti tle,X,Y,Z",A$,X,Y,Z:PROC£MV3(X,Y,Z):VDU 5:PRINTA$:VDU4
630 IF A$="U"THEN PROCfn
640 IF A$="A"THENINPUT"Theta,Phi ",X,Y:£TH=PI*X/180:£PH=PI*Y/180:CLG:PROC£AX3(0):PROC£co(£XC%,2)
670 IF A$="?"THENPRINT"A,M,D,C,L,P,T,F,U":A$=INKEY$(500)
680 GOTO 550
690 REM error branch
700 MODE 7:IF ERR=17 THEN 900
710 REPORT
900 PRINTTAB(0,10)"Stop or repeat?(S/R)";
910 A$=GET$
920 IF A$="S" THENPRINT:END
930 IF A$="R" THEN 90
940 GOTO910
950 REM
1000 DEF FNp(M%,L%,P$,V):LOCAL P%,V$
1010 PRINT TAB(2,L%);P$;" =";V;
1020 IF M%>0 THEN PRINT" ? ";:P%=POS
1030 PRINT SPC(39-P%);:IF M%=0 THEN =V
1040 INPUT TAB(P%,L%)V$
1050 IF LEN(V$)>0 THEN V=VAL(V$)ELSE M%=0
1060 GOTO1010
1100 DEF PROCh(N%):CLS
1120 PRINT TAB(2,2);"3-D SURFACE VIEWER";SPC(5);"PAGE ";N%
1130 ENDPROC
1200 DEF FNe:LOCAL A$
1210 PRINT TAB(0,29)"Type C to change data,";:GOSUB 1270
1220 A$=GET$
1230 IF A$=" " THEN =TRUE
1240 IF A$="C" THEN =FALSE
1250 GOTO 1220
1260 REM
1270 PRINT" SPACE to continue":RETURN
1300 DEF PROCc(L%)
1302 PRINTTAB(2,L%)"Logical colours for:"
1304 IF FN£pr(£XC%,6)=0 THEN A%=1:B%=1:C%=1:GOTO1330
1310 A%=FN£pr(£XC%,4):B%=FN£pr(£XC%,2)
1320 C%=FN£pr(£XC%,0)
1330 A%=FNp(K%,L%+2,"axes ",A%)
1340 B%=FNp(K%,L%+3,"pips ",B%)
1350 C%=FNp(K%,L%+4,"labels",C%)
1360 £XC%=((100+A%)*100+B%)*100+C%
1370 PRINTTAB(2,L%+6)"Actual colours may be changed later."
1380 ENDPROC
1400 DEF PROCfn
1410 INPUT"F(X,Y) at X,Y,Z",X,Y,Z
1420 PROC£MV3(X,Y,Z):VDU5
1430 PRINT"F(X,Y)=";F$
1440 VDU4:ENDPROC
1500 DEF PROCth(l%)
1510 £TH=PI*FNp(K%,l%,"Theta",180*£TH/PI)/180:ENDPROC
1520 DEF PROCph(l%)
1530 £PH=PI*FNp(K%,18,"Phi ",180*£PH/PI)/180:ENDPROC
2000 DEF PROCp1ot:LOCAL D,E
2010 D=(£XH-£XL)/NX%:E=(£YH-£YL)/NY%
2020 FOR X=£XL TO £XH+D/2 STEP D
2030 Y=£YL:PROC£MV3(X,Y,EVAL(F$))
2040 FOR Y=£YL+E TO £YH+E/2 STEP E
2050 PROC£DR3(X,Y,EVAL(F$))
2060 NEXT:NEXT
2070 FOR Y=£YL TO £YH+E/2 STEP E
2080 X=£XL:PROC£MV3(X,Y,EVAL(F$))
2090 FOR X=£XL+D TO £XH+D/2 STEP D
2100 PROC£DR3(X,Y,EVAL(F$))
2110 NEXT:NEXT
2120 ENDPROC
10060 DEFPROC£INIT(M%):£M%=M%
10070 £XL=-10:£XH=10:£YL=-10:£YH=10:£ZL=-10:£ZH=10
10080 £XO=0:£YO=0:£ZO=0:£XI%=7:£YI%=7:£ZI%=7
10090 £XN%=1:£YN%=1:£SN%=1
10100 IFM%=2ORM%=5THEN £CH%=64ELSE£CH%=32
10110 £YB%=0:£YS%=1023:£XB%=3*£CH%:£XS%=1279-£XB%
10120 £VM%=64064:£HM%=2*(1000*£CH%+£CH%):£CH%=1000*£CH%+32
10130 £XP%=484040225:£YP%=504040225:£ZP%=540040225
10140 IFM%=1ORM%=2ORM%=5THEN£XC%=1010203ELSE£XC%=0
10150 £YC%=0:£ZC%=0
10160 £TH=1.3:£PH=-1.3
10170 ENDPROC
10200 DEFFN£I(N%,LO,HI):LOCALA,B,C
10210 IF0>=N%THENPROC£er("Bad no. of intervals")
10220 C=(HI-LO)/N%:IF0>=C THENPROC£er("Bad axis range")
10230 C=FNmax(C,FNmax(ABS(LO),ABS(HI))/1E6)
10250 A=10^INT(LOG(C)):B=C/A
10270 IFB>7.1THENB=10ELSEIFB>3.2THENB=5ELSEIFB>1.4THENB=2ELSEB=1
10280 =A*B
10310 DEF PROC£ax(O,LO,HI,I)
10350 IFLO-I/2>=O ORO>=HI THENO=INT(LO/I-.1)*I:LO=O
10370 LO=O+I*INT((LO-O)/I+.1)
10380 HI=O-I*INT((O-HI)/I+.1)
10400 £0=O:£1=LO:£2=HI:ENDPROC
10430 DEF PROC£se:LOCAL S%
10440 S%=(£SN%-1)MOD(£XN%*£YN%)
10450 £SXS%=£XS%DIV£XN%:£SYS%=£YS%DIV£YN%
10460 £SXB%=£XB%+S%MOD£XN%*£SXS%
10470 £SYB%=£YB%+S%DIV£XN%*£SYS%:ENDPROC
10490 DEFFN£fa(S%,M%,HI,LO):£0=HI-LO:=(S%-(M%MOD1000)-(M%DIV1000))/£0
10510 DEF FN£pp(L,M%)
10520 £0=FN£pr(M%,0)*L/100
10530 ON1+(FN£pr(M%,2)MOD3)GOTO10540,10550,10560
10540 =0.
10550 =-£0
10560 =-£0/2
10590 DEFPROC£co(C%,N%):IFFN£pr(C%,6)>0THENGCOL0,FN£pr(C%,N%)
10600 ENDPROC
10630 DEFFN£su(lo,hi,I,f%):LOCALi%,j%,c%,d%,s%,p%
10640 i%=INT(LOG(I)+.01):j%=INT(LOG(FNmax(ABS(lo),ABS(hi)))+.01)
10660 IFj%>0THENc%=j%+1:ELSEc%=1
10670 IFNOTi%<0THENd%=0:p%=0:ELSEd%=-i%:p%=1
10690 IFlo<0ORhi<0THENs%=1ELSEs%=0
10710 IFNOT(f%<p%+s%+c%+d%)THEN£0=0ELSEd%=0:p%=0:£0=FNmin(-i%,f%-j%-s%-1)
10730 IFd%=0THENi%=&10000+f%ELSEi%=&10200+d%
10740 =f%+&100*i%
10760 DEFFNmax(a,b):IFb>a THEN=b ELSE=a
10770 DEFFNmin(a,b):IFb<a THEN=b ELSE=a
10780 DEFFN£pr(n%,d%)=(n%DIV(10^d%))MOD100
10790 DEFPROC£er(a$):PRINT"Graphics package error"
10800 PRINTa$:STOP:ENDPROC
13010 DEFPROC£MV3(X,Y,Z):PROC£PL3(4,X,Y,Z):ENDPROC
13020 DEFPROC£DR3(X,Y,Z):PROC£PL3(5,X,Y,Z):ENDPROC
13030 DEFPROC£PL3(K%,X,Y,Z):LOCAL RX,RY,RZ,x%,y%
13040 IF3<K%MOD8THENRX=£SXO:RY=£SYO:£RZ=£SZO:x%=£XCR%:y%=£YCR%:£XSC%=0:£YSC%=0
13050 RX=(X-RX)*£XFA:RY=(Y-RY)*£YFA:RZ=(Z-RZ)*£ZFA
13060 x%=x%+£P11*RX+£P12*RY
13070 y%=y%+£P21*RX+£P22*RY+£P23*RZ
13080 £XSC%=£XSC%+x%:£YSC%=£YSC%+y%
13090 PLOTK%,x%,y%:ENDPROC
13100 DEFFN£PT3(X,Y,Z):PROC£PL3(4,X,Y,Z):=POINT(£XSC%,£YSC%)
13130 DEFPROC£AX3(M%):LOCALP1,P2,P3,P4,P5,P6,LM%,DM%,a%
13140 IFM%=1THENGOSUB13170ELSEIFM%=2THENGOSUB13560ELSEIFM%=3THENGOSUB13700ELSEGOSUB13170:GOSUB13560:GOSUB13700
13150 ENDPROC
13170 £SXI=FN£I(£XI%,£XL,£XH):£SYI=FN£I(£YI%,£YL,£YH):£SZI=FN£I(£ZI%,£ZL,£ZH)
13180 PROC£ax(£XO,£XL,£XH,£SXI):£SXO=£0:£SXL=£1:£SXH=£2
13190 PROC£ax(£YO,£YL,£YH,£SYI):£SYO=£0:£SYL=£1:£SYH=£2
13200 PROC£ax(£ZO,£ZL,£ZH,£SZI):£SZO=£0:£SZL=£1:£SZH=£2
13220 PROC£se
13240 P4=£SXH-£SXL:P5=£SYH-£SYL:P6=£SZH-£SZL
13260 LM%=£HM%DIV1E3:DM%=£VM%DIV1E3
13270 £1=£SXS%-LM%-£HM%MOD1E3:P1=£1/P4:P2=£1/P5
13280 £2=£SYS%-DM%-£VM%MOD1E3:P3=£2/P6
13300 IFABS((P1-P2)/(P1+P2))<.4THENP1=FNmin(P1,P2):P2=P1
13310 IFABS((P1-P3)/(P1+P3))>.2THEN13340
13320 IFP1<P3 THENP3=P1 ELSE£0=P1:P1=P3:IF£0=P2 THENP2=P3
13340 £0=COS(£TH):£P11=-SIN(£PH):£P22=£0*£P11
13350 £P12=COS(£PH):£P21=-£0*£P12:£P23=SIN(£TH)
13370 P6=P1*P4*ABS(£P21)+P2*P5*ABS(£P22)+P3*P6*ABS(£P23)
13380 P5=P1*P4*ABS(£P11)+P2*P5*ABS(£P12)
13400 £0=FNmin(£1/P5,£2/P6)
13410 £XFA=£0*P1:£YFA=£0*P2:£ZFA=£0*P3:P5=£0*P5:P6=£0*P6
13430 IF£P11<0THENP1=£SXH ELSEP1=£SXL
13440 IF£P12<0THENP2=£SYH ELSEP2=£SYL
13450 P3=(P2-£SYO)*£YFA*£P12+(P1-£SXO)*£XFA*£P11
13470 IF£P21<0THENP1=£SXH ELSEP1=£SXL
13480 IF£P22<0THENP2=£SYH ELSEP2=£SYL
13490 IF£P23<0THENP4=£SZH ELSEP4=£SZL
13500 P4=(P1-£SXO)*£XFA*£P21+(P2-£SYO)*£YFA*£P22+(P4-£SZO)*£ZFA*£P23
13520 £XCR%=£SXB%+LM%+(£1-P5)/2-P3
13530 £YCR%=£SYB%+DM%+(£2-P6)/2-P4
13540 RETURN
13560 PROC£co(£XC%,4):PROC£MV3(£SXL,£SYO,£SZO):PROC£DR3(£SXH,£SYO,£SZO)
13570 PROC£co(£YC%,4):PROC£MV3(£SXO,£SYL,£SZO):PROC£DR3(£SXO,£SYH,£SZO)
13580 PROC£co(£ZC%,4):PROC£MV3(£SXO,£SYO,£SZL):PROC£DR3(£SXO,£SYO,£SZH)
13590 B=FN£pp(£SZI,£XP%):PROC£co(£XC%,2)
13600 FORA=£SXL TO£SXH+£SXI/2STEP£SXI
13610 PROC£MV3(A,£SYO,£SZO+B):PROC£DR3(A,£SYO,£SZO+B+£0):NEXT
13620 B=FN£pp(£SXI,£YP%):PROC£co(£YC%,2)
13630 FORA=£SYL TO£SYH+£SYI/2STEP£SYI
13640 PROC£MV3(£SXO+B,A,£SZO):PROC£DR3(£SXO+B+£0,A,£SZO):NEXT
13650 B=FN£pp(£SXI,£ZP%):PROC£co(£ZC%,2)
13660 FORA=£SZL TO£SZH+£SZI/2STEP£SZI
13670 PROC£MV3(£SXO+B,£SYO,A):PROC£DR3(£SXO+B+£0,£SYO,A):NEXT
13680 RETURN
13700 P1=FN£pr(£XP%,4):P2=(£XP%DIV1E6)-500:P3=£CH%DIV1E3
13720 a%=@%:@%=FN£su(£SXL,£SXH,£SXI,P1)
13740 VDU5:PROC£co(£XC%,0):PROC£MV3(£SXH,£SYO,£SZO)
13750 PLOT0,0,P2:FORP4=1TOP1 DIV2:VDU8:NEXT:PRINT£SXH*10^£0:IF£0<>0THENPRINT"E";-£0
13760 P1=FN£pr(£YP%,4):P2=(£YP%DIV1E6)-500
13770 @%=FN£su(£SYL,£SYH,£SYI,P1)
13780 PROC£co(£YC%,0):PROC£MV3(£SXO,£SYH,£SZO)
13790 PLOT0,0,P2:PRINT£SYH*10''£0:IF£0<>0THENPRINT"E";-£0
13800 P1=FN£pr(£ZP%,4):P2=(£ZP%DIV1E6)-500
13810 @%=FN£su(£SZL,£SZH,£SZI,P1)
13820 PROC£co(£ZC%,0):PROC£MV3(£SXO,£SYO,£SZH)
13830 PLOT0,0,P2:FORP4=1TOP1 DIV2:VDU8:NEXT:PRINT£SZH*10^£0:IF£0<>0THENPRINT"E";-£0
13840 VDU4:@%=a%:RETURN
5.2 Level Two Programs
10000 REM Graphs and Charts
10020 REM Copyright (C) Acornsoft 1982
10030 REM L1-2D
10040 REM
10050 REM Initialisation
10060 DEF PROC£INIT(M%):£M%=M%
10070 £XL=-10:£XH=10:£YL=-10:£YH=10:£ZL=-10:£ZH=10
10080 £XO=0:£YO=0:£ZO=0:£XI%=7:£YI%=7:£ZI%=7
10090 £XN%=1:£YN%=1:£SN%=1
10100 IF M%=2 OR M%=5 THEN £CH%=64 ELSE £CH%=32
10110 £YB%=0:£YS%=1023:£XB%=3*£CH%:£XS%=1279-£XB%
10120 £VM%=64064:£HM%=2*(1000*£CH%+£CH%):£CH%=1000*£CH%+32
10130 £XP%=484040225:£YP%=504040225:£ZP%=540040225
10140 IF M%=1 OR M%=2 OR M%=5 THEN £XC%=1010203 ELSE £XC%=0
10150 £YC%=0:£ZC%=0
10160 £TH=1.3:£PH=-1.3
10170 ENDPROC
10180 REM
10190 REM Interval chooser
10200 DEF FN£I(N%,LO,HI):LOCAL A,B,C
10210 IF0>=N%THENPROC£er("Bad no. of intervals")
10220 C=(HI-LO)/N%:IF0>=C THENPROC£er("Bad axis range")
10230 C=FNmax(C,FNmax(ABS(LO),ABS(HI))/1E6)
10240 REM normalise interval size ^10
10250 A=10^INT(LOG(C)):B=C/A
10260 REM select nearest round interval
10270 IFB>7.1THENB=10ELSEIFB>3.2THENB=5ELSEIFB>1.4THENB=2ELSEB=1
10280 =A*B
10290 REM
10300 REM calc secondary origin,lo,hi
10310 DEF PROC£ax(O,LO,HI,I)
10320 REM if axes wld cross out range,
10330 REM set sec pars so cross at lo,
10340 REM and ensure orig at integer*intvl
10350 IF LO-I/2>=O OR O>=HI THEN O=INT(LO/I-.1)*I:LO=O
10360 REM anyway make ends at intg*intvl
10370 LO=O+I *INT((LO-O)/I+.1)
10380 HI=O-I*INT((O-HI)/I+.1)
10390 REM return value in £0,£1,£2
10400 £0=O:£1=LO:£2=HI:ENDPROC
10410 REM
10420 REM set up sector
10430 DEF PROC£se:LOCAL S%
10440 S%=(£SN%-1)MOD(£XN%*£YN%)
10450 £SXS%=£XS% DIV £XN%:£SYS%=£YS% DIV £YN%
10460 £SXB%=£XB%+S%MOD£XN%*£SXS%
10470 £SYB%=£YB%+S%DIV£XN%*£SYS%:ENDPROC
10480 REM
10490 DEF FN£fa(S%,M%,HI,LO):£0=HI-LO:=(S%-(M%MOD1000)-(M%DIV1000))/£0
10500 REM
10510 DEF FN£pp(L,M%)
10520 £0=FN£pr(M%,0)*L/100
10530 ON 1+(FN£pr(M%,2)MOD 3)GOTO 10540,10550,10560
10540 =0.
10550 =-£0
10560 =-£0/2
10570 REM
10580 REM Extract colour
10590 DEF PROC£co(C%,N%):IF FN£pr(C%,6)>0 THEN GCOL 0,FN£pr(C%,N%)
10600 ENDPROC
10610 REM
10620 REM scale or unscale labels
10630 DEF FN£su(lo,hi,I,f%):LOCAL i%,j%,c%,d%,s%,p%
10640 i%=INT(LOG(I)+.01):j%=INT(LOG(FNmax(ABS(lo),ABS(hi)))+.01)
10650 REM digits needed c% before,d% after
10660 IF j%>0 THEN c%=j%+1:ELSE c%=1
10670 IF NOT i%<0 THEN d%=0:p%=0:ELSE d%=-i%:p%=1
10680 REM is sign needed
10690 IF lo<0 OR hi<0 THEN s%=1 ELSEs%=0
10700 REM decide scaledy'unscaled
10710 IF NOT(f%<p%+s%+c%+d%)THEN £0=0 ELSE d%=0:p%=0:£0=FNmin(-i%,f%-j%-s%-I)
10720 REM format; gen if integer el fix
10730 IF d%=0 THEN i%=&10000+f% ELSE i%=&10200+d%
10740 =f%+&100*i%
10750 REM
10760 DEF FNmax(a,b):IFb>a THEN=b ELSE=a
10770 DEF FNmin(a,b):IFb<a THEN=b ELSE=a
10780 DEF FN£pr(n%,d%)=(n%DIV(10^d%))MOD100
10790 DEF PROC£er(a$):PRINT "Graphics package error"
10800 PRINT a$:STOP:ENDPROC
10810 REM
12000 REM --- TWO DIM ROUTINES ---
12010 DEF PROC£MOVE(X,Y):PLOT 4,FN£x(X),FN£y(Y):ENDPROC
12020 DEF PROC£DRAW(X,Y):PLOT 5,FN£x(X),FN£y(Y):ENDPROC
12030 DEF PROC£PLOT(K%,X,Y):LOCAL x,y
12040 IF K%MOD8<4 THEN x=£XFA*X:y=£YFA*Y:£XSC%=£XSC%+x:£YSC%=£YSC%+y:ELSE x=FN£x(X):y=FN£y(Y)
12050 PLOT K%,x,y:ENDPROC
12060 DEF FN£POINT(X,Y)=POINT FN£x(X),FN£y(Y)
12070 DEF FN£x(X):£XSC%=£XCR%+£XFA*(X-£SXO):=£XSC%
12080 DEF FN£y(Y):£YSC%=£YCR%+£YFA*(Y-£SYO):=£YSC%
12090 REM two dim scales & axes
12100 DEF PROC£AXES(M%):LOCAL A,B,f%,d%,a%,l%,w%,L$,y%
12110 IF M%=1 THEN GOSUB 12140 ELSE IF M%=2 THENGOSUB 12300ELSE IF M%=3 THEN GOSUB 12400 ELSEGOSUB 12140:GOSUB 12300:GOSUB 12400
12120 ENDPROC
12130 REM set intervals & ends
12140 £SXI=FN£I(£XI%,£XL,£XH):£SYI=FN£I(£YI%,£YL,£YH)
12150 PROC£ax(£XO,£XL,£XH,£SXI):£SXO=£0:£SXL=£1:£SXH=£2
12160 PROC£ax(£YO,£YL,£YH,£SYI):£SYO=£0:£SYL=£1:£SYH=£2
12170 REM set sector
12180 PROC£se
12190 REM scale factors,allow margins
12200 £XFA=FN£fa(£SXS%,£HM%,£SXH,£SXL):A=£0*£XFA
12210 £YFA=FN£fa(£SYS%,£VM%,£SYH,£SYL):B=£0*£YFA
12220 REM equalise if within 30%
12230 £0=ABS((£XFA-£YFA)/(£XFA+£YFA))
12240 IF ABS((£XFA-£YFA)/(£XFA+£YFA))<.15 THEN £XFA=FNmin(£XFA,£YFA):£YFA=£XFA
12250 REM position the sixes cross
12260 £XCR%=£SXB%+(£HM% DIV 1000)+£XFA*(£SXO-£SXL)+(A-£XFA*(£SXH-£SXL))/2
12270 £YCR%=£SYB%+(£VM%DIV1000)+£YFA*(£SYO-£SYL)+(B-£YFA*(£SYH-£SYL))/2
12280 RETURN
12290 REM draw & mark off axes
12300 PROC£co(£XC%,4):PROC£MOVE(£SXL,£SYO):PROC£DRAW(£SXH,£SYO)
12310 PROC£co(£YC%,4):PROC£MOVE(£SXO,£SYL):PROC£DRAW(£SXO,£SYH)
12320 B=FN£pp(£SYI,£XP%):PROC£co(£XC%,2)
12330 FOR A=£SXL TO £SXH+£SXI/2 STEP £SXI
12340 PROC£MOVE(A,£SYO+B):PROC£DRAW(A,£SYO+B+£0):NEXT
12350 A=FN£pp(£SXI,£YP%):PROC£co(£YC%,2)
12360 FOR B=£SYL TO £SYH+£SYI/2 STEP £SYI
12370 PROC£MOVE(£SXO+A,B):PROC£PLOT(1,£0,0):NEXT
12380 RETURN
12390 REM label axes
12400 f%=FN£pr(£XP%,4):w%=£CH%DIV1E3
12410 REM decide scaled or unscaled
12420 a%=@%:@%=FN£su(£SXL,£SXH,£SXI,f%)
12430 REM decide if OK to label all pts
12440 IF£XFA*£SXI>(1+f%)*w%ANDNOT(£M%=2OR£M%=5)THENl%=TRUE ELSEl%=FALSE
12450 REM now label
12460 VDU 5:PROC£co(£XC%,0):A=£SXH
12470 IF£0<>0THENL$="E"+STR$(-£0)ELSEL$=""
12480 d%=£SXB%+£SXS%:y%=FN£y(£SYO)+(£XP%DIV1E6)-500
12490 REPEATIFABS(A)<£SXI/2THENA=0
12500 L$=STR$(A*10^£0)+L$:B=LEN(L$)*w%
12510 d%=FNmin(FN£x(A)-B/2,d%-B-w%DIV2)
12520 PLOT4,d%,y%:PRINTL$:L$=""
12530 IFl%THENA=A-£SXI ELSEA=£SXL:l%=TRUE
12540 UNTILA<£SXL-£SXI/2
12550 REM now label Y-axis
12560 f%=FN£pr(£YP%,4):y%=£CH%MOD1E3:d%=y%+£YP%DIV1E6-500
12570 @%=FN£su(£SYL,£SYH,£SYI,f%)
12580 IF£YFA*£SYI>2*y%ANDNOT(£M%=2OR£M%=5)THENl%=1ELSEl%=0
12590 PROC£co(£YC%,0):B=£SYL
12600 REPEAT PROC£MOVE(£SXO,B)
12610 IF ABS(B)<£SYI/2 THEN B=0
12630 PLOT0,-w%DIV2,d%:FORA=1TOf%:VDU8:NEXT:PRINTB*10^£0;
12640 IFl%=1THENB=B+£SYI ELSE B=£SYH:l%=1
12650 UNTILB>£SYH+£SYI/2
12660 IF £0<>0 THEN PRINT"E";-£0
12670 VDU 4:@%=a%:RETURN
15050 :REM L2-HIS
15060 DEF PROC£BAR(K%,X,Y0,Y,W):LOCAL x,y0
15070 REM K%=0 left of bar at X
15080 REM K%=1 bar centered on X
15090 REM YO is base,Y is top,W width
15100 REM all in user units.
15110 IF ABS(Y0-Y)*£YFA<5 THEN ENDPROC
15120 IF Y0=£SYO THEN y0=Y0+SGN(Y-Y0)*10/£YFA ELSE y0=Y0
15130 IF K%=0 THEN x=X ELSE x=X-W/2
15140 PROC£PLOT(84,x,Y):PROC£PLOT(84,x,y0)
15150 PROC£PLOT(85,x+W,Y):PROC£PLOT(85,x+W,y0)
15160 ENDPROC
15170 REM
16000 REM --- Level Two:histogram --
16010 REM data expected in £X(),£Y()
16020 DEF PROC£HIS(I%,N%,W)
16030 IF I%>9 THEN GOTO 16140
16040 PROC£INIT(I%)
16050 REM find min/max X/Y
16060 £XL=£X(0):£XH=£XL:£YH=0:£YL=0
16070 FOR I%=0 TO N%
16080 £XL=FNmin(£XL,£X(I%))
16090 £YL=FNmin(£YL,£Y(I%))
16100 £XH=FNmax(£XH,£X(I%))
16110 £YH=FNmax(£YH,£Y(I%))
16120 NEXT:£XH=£XH+W
16130 PROC£AXES(0):PROC£co(£XC%,2)
16140 FOR I%=0 TO N%
16150 PROC£BAR(0,£X(I%)+W/10,0,£Y(I%),W)
16160 NEXT:ENDPROC
16170 REM ---------------------------
1518 0:REM L2-PIE
15190 DEF PROC£SEC(M%,X,Y,R,A,B):LOCAL a,b,I%
15200 REM tens digit of M%: center
15210 REM 0=screen, 1=user
15220 IF M%DIV10=1 THEN X=FN£x(X):Y=FN£y(Y)
15230 REM ones digit of M%:radius
15240 IF M%MOD10=1 THEN R=R*£YFA
15250 M%=1+50*ABS(B-A):b=(B-A)*2*PI/M%
15260 A=2*PI*A:PLOT 84,X+R*COS(A),Y+R*SIN(A)
15270 FOR I%=1 TO M%:a=A+I%*b:PLOT 84,X,Y
15280 PLOT 81,R*COS(a),R*SIN(a):NEXT
15290 a=A+M%*b/2:MOVE X+R*COS(a)*.7,Y+R*SIN(a)*.7
15300 ENDPROC
15310 REM ----------------------------
16180 REM ---- Level Two: pie chart --
16190 REM data expected in £Y() in %.
16200 DEF PROC£PIE(I%,N%):LOCAL A,B,a%,c%
16210 IF I%>8 THEN PRINT"Bad mode":STOP
16220 a%=@%:@%=&01000202:VDU5:c%=1
16230 PROC£INIT(I%):PROC£AXES(1)
16240 A=0:FOR I%=0 TO N%:B=A+£Y(I%)/100
16250 GCOL0,c%:PROC£SEC(11,0,0,8,A,B)
16260 VDU8:c%=3-c%:GCOL0,c%:PRINT £Y(I%)
16270 A=B:NEXT:@%=a%:VDU4:ENDPROC
16280 REM ----------------------------
1629 0:REM L2-XY
16300 REM data expected in £X,£Y
16310 DEF PROC£XY(I%,N%)
16320 IF I%>9 THEN GOTO 16420
16330 PROC£INIT(I%)
16340 £XL=£X(0):£XH=£XL:£YL=£Y(0):£YH=£YL
16350 FOR I%=1 TO N%
16360 £XL=FNmin(£XL,£X(I%))
16370 £YL=FNmin(£YL,£Y(I%))
16380 £XH=FNmax(£XH,£X(I%))
16390 £YH=FNmax(£YH,£Y(I%))
16400 NEXT
16410 PROC£AXES(0):PROC£co(£XC%,2)
16420 PROC£MOVE(£X(0),£Y(0))
16430 FOR I%=1 TO N%
16440 PROC£DRAW(£X(I%),£Y(I%)):NEXT
16450 ENDPROC
16460 REM ----------------------------
1686 0:REM L2-XYZ
16870 REM data expected in £X,£Y,£Z
16880 DEF PROC£XYZ(I%,N%)
16890 IF I%>9 THEN 17020
16900 PROC£INIT(I%)
16910 £XL=£X(0):£XH=£XL:£YL=£Y(0)
16920 £YH=£YL:£ZL=£Z(0):£ZH=£ZL
16930 FOR I%=1 TO N%
16940 £XL=FNmin(£XL,£X(I%))
16950 £YL=FNmin(£YL,£Y(I%))
16960 £XH=FNmax(£XH,£X(I%))
16970 £YH=FNmax(£YH,£Y(I%))
16980 £ZL=FNmin(£ZL,£Z(I%))
16990 £ZH=FNmax(£ZH,£Z(I%))
17000 NEXT
17010 PROC£AX3(0):PROC£co(£XC%,2)
17020 PROC£MV3(£X(0),£Y(0),£Z(0))
17030 FOR I%=1 TO N%
17040 PROC£DR3(£X(I%),£Y(I%),£Z(I%)):NEXT
17050 ENDPROC
17060 REM -----------------------------
1400 0 :REM L2-C2
14020 DEF PROC£CNTR(Z,NI%,NJ%):LOCAL D,K%,X,Y,F%,I%,J%,Z0,Z1
14030 REM scans £W(I,J)where 0:I,J:NI,NJ
14040 REM for mesh coords where W takes
14050 REM value Z. Calls PROC£PLOTCON(K,X,Y)
14060 REM where X,Y in mesh coords.
14070 FOR J%=0 TO NJ%-1:FOR I%=0 TO NI%-1:K%=1
14080 Z0=£W(I%,J%):Z1=£W(I%+1,J%):GOSUB 14180
14090 IF F%=1 THEN X=I%+D:Y=J%:GOSUB 14210
14100 Z0=Z1:Z1=£W(I%+1,J%+1):GOSUB 14180
14110 IF F%=1 THEN X=I%+1:Y=J%+D:GOSUB 14210
14120 Z0=Z1:Z1=£W(I%,J%+1):GOSUB 14180
14130 IF F%=1 THEN X=I%+1-D:Y=J%+1:GOSUB 14210
14140 Z0=Z1:Z1=£W(I%,J%):GOSUB 14180
14150 IF F%=1 THEN X=I%:Y=J%+1-D:GOSUB 14210
14160 NEXT:NEXT:ENDPROC
14170 REM test sides for crossing
14180 IF Z0=Z THEN D=0:K%=1-K%:F%=1:RETURN
14190 IF(Z0-Z)*(Z1-Z)<0THEN D=(Z-Z0)/(Z1-Z0):K%=1-K%:F%=1:RETURN ELSE F%=0:RETURN
14200 REM call to PROC defined by user
14210 PROC£PLOTCON(K%+4,X,Y):RETURN
15050 :REM L2-HIS
15060 DEF PROC£BAR(K%,X,Y0,Y,W):LOCAL x,y0
15070 REM K%=0 left of bar at X
15080 REM K%=1 bar centered on X
15090 REM YO is base,Y is top,W width
15100 REM all in user units.
15110 IF ABS(Y0-Y)*£YFA<5 THEN ENDPROC
15120 IF Y0=£SYO THEN y0=Y0+SGN(Y-Y0)*10/£YFA ELSE y0=Y0
15130 IF K%=0 THEN x=X ELSE x=X-W/2
15140 PROC£PLOT(84,x,Y):PROC£PLOT(84,x,y0)
15150 PROC£PLOT(85,x+W,Y):PROC£PLOT(85,x+W,y0)
15160 ENDPROC
15170 REM
16470 REM --- L2-CN2D 2 dim contour ---
16480 REM expects £W(I,J)
16490 DEF PROC£CN2D(K%,IM%,JM%,N%)
16500 LOCAL I%,J%,Z
16510 IF K%>9 THEN GOTO 16630
16520 PROC£INIT(K%):£XL=0:£YL=0:£XH=IM%:£YH%=JM%
16530 REM find min/max Z
16540 £ZL=£W(0,0):£ZH=£ZL
16550 FOR I%=0 TO IM%:FOR J%=0 TO JM%
16560 Z=£W(I%,J%):£ZL=FNmin(Z,£ZL)
16570 £ZH=FNmax(Z,£ZH):NEXT:NEXT
16580 REM round the contour heights
16590 £SZI=FN£I(N%,£ZL,£ZH)
16600 PROC£ax(£ZL,£ZL,£ZH,£SZI):£SZL=£1:£SZH=£2
16610 PROC£AXES(0):PROC£co(£XC%,2)
16620 REM plot contours
16630 FOR Z=£SZL TO £SZH+.1*£SZI STEP £SZI
16640 PROC£CNTR(Z,IM%,JM%):NEXT:ENDPROC
16650 DEF PROC£PLOTCON(K%,I,J)
16660 PROC£PLOT(K%,I,J):ENDPROC
16670 REM ------------------------------
1401 0:REM L2-C3
14020 DEF PROC£CNTR(Z,NI%,NJ%):LOCAL D,K%,X,Y,F%,I%,J%,Z0,Z1
14070 FOR J%=0 TO NJ%-1:FOR I%=0 TO NI%-1:K%=1
14080 Z0=£W(I%,J%):Z1=£W(I%+1,J%):GOSUB 14180
14090 IF F%=1 THEN X=I%+D:Y=J%:GOSUB 14210
14100 Z0=Z1:Z1=£W(I%+1,J%+1):GOSUB 14180
14110 IF F%=1 THEN X=I%+1:Y=J%+D:GOSUB 14210
14120 Z0=Z1:Z1=£W(I%,J%+1):GOSUB 14180
14130 IF F%=1 THEN X=I%+1-D:Y=J%+1:GOSUB 14210
14140 Z0=Z1:Z1=£W(I%,J%):GOSUB 14180
14150 IF F%=1 THEN X=I%:Y=J%+1-D:GOSUB 14210
14160 NEXT:NEXT:ENDPROC
14180 IF Z0=Z THEN D=0:K%=1-K%:F%=1:RETURN
14190 IF(Z0-Z)*(Z1-Z)<0THEN D=(Z-Z0)/(Z1-Z0):K%=1-K%:F%=1:RETURN ELSE F%=0:RETURN
14210 PROC£PLOTCON(K%+4,X,Y):RETURN
16680 REM --- L2-CN3D 3 dim contour --
16690 REM expects £W(I,J)
16700 DEF PROC£CN3D(K%,IM%,JM%,N%)
16710 LOCAL I%,J%,Z
16720 IF K%>9 THEN GOTO 16810
16730 PROC£INIT(K%):£XL=0:£YL=0:£XH=IM%:£YH%=JM%
16740 REM find min/max Z
16750 £ZL=£W(0,0):£ZH=£ZL
16760 FOR I%=0 TO IM%:FOR J%=0 TO JM%
16770 Z=£W(I%,J%):£ZL=FNmin(Z,£ZL)
16780 £ZH=FNmax(Z,£ZH):NEXT:NEXT
16790 PROC£AX3(0):PROC£co(£XC%,2)
16800 REM plot contours
16810 Z=(£ZH-£ZL)/(N%+1):FOR I%=1 TO N%:£2=£ZL+I%*Z
16820 PROC£CNTR(£2,IM%,JM%):NEXT:ENDPROC
16830 DEF PROC£PLOTCON(K%,I,J)
16840 PROC£PL3(K%,I,J,£2):ENDPROC
16850 REM -----------------------------
1707 0:REM L2-SURF
17090 DEF PROC£SURF(K%,IM%,JM%)
17100 LOCAL I%,J%,Z
17110 IF K%>9 THEN GOTO 17200
17120 PROC£INIT(K%):£XL=0:£YL=0:£XH=IM%:£YH%=JM%
17130 REM find min/max Z
17140 £ZL=£W(0,0):£ZH=£ZL
17150 FOR I%=0 TO IM%:FOR J%=0 TO JM%
17160 Z=£W(I%,J%):£ZL=FNmin(Z,£ZL)
17170 £ZH=FNmax(Z,£ZH):NEXT:NEXT
17180 PROC£AX3(0):PROC£co(£XC%,2)
17190 REM plot the surface
17200 FOR I%=0 TO IM%:PROC£MV3(I%,0,£W(I%,0))
17210 FOR J%=1 TO JM%:PROC£DR3(I%,J%,£W(I%,J%))
17220 NEXT:NEXT
17230 FOR J%=0 TO JM%:PROC£MV3(0,J%,£W(0,J%))
17240 FOR I%=1 TO IM%:PROC£DR3(I%,J%,£W(I%,J%))
17250 NEXT:NEXT:ENDPROC
17260 REM-----------------------------
1727 0:REM L2-STER
17280 REM data expected in £X,£Y,£Z
17290 DEF PROC£STEREO(I%,N%)
17300 IF I%>9 THEN 17420
17310 PROC£INIT(I%)
17320 £XL=£X(0):£XH=£XL:£YL=£Y(0)
17330 £YH=£YL:£ZL=£Z(0):£ZH=£ZL
17340 FOR I%=1 TO N%
17350 £XL=FNmin(£XL,£X(I%))
17360 £YL=FNmin(£YL,£Y(I%))
17370 £XH=FNmax(£XH,£X(I%))
17380 £YH=FNmax(£YH,£Y(I%))
17390 £ZL=FNmin(£ZL,£Z(I%))
17400 £ZH=FNmax(£ZH,£Z(I%))
17410 NEXT
17420 £XB%=0:£YB%=0:£XS%=1130:£YS%=924
17430 £HM%=0:£VM%=0:£XC%=0:£PH=-1.3
17440 GCOL 0,1:GOSUB 17470
17450 £XB%=150:£YB%=50:£PH=-1.2
17460 GCOL 0,2:GOSUB 17470:ENDPROC
17470 PROC£AX3(1):PROC£AX3(2)
17480 PROC£MV3(£X(0),£Y(0),£Z(0))
17490 FOR I%=1 TO N%
17500 PROC£DR3(£X(I%),£Y(I%),£Z(I%))
17510 NEXT:RETURN
17520 REM -----------------------------
1753 0:REM L2-STSU
17540 REM expects £W(I,J)
17550 DEF PROC£STSURF(K%,IM%,JM%)
17560 LOCAL I%,J%,Z
17570 IF K%>9 THEN GOTO 17650
17580 PROC£INIT(K%):£XL=0:£YL=0:£XH=IM%:£YH%=JM%
17590 REM find miny/max Z
17600 £ZL=£W(0,0):£ZH=£ZL
17610 FOR I%=0 TO IM%:FOR J%=0 TO JM%
17620 Z=£W(I%,J%):£ZL=FNmin(Z,£ZL)
17630 £ZH=FNmax(Z,£ZH):NEXT:NEXT
17640 REM set up for first view
17650 £XB%=0:£YB%=0:£XS%=1130:£YS%=924
17660 £HM%=0:£VM%=0:£XC%=0:£PH=-1.3
17670 GCOL 0,1:GOSUB 17700
17680 £XB%=150:£YB%=50:£PH=-1.2
17690 GCOL 0,2:GOSUB 17700:ENDPROC
17700 PROC£AX3(1):PROC£AX3(2)
17710 FOR I%=0 TO IM%:PROC£MV3(I%,0,£W(I%,0))
17720 FOR J%=1 TO JM%:PROC£DR3(I%,J%,£W(I%,J%))
17730 NEXT:NEXT
17740 FOR J%=0 TO JM%:PROC£MV3(0,J%,£W(0,J%))
17750 FOR I%=1 TO IM%:PROC£DR3(I%,J%,£W(I%,J%))
17760 NEXT:NEXT:RETURN
17770 REM ----------------------------
5.3 Level One Procedures
10000 REM Graphs and Charts
10020 REM Copyright (C) Acornsoft 1982
10030 REM L1-2D
10040 REM
10050 REM Initia1isation
10060 DEF PROC£INIT(M%):£M%=M%
10070 £XL=-10:£XH=10:£YL=-10:£YH=10:£ZL=-10:£ZH=10
10080 £XO=0:£YO=0:£ZO=0:£XI%=7:£YI%=7:£ZI%=7
10090 £XN%=1:£YN%=1:£SN%=1
10100 IF M%=2 OR M%=5 THEN £CH%=64 ELSE £CH%=32
10110 £YB%=0:£YS%=1023:£XB%=3*£CH%:£XS%=1279-£XB%
10120 £VM%=64064:£HM%=2*(1000*£CH%+£CH%):£CH%=1000*£CH%+32
10130 £XP%=484040225:£YP%=504040225:£ZP%=540040225
10140 IF M%=1 OR M%=2 OR M%=5 THEN £XC%=1010203 ELSE £XC%=0
10150 £YC%=0:£ZC%=0
10160 £TH=1.3:£PH=-1.3
10170 ENDPROC
10180 REM
10190 REM Interval chooser
10200 DEF FN£I(N%,LO,HI):LOCAL A,B,C
10210 IF0>=N%THENPROC£er("Bad no. of intervals")
10220 C=(HI-LO)/N%:IF0>=C THENPROC£er("Bad axis range")
10230 C=FNmax(C,FNmax(ABS(LO),ABS(HI))/1E6)
10240 REM normalise interval size ^10
10250 A=10^INT(LOG(C)):B=C/A
10260 REM select nearest round interval
10270 IFB>7.1THENB=10ELSEIFB>3.2THENB=5ELSEIFB>1.4THENB=2ELSEB=1
10280 =A*B
10290 REM
10300 REM calc secondary origin,lo,hi
10310 DEF PROC£ax(O,LO,HI,I)
10320 REM if axes wld cross out range,
10330 REM set sec pars so cross at lo,
10340 REM and ensure orig at integer*intvl
10350 IF LO-I/2>=O OR O>=HI THEN O=INT(LO/I-.1)*I:LO=O
10360 REM anyway make ends at intg*intvl
10370 LO=O+I *INT((LO-O)/I+.1)
10380 HI=O-I*INT((O-HI)/I+.1)
10390 REM return value in £0,£1,£2
10400 £0=O:£1=LO:£2=HI:ENDPROC
10410 REM
10420 REM set up sector
10430 DEF PROC£se:LOCAL S%
10440 S%=(£SN%-1)MOD(£XN%*£YN%)
10450 £SXS%=£XS% DIV £XN%:£SYS%=£YS% DIV £YN%
10460 £SXB%=£XB%+S%MOD£XN%*£SXS%
10470 £SYB%=£YB%+S%DIV£XN%*£SYS%:ENDPROC
10480 REM
10490 DEF FN£fa(S%,M%,HI,LO):£0=HI-LO:=(S%-(M%MOD1000)-(M%DIV1000))/£0
10500 REM
10510 DEF FN£pp(L,M%)
10520 £0=FN£pr(M%,0)*L/100
10530 ON 1+(FN£pr(M%,2)MOD 3)GOTO 10540,10550,10560
10540 =0.
10550 =-£0
10560 =-£0/2
10570 REM
10580 REM Extract colour
10590 DEF PROC£co(C%,N%):IF FN£pr(C%,6)>0 THEN GCOL 0,FN£pr(C%,N%)
10600 ENDPROC
10610 REM
10620 REM scale or unscale labels
10630 DEF FN£su(lo,hi,I,f%):LOCAL i%,j%,c%,d%,s%,p%
10640 i%=INT(LOG(I)+.01):j%=INT(LOG(FNmax(ABS(lo),ABS(hi)))+.01)
10650 REM digits needed c% before,d% after
10660 IF j%>0 THEN c%=j%+1:ELSE c%=1
10670 IF NOT i%<0 THEN d%=0:p%=0:ELSE d%=-i%:p%=1
10680 REM is sign needed
10690 IF lo<0 OR hi<0 THEN s%=1 ELSEs%=0
10700 REM decide scaledy'unscaled
10710 IF NOT(f%<p%+s%+c%+d%)THEN £0=0 ELSE d%=0:p%=0:£0=FNmin(-i%,f%-j%-s%-I)
10720 REM format; gen if integer el fix
10730 IF d%=0 THEN i%=&10000+f% ELSE i%=&10200+d%
10740 =f%+&100*i%
10750 REM
10760 DEF FNmax(a,b):IFb>a THEN=b ELSE=a
10770 DEF FNmin(a,b):IFb<a THEN=b ELSE=a
10780 DEF FN£pr(n%,d%)=(n%DIV(10^d%))MOD100
10790 DEF PROC£er(a$):PRINT "Graphics package error"
10800 PRINT a$:STOP:ENDPROC
10810 REM
12000 REM --- TWO DIM ROUTINES ---
12010 DEF PROC£MOVE(X,Y):PLOT 4,FN£x(X),FN£y(Y):ENDPROC
12020 DEF PROC£DRAW(X,Y):PLOT 5,FN£x(X),FN£y(Y):ENDPROC
12030 DEF PROC£PLOT(K%,X,Y):LOCAL x,y
12040 IF K%MOD8<4 THEN x=£XFA*X:y=£YFA*Y:£XSC%=£XSC%+x:£YSC%=£YSC%+y:ELSE x=FN£x(X):y=FN£y(Y)
12050 PLOT K%,x,y:ENDPROC
12060 DEF FN£POINT(X,Y)=POINT FN£x(X),FN£y(Y)
12070 DEF FN£x(X):£XSC%=£XCR%+£XFA*(X-£SXO):=£XSC%
12080 DEF FN£y(Y):£YSC%=£YCR%+£YFA*(Y-£SYO):=£YSC%
12090 REM two dim scales & axes
12100 DEF PROC£AXES(M%):LOCAL A,B,f%,d%,a%,l%,w%,L$,y%
12110 IF M%=1 THEN GOSUB 12140 ELSE IF M%=2 THENGOSUB 12300ELSE IF M%=3 THEN GOSUB 12400 ELSEGOSUB 12140:GOSUB 12300:GOSUB 12400
12120 ENDPROC
12130 REM set intervals & ends
12140 £SXI=FN£I(£XI%,£XL,£XH):£SYI=FN£I(£YI%,£YL,£YH)
12150 PROC£ax(£XO,£XL,£XH,£SXI):£SXO=£0:£SXL=£1:£SXH=£2
12160 PROC£ax(£YO,£YL,£YH,£SYI):£SYO=£0:£SYL=£1:£SYH=£2
12170 REM set sector
12180 PROC£se
12190 REM scale factors,allow margins
12200 £XFA=FN£fa(£SXS%,£HM%,£SXH,£SXL):A=£0*£XFA
12210 £YFA=FN£fa(£SYS%,£VM%,£SYH,£SYL):B=£0*£YFA
12220 REM equalise if within 30%
12230 £0=ABS((£XFA-£YFA)/(£XFA+£YFA))
12240 IF ABS((£XFA-£YFA)/(£XFA+£YFA))<.15 THEN £XFA=FNmin(£XFA,£YFA):£YFA=£XFA
12250 REM position the sixes cross
12260 £XCR%=£SXB%+(£HM% DIV 1000)+£XFA*(£SXO-£SXL)+(A-£XFA*(£SXH-£SXL))/2
12270 £YCR%=£SYB%+(£VM%DIV1000)+£YFA*(£SYO-£SYL)+(B-£YFA*(£SYH-£SYL))/2
12280 RETURN
12290 REM draw & mark off axes
12300 PROC£co(£XC%,4):PROC£MOVE(£SXL,£SYO):PROC£DRAW(£SXH,£SYO)
12310 PROC£co(£YC%,4):PROC£MOVE(£SXO,£SYL):PROC£DRAW(£SXO,£SYH)
12320 B=FN£pp(£SYI,£XP%):PROC£co(£XC%,2)
12330 FOR A=£SXL TO £SXH+£SXI/2 STEP £SXI
12340 PROC£MOVE(A,£SYO+B):PROC£DRAW(A,£SYO+B+£0):NEXT
12350 A=FN£pp(£SXI,£YP%):PROC£co(£YC%,2)
12360 FOR B=£SYL TO £SYH+£SYI/2 STEP £SYI
12370 PROC£MOVE(£SXO+A,B):PROC£PLOT(1,£0,0):NEXT
12380 RETURN
12390 REM label axes
12400 f%=FN£pr(£XP%,4):w%=£CH%DIV1E3
12410 REM decide scaled or unscaled
12420 a%=@%:@%=FN£su(£SXL,£SXH,£SXI,f%)
12430 REM decide if OK to label all pts
12440 IF£XFA*£SXI>(1+f%)*w%ANDNOT(£M%=2OR£M%=5)THENl%=TRUEELSEl%=£
12450 REM now label
12460 VDU 5:PROC£co(£XC%,0):A=£SXH
12470 IF£0<>0THENL$="E"+STR$(-£0)ELSEL$=""
12480 d%=£SXB%+£SXS%:y%=FN£y(£SYO)+(£XP%DIV1E6)-500
12490 REPEATIFABS(A)<£SXI/2THENA=0
12500 L$=STR$(A*10^£0)+L$:B=LEN(L$)*w%
12510 d%=FNmin(FN£x(A)-B/2,d%-B-w%DIV2)
12520 PLOT4,d%,y%:PRINTL$:L$=""
12530 IFl%THENA=A-£SXI ELSEA=£SXL:l%=TRUE
12540 UNTILA<£SXL-£SXI/2
12550 REM now label Y-axis
12560 f%=FN£pr(£YP%,4):y%=£CH%MOD1E3:d%=y%+£YP%DIV1E6-500
12570 @%=FN£su(£SYL,£SYH,£SYI,f%)
12580 IF£YFA*£SYI>2*y%ANDNOT(£M%=2OR£M%=5)THENl%=1ELSEl%=0
12590 PROC£co(£YC%,0):B=£SYL
12600 REPEAT PROC£MOVE(£SXO,B)
12610 IF ABS(B)<£SYI/2 THEN B=0
12630 PLOT0,-w%DIV2,d%:FORA=1TOf%:VDU8:NEXT:PRINTB*10^£0;
12640 IFl%=1THENB=B+£SYI ELSE B=£SYH:l%=1
12650 UNTILB>£SYH+£SYI/2
12660 IF £0<>0 THEN PRINT"E";-£0
12670 VDU 4:@%=a%:RETURN
10000 REM Graphs and Charts
10010 REM Copyright(C)Acornsoft 1982
10020 REM L1-3D
10040 REM
10050 REM Initialisation
10060 DEF PROC£INIT(M%):£M%=M%
10070 £XL=-10:£XH=10:£YL=- 10:£YH=10:£ZL=-10:£ZH=10
10080 £XO=0:£YO=0:£ZO=0:£XI%=7:£YI%=7:£ZI%=7
10090 £XN%=1:£YN%=1:£SN%=7
10100 IF M%=2 OR M%=5 THEN £CH%=64 ELSE £CH%=32
10110 £YB%=0:£YS%=1023:£XB%=3*£CH%:£XS%=1279-£XB%
10120 £VM%=64064:£HM%=2*(1000*£CH%+£CH%):£CH%=1000*£CH%+32
10130 £XP%=484040225:£YP%=504040225:£ZP%=540040225
10140 IF M%=1 OR M%=2 OR M%=5 THEN £XC%=1010203 ELSE £XC%=0
10150 £YC%=0:£ZC%=0
10160 £TH=1.3:£PH=-1.3
10170 ENDPROC
10180 REM
10190 REM Interval chooser
10200 DEF FN£I(N%,LO,HI):LOCAL A,B,C
10210 IF0>=N%THENPROC£er("Bad no. of intervals")
10220 C=(HI-LO)/N%:IF0>=C THENPROC£er("Bad axis range")
10230 C=FNmax(C,FNmax(ABS(LO),ABS(HI))/1E6)
10240 REM normalise interval size ^10
10250 A=10^INT(LOG(C)):B=C/A
10260 REM select nearest round istterval
10270 IFB>7.1THENB=10ELSEIFB>3.2THENB=5ELSEIFB>1.4THENB=2ELSEB=1
10280 =A*B
10290 REM
10300 REM calc secondary origin,lo,hi
10310 DEF PROC£ax(O,LO,HI,I)
10320 REM if axes wld cross out range,
10330 REM set sec pars so cross at lo,
10340 REM and ensure orig at integer*intvl
10350 IF LO-I/2>=O OR O>=HI THEN O=INT(LO/I-.1)*I:LO=O
10360 REM anyway make ends at intg*intvl
10370 LO=O+I*INT((LO-O)/I+.1)
10380 HI=O-I*INT((O-HI)/I+.1)
10390 REM return value in £0,£1,£2
10400 £0=O:£1=LO:£2=HI:ENDPROC
10410 REM
10420 REM set up sector
10430 DEF PROC£se:LOCAL S%
10440 S%=(£SN%-1)MOD(£XN%*£YN%)
10450 £SXS%=£XS% DIV £XN%:£SYS%=£YS% DIV £YN%
10460 £SXB%=£XB%+S%MOD£XN%*£SXS%
10470 £SYB%=£YB%+S%DIV £XN%*£SYS%:ENDPROC
10480 REM
10490 DEF FN£fa(S%,M%,HI,LO):£0=HI-LO:=(S%-(M%MOD1000)-(M%DIV1000))/£0
10500 REM
10510 DEF FN£pp(L,M%)
10520 £0=FN£pr(M%,0)*L/100
10530 ON 1+(FN£pr(M%,2)MOD 3)GOTO 10540,10550,10560
10540 =0.
10550 =-£0
10560 =-£0/2
10570 REM
10580 REM Extract colour
10590 DEF PROC£co(C%,N%):IF FN£pr(C%,6)>0 THEN GCOL 0,FN£pr(C%,N%)
10600 ENDPROC
10610 REM
10620 REM scale or unscale labels
10630 DEF FN£su(lo,hi,I,f%):LOCAL i%,j%,c%,d%,s%,p%
10640 i%=INT(LOG(I)+.01):j%=INT(LOG(FNmax(ABS(lo),ABS(hi)))+.01)
10650 REM digits needed c% before,d% after
10660 IF j%>0 THEN c%=j%+1:ELSE c%=1
10670 IF NOT i%<0 THEN d%=0:p%=0:ELSE d%=-i%:p%=1
10680 REM is sign needed
10690 IF lo<0 OR hi<0 THEN s%=1 ELSEs%=0
10700 REM decide scaled/unscaled
10710 IF NOT(f%<p%+s%+c%+d%)THEN £0=0 ELSE d%=0:p%=0:£0=FNmin(-i%,f%-j%-s%-1)
10720 REM format; gen if integer el fix
10730 IF d%=0 THEN i%=&10000+f% ELSE i%=&10200+d%
10740 =f%+&100*i%
10750 REM
10760 DEF FNmax(a,b):IFb>a THEN=b ELSE=a
10770 DEF FNmin(a,b):IFb<a THEN=b ELSE=a
10780 DEF FN£pr(n%,d%)=(n%DIV(10^d%))MOD100
10790 DEF PROC£er(a$):PRINT "Graphics package error"
10800 PRINT a$:STOP:ENDPROC
10810 REM
13000 REM --- THREE DIM LEVEL 1 --
13010 DEF PROC£MV3(X,Y,Z):PROC£PL3(4,X,Y,Z):ENDPROC
13020 DEF PROC£DR3(X,Y,Z):PROC£PL3(5,X,Y,Z):ENDPROC
13030 DEF PROC£PL3(K%,X,Y,Z):LOCAL RX,RY,RZ,x%,y%
13040 IF 3<K%MOD8 THEN RX=£SXO:RY=£SYO:£RZ=£SZO:x%=£XCR%:y%=£YCR%:£XSC%=0:£YSC%=0
13050 RX=(X-RX)*£XFA:RY=(Y-RY)*£YFA:RZ=(Z-RZ)*£ZFA
13060 x%=x%+£P11*RX+£P12*RY
13070 y%=y%+£P21 *RX+£P22*RY+£P23*RZ
13080 £XSC%=£XSC%+x%:£YSC%=£YSC%+y%
13090 PLOT K%,x%,y%:ENDPROC
13100 DEF FN£PT3(X,Y,Z):PROC£PL3(4,X,Y,Z):=POINT(£XSC%,£YSC%)
13110 REM
13120 REM 3-dim axes
13130 DEF PROC£AX3(M%):LOCAL P1,P2,P3,P4,P5,P6,LM%,DM%,a%
13140 IF M%=1 THEN GOSUB 13170 ELSE IF M%=2 THENGOSUB 13560ELSE IF M%=3 THEN GOSUB 13700 ELSEGOSUB 13170:GOSUB 13560:GOSUB 13700
13150 ENDPROC
13160 REM set intervals,ends
13170 £SXI=FN£I(£XI%,£XL,£XH):£SYI=FN£I(£YI%,£YL,£YH):£SZI=FN£I(£ZI%,£ZL,£ZH)
13180 PROC£ax(£XO,£XL,£XH,£SXI):£SXO=£0:£SXL=£1:£SXH=£2
13190 PROC£ax(£YO,£YL,£YH,£SYI):£SYO=£0:£SYL=£1:£SYH=£2
13200 PROC£ax(£ZO,£ZL,£ZH,£SZI):£SZO=£0:£SZL=£1:£SZH=£2
13210 REM set sector
13220 PROC£se
13230 REM ranges
13240 P4=£SXH-£SXL:P5=£SYH -£SYL:P6=£SZH-£SZL
13250 REM margins,provisional scales
13260 LM%=£HM%DIV1E3:DM%=£VM%DIV1E3
13270 £1=£SXS%-LM%-£HM%MOD1E3:P1=£1/P4:P2=£1/P5
13280 £2=£SYS%-DM%-£VM%MOD1E3:P3=£2/P6
13290 REM scale equalisation
13300 IF ABS((P1-P2)/(P1+P2))<.4 THEN P1=FNmin(P1,P2):P2=P1
13310 IF ABS((P1-P3)/(P1+P3))>.2 THENGOTO 13340
13320 IF P1<P3 THEN P3=P1 ELSE £0=P1:P1=P3:IF £0=P2 THENP2=P3
13330 REM projection matrix
13340 £0=COS(£TH):£P11=-SIN(£PH):£P22=£0*£P11
13350 £P12=COS(£PH):£P21=-£0*£P12:£P23=SIN(£TH)
13360 REM screen span
13370 P6=P1*P4*ABS(£P21)+P2*P5*ABS(£P22)+P3*P6*ABS(£P23)
13380 P5=P1*P4*ABS(£P11)+P2*P5*ABS(£P12)
13390 REM shrink factor
13400 £0=FNmin(£1/P5,£2/P6)
13410 £XFA=£0*P1:£YFA=£0*P2:£ZFA=£0*P3:P5=£0*P5:P6=£0*P6
13420 REM leftmost displacement(screen)
13430 IF £P11<0 THEN P1=£SXH ELSE P1=£SXL
13440 IF £P12<0 THEN P2=£SYH ELSE P2=£SYL
13450 P3=(P2-£SYO)*£YFA*£P12+(P1-£SXO)*£XFA*£P11
13460 REM lowest displacement
13470 IF £P21<0 THEN P1=£SXH ELSE P1=£SXL
13480 IF £P22<0 THEN P2=£SYH ELSE P2=£SYL
13490 IF £P23<0 THEN P4=£SZH ELSE P4=£SZL
13500 P4=(P1-£SXO)*£XFA*£P21+(P2-£SYO)*£YFA*£P22+(P4-£SZO)*£ZFA*£P23
13510 REM position axis cross
13520 £XCR%=£SXB%+LM%+(£1-P5)/2-P3
13530 £YCR%=£SYB%+DM%+(£2-P6)/2-P4
13540 RETURN
13550 REM draw & mark off axes
13560 PROC£co(£XC%,4):PROC£MV3(£SXL,£SYO,£SZO):PROC£DR3(£SXH,£SYO,£SZO)
13570 PROC£co(£YC%,4):PROC£MV3(£SXO,£SYL,£SZO):PROC£DR3(£SXO,£SYH,£SZO)
13580 PROC£co(£ZC%,4):PROC£MV3(£SXO,£SYO,£SZL):PROC£DR3(£SXO,£SYO,£SZH)
13590 B=FN£pp(£SZI,£XP%):PROC£co(£XC%,2)
13600 FOR A=£SXL TO £SXH+£SXI/2 STEP £SXI
13610 PROC£MV3(A,£SYO,£SZO+B):PROC£DR3(A,£SYO,£SZO+B+£0):NEXT
13620 B=FN£pp(£SXI,£YP%):PROC£co(£YC%,2)
13630 FOR A=£SYL TO £SYH+£SYI/2 STEP£SYI
13640 PROC£MV3(£SXO+B,A,£SZO):PROC£DR3(£SXO+B+£0,A,£SZO):NEXT
13650 B=FN£pp(£SXI,£ZP%):PROC£co(£ZC%,2)
13660 FOR A=£SZL TO £SZH+£SZI/2 STEP£SZI
13670 PROC£MV3(£SXO+B,£SYO,A):PROC£DR3(£SXO+B+£0,£SYO,A):NEXT
13680 RETURN
13690 REM label ends only
13700 P1=FN£pr(£XP%,4):P2=(£XP%DIV1E6)-500:P3=£CH%DIV1E3
13710 REM decide scaled or unscaled
13720 a%=@%:@%=FN£su(£SXL,£SXH,£SXI,P1)
13730 REM now label
13740 VDU 5:PROC£co(£XC%,0):PROC£MV3(£SXH,£SYO,£SZO)
13750 PLOT 0,0,P2:FOR P4=1 TO PI DIV2:VDU8:NEXT:PRINT £SXH*10^£0:IF £0<>0 THEN PRINT "E";-£0
13760 P1=FN£pr(£YP%,4):P2=(£YP%DIV1E6)-500
13770 @%=FN£su(£SYL,£SYH,£SYI,P1)
13780 PROC£co(£YC%,0):PROC£MV3(£SXO,£SYH,£SZO)
13790 PLOT 0,0,P2:PRINT £SYH*10^£0:IF £0<>0 THEN PRINT "E";-£0
13800 P1=FN£pr(£ZP%,4):P2=(£ZP%DIV1E6)-500
13810 @%=FN£su(£SZL,£SZH,£SZI,P1)
13820 PROC£co(£ZC%,0):PROC£MV3(£SXO,£SYO,£SZH)
13830 PLOT 0,0,P2:FOR P4=1 TO PI DIV2:VDU8:NEXT:PRINT £SZH*10^£0:IF £0<>0 THEN PRINT "E";-£0
13840 VDU4:@%=a%:RETURN
14000 REM L1-CNTR
14010 REM
14020 DEF PROC£CNTR(Z,NI%,NJ%):LOCAL D,K%,X,Y,F%,I%,J%,Z0,Z1
14030 REM scans £W(I,J)where 0:I,J:NI,NJ
14040 REM for mesh coords where W takes
14050 REM value Z. Calls PROC£PLOTCON(K,X,Y)
14060 REM where X,Y in mesh coords.
14070 FOR J%=0 TO NJ%-1:FOR I%=0 TO NI%-1:K%=1
14080 Z0=£W(I%,J%):Z1=£W(I%+1,J%):GOSUB 14180
14090 IF F%=1 THEN X=I%+D:Y=J%:GOSUB 14210
14100 Z0=Z1:Z1=£W(I%+1,J%+1):GOSUB 14180
14110 IF F%=1 THEN X=I%+1:Y=J%+D:GOSUB 14210
14120 Z0=Z1:Z1=£W(I%,J%+1):GOSUB 14180
14130 IF F%=1 THEN X=I%+1-D:Y=J%+1:GOSUB 14210
14140 Z0=Z1:Z1=£W(I%,J%):GOSUB 14180
14150 IF F%=1 THEN X=I%:Y=J%+1-D:GOSUB 14210
14160 NEXT:NEXT:ENDPROC
14170 REM test sides for crossing
14180 IF Z0=Z THEN D=0:K%=1-K%:F%=1:RETURN
14190 IF(Z0-Z)*(Z1-Z)<0THEN D=(Z-Z0)/(Z1-Z0):K%=1-K%:F%=1:RETURN ELSE F%=0:RETURN
14200 REM call to PROC defined by user
14210 PROC£PLOTCON(K%+4,X,Y):RETURN
15000 REM L1-BOX
15010 DEF PROC£BOX
15020 REM box round current sector
15030 PLOT 4,£SXB%,£SYB%:PLOT 1,£SXS%,0:PLOT 1,0,£SYS%
15040 PLOT 1,-£SXS%,0:PLOT 1,0,-£SYS%:ENDPROC
15050 :REM L2-HIS
15060 DEF PROC£BAR(K%,X,Y0,Y,W):LOCAL x,y0
15070 REM K%=0 left of bar at X
15080 REM K%=1 bar centered on X
15090 REM YO is base,Y is top,W width
15100 REM all in user units.
15110 IF ABS(Y0-Y)*£YFA<5 THEN ENDPROC
15120 IF Y0=£SYO THEN y0=Y0+SGN(Y-Y0)*10/£YFA ELSE y0=Y0
15130 IF K%=0 THEN x=X ELSE x=X-W/2
15140 PROC£PLOT(84,x,Y):PROC£PLOT(84,x,y0)
15150 PROC£PLOT(85,x+W,Y):PROC£PLOT(85,x+W,y0)
15160 ENDPROC
15170 REM
15180 :REM L1-SEC
15190 DEF PROC£SEC(M%,X,Y,R,A,B):LOCAL a,b,I%
15200 REM tens digit of M%: center
15210 REM 0=screen, 1=user
15220 IF M%DIV10=1 THEN X=FN£x(X):Y=FN£y(Y)
15230 REM ones digit of M%:radius
15240 IF M%MOD10=1 THEN R=R*£YFA
15250 M%=1+50*ABS(B-A):b=(B-A)*2*PI/M%
15260 A=2*PI*A:PLOT 84,X+R*COS(A),Y+R*SIN(A)
15270 FOR I%=1 TO M%:a=A+I%*b:PLOT 84,X,Y
15280 PLOT 81,R*COS(a),R*SIN(a):NEXT
15290 a=A+M%*b/2:MOVE X+R*COS(a)*.7,Y+R*SIN(a)*.7
15300 ENDPROC
15310 REM ----------------------------
Top