This started with the inquiries of whitetiger.
Code:
xmax% = 3200
ymax% = 2000
DIM particleAmount AS INTEGER, particleAmount2 AS INTEGER
DIM blackHoleAmount AS INTEGER, blackHoleAmount2 AS INTEGER
DIM teleportOn AS INTEGER
teleportOn = 1
particleAmount = 200
particleAmount2 = particleAmount - 1
blackHoleAmount = 15
blackHoleAmount2 = blackHoleAmount - 1
CONST spaceconst1 = 1000
DIM SHARED particleVX(particleAmount2) AS LONG
DIM SHARED particleVY(particleAmount2) AS LONG
DIM SHARED particleX(particleAmount2) AS INTEGER
DIM SHARED particleY(particleAmount2) AS INTEGER
DIM SHARED particleColor(particleAmount2) AS INTEGER
DIM blackHoleX(blackHoleAmount2) AS INTEGER
DIM blackHoleY(blackHoleAmount2) AS INTEGER
IF teleportOn THEN
DIM blackHoleTargetX(blackHoleAmount2) AS INTEGER
DIM blackHoleTargetY(blackHoleAmount2) AS INTEGER
END IF
DIM blackHoleGravity(blackHoleAmount2) AS INTEGER
'RANDOMIZE TIMER
FOR i% = 0 TO particleAmount2
particleX(i%) = RND * xmax%
particleY(i%) = RND * ymax%
particleVX(i%) = RND * 5 - 2
particleVY(i%) = RND * 5 - 2
particleColor(i%) = RND * 16
NEXT i%
FOR i% = 0 TO blackHoleAmount2
blackHoleGravity(i%) = RND * 8 + 8
blackHoleX(i%) = RND * xmax%
blackHoleY(i%) = RND * ymax%
redo1:
IF teleportOn THEN
blackHoleTargetX(i%) = RND * xmax%
blackHoleTargetY(i%) = RND * ymax%
IF blackHoleX(i%) = blackHoleTargetX(i%) THEN IF blackHoleY(i%) = blackHoleTargetY(i%) THEN GOTO redo1
END IF
NEXT i%
SCREEN 7, , 0, 1
DO
FOR i% = 0 TO particleAmount2
'calculate gravitational effects
px% = particleX(i%): py% = particleY(i%)
pvx& = particleVX(i%) * 10000: pvy& = particleVY(i%) * 10000
pvxconst& = pvx&: pvyconst& = pvy&
FOR j% = 0 TO blackHoleAmount2
bx% = blackHoleX(j%)
by% = blackHoleY(j%)
bg% = blackHoleGravity(j%)
xpart& = px% - bx%
ypart& = py% - by%
IF px% - bx% < xmax% - px% + bx% THEN
IF py% - by% < ymax% - py% + by% THEN
distance& = (px% - bx%) ^ 2 + (py% - by%) ^ 2
ELSE
distance& = (px% - bx%) ^ 2 + (ymax% - py% - by%) ^ 2
END IF
ELSE
IF py% - by% < ymax% - py% + by% THEN
distance& = (xmax% - px% + bx%) ^ 2 + (py% - by%) ^ 2
ELSE
distance& = (xmax% - px% + bx%) ^ 2 + (ymax% - py% - by%) ^ 2
END IF
END IF
distance& = distance& / bg%
IF distance& THEN
xpart& = xpart& / SQR(distance&)
ypart& = ypart& / SQR(distance&)
IF xpart& THEN
temp& = ((xpart& + ypart&) / xpart&): pvx& = pvx& + temp&
END IF
IF ypart& THEN
temp& = ((xpart& + ypart&) / ypart&): pvy& = pvy& + temp&
END IF
END IF
NEXT j%
'calculate new sum velocity
particleVX(i%) = pvx& \ 10000
particleVY(i%) = pvy& \ 10000
'calculate new position
particleX(i%) = (px% + pvx&) MOD xmax%
particleY(i%) = (py% + pvy&) MOD ymax%
IF particleX(i%) < 0 THEN particleX(i%) = particleX(i%) + xmax%
IF particleY(i%) < 0 THEN particleY(i%) = particleY(i%) + ymax%
'teleport
IF teleportOn THEN
FOR j% = 0 TO blackHoleAmount2
IF particleX(i%) = blackHoleX(j%) THEN
IF particleY(i%) = blackHoleY(j%) THEN
particleX(i%) = blackHoleTargetX(j%)
particleY(i%) = blackHoleTargetY(j%)
EXIT FOR
END IF
END IF
NEXT j%
END IF
'draw it
PSET (particleX(i%) / xmax% * 320, particleY(i%) / ymax% * 200), particleColor(i%)
NEXT i%
FOR j% = 0 TO blackHoleAmount2
CIRCLE (blackHoleX(j%) / xmax% * 320, blackHoleY(j%) / ymax% * 200), SQR(blackHoleGravity(j%)) * 1000 / spaceconst1, 15
NEXT j%
PCOPY 0, 1: CLS
SELECT CASE INKEY$
CASE IS <> "": EXIT DO
END SELECT
LOOP
cool... that is really cool! ill look at it!
Pretty much hacked it up though.
I'd really like to have implemented collision with the black holes.. oh well.
Pretty cool...This is appropos to nothing, but, someone might like it!!!
I call it "Spiral6.bas"
Code:
'Joe Campbell (c) 2002
RANDOMIZE TIMER
DEFINT A-Z
begin:
SCREEN 12
CLS
DO
rf! = .01 + RND * 1.5 'spiral "tightness"
maxsize = RND * 600 'max spiral diameter
xini = RND * 640 'spiral center
yini = RND * 480 'spiral center
cini = (RND * 16) - 1 'color
r! = 1 'initial radius (not an integer)
x = -.707 * r! '1/4 circle +/- sin45
DO 'draw a quadrant
'it is necessary to draw spiral 1 quadrant
FOR j = 1 TO 4 'at a time to avoid gaps that appear if it's drawn 1/2 at a time
p! = rf! / 10 'radius expantion factor
SELECT CASE j
CASE 1
b = 1
c = 1
d = 1
xy = -1
CASE 2
b = 1
c = 1
d = -1
xy = 1
CASE 3
b = -1
c = -1
d = 1
xy = -1
CASE 4
b = -1
c = -1
d = -1
xy = 1
END SELECT
x = x + d
DO WHILE x <= .707 * r! AND x >= -.707 * r!
y = SQR((r! ^ 2) - (x ^ 2)) 'formula for circle solved for y
IF xy = 1 THEN SWAP x, y 'never solve for x...just swap values
PSET (xini + x * b, yini + y * c), cini 'when drawing the 'veritcals'
IF xy = 1 THEN SWAP x, y 'return values
x = x + d 'increment x (d=+/-1)
r! = r! + p! 'increase radius
FOR g = 1 TO 10 'clear the screen. 10 pts/circle point
PRESET (RND * 640, RND * 480) 'this loop slows the program a lot.
NEXT g 'looks better this way
LOOP 'end quadrant drawing loop
NEXT j 'loop to draw next quadrant
LOOP UNTIL r! > maxsize 'stop spiraling
a$ = INKEY$
LOOP UNTIL a$ <> "" 'make a new spiral (different size/location)
PRINT "Continue? (y/n)"
DO
a$ = INKEY$
LOOP UNTIL a$ <> ""
IF a$ = "y" OR a$ = "Y" THEN GOTO begin
END
Nice. Could be a lot more interesting with a bit of work though.
Quote:Nice. Could be a lot more interesting with a bit of work though.
Thanks...I'm sure it could be made more interesting. The point was to figure out how to draw a 'normal-looking' spiral that was drawn from the inside out...the same way that a human would...rather than the 'constant spacing' spirals that you sometimes see. It took a fair amount of fiddling to get it right...
I just posted the code because your code somehow reminded me of this one...
cheers
EDIT:
Aga...this doesn't really make it *look* any better, but it may be more interesting. In the first code, all the spirals turned the same direction, and ended at the same location (270 deg)....this modificaion has both right-handed and left-handed spirals and they can end in any orientation.
EDIT2: OK...the "interesting" stuff I changed above...and it *looks* much better...although it does lose the mostly-black-particle-trail-sparse-space-look that it used to have...
Code:
'Joe Campbell (c) 2002
RANDOMIZE TIMER
DEFINT A-Z
begin:
SCREEN 12
CLS
DO
rf! = (.01 + RND * .15) 'spiral "tightness"
maxsize = RND * 600 'max spiral diameter
xini = RND * 640 'spiral center
yini = RND * 480 'spiral center
cini = (RND * 16) - 1 'color
chirality = (2 * INT(RND * 2)) - 1 '1 or 1/-1
r! = 1 'initial radius (not an integer)
x = -.707 * r! * chirality '1/4 circle +/- sin45
outtahere = 0
DO 'draw a quadrant it is necessary to draw spiral 1 quadrant
FOR j = 1 TO 4 'at a time to avoid gaps that appear if it's drawn 1/2 at a time
SELECT CASE j
CASE 1
b = 1 * chirality
c = 1 * chirality
d = 1 * chirality
xy = -1
CASE 2
b = 1
c = 1
d = -1 * chirality
xy = 1
CASE 3
b = -1 * chirality
c = -1 * chirality
d = 1 * chirality
xy = -1
CASE 4
b = -1
c = -1
d = -1 * chirality
xy = 1
END SELECT
x = x + d
DO WHILE x <= .707 * r! AND x >= -.707 * r!
y = SQR((r! ^ 2) - (x ^ 2)) 'formula for circle solved for y
IF xy = 1 THEN SWAP x, y 'never solve for x...just swap values
CIRCLE (xini + x * b, yini + y * c), r! * rf!, cini 'when drawing the 'veritcals'
IF xy = 1 THEN SWAP x, y 'return values
x = x + d 'increment x (d=+/-1)
r! = r! + rf! 'increase radius
IF r! > maxsize THEN
outtahere = 1
EXIT DO
END IF
LOOP 'end quadrant drawing loop
IF outtahere THEN EXIT FOR
NEXT j 'loop to draw next quadrant
LOOP UNTIL outtahere 'stop spiraling
a$ = INKEY$
LOOP UNTIL a$ <> "" 'make a new spiral (different size/location)
PRINT "More Spirals?? (y/n)"
DO
a$ = INKEY$
LOOP UNTIL a$ <> ""
IF a$ = "y" OR a$ = "Y" THEN GOTO begin
END
EDIT::
Here's another one...that looks pretty cool. It looks like the end of one leads to the birth of a new one. The code includes a delay technique I came up with that is intended to slow down the code by a const amount even on different-speed machines...any opinions on how effective this delay-technique is be??
Code:
'Joe Campbell (c) 2002
RANDOMIZE TIMER
DEFINT A-Z
'experimental code to delay const amount on different speed computers
a! = TIMER + 1
FOR g = 1 TO 30000
FOR g1 = 1 TO 100
FOR g2 = 1 TO 100
NEXT g2
IF TIMER > a! THEN EXIT FOR
NEXT g1
IF TIMER > a! THEN EXIT FOR
NEXT g
begin:
SCREEN 12
CLS
DO
rf! = (.01 + RND * .15) 'spiral "tightness"
maxsize = RND * 600 'max spiral diameter
xini = RND * 640 'spiral center
yini = RND * 480 'spiral center
'LINE -(xini, yini), cini
cini = (RND * 16) - 1 'color
chirality = (2 * INT(RND * 2)) - 1 '1 or 1/-1
r! = 1 'initial radius (not an integer)
x = -.707 * r! * chirality '1/4 circle +/- sin45
outtahere = 0
DO 'draw a quadrant it is necessary to draw spiral 1 quadrant
FOR j = 1 TO 4 'at a time to avoid gaps that appear if it's drawn 1/2 at a time
SELECT CASE j
CASE 1
b = 1 * chirality
c = 1 * chirality
d = 1 * chirality
xy = -1
CASE 2
b = 1
c = 1
d = -1 * chirality
xy = 1
CASE 3
b = -1 * chirality
c = -1 * chirality
d = 1 * chirality
xy = -1
CASE 4
b = -1
c = -1
d = -1 * chirality
xy = 1
END SELECT
x = x + d
DO WHILE x <= .707 * r! AND x >= -.707 * r!
y = SQR((r! ^ 2) - (x ^ 2)) 'formula for circle solved for y
IF xy = 1 THEN SWAP x, y 'never solve for x...just swap values
xtmp = xini + x * b: ytmp = yini + y * c
z = 2 * r! * rf!
FOR here = 1 TO 1
LINE -(xtmp + (z - (RND * z)), ytmp + (z - (RND * z))), cini
NEXT here
dx = POINT(0): dy = POINT(1)
IF xy = 1 THEN SWAP x, y 'return values
FOR zzz = 1 TO g / (g / 25) 'to slow down same amount on different platforms
FOR zz = 1 TO g / 2: NEXT zz
PRESET (RND * 640, RND * 480)
NEXT zzz
PRESET (dx, dy)
x = x + d 'increment x (d=+/-1)
r! = r! + rf! 'increase radius
IF (r! > maxsize) THEN
outtahere = 1
EXIT DO
END IF
LOOP 'end quadrant drawing loop
IF outtahere THEN EXIT FOR
NEXT j 'loop to draw next quadrant
LOOP UNTIL outtahere 'stop spiraling
a$ = INKEY$
LOOP UNTIL a$ <> "" 'make a new spiral (different size/location)
PRINT "More Spirals?? (y/n)"
DO
a$ = INKEY$
LOOP UNTIL a$ <> ""
IF a$ = "y" OR a$ = "Y" THEN GOTO begin
END
Mango, I think it looks pretty good. Especially the thick spirals..
Neo: I'll check it out..
I didn't read you whole story, but I think it may apply to your program about gravitational forces driving towards a center.
