1IBMPROGABQSYC-TO-PASC ]$GFOURIER BASt%FTEXT BASdFOUREXT BASlFT BASPARANOIADQC"YMODEL3D BAS#SIGEN BASCHEATSUB BQSULJANUS-L1LSTlJANUS-L2LST jVJANUS-L3LST K]PROGRAMSFEB %'vIBMPROGA.BASh  !"#$%&'()*+,-./0123456o789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefgLūH2,ONL2x,#v6S?x}:Wr6Sſe!.8ݍP l"j "u6Sl"fLEl"LVR^}3R TMN)CHMVI"z).4I~s߱w`nr7=r6I9i$D 6s}ιu6Ib&JKoM  gB8$@.9)˲,[qY6 f2Ҹ,MZM^Sx3rx~Oq:Sl|/"_'F|<}|o|yx݈>/A9ĥgI<𬴌 !)r6uL|<}M❀ge`]lBSlo<+-#zo"gBxVZFN|<}MD2m OI xVZ:geDW݈#.>#.Ǘ 77n6Uw]'gtUMW?Mj7`nQ sU{)i$L8gex*z:H490CIQgb&06%B?I6gb/0#KlR<+-tȉACa`eH9[J !\zBN= :r6gIxVZFnDNL2?^|8#Η8ݍ8~>}g\3/I xVZFOן>+eqn@CONjgF\_q|K9ԅgI] xVZF>E&u)YiX"x_&r6guAՑI𬴌 }"gz'YilRo<+-#:GF\}8q /q9?NWyDtPQ*;ٮI)<+-AFmCFOӯ)Wߨ4j7z0SHX8g%;A.=q.j z+MX7Jro*WorlR6%d_֔otl6&e-@Mx}g5Le&|nnIY T*a6uoq6)gCȻ9nzn8.ID.92=s9 l"gr'Yi8])F<,r6)&3!YiO8ݍ !狷8G?^|8>޾|x<_O8ݍW_dxVZF琁TONjgF\/^/O8\+%rߌ,𬴌Nw#N#{{}pqt7<,r6 3/>Nw.Ǘ7oX*Kx,dV xVZF'F///88p}u|q#Nxp_=r|/ps!6mdN6&{!Yi b6 I~MlM& 6i 9%d_ g}"& 6H Yi.!R bŻ Hf[l<+-;(7d^'%x9 I`T@TF7Icr6i\ lt })V~&V~/V~'V~+VNg})חx:^xq?/ONjqqNSl xVZF篐w#a|qj|ΘR<^ yw}=ǫ_#g^2qOח_Ο'O8_}y8}~}/4nptn'YiF?^|8qwqrkl xVZ6&[!Yi \_]/qxx~狷x~{yxu8ݍxaMget~z:wח8?=K\_x5//qƔ7痷cl<+-xN8ݍ8~#.>|o+oF&B2\1Bn5n5~|MgɶBQaʰ$&'bsgL@M0fH)iL'R A$R8ljb&S҈&۝gedQx &XACcNJLEv+0mEÔaϙ'd^Bef gc!wsĻh2,RS=2ҝH<+-JKgc xVZF19=-4k9% uO6=L]Vl70¶8}t.y}߮=-M&O4<+-n!ȀXX p6[q!E]U\*kXťx6x,ŪĪĪkk!!ab?`?*,PX1?zg$PL'rJCȻ9N8'`:͐& uO64bPbQg`ʐ.Rg`0X< FW ]!xv6NJ "u6NfCȻ9N8'{5erJLcl}ȩ!]9'[ "u6S(y ]nwsT)$}xl'LElLElL*,K#lLEl>op0D+=Wⲽs"߮澽u6gC2At{:{>$d4Lcl28 0eHq!2R}8*#q0eHq peI YOq9>_J qY6L2L8d0fl\rLgFSzhse YM]ϗ6)=k4g`kg`ʐ.Rgb&SFZTS;{ "u6.vjoJ0_JJ4dRR:_JI`$Sfԛnfel\ &ٱv6 "u6c J2ٸ.2ٸ z3P~ 4.K)i0Ɏ5 t=q6K5|))4(fI3_JJq=`kgz/!]N)CLr LU1平q`ʐ.RgRj(j<+-Jˈ$7H4ƔLE<"u6.MlɦD:o }F ѷaun`tmq6. 5Aߦ4tқ!M&ٱv6.k5Aߦџ#)ixVZ6Lcl\TUo5AOzmݤ54<+-A}ND83ojӞ&]jW/%)a*۵vo˽!6fBQ$hy7 4Rgr'@ie7sergr+&fGoo7 )ixVZFwDwQ3B8τ!6/%n"ID&Ȼ,I B8RRw,`kgY!!]ƳZ)V  Y$̗/%9J "u6&RTFvYFQYi +IBEx||HKbTF()=`}w#[g^jS}'ui<+-QƳj UF Qaun`tmq6mUFrJIo4idx/UF Yi0Ɏ>PTm=DSxfH24!ȀxX2ڴ2Uۨ z.k714^8 JtVFvY !(D4]]ly7 4L8K50ڛ 1.K]aқ!S҈wp6*#,2F\ f@Fara%%il f\{3Пr}I+#aʰ_oXIBedAft6wsE, T{V  Y:jRR%@77 4dx'wsu- R0UŔƻD`y7G\ĢaʰJ7KhzH. g3l+<+-Ju i0=ް~&˨BF9j&ٱv6ޕLEl 0eRJn/!]ƻn8.EÔa=F~`"l xVZFWק_GF?^|8-..޾xx/FX2w#>]\.>xO竧K#^O8]x9o Ji'F<t6jTWs7xq~z:Dt;W&oo#!"gm)Yiansj;x;𬴌xT*YBӃ|))r6<+-#,ޭ}oL?Ur̗"gN2:l&$d7f 'KIv+YianoS0%&2T*-𬴌x7Oa6KJH<+-#,ޭl@Zc7$! akrğqq zi9[X2ݺ`JC&ґ(<+-#,ޭmޱyoBE<+-#,ޭĘR3Wq} i|NBִ=( a`Eb&$;b/!]b'Ow8XbJTfziBl2xSz@.YJt%F)*:i4.sHSt:[$@epHbI`4 IAgR֙!vIAɍڬ"5kC`<<4.KoF=!v AV8[$&xx,0묄FeMҨ'>n!Ȁ" gd& ^g54҇zsCpS^Ȼ,ͻO_&l-&Ȼ1.KFerJy7Ey7 4<+-;(; bŻ"$T$;q"!]q, +I0/%9[ąSt:[ĵoJĻ)$$x3odlRSnohs0eXkNV@L_azm2,1'7$al<+-Xܮ+#ls0eXke xJEėbur%9mn $Ü-$0*2,M SŻ7$,- !$;E"!]E,T0/%9[St:[g%Ô۵7mn ITf -blQRSnmÔa9I0 $gb&Yi/0v]uY6LZuYDeANZ:[{JK|)V)\raʰLB.9٢ peIM~X+;ٮ՗bi2,Ҿ4VIv-j!!]u"',Al٢2٢.<+-J', F< *ɩJKg/%fT8[ԥ$0( $6#gz&Lc Ȁ,-❚`mr@RFWre 9% gz'xM/ Alr9[[@Ӄ|)񬴌(f۟E)4=Hx3E̗Rx3P*&ٱv(c "u(  UyȀD٢2٢,wsq)-ʙ$0z&٢ 7)a*u$Szhse Ygr'T6e5LeD}JzYgr+xVZ˕n+ojoRR{5n-fBF&b,UMY Sٮ#}C^f\{3Пr}lVb ,yVZ˕{t[UFbV,ީ (f&KIi\SҨd:MfZ`ny7G\עQ̗ ,Sl49[J@ӃDl1 hzuYixVZ:[joJ(I`tRR%4<+-/& !]0Ɏl'YiX6!0@Ѓmi٦JNdl1 =-4:G0eF i٦)kꞖFWؖg𬴄exVZ6juO64r&-@ӲMi9%7C4LclꞖm9XPvb_0eHž`ʐ\b_ 0eH~&0#Kl ̕4JƳ2"-179`)ϡ4`*:XmpsbҾ:4`>9k5ƼMSn&?FWؖgP4FSҘNz3I$;D@M0o4<+-&ٱvse6+m&I1F g]!YilA\mwsI"2ywYYixVZ6jқrJ~/-v7/%6+#!fy7GakgL)CH-v{ Lyda6KgN)CH-v[oJE3_JJE3#KlCȻ9D0ڛMʕQ̗R9% JˈTJf֛-|))/%}O5|))4(fI3_JJŶPx3k@M9%b+Ŷl(|)) X;[lK "u2a% ,!sȜ-{ "uwsq)-[Ju 5LsdU/%"gk!<+-E"Yiɥ'`@x 9d<+-#,~ `ka`E֢𬴌n *,1##E֢𬴌&ٱ 6&26X,T9[R23,9 l2(AߐFb&YixVZF%1r UиyDtۨ{ZҾ:8[g%=-[gkP{Zit`tuO5ANICӲMSn&?=- -7b+&PlHGS`kgD =-4FSҘNz3I$;I"&Pl4<+-&ٱvNb5e-#)iۭpN I`Jd@ol@ed,צ623)iV8['Peied qY6TP!.g7kSU7: kDnuwsq-!EQ gd' 2Ҽ>VFv4<+-.~2@jWll4=Hrge3_JJE@hd:N2:2'0%F{LTOq!!]q-0#KxVZFrJT~ &#”F=AK4LCN &rKJ3e!hi Jc:y2/23"gx&YiQ}94USDz y~9[{JHN T^azPTz@{LTO9(9㝀ge$ IK4~9kxVZ6V`z,j<+-JKgB(;ĐSDMF,C1Q=jz&ٺHՓ6i4Փ6itANIc:͐& X;[`z&6!0&'m2jES`kg4$IWYl]P rnƳ_0Zm`t,7E) P!.gg%Tz7Eorl]4=HЇ%idٺ 0eHu`S0%&3T*w.LEl] !q\ƳҲ񬴌0 }(=@0U.&(%SD9[׉geDTA㷯ߢƳҲtc)Gl<+-B@iɈ$DMFp ^f~nnDMFu] &'m2jh!0&'m2j.tқ!M&ٱvK5DMFm9B`LTOdԦ $;L x҈T&'m2jG_=guJd@ot4JNK2gz' P!.gg%>J ݪ˙u]etmr60B\)iL8[BPf\c\SҨX8[`r6ied!0r AL8[Yi.~A= Ҿ4p0Q=q+r. 2z]2/!ް&˨BF9[Yi.~sds" 3,Wl]9}Iҕu9 Cr—akgr/!]N)C{s`pl]n2z&Ĝ@ܧuS𬴌t S5LyBgY"& ,`t>X@NIó23LTOy AԳpjbNFW Ӻ )ixVZFD5Cl/gY9% JKD1>j ^8[j51rJSN9d6YF5Cl/grJQux1Q=i UпIȥ's[ AԳp}KxVZ"o490D|)^i—薸w<+-#ϔ0z{ZBJwGDe*;ٮMYil= 9-S`ʻ g[7C8[Se8I>Cz 0eH`pzTAC'&g}-!]R2 .U\d;[eJU\d;[erlg,Wvl TFxJU\,WqYl*Vvr*Μ{Hd;[eJU\eJU\d;[er~'Pilg,WvJU\,Wvrlg,WvzPPQ@NI) ;!&\}4S.L8[54rPz (W(!zֻB# *JKDe'jHtlp0P xVZ0vds{rE=L]Ǣܮ~l+&2 )w3# jUƳ)dF@t{rNv6Vֻ l `$! xVZ0v =L]ǢܮcQnnSnnqm&2 )B`2<6p0VExVZ0v]7)2Oq$HB*vZ@M@Fi 9% JHI Υ{}I`"6 !#gm)ЇdEYiH}x~<^|quq?.>]x{"gL# vƳ.>}Ňy<|x\E۽@FbEYit7^xNjxzHBbxVZ"3Nqquz;ѭv+`Tivl&ٱv- I MOD 256=0 THEN PRINT "LOADING PAGE";I/256 4490 /* C to pascal - filter to replace C punctuation and certain key words with their Pascal equivalents. C form Pascal form ------ ----------- " ' { BEGIN } END; <2 blank spaces> () && AND || OR comment start { comment end } == = != <> = := printf writeln scanf readln while WHILE Usage: ctp outfile Copyright 1984 Ted Carnevale. Permission granted for personal nonprofit use. All other rights reserved. */ #define EOF -1 #define EOS '\0' main() { char c,*letter,word[100]; int wordlnth; letter=word; wordlnth=0; while ((c=getchar()) != EOF) { if (isalpha(c)) letter[wordlnth++]=c; else { if (wordlnth>0) { /* word ready to check */ letter[wordlnth]='\0'; wtest(word); /* pass or replace it */ wordlnth=0; /* reset index */ } ctest(c); /* process following char */ } } } /* note: the last word in the file will be missed if it is immediately followed by EOF with no intervening nonalpha character. This is not a problem for Pascal or C program sources. However, a general purpose word filter would have to check for a nonzero wordlength after EOF is reached. */ wtest(word) char *word; { char *swapword; swapword=word; switch (word[0]) { /* test first letter, then rest of word */ case 'p': if (strcmp(word,"printf\0")==0) swapword="writeln\0"; break; case 's': if (strcmp(word,"scanf\0")==0) swapword="readln\0"; break; case 'w': if (strcmp(word,"while\0")==0) swapword="WHILE\0"; break; default: break; /* pass unchanged */ } swap(swapword); } ctest(c) char c; { switch (c) { case '"': putchar('\''); break; case '{': swap("BEGIN\0"); break; case '}': swap("END;\0"); break; case '\t': swap(" \0"); break; case '&': swapif('&','&'," AND \0"); break; case '|': swapif('|','|'," OR \0"); break; case '(': swapif('(',')',"\0"); /* () simply deleted */ break; case '/': swapif('/','*',"{\0"); break; case '*': swapif('*','/',"}\0"); break; case '!': swapif('!','=',"<>\0"); /* != -> <> */ break; case '<': case '>': putchar(c); /* x are passed unchanged */ c=getchar(); putchar(c); break; case '=': identassign(); /* == -> = , = -> := */ break; default: putchar(c); break; } } swap(s) char *s; { while (*s!=EOS) putchar(*s++); } swapif(first,second,replacement) char first,second,*replacement; { char c; if ((c=getchar())==second) swap(replacement); else { putchar(first); putchar(c); } } identassign() { char c; if ((c=getchar())!= '=') { /* assignment */ putchar(':'); putchar('='); } putchar(c); } /* end of ctp.c */ 2 '*********************************************************************** 4 '* FOURIER SMOOTHING WITHOUT THE FAST FOURIER TRANSFORM PROGRAM * 6 '* By Eric E. Aubanel and Keith B. Oldham * 8 '*********************************************************************** 10 CLS 12 INPUT "ENTER NUMBER OF DATA POINTS";N 14 REM LEAVING R AND I ARRAYS UNDIMENSIONED LIMITS VALID VALUES OF E TO <=10 16 DIM X(N),X1(N),U(N),V(N) 18 FOR I=0 TO N-1 20 INPUT "ENTER DATAPOINT VALUE";X(I) 22 NEXT I 24 GOSUB 60 26 PRINT "THE SMOOTHED DATA VALUES ARE:" 28 FOR I=0 TO N-1 30 PRINT "X(";I+1;") = ";X1(I) 32 NEXT I 34 END 36 REM FOURIER ALGORITHM SUBROUTINE BEGINS AT LINE 60. LINE NUMBERS ARE THE SAME AS FOR THE HP VERSION OF THE SUBROUTINE 60 PI=3.141593 70 PRINT "NUMBER OF TRANSFORM POINTS TO BE KEPT"; 80 INPUT E 90 IF E>INT((N+1)/2) THEN PRINT "E TOO LARGE":GOTO 70 100 IF E<>INT(E) OR E<=1 THEN GOTO 70 110 IF E<=Q THEN 870 120 REM 130 IF Q<>0 THEN 330 240 'CALCULATE R(0) 250 G=0 260 FOR J=0 TO N-1 280 G=G+X(J) 290 NEXT J 300 R(0)=G/N 310 Q=1 320 REM 330 PRINT "WORKING ON R(K) TRANSFORM CALCULATIONS" 340 J2=INT((N-1)/2) 350 P1=INT(LOG(2*J2-1)/LOG(2)) 360 FOR K=Q TO E-1 370 J1=J2 380 S=PI*K*2/N 390 C=COS(S):S=SIN(S) 400 FOR J=1 TO J1 410 L=2*J-1 420 U(J)=X(L)*C+X(L+1) 430 V(J)=X(L)*S 440 NEXT J 450 S=2*S*C:C=2*C*C-1 460 FOR P=1 TO P1 470 U(J1+1)=0:V(J1+1)=0 480 J1=INT((J1+1)/2) 490 FOR J=1 TO J1 500 L=2*J-1 510 U=U(L)*C-V(L)*S+U(L+1) 520 V(J)=U(L)*S+V(L)*C+V(L+1) 530 U(J)=U 540 NEXT J 550 S=2*S*C:C=2*C*C-1 560 NEXT P 570 R(K)=(X(0)+(U(1)*C+V(1)*S))/N 580 NEXT K 590 REM 600 PRINT "WORKING ON I(K) TRANSFORM CALCULATIONS" 610 FOR K=Q TO E-1 620 J1=J2 630 S=2*PI*K/N 640 C=COS(S):S=SIN(S) 650 FOR J=1 TO J1 660 L=2*J-1 670 U(J)=-(X(L)*S) 680 V(J)=X(L)*C+X(L+1) 690 NEXT J 700 S=2*S*C:C=2*C*C-1 710 FOR P=1 TO P1 720 U(J1+1)=0:V(J1+1)=0 730 J1=INT((J1+1)/2) 740 FOR J=1 TO J1 750 L=2*J-1 760 U=U(L)*C-V(L)*S+U(L+1) 770 V(J)=U(L)*S+V(L)*C+V(L+1) 780 U(J)=U 790 NEXT J 800 S=2*S*C:C=2*C*C-1 810 NEXT P 820 I(K)=-((U(1)*C+V(1)*S)/N) 830 NEXT K 840 REM 850 IF E>Q THEN Q=E 860 REM 870 PRINT "WORKING ON INVERSE TRANSFORM" 880 REM 890 'CALCULATE X1(0) 900 F1=0:F2=0 910 FOR K=1 TO E-1 920 T=R(K) 930 F1=F1+T 940 F2=F2+K*K*T 950 NEXT K 960 X1(0)=R(0)+2*(F1-F2*(1/E/E)) 980 REM 990 P1=INT(LOG(2*E-3)/LOG(2)) 1000 FOR J=1 TO N-1 1010 T2=E*E 1020 FOR K=1 TO E-1 1030 F=1-K*K/T2 1040 U(K)=R(K)*F:V(K)=-(I(K)*F) 1050 NEXT K 1060 K1=E-1 1070 S=2*PI*J/N 1080 C=COS(S):S=SIN(S) 1090 FOR P=1 TO P1 1100 U(K1+1)=0:V(K1+1)=0 1110 K1=INT((K1+1)/2) 1120 FOR K=1 TO K1 1130 L=2*K-1 1140 U=U(L)*C-V(L)*S+U(L+1) 1150 V(K)=U(L)*S+V(L)*C+V(L+1) 1160 U(K)=U 1170 NEXT K 1180 S=2*S*C:C=2*C*C-1 1190 NEXT P 1200 X1(J)=R(0)+2*(U(1)*C+V(1)*S) 1220 NEXT J 1230 RETURN 140 ! STRAIGHT LINE CALCULATION 150 S1,S2=0 160 D=INT(N/10) 170 FOR J=0 TO D-1 180 S1=S1+X(J) 190 S2=S2+X(N-J-1) 200 NEXT J 210 X1=S1/D @ X2=S2/D 220 M=(X2-X1)/(N-D) 230 B=(X1+X2)/2-M*N/2 270 X(J)=X(J)-M*J-B 970 X1(0)=X1(0)+B 1210 X1(J)=X1(J)+M*J+B 140 'STRAIGHT LINE CALCULATION 150 S1=0:S2=0 160 D=INT(N/10) 170 FOR J=0 TO D-1 180 S1=S1+X(J) 190 S2=S2+X(N-J-1) 200 NEXT J 210 X1=S1/D:X2=S2/D 220 M=(X2-X1)/(N-D) 230 B=(X1+X2)/2-M*N/2 270 X(J)=X(J)-M*J-B 970 X1(0)=X1(0)+B 1210 X1(J)=X1(J)+M*J+B 10 ! 20 ! **************** 30 ! SUBROUTINE FRTRN 40 ! **************** 50 ! 60 RAD 70 DISP "Number of transform points to be kept"; 80 INPUT E 90 IF E>INT((N+1)/2) THEN DISP "E too large" @ GOTO 70 100 IF E#INT(E) OR E<=1 THEN GOTO 70 110 IF E<=Q THEN 870 120 ! 130 IF Q#0 THEN 330 240 ! CALCULATE R(0) 250 G=0 260 FOR J=0 TO N-1 280 G=G+X(J) 290 NEXT J 300 R(0)=G/N 310 Q=1 320 ! 330 DISP "Working on R(K) transform calculations." 340 J2=INT((N-1)/2) 350 P1=INT(LOG(2*J2-1)/LOG(2)) 360 FOR K=Q TO E-1 370 J1=J2 380 S=PI*K*2/N 390 C=COS(S) @ S=SIN(S) 400 FOR J=1 TO J1 410 L=2*J-1 420 U(J)=X(L)*C+X(L+1) 430 V(J)=X(L)*S 440 NEXT J 450 S=2*S*C @ C=2*C*C-1 460 FOR P=1 TO P1 470 U(J1+1),V(J1+1)=0 480 J1=INT((J1+1)/2) 490 FOR J=1 TO J1 500 L=2*J-1 510 U=U(L)*C-V(L)*S+U(L+1) 520 V(J)=U(L)*S+V(L)*C+V(L+1) 530 U(J)=U 540 NEXT J 550 S=2*S*C @ C=2*C*C-1 560 NEXT P 570 R(K)=(X(0)+(U(1)*C+V(1)*S))/N 580 NEXT K 590 ! 600 DISP "Working on I(K) transform calculations." 610 FOR K=Q TO E-1 620 J1=J2 630 S=2*PI*K/N 640 C=COS(S) @ S=SIN(S) 650 FOR J=1 TO J1 660 L=2*J-1 670 U(J)=X(L)*C+X(L+1) 680 V(J)=X(L)*S 690 NEXT J 700 S=2*S*C @ C=2*C*C-1 710 FOR P=1 TO P1 720 U(J1+1),V(J1+1)=0 730 J1=INT((J1+1)/2) 740 FOR J=1 TO J1 750 L=2*J-1 760 U=U(L)*C-V(L)*S+U(L+1) 770 V(J)=U(L)*S+V(L)*C+V(L+1) 780 U(J)=U 790 NEXT J 800 S=2*S*C @ C=2*C*C-1 810 NEXT P 820 I(K)=-((U(1)*C+V(1)*S)/N) 830 NEXT K 840 ! 850 IF E>Q THEN Q=E 860 ! 870 DISP "Working on inverse transform." 880 ! 890 ! CALCULATE X1(0) 900 F1,F2=0 910 FOR K=1 TO E-1 920 T=R(K) 930 F1=F1+T 940 F2=F2+K*K*T 950 NEXT K 960 X1(0)=R(0)+2*(F1-F2*(1/E/E)) 980 ! 990 P1=INT(LOG(2*E-3)/LOG(2)) 1000 FOR J=1 TO N-1 1010 T2=E*E 1020 FOR K=1 TO E-1 1030 F=1-K*K/T2 1040 U(K)=R(K)*F @ V(K)=-(I(K)*F) 1050 NEXT K 1060 K1=E-1 1070 S=2*PI*J/N 1080 C=COS(S) @ S=SIN(S) 1090 FOR P=1 TO P1 1100 U(K1+1),V(K1+1)=0 1110 K1=INT((K1+1)/2) 1120 FOR K=1 TO K1 1130 L=2*K-1 1140 U=U(L)*C-V(L)*S+U(L+1) 1150 V(K)=U(L)*S+V(L)*C+V(L+1) 1160 U(K)=U 1170 NEXT K 1180 S=2*S*C @ C=2*C*C-1 1190 NEXT P 1200 X1(J)=R(0)+2*(U(1)*C+V(1)*S) 1220 NEXT J 1230 RETURN vPARANOIA.DOC[  !"o#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ/9.(i>~̳ZNSDX¥~3E{y%yI7%03Z3S -F1դ 51] |guUp\5#Oepܗ>͌֌.x(i㹤WvVwQLlmT:/l3_M 1z(iʹ$:QFY2&ej ]]ܔTʹ$ ⮤e=*7^SefIœwqUҲT$YhrmRYO.&6e>F"bmLr)Ś?)kJ ]<,z>NX擙.J˒1}83 X擙Q]ۨK 4󋒖2zX'Se %_)fbJZW| >X6T9뽘9Q| SDƚ"hp%mpo%l+#3ݔ%mp7el+l+-6W$қ(9ge"6+1F6GfF:མ9Q| SDƚ"" 榬hN/%6dEo ]c\9殬Tg#يxcAl/fj:E_5+(2΃*Tg#{3RIl+57VF/iy(/8ELfFy<+'A}{n.nKnJʒObEr5E?oF$ww^RIL'&5Q+RE Qr"N2Mjz&446JTWENm~$t]FɬISpww%-ٻlD{kSpwW%mpw%gdf46fj l+<:ky_5̕°,E0ݽ5{=#{_\wU5Se`dj ؈WZK%'JX3W;I]]]5_>1^F~Ьw:z(]c\DlznJJv;>O UI}ICI'1(L;IR0^%ஞKJ6N4+/K`=FfF(i?/kn3$Iaʹ$ᑙQ7(^Sp7ezr)>6TG#ɥOL2IYO.&f_#ɥ<23ZR}\(9{1s _ߗ5_>qʞɥp(=%-/ dIJKv;>fI0ym$)Lpo%mpe NR|l`=.JK`OfFɥpSpW/H"6ʯJ҉l°.z2̌2y2̌pUp_3/b)| +dfJ`OLX擙KJ`j /bLV̌\z^S"OX擩2p#3=_=hbOfF{)=#31} 223Z{*i{/zX'Se"#Se`z^)Z/+Rpo%mpoe |Ğe>_2̌/DFdj |x =#|2^}{nKٻoWepo7ew|ocfHcyo3DlB")?}PvUNK6f=1m2JgMynb>S96/|\p/9.&Y1564Ed[1] ˼\"p\p]aR Gx*pQ|5)D¤hMLu |Mqjfʧr"O3\͂@u#S/mY煍bI!&Y/C v0#S/end-5/s 1lmRPapuM1x@u|i'I C]p|LȘZ/6N6Lm>I"\ۨk6cSp'3TG;2X!)2mkاH)k(r'Sevdj0^~bOfFfF_ ؑp(bOfF:w}nz.%6t6S8 Z/Ë>#S/2bOP5W+=َLm6E9L6T5 _Ju#S/\ 6|l+`+sbc#{1s Bt5sE"='08 8`#^ٍ̌.2QGuF6G6u6W$қ(9ge"6+:v##3 8?x/fNa_hfHȨ8O/%6dEo ]c\9:> xOuVl낃 6Z35"TgQ:ۍV̌5㉍$ךx+ TGQGuܛ(9(m:+'4+5Qp@pxbdiaflml"6ʵej"x08ࠞ^o5#66H}6+j~In;08ࠖ)"N2MjWR0b6E2dDLr)ppPFjvʺɵO(2 1i~wl4'08 8`ndftDm 882وWxd:;}AX3W ZKTGQ祈v#{G ~,E͕}]TGQOzXpPS-MT\+]c\id&TGQGuܛ(9SeO͊pPk+Y/.3Sک20Ҿ2^N|㉍2ɴ$A Se\bkL;IRv#?hV,6cCu]d:Q:6Nm$) ̌.~.ze.1TGQoǦލldž'˰2IوMMutz7GfF>.M뽘9њ08਎{%=+6c 33 j$zi'IkL6NL;IRND)F|li_و 'e>e72376c$jnNi΋)in$F) 7I,(#+|23"8 8`fEL؍װbOfF9l^,z؍5Se'dft0^1}b7Sek`"8`j /bn䔩2+dj "8 8``723 X擙Ep(bfEL_ٍ̌+Ep@p@b72^V,zzX1^1}ZF5{Fdfse>=QFFdj 'X9Y擩25Q_f57mlil2m2MH$5E͓e&QssJovv'<^_4mPlSgZNxm 6!}ZN4OJpTǗD)¥~3Er6xK|XMAX THEN XMAX=X(N) 360 IF X(N)YMAX THEN YMAX=Y(N) 380 IF Y(N)ZMAX THEN ZMAX=Z(N) 400 IF Z(N)=1 570 FOR I=IGAP+1 TO N 580 FOR J=I-IGAP TO 1 STEP -IGAP 590 JG=J+IGAP 600 IF Y(J)<=Y(JG) THEN GOTO 640 610 SWAP X(J),X(JG):SWAP Y(J),Y(JG) 620 SWAP Z(J),Z(JG):SWAP S(J),S(JG) 630 NEXT J 640 NEXT I 650 IGAP=INT(CSNG(IGAP)/2!) 660 WEND 670 ' 680 ' For perspective projection and scale coordinates 690 SCALE=-1E+25:SMAX=SCALE 700 FOR I=1 TO N 710 YA=1!/(VIEWD-Y(I)):X(I)=X(I)*YA:Z(I)=Z(I)*YA:S(I)=S(I)*YA 720 IF SCALE?@ABCDEFGHIm8"0!X0 lwU*l*d(5: 4VW;Fdj89 >*!0yVb >0u8vxIG4bwգjǯؑvrB?s ^G$L1aJcĚ=dfT# !3cW!&:랩9 A'#0zYPY̽"sP"=i<'r9M" \!X/0ׄ+q/܇b ?cz .H**b 4%S9˾="voPX bqvPA9#^01 C]LQ+:TaGϜ1ň!3j7n 'X Pw#9_ 5:[BQҸݯyM{iϛf=44ӡ11\RmpC0OD^Q/`"#D^Fp^v{BX˾P(8DFE n&E=֟}}yy8xKn# v^(f uQkbU9 ?!Lj]{lcJԂ0ex,FCۻ笢 NM*y>h煂k3m4/ qRjAV l!4 EIv>S6f7l~mxNn#G,F''LdUB5 N_Q v?B &dPpvׄq_iem0GLd?9/`"WT ׆.c]xxo!3;%ꙺbUi61_Цؗ8ϐ 'Xɉ~!8<}|٧Ccb84Ǘ} ١Pp:JA/L`hge{_:b_^47؂c|0ʬt@pA CѐïZBi (Cfhեb(~Rs3XspD[S7P4nkòio_ۻzh;ixs0Gǩ#>hUGp̌biϗq_)w^hn6mڰzh;ix1a!bĐA9AfF!&Z~xomJ#8ux>'bj!3;\iq_=SW6f=44<‚bUSvLx=&%ꙺbUi61_Цؗϟdfc9a! ϐ#9CBi^ ĞbHxفv^?z,Fju%~o r_=?huOe{/!p(]i& 7a *V/8&x1WZ xOuVl낃 6Z35"TgQ:ۍV̌5㉍$ךx+ TGQGuܛ(9(m:+'--\HY --\UN --\BF --\SSA --\SSB --\LM2,RM78,TM1,BM1,NP -- Translated from C version, August 1983 BYTE, p. 88 package body floatbch is const1 : constant float := 3.141597E0; const2 : constant float := 1.7839032E4; count : constant integer := 1000; a, b, c : float; i: integer; begin -- float main program body a := const1; b := const2; for i in 1..count loop c := a * b; c := c / a; c := a * b; c := c / a; c := a * b; c := c / a; c := a * b; c := c / a; c := a * b; c := c / a; c := a * b; c := c / a; c := a * b; c := c / a; end loop; -- for i put("Done"); new_line; end floatbch;  * b; c := c / a; c := a * --\HY --\UN --\BF --\SSA --\SSB --\LM2,RM78,TM1,BM1,NP -- translated from C, as printed in the June 1984 BYTE, p. 307 package body fibo is ntimes : constant integer := 10; -- # of times to compute fibonacci value number : constant integer := 24; -- biggest we can compute in 16 bits value : integer; i : integer; -------- function fib(x: in integer) return integer is begin if x > 2 then return (fib(x - 1) + fib(x - 2)); else return 1; end if; end; -- function fib -------- begin -- fibo put(ntimes); put(" iterations: "); new_line; for i in 1..ntimes loop value := fib(number); end loop; -- for i put("fibonacci("); put(number); put(") = "); put(value); new_line; end; -- fibo umber); end loop; -- for i put("fibonacci("); put(number); put(") = "); put(value); new_line;--\HY --\UN --\BF --\SSA --\SSB --\LM2,RM78,TM1,BM1,NP -- translated from C, as printed in the June 1984 BYTE, p. 307 with longops; package body fibo is use longops; ntimes : constant integer := 10; -- # of times to compute fibonacci value number : constant long_integer := lint(24); -- biggest we can compute in 16 bits one : constant long_integer := lint(1); two : constant long_integer := lint(2); value : long_integer; i : long_integer; -------- function fib(x: in long_integer) return long_integer is begin if Lgt(x,two) then return Ladd(fib(Lsub(x,one)),fib(Lsub(x,two))); else return one; end if; end; -- function fib -------- begin -- fibo put(ntimes); put(" iterations: "); new_line; for i in 1..ntimes loop value := fib(number); end loop; -- for i put("fibonacci("); put(L_to_Int(number)); put(") = "); put(L_to_Int(value)); new_line; end; -- fibo  -- for i put("fibonacci("); February 1985 ------------- "Ciarcia's Circuit Cellar: Build A Serial EPROM Programmer," p. 104. IBMPROGA.BAS 19313 Listing 1, p. 114. "C To Pascal," by Ted Carnevale, p. 138. C-TO-PAS.C 2944 Listing 1, p. 140. "A Low-Cost Data-Acquisition System," by Kiyohisa Okamura and Kamyab Aghai-Tabriz, p. 199. "Fourier Smoothing Without the Fast Fourier Transform," by Eric E. Aubanel and Keith Oldham, p.207. FOURIER.BAS 3584 Listing 1, p. 212. Microsoft BASIC. FTEXT.BAS 384 Hewlett-Packard BASIC. FOUREXT.BAS 384 HP BASIC. FT.BAS 2304 HP BASIC. "Paranoia: A Floating-Point Benchmark," by Richard Karpinski, p.223. PARANOIA.DOC 6528 Listings 1 and 2, pp. 230 through 235. "Viewing Molecules with the Macintosh," by Earl J. Kirkland, p. 251. MODEL3D.BAS 3328 Listing 1, p. 253. SIGEN.BAS 896 Listing 2, p. 256. "Interfacing for Data Acquisition," by Tom Clune, p. 269. HEATSUB.BAS 5248 Listing 1, p. 278. "Janus/Ada," by Mark J. Welch, p. 295. JANUS-L1.LST 896 Listing 1, p. 297. JANUS-L2.LST 1024 Listing 2, p. 297. JANUS-L3.LST 1152 Listing 3, p. 298.