home *** CD-ROM | disk | FTP | other *** search
/ ftp.uni-stuttgart.de/pub/systems/acorn/ / Acorn.tar / Acorn / acornet / dev / basic / complex.basic < prev    next >
Text File  |  1991-07-22  |  9KB  |  270 lines
  1.    10REM > %.COMPLEX LIBRARY INCLUDING TRANCEDENTAL FUNCTIONS.
  2.    20PROCINITCOMPLEX
  3.    30PROCHELP
  4.    40END
  5.    50REM----------------------------------------------------------------------
  6.    60REM > TSTCMPLX
  7.    70ON ERROR INSTALL "%.COMPLEX":RUN
  8.    80PROCINITCOMPLEX
  9.    90ON ERROR OFF
  10.   100MODE9
  11.   110FORX%=0TO1280STEP4:X=-2+2.5*X%/1280.
  12.   120  FORY%=0TO1024STEP4:Y=-1.25+2.5*Y%/1024.
  13.   130    PROCSET(0,0,Z())
  14.   140    PROCSET(X,Y,C())
  15.   150    N%=0
  16.   160    REPEAT
  17.   170      N%+=1
  18.   180      PROCMUL(Z(),Z(),A())
  19.   190      PROCADD(A(),C(),Z())
  20.   200    UNTIL N%=20 OR FNABS(Z())>2.
  21.   210    IF N%=20 GCOL0 ELSE GCOL((N%MOD7)+1)
  22.   220    PLOT69,X%,Y%
  23.   230  NEXT
  24.   240NEXT
  25.   250END
  26.   260:
  27.   270:
  28.   280:
  29.   290REM > TSTCMPLX2
  30.   300ON ERROR INSTALL "%.COMPLEX":RUN
  31.   310PROCINITCOMPLEX
  32.   320S=1.2
  33.   330ON ERROR OFF
  34.   340MODE9
  35.   350FORX%=0TO1024STEP4:X=-S+2*S*X%/1024.
  36.   360  FORY%=0TO1024STEP4:Y=-S+2*S*Y%/1024.
  37.   370    PROCSET(X,Y,Z())
  38.   380    PROCSET(.6,0,C())
  39.   390    N%=0
  40.   400    REPEAT
  41.   410      N%+=1
  42.   420      PROCRPOWER(Z(),5,A())
  43.   430      PROCADD(A(),C(),Z())
  44.   440    UNTIL N%=10 OR ABS(Z(0))>10 OR ABS(Z(1))>10 OR FNABS(Z())>10
  45.   450    IF ABS(Z(0))<10 OR ABS(Z(1))<10 PLOT69,X%,Y%
  46.   460  NEXT
  47.   470NEXT
  48.   480END
  49.   490:
  50.   500:
  51.   510:
  52.   520REM > TSTCMPLX3
  53.   530ON ERROR INSTALL "%.COMPLEX":RUN
  54.   540PROCINITCOMPLEX
  55.   550S=1.2
  56.   560ON ERROR OFF
  57.   570MODE9
  58.   580FORX%=0TO1024STEP4:X=-S+2*S*X%/1024.
  59.   590  FORY%=0TO1024STEP4:Y=-S+2*S*Y%/1024.
  60.   600    PROCSET(X,Y,Z())
  61.   610    PROCSET(.6,0,C())
  62.   620    N%=0
  63.   630    REPEAT
  64.   640      N%+=1
  65.   650      PROCPOWER(Z(),Z(),A())
  66.   660      PROCRPOWER(Z(),5,B())
  67.   670      A()=A()+B()
  68.   680      PROCADD(A(),C(),Z())
  69.   690    UNTIL N%=10 OR ABS(Z(0))>10 OR ABS(Z(1))>10 OR FNABS(Z())>10
  70.   700    IF ABS(Z(0))<10 OR ABS(Z(1))<10 PLOT69,X%,Y%
  71.   710  NEXT
  72.   720NEXT
  73.   730END
  74.   740:
  75.   750:
  76.   760:
  77.   770REM > TSTCMPLX4
  78.   780ON ERROR INSTALL "%.COMPLEX":RUN
  79.   790PROCINITCOMPLEX
  80.   800S=2.2
  81.   810ON ERROR OFF
  82.   820MODE9
  83.   830FORX%=0TO1024STEP4:X=-S+2*S*X%/1024.
  84.   840  FORY%=0TO1024STEP4:Y=-S+2*S*Y%/1024.
  85.   850    PROCSET(X,Y,Z())
  86.   860    PROCSET(.5,0,C())
  87.   870    N%=0
  88.   880    REPEAT
  89.   890      N%+=1
  90.   900      PROCSIN(Z(),A())
  91.   910      PROCRPOWER(Z(),2,B())
  92.   920      A()=A()+B()
  93.   930      Z()=A()+C()
  94.   940    UNTIL N%=10 OR ABS(Z(0))>10 OR ABS(Z(1))>10 OR FNABS(Z())>10
  95.   950    IF ABS(Z(0))<10 OR ABS(Z(1))<10 PLOT69,X%,Y%
  96.   960  NEXT
  97.   970NEXT
  98.   980END
  99.   990:
  100.  1000:
  101.  1010:
  102.  1020REM > TSTCMPLX5
  103.  1030ON ERROR INSTALL "%.COMPLEX":RUN
  104.  1040PROCINITCOMPLEX
  105.  1050S=3.5
  106.  1060ON ERROR OFF
  107.  1070MODE9
  108.  1080FORX%=0TO1024STEP4:X=-S+2*S*X%/1024.
  109.  1090  FORY%=0TO1024STEP4:Y=-S+2*S*Y%/1024.
  110.  1100    PROCSET(X,Y,Z())
  111.  1110    PROCSET(1,1,C())
  112.  1120    N%=0
  113.  1130    REPEAT
  114.  1140      N%+=1
  115.  1150      PROCSIN(Z(),A())
  116.  1160      PROCEXP(Z(),B())
  117.  1170      A()=A()+B()
  118.  1180      Z()=A()+C()
  119.  1190    UNTIL N%=10 OR ABS(Z(0))>10 OR ABS(Z(1))>10 OR FNABS(Z())>10
  120.  1200    IF ABS(Z(0))<10 OR ABS(Z(1))<10 PLOT69,X%,Y%
  121.  1210  NEXT
  122.  1220NEXT
  123.  1230END
  124.  1240:
  125.  1250:
  126.  1260:
  127.  1270REM > TSTCMPLX6
  128.  1280ON ERROR INSTALL "%.COMPLEX":RUN
  129.  1290PROCINITCOMPLEX
  130.  1300S=3.25
  131.  1310ON ERROR OFF
  132.  1320MODE18
  133.  1330FORX%=0TO1024STEP2:X=-S+2*S*X%/1024.
  134.  1340  FORY%=0TO1024STEP2:Y=-S+2*S*Y%/1024.
  135.  1350    PROCSET(X,Y,Z())
  136.  1360    PROCSET(0.5,0,C())
  137.  1370    N%=0
  138.  1380    REPEAT
  139.  1390      N%+=1
  140.  1400      PROCSINH(Z(),A())
  141.  1410      PROCSIN(Z(),B())
  142.  1420      A()=A()+C()
  143.  1430      Z()=A()+B()
  144.  1440    UNTIL N%=10 OR ABS(Z(0))>10 OR ABS(Z(1))>10 OR FNABS(Z())>10
  145.  1450    IF ABS(Z(0))<10 OR ABS(Z(1))<10 PLOT69,X%,Y%
  146.  1460  NEXT
  147.  1470NEXT
  148.  1480END
  149.  1490REM-----------------------------------------------------------------------
  150.  1500DEFPROCHELP
  151.  1510CLS
  152.  1520PRINT"THIS LIBRARY PROVIDES THE FOLLOWING PROCEDURES:"'
  153.  1530PRINT"U(),V() AND W() DENOTE COMPLEX VARIABLES."
  154.  1540PRINT"X AND Y DENOTE REAL VALUES."
  155.  1550PRINT"PROCADD(   U(),V(),RETURN W())   PROCSUB(  U(),V(),RETURN W())"
  156.  1560PRINT"PROCMUL(   U(),V(),RETURN W())   PROCDIV(  U(),V(),RETURN W())"
  157.  1570PRINT"PROCRPOWER(U(),  X,RETURN W())   PROCPOWER(U(),V(),RETURN W())"
  158.  1580PRINT"PROCEXP(   U(),    RETURN W())   PROCLN(   U(),    RETURN W())"
  159.  1590PRINT"PROCSIN(   U(),    RETURN W())   PROCCOS(  U(),    RETURN W())"
  160.  1600PRINT"PROCSINH(  U(),    RETURN W())   PROCCOSH( U(),    RETURN W())"
  161.  1610PRINT"PROCTAN(   U(),    RETURN W())   PROCSET(    X,  Y,RETURN W())"
  162.  1620PRINT
  163.  1630PRINT"ALSO SUPPLIED ARE THE FOLLOWIG REAL FUNCTIONS:"
  164.  1640PRINT"FNSH(X)      FNCH(X)     FNREAL(Z())"
  165.  1650PRINT"FNIMAG(Z())  FNABS(Z())  FNARG(Z())"
  166.  1660PRINT'"OF WHICH THE FIRST TWO GIVE THE HYPERBOLIC SINE AND COSINE"
  167.  1670PRINT"OF A REAL VALUE."'
  168.  1680PRINT"CALL THE PROCEDURE PROCINITCOMPLEX,TO DEFINE THE COMPLEX VARIABLES"
  169.  1690PRINT"A() TO Z() AND THE INTERNAL DUMMY'S _A(),_B(),_C(),_A,_B AND _C"
  170.  1700PRINT"THE MULTYVALUED ROUTINES GIVE YOU THE PRINCIPAL VALUE ONLY."
  171.  1710PRINT'"TESTS HAVE BEEN RUN AGAINST ACORN FORTRAN"
  172.  1720PRINT'"6 EXAMPLE PROGRAMS WITH INTERESTING FRACTALS CAN BE FOUND INSIDE THE CODE."
  173.  1730PRINT'"YOU CAN SPLIT THEM OFF FOR TESTING, OR"
  174.  1740PRINT'"YOU CAN LEAVE THEM THERE,THEY ARE IGNORED."
  175.  1750ENDPROC
  176.  1760 
  177.  1770REM-----------------------------------------------------------------------
  178.  1780DEFPROCINITCOMPLEX
  179.  1790_A=0
  180.  1800_B=0
  181.  1810_C=0
  182.  1820DIM _A(1),_B(1),_C(1)
  183.  1830DIM A(1),B(1),C(1),D(1),E(1),F(1),G(1),H(1),I(1),J(1),K(1),L(1),M(1),N(1),O(1),P(1),Q(1),R(1),S(1),T(1),U(1),V(1),W(1),X(1),Y(1),Z(1)
  184.  1840ENDPROC
  185.  1850REM-----------------------------------------------REAL HYPERBOLIC SINE----
  186.  1860DEFFNSH(Y):=(EXPY-EXP(-Y))/2
  187.  1870REM-----------------------------------------------REAL HYPERBOLIC COSINE--
  188.  1880DEFFNCH(Y):=(EXPY+EXP(-Y))/2
  189.  1890REM-----------------------------------------------COMPLEX SINE------------
  190.  1900DEFPROCSIN(U(),W())
  191.  1910_A(0)=SINU(0)*FNCH(U(1)):_A(1)=COSU(0)*FNSH(U(1)):W()=_A()
  192.  1920ENDPROC
  193.  1930REM-----------------------------------------------COMPLEX COSINE----------
  194.  1940DEFPROCCOS(U(),W())
  195.  1950_A(0)=COSU(0)*FNCH(U(1)):_A(1)=-SINU(0)*FNSH(U(1)):W()=_A()
  196.  1960ENDPROC
  197.  1970REM-----------------------------------------------COMPLEX TANGENT---------
  198.  1980DEFPROCTAN(U(),W())
  199.  1990PROCSIN(U(),_B())
  200.  2000PROCCOS(U(),_C())
  201.  2010PROCDIV(_B(),_C(),_A())
  202.  2020W()=_A()
  203.  2030ENDPROC
  204.  2040REM-----------------------------------------------COMPLEX HYPERBOLIC SINE-
  205.  2050DEFPROCSINH(U(),W())
  206.  2060_A(0)=FNSH(U(0))*COSU(1):_A(1)=FNCH(U(0))*SINU(1):W()=_A()
  207.  2070ENDPROC
  208.  2080REM-----------------------------------------------COMPLEX HYPERBOLIC COSINE
  209.  2090DEFPROCCOSH(U(),W())
  210.  2100_A(0)=FNCH(U(0))*COSU(1):_A(1)=FNSH(U(0))*SINU(1):W()=_A()
  211.  2110ENDPROC
  212.  2120REM-----------------------------------------------COMPLEX MULTIPLICATION--
  213.  2130DEFPROCMUL(U(),V(),W())
  214.  2140_A(0)=U(0)*V(0)-U(1)*V(1):_A(1)=U(0)*V(1)+U(1)*V(0):W()=_A()
  215.  2150ENDPROC
  216.  2160:
  217.  2170REM-----------------------------------------------COMPLEX DIVISION--------
  218.  2180DEFPROCDIV(U(),V(),W()):_A=V(0)*V(0)+V(1)*V(1):_A(0)=(U(0)*V(0)+U(1)*V(1))/_A:_A(1)=(U(1)*V(0)-U(0)*V(1))/_A:W()=_A()
  219.  2190ENDPROC
  220.  2200REM-----------------------------------------------COMPLEX ADDITION--------
  221.  2210DEFPROCADD(U(),V(),W())
  222.  2220_A()=U()+V():W()=_A()
  223.  2230ENDPROC
  224.  2240REM-----------------------------------------------COMPLEX SUBTRACTION-----
  225.  2250DEFPROCSUB(U(),V(),W())
  226.  2260_A()=U()-V():W()=_A()
  227.  2270ENDPROC
  228.  2280REM-----------------------------------------COMPLEX TO A REAL(BROKEN) POWER
  229.  2290DEFPROCRPOWER(U(),X,W())
  230.  2300_C=FNABS(U())^X
  231.  2310_B=FNARG(U())*X
  232.  2320W(0)=_C*COS_B:W(1)=_C*SIN_B:ENDPROC
  233.  2330REM-----------------------------------------E TO A COMPLEX POWER-----------
  234.  2340DEFPROCEXP(U(),W())
  235.  2350_A=EXP(U(0)):_A(0)=_A*COSU(1):_A(1)=_A*SINU(1):W()=_A()
  236.  2360ENDPROC
  237.  2370REM-----------------------------------------NATURAL LOG OF A COMPLEX-------
  238.  2380DEFPROCLN(U(),W())
  239.  2390_A(0)=LN(FNABS(U())):_A(1)=FNARG(U())
  240.  2400W()=_A()
  241.  2410ENDPROC
  242.  2420REM-----------------------------------------COMPLEX TO A COMPLEX POWER-----
  243.  2430DEFPROCPOWER(U(),V(),W())
  244.  2440PROCLN(U(),_B())
  245.  2450PROCMUL(V(),_B(),_B())
  246.  2460PROCEXP(_B(),_B())
  247.  2470W()=_B()
  248.  2480ENDPROC
  249.  2490REM-----------------------------------------SET A COMPLEX TO A VALUE-------
  250.  2500DEFPROCSET(X,Y,W())
  251.  2510W(0)=X
  252.  2520W(1)=Y
  253.  2530ENDPROC
  254.  2540REM-----------------------------------------GET REAL PART OF COMPLEX-------
  255.  2550DEFFNREAL(U()):=U(0)
  256.  2560REM-----------------------------------------GET IMAGINAIRY PART OF COMPLEX-
  257.  2570DEFFNIMAG(U()):=U(1)
  258.  2580REM-----------------------------------------GET ABSOLUTE VALUE OF COMPLEX--
  259.  2590DEFFNABS(U()):=SQR(U(0)*U(0)+U(1)*U(1))
  260.  2600REM-----------------------------------------GET ARGUMENT OF COMPLEX--------
  261.  2610DEFFNARG(U())
  262.  2620IF U(0)=0 THEN
  263.  2630  IF U(1)>0 _A=PI/2 ELSEIF U(1)<0 _A=-PI/2 ELSE _A=0
  264.  2640ELSE
  265.  2650  _A=ATN(U(1)/U(0))
  266.  2660  IFU(0)<0 AND U(1)>=0 _A=_A+PI
  267.  2670  IFU(0)<0 AND U(1)<0  _A=_A-PI
  268.  2680ENDIF
  269.  2690=_A
  270.