---------------
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<X>[]^5M
U"l[4D1v^4\VQS9e7az+yms/0=esIeoIkYFVP?Y0/I$.>z&Md5M#X(R3ds?m_pAGB
U"E\Xnt6?<Vg,[x$s+<2x)D/+UH,Y^H50)5VK\ve?8?HwB._UG,P>,5>=5ka,TTfp
U"jZjqQzTPQTTt0+V+F]L?<g-v/ulRM01l$4SXU;a'PR7\SL*8<=^i[p((8h?u*W<
U"xdi;mtBtOLm<&Y:q>589r=.o$vu[6)q%EnwL]nV)_7<<+(+8+gT0g+D>_5:Ew,l
U")o)bfC<ucw.;m:gE6I2?<FKT0GPE(B1qpDmX,Qj7ll?/3-H=s/,?)1glcO:MH,9
U"C0JwAcB_vruD[nA(.]9e_KnR%ro&GGvO?<OJkWY6MRHKj-h6TW;Cp'%$?bwPATJ
U"rwA23a/ACW6JJe286yn&aRu__(W#xJ2_\++u]l-2no4aPWEW^-8*Oo(wUsuEB]:
U"476uG8;]3Jte_Kh<k%RC.HS*1ajbw%9VrGFM[L:plNXS6j\Gro#iLO-GT^^vtbo
U"8ya7Tpsp>dwkdfJ4bm3x3n<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<Inls\ap7j.#xsMbfw.*]5.v>.sgxQ=KFKQYBkHuSTcD1d1<Jy3hgB<t
U"OgX^rFy)35N__9\q]po2.x3aP6Yodl=v6'U4gkFDGG$0Bf^aaKU4y$9:D%L>W);
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)