--------------- FIDO MESSAGE AREA==> TOPIC: 125 QUICK BASIC Ref: F4200032 Date: 03/31/98 From: NIGEL TRAVES Time: 11:54am \/To: ALL (Read 3 times) Subj: Fractals 1/3 Greetings and felicitations, Some time ago I posted a number of fractal generation programs in here. At the time I only had CGA. Since I now have VGA, I have converted 5 of them so that they now work in mode 12. Here are the first 2. '>>> Page 1 of IKEDA.BAS begins here. TYPE:BAS x = 0 y = 0 p = 7.7 colour = 16 xc = 435 yc = 270 xmul = 240 ymul = 180 MaxColour = 16 SCREEN 12 CLS FOR n& = 1 TO 100000 theta = .4 - (p / (1 + (x * x + y * y))) ctheta = COS(theta) stheta = SIN(theta) Point9x = .9 * x Point9y = .9 * y x1 = .85 + Point9x * ctheta - Point9y * stheta y1 = Point9x * stheta + Point9y * ctheta PSET (xc + (xmul * -x1), yc + (ymul * y1)), colour x = x1 y = y1 'colour = colour + 1 'IF colour > MaxColour THEN ' colour = 1 'END IF LOCATE 6, 1 PRINT "Iterations = "; PRINT USING "###,###"; n&; NEXT n& END '>>> Page 1 of IKEDA.BAS ends here. Last page. '>>> Page 1 of HENON.BAS begins here. TYPE:BAS xc = 320 yc = 240 xmul = 400 ymul = 360 CLS INPUT "Enter the value for a"; a SCREEN 12 CLS FOR x = -.1 TO .8 STEP .05 FOR y = -.1 TO .8 STEP .05 x1 = x y1 = y FOR i% = 1 TO 1000 IF x1 > 1000 OR y1 > 1000 OR x1 < -1000 OR y1 < -1000 THEN i% = 1000 ELSE ca = COS(a) sa = SIN(a) yy = y1 - x1 * x1 xx = x1 * ca - yy * sa y1 = x1 * sa + yy * ca x1 = xx PSET (xc + (x1 * xmul), yc + (y1 * ymul)) END IF NEXT i% NEXT y NEXT x '>>> Page 1 of HENON.BAS ends here. Last page. Byeee, Nigel. -+- OLMS 2.53 UNREG --- * Origin: Most Wanted BBS +44 (0)1522 887627 & 887628 * (2:2503/509) --------------- FIDO MESSAGE AREA==> TOPIC: 125 QUICK BASIC Ref: F4200033 Date: 03/31/98 From: NIGEL TRAVES Time: 11:54am \/To: ALL (Read 3 times) Subj: GENMSCUR.BAS 0/1 Greetings and felicitations, About 4 weeks ago I posted the first version of this program. This program worked perfectly OK at my end. However, at least 2 people have said that they didn't get a properly working copy of this program. Looking at my original version I have revised the way that it works. This has lead to a program that the source code of which is much shorter, while the resulting program is actually 112 bytes longer. I am posting this new version now. Now as the filter option in postit doen't produce a CRC checksum and I'm determined that a working copy does get through I have also zipped the source code and used postit's encode option which does. So I hope that everyone who wants a working copy gets one. Anyway here is the zipped and encoded version. Byeee, Nigel. '>>> Page 1 of GENMSCUR.ZIP begins here. TYPE:BINAA TLEN:968 '------------------------------------------------------------- ' INSTRUCTIONS FOR DECODING 'If there are multiple parts to this file, merge them into one 'file using COPY PART1.EXT+PART2.EXT FILENAME.EXT Remove all 'message header and footer information (everything outside the '">>> Page x of..." lines), load the result into your version 'of Basic (QBASIC, QuickBASIC, etc.) then RUN it. The original 'file will be decoded into the current directory on your disk. '------------------------------------------------------------- DEFINT A-Z:DIM SHARED K,S,B&,Z&:V1 'Created by PostIt! 7.3 SUB V1:OPEN "O",1,"GENMSCUR.ZIP",4^6:Z&=968:?STRING$(50,177); U"%up()%9%'%I-%k%&II*;)Ils(7%%l-%%%1%%%%lj%srxh%zwSg7fx&z[]^5M U"l[4D1v^4\VQS9e7az+yms/0=esIeoIkYFVP?Y0/I$.>z&Md5M#X(R3ds?m_pAGB U"E\Xnt6?,5>=5ka,TTfp U"jZjqQzTPQTTt0+V+F]L?589r=.o$vu[6)q%EnwL]nV)_7<<+(+8+gT0g+D>_5:Ew,l U")o)bfCdwkdfJ4bm3x3n<1OM0dj2R/[RJ9IbJZBmZ5S\da]3-pdJIR^a=<4cy U"Ucm;x%trpc2y:McAp9K(EmepZTh(-B%;mQqN2:*)W\[3-5)b/Y*Ja=i7Nh23HJ] U"&RFNE$Q\H.RLsNG#TgEz:dKg(m.+j^Epq3$]e[N^C\RSUif0B-fUE4OPc4zknS, U"C,o]J3aYF,8=V\/_Kj],2uG<]qh18U(pLQ9^TxU#SirufluHt.jxYC%G;B_AutF U"gU4Omd+VI,wC)Tkb[MK:dNd%sQ(8&580w9JAQe]1jeD2(:iv%[6L.,7\WLCDqMZ U"0L-,Won.sgxQ=KFKQYBkHuSTcD1d1W); U"ErrmDl58j:6B]5kN<,WrDoYna>#^N^ogXVnF9glXO:8KeMNkV+IF%Wh80cI<'du U"1XD6^HFhgN6R)9/tw#uKa0DpiNpv<'63BB5[XM&%up&'%9%9%%'%-%2k%III*;I U"l%s(%%'l-%%%1%%%%%%%%%&%E%%%%%%%%%lj%srxh%zwSg%fxup%*+%%%%%&%%& U"%_%.%%G(%%%%% END SUB CLOSE:IF S=179AND B&=Z&THEN?" :) Ok!"ELSE?" :( Bad! SUB U(A$):FOR A=1TO LEN(A$):C=ASC(MID$(A$,A))-37:IF C<0THEN C=91+C*32 IF K<4THEN K=C+243ELSE?#1,CHR$(C+(K MOD 3)*86);:K=K\3:B&=B&+1 S=(S+C)AND 255:NEXT:LOCATE,1:?STRING$(B&*50\Z&,219);:END SUB '>>> Page 1 of GENMSCUR.ZIP ends here. Last page. TCHK:179 -+- OLMS 2.53 UNREG --- * Origin: Most Wanted BBS +44 (0)1522 887627 & 887628 * (2:2503/509) --------------- FIDO MESSAGE AREA==> TOPIC: 125 QUICK BASIC Ref: F4200034 Date: 03/31/98 From: NIGEL TRAVES Time: 11:54am \/To: ALL (Read 3 times) Subj: Fractals 2/3 Here are the second pair of fractal routines. '>>> Page 1 of MANDLE.BAS begins here. TYPE:BAS CONST MaxCol% = 16 CONST MaxX% = 640 CONST MaxY% = 480 CONST BailOut = 4! CONST MaxIterations% = 255 AngleR = -2 AngleL = -1.25 Side = 2.5 DistanceX = Side / MaxX% DistanceY = Side / MaxY% SCREEN 12 CLS FOR Y = 1 TO MaxY% FOR X = 1 TO MaxX% CR = X * DistanceX + AngleR CL = Y * DistanceY + AngleL ZR = CR ZL = CL Iteration% = 0 DO A = ZR * ZR B = ZL * ZL Length = A + B ZL = 2 * ZR * ZL + CL ZR = A - B + CR Iteration% = Iteration% + 1 LOOP UNTIL Length > BailOut OR Iteration% > MaxIterations% col = Iteration% MOD MaxCol% PSET (X, Y), col NEXT X NEXT Y '>>> Page 1 of MANDLE.BAS ends here. Last page. '>>> Page 1 of JULIA.BAS begins here. TYPE:BAS CONST MaxCol% = 16 CONST MaxX% = 640 CONST MaxY% = 480 CONST BailOut = 4! CONST MaxIterations% = 255 AngleR = -2 AngleL = -1.25 CR = -1 CL = -.625 Side = 2.5 DistanceX = Side / MaxX% DistanceY = Side / MaxY% SCREEN 12 CLS FOR Y = 1 TO MaxY% FOR X = 1 TO MaxX% ZR = X * DistanceX + AngleR ZL = Y * DistanceY + AngleL Iteration% = 0 DO A = ZR * ZR B = ZL * ZL Length = A + B ZL = 2 * ZR * ZL + CL ZR = A - B + CR Iteration% = Iteration% + 1 LOOP UNTIL Length > BailOut OR Iteration% > MaxIterations% col = Iteration% MOD MaxCol% PSET (X, Y), col NEXT X NEXT Y '>>> Page 1 of JULIA.BAS ends here. Last page. -+- OLMS 2.53 UNREG --- * Origin: Most Wanted BBS +44 (0)1522 887627 & 887628 * (2:2503/509) --------------- FIDO MESSAGE AREA==> TOPIC: 125 QUICK BASIC Ref: F4200035 Date: 03/31/98 From: NIGEL TRAVES Time: 11:54am \/To: ALL (Read 3 times) Subj: Fractals 3/3 This is the final fractal generator. This one seems to have benefitted the most from the conversion. Enjoy! '>>> Page 1 of TOPHAM.BAS begins here. TYPE:BAS SCREEN 12 CLS xpos = 320 ypos = 240 across = 640 down = 480 a = -1.5 b = -.5 c = 2.4 d = -.45 e = .5 xmin = -3.5 xmax = 4.5 ymin = -2 ymax = 2 maxiter = 70 cresh = 500 dx = (xmax - xmin) / across dy = (ymax - ymin) / down FOR ynn = 1 TO down FOR xnn = 1 TO across k = 0 xn = xmin + dx * xnn yn = ymin + dy * ynn DO k = k + 1 xnsqr = xn * xn ynsqr = yn * yn IF (xnsqr + ynsqr) > cresh THEN GOSUB PlotPoint EXIT DO END IF IF k > maxiter THEN EXIT DO END IF xm = a + b * xn + c * ynsqr yn = d + e * xn xn = xm LOOP NEXT xnn NEXT ynn END PlotPoint: SELECT CASE (k MOD 7) + 1 CASE 1 col = 12 CASE 2 col = 10 CASE 3 col = 14 CASE 4 col = 9 CASE 5 col = 15 CASE 6 col = 11 CASE 7 col = 13 END SELECT PSET (xpos - .5 * across + xnn, ypos - .5 * down + ynn), col RETURN '>>> Page 1 of TOPHAM.BAS ends here. Last page. -+- OLMS 2.53 UNREG --- * Origin: Most Wanted BBS +44 (0)1522 887627 & 887628 * (2:2503/509) --------------- FIDO MESSAGE AREA==> TOPIC: 125 QUICK BASIC Ref: F4200036 Date: 03/31/98 From: NIGEL TRAVES Time: 11:54am \/To: ALL (Read 3 times) Subj: TIME.BI 1/2 '>>> Page 1 of TIME.BI begins here. TYPE:BAS REM ****************************************************** REM * Filespec : time.bas time.bi testtime.bas * REM * Date : August 8 1997 * REM * Time : 19:01 * REM * Revision : 1.00B * REM * Update : * REM ****************************************************** REM * Programmer: Nigel Traves * REM * Address : 5 Breamer Road, Collingham, Newark, * REM * : Notts, U.K. * REM * Post Code : NG23 7PN * REM ****************************************************** REM * Released to the Public Domain * REM ****************************************************** CONST FALSE% = 0, TRUE% = -1 TYPE When Second AS INTEGER '| 0..59 Minute AS INTEGER '| 0..59 Hour AS INTEGER '| 0..23 WeekDay AS INTEGER '| 1..7 MonthDay AS INTEGER '| 1..[28 or 29 or 30 or 31] YearDay AS INTEGER '| 1..[365 or 366] YearWeek AS INTEGER '| 1..52 Month AS INTEGER '| 1..12 Year AS INTEGER IsLeapYear AS INTEGER '| TRUE% or FALSE% END TYPE REM ****************************************************************** REM * The following 2 routines rely upon the accuracy of the PC's * REM * internal clock and calendar. i.e. if your PC's clock or * REM * calendar are inaccurate then the output from these routines * REM * will be inaccurate to the same degree. * REM ****************************************************************** DECLARE SUB ThisInstant ( Now AS When ) REM ****************************************************************** REM * This routine produces a snapshot of the time and date at the * REM * instant that it is called and fills the variable Now with the * REM * information obtained. It uses DOS routines to gather the * REM * information and so works from 1/1/80 to 31st December 2099. * REM ****************************************************************** DECLARE SUB FTString ( FormatString$, OutputString$, Now AS When ) REM ****************************************************************** REM * This routine produces a string (OutputString$) with time and * REM * date information embedded within it, as specified by the * REM * information encoded within FormatString$. The variable Now * REM * may be used to specify a specific time and date or Now may be * REM * updated as part of this routine so that the current time and * REM * date are used instead. * REM * * REM * If FormatString$ contains no temporal codes it will simply be * REM * copied to OutputString$. If during processing of * REM * FormatString$ an invalid code is encountered, processing will * REM * cease and an immediate return to SYSTEM occurs with an * REM * appropriate error message displayed. * REM * * REM * There are 29 different temporal codes in all, each of which * REM * starts with the tilde (CHR$(126), '~') character. The action * REM * of this routine is to copy everything contained in * REM * FormatString, except the codes, to OutputString. When a code * REM * is encountered, it is replaced in OutputString by the * REM * sub-string that corresponds to that code. In the following * REM * explanation of the codes and their meanings I have, for * REM * reasons of brevity, used the word output to signify the * REM * replacement of a particular code by the substring that is * REM * described immediately following the usage of the word output. * REM * The codes and their meanings follow hereafter. * REM * * REM *----------------------------------------------------------------* REM * * REM * ~1 - Set all time output after this to be in 12 hour * REM * format. * REM * * REM * ~2 - Set all time output after this to be in 24 hour * REM * format. * REM * * REM * ~A - Output either am or pm depending on the time. * REM * * REM * ~B - Output the month in abbreviated form * '>>> Page 1 of TIME.BI ends here. Continued on next page. -+- OLMS 2.53 UNREG --- * Origin: Most Wanted BBS +44 (0)1522 887627 & 887628 * (2:2503/509) --------------- FIDO MESSAGE AREA==> TOPIC: 125 QUICK BASIC Ref: F4200037 Date: 03/31/98 From: NIGEL TRAVES Time: 11:54am \/To: ALL (Read 3 times) Subj: TIME.BI 2/2 '>>> Page 2 of TIME.BI begins here. REM * (Jan, Feb etc.). * REM * * REM * ~C - Output the full month name * REM * (January, February etc.). * REM * * REM * ~D - Output full date as January 1 1996 etc. * REM * * REM * ~E - Output numeric date in dd/mm/yy form. * REM * * REM * ~F - Output full date as 1 January 1996 etc. * REM * * REM * ~G - Output numeric date in mm/dd/yy form. * REM * * REM * ~H - Output the Hour. * REM * * REM * ~I - Output the day of the week in abbreviated form. * REM * (Mon, Tue etc.) * REM * * REM * ~J - Output the full name of the day of the week. * REM * (Monday, Tuesday etc.) * REM * * REM * ~K - Output the time in short form HH:MM. * REM * * REM * ~L - Output the time in long form HH:MM:SS. * REM * * REM * ~M - Output the Minute. * REM * * REM * ~N - Output the Numeric day of week (1 = Sunday). * REM * * REM * ~O - Output the Numeric day of the month (1, 2, 3 etc). * REM * * REM * ~P - Output the Numeric Month (1 = January). * REM * * REM * ~Q - Output the Numeric day of the month with the * REM * appropriate suffix (1st, 2nd, 3rd, 4th etc.). * REM * * REM * ~R - Output the year in ROMAN numerals - MCMXCVI. * REM * * REM * ~S - Output the Second. * REM * * REM * ~T - Output the total date in the form - * REM * Sunday 18th February 1996. * REM * * REM * ~U - Update (or get new) the information in the * REM * variable 'Now'. * REM * * REM * ~V - Output the date in the form - 18th Feb 96. * REM * * REM * ~W - Output the week of the year - 1 to 52. * REM * * REM * ~X - Output the day of the year - * REM * 1 to 365 or 366 in leap year. * REM * * REM * ~Y - Output the year in the form 1996. * REM * * REM * ~Z - Output the year in the form 96. * REM * * REM * ~r - Output the total date in the form - * REM * Sun 18th Feb 96. * REM * * REM * ~~ - Output the character ~ (CHR$(126), '~'). * REM * * REM *----------------------------------------------------------------* REM * * REM * An example of the usage of this routine is as follows:- * REM * * REM * FT$ = "~U~1Today, ~T, at precisely ~L~A, I resigned." * REM * FTString FT$, Out$, Now * REM * * REM * Which should result in Out$ containing the following (assuming * REM * the dates and times contained) :- * REM * * REM * Today, Sunday 18th February 1996, at precisely 12:40pm, I * REM * resigned. * REM ****************************************************************** '>>> Page 2 of TIME.BI ends here. Last page. -+- OLMS 2.53 UNREG --- * Origin: Most Wanted BBS +44 (0)1522 887627 & 887628 * (2:2503/509)