Here you go

by Unseen Machine (no login)

Might run in qb45 but it is for qb64 really. Made by me(roating text) and codeguy(nspace and rotating polys)

'* nspace5.bas
'$checking: off
CONST NXDivs% = 16
CONST NYDivs% = 16
CONST NZDivs% = 16
CONST ubst% = 2519
CONST NDimensions% = 2
CONST MaxObjectRadius% = 3
MaxFPS% = 64
DIM SHARED MinScreenX%, MaxScreenX%, MinScreenY%, MaxScreenY%, NxDivSize%, NyDivSize%
DIM SHARED cstart AS SINGLE, cend AS SINGLE, minx, maxx, miny, maxy
cstart = 0: cend = 6.2
REDIM SHARED PolysInRegion%(NXDivs%, NYDivs%, 0), counts%(NXDivs%, NYDivs%), MaxPolys%
REDIM SHARED SinTable!(0 TO ubst%), CosTable!(0 TO ubst%), PolysInRegion%(NXDivs%, NYDivs%, 0)
'***********
DIM SHARED text$

text$ = "QBasic"

DIM SHARED word(1 TO LEN(text$) * 8, 1 TO 16)

FOR i& = 0 TO ubst%
SinTable!(i&) = SIN(2 * i& * 3.1415926535 / (ubst% + 1))
CosTable!(i&) = COS(2 * i& * 3.1415926535 / (ubst% + 1))
NEXT
oscreen& = _SCREENIMAGE
MaxScreenX% = _WIDTH(oscreen&) / 2
MaxScreenY% = _HEIGHT(oscreen&) / 2
MaxScreenZ% = 0
_FREEIMAGE oscreen&
MinScreenX% = 0
MinScreenY% = 0
MinScreenZ% = 0
ModNxDivsSx% = (MaxScreenX% - MinScreenX%) MOD NXDivs%
ModNyDivsSy% = (MaxScreenY% - MinScreenY%) MOD NYDivs%
ModNzDivsSz% = (MaxScreenZ% - MinScreenZ%) MOD NZDivs%
NxDivSize% = ((MaxScreenX% - MinScreenX%) - ModNxDivSx%) / NXDivs%
NyDivSize% = ((MaxScreenY% - MinScreenY%) - ModNyDivSy%) / NYDivs%
NzDivSize% = ((MaxScreenZ% - MinScreenZ%) - ModNzDivSz%) / NZDivs%

TYPE Polygons
x AS SINGLE
y AS SINGLE
z AS SINGLE
mass AS SINGLE
radius AS INTEGER
speedx AS SINGLE
speedy AS SINGLE
speedz AS SINGLE
color AS INTEGER
mass AS SINGLE
nsides AS INTEGER
radius2 AS SINGLE
END TYPE
REDIM b(0 TO 1) AS Polygons
MaxPolys% = 127
DIM SHARED Polys(0 TO MaxPolys%) AS Polygons
SepX% = (MaxScreenX% - MinScreenX%) / (2 * MaxObjectRadius%)
accum% = MaxObjectRadius%
x% = MaxObjectRadius%
y% = MaxObjectRadius%
FOR i% = LBOUND(Polys) TO UBOUND(Polys)
Polys(i%).nsides = SetRand(3, 5)
Polys(i%).radius = MaxObjectRadius% '* SetRand%(0, MaxObjectRadius%)
Polys(i%).x = x% '* SetRand(MinScreenX% + Polys(i%).radius, MaxScreenX% - Polys(i%).radius)
Polys(i%).speedx = SetRand(0, MaxObjectRadius% / 2)
Polys(i%).y = y% '* SetRand(MinScreenY% + Polys(i%).radius, MaxScreenY% - Polys(i%).radius)
Polys(i%).z = SetRand(MinScreenZ% + Polys(i%).radius, MaxScreenZ% - Polys(i%).radius)
Polys(i%).speedy = SetRand(0, MaxObjectRadius% / 2)
Polys(i%).speedz = SetRand(0, MaxObjectRadius% / 2)
Polys(i%).color = SetRand(43, 127)
Polys(i%).mass = Polys(i%).nsides \ 2 + 1
IF x% > MaxScreenX% - MaxObjectRadius% THEN
y% = y% + 2 * MaxObjectRadius%
x% = MaxObjectRadius%
ELSE
x% = x% + 2 * MaxObjectRadius%
END IF
Polys(i%).radius2 = Polys(i%).radius ^ 2
NEXT
DIM logo AS Polygons
logo.z = 0
logo.speedx = 0
logo.speedy = 0
logo.speedz = 0
logo.mass = 1
GameScreen& = _NEWIMAGE(MaxScreenX%, MaxScreenY%, 256)
dimensionFlags% = 1
TempX% = (NDimensions% - 1)
BitSet% = 1
WHILE TempX% > 0
dimensionFlags% = dimensionFlags% OR 2 ^ BitSet%
BitSet% = BitSet% + 1
TempX% = TempX% \ 2
WEND
SCREEN GameScreen&
logo.x = _WIDTH / 2
logo.y = _HEIGHT / 2
LOCATE 2, 1: PRINT text$;
analyse
DO



'_AUTODISPLAY
IF _MOUSEINPUT THEN
PlayerX% = _MOUSEX
PlayerY% = _MOUSEY
lmb% = _MOUSEBUTTON(1)
rmb% = _MOUSEBUTTON(2)
END IF
'* check to see if objects collide with each other
DIM row AS INTEGER, cnt AS INTEGER
DIM xrot AS INTEGER, yrot AS INTEGER, scale AS INTEGER

xrot = 8: yrot = 2: scale = 3

OUT &H3C8, 1: OUT &H3C9, 10: OUT &H3C9, 20: OUT &H3C9, 63

time! = TIMER
DO


CLS
row = 2
Ltime! = TIMER
DO

DO
'LINE (minx, miny)-(max, maxy), 0, BF
minx = 32767
miny = 32767
FOR i = cstart TO cend STEP .04

x = (scale * 60 - (row * xrot)) * (COS(i))
IF x < minx THEN
minx = x
END IF
IF x > maxx THEN
maxx = x
END IF
y = (scale * 60 - (row * yrot)) * (SIN(i))
IF y < miny THEN
miny = y
END IF
IF y > maxy THEN
maxy = y
END IF
cnt = cnt + 1

IF word(cnt, row) > 0 THEN

CIRCLE (x / 2 + _WIDTH / 2, y / 2 + _HEIGHT / 2), scale, 1
PAINT STEP(0, 0), 1, 1

END IF

IF cnt = LEN(text$) * 8 THEN cnt = 0: EXIT DO

NEXT
LOOP

row = row + 1

LOOP UNTIL row = 16

cend = cend + .1
cstart = cstart + .1
IF ABS(maxx) > ABS(maxy) THEN
logo.radius = ABS(maxx) / 2
ELSE
logo.radius = ABS(maxy) / 2
END IF
logo.mass = 1
logo.radius2 = logo.radius ^ 2
IF -1 THEN
FOR i% = LBOUND(polys) TO UBOUND(polys)
IF Collision%(logo, Polys(i%), dimensionFlags%) THEN
IF (logo.x = Polys(i%).x) THEN
logo.speedx = (logo.radius / (scale ^ 2))
logo.speedy = 1
ELSE
slope! = (logo.y - Polys(i%).y) / (logo.x - Polys(i%).x)
IF Polys(i%).y >= logo.y THEN '* either going N or E (270-90)
IF Polys(i%).x >= logo.x THEN 'going east
Theta! = slope! * 90
ELSE 'going north
Theta! = 270 + slope! * 90
END IF
ELSE
IF Polys(i%).x >= logo.x THEN
Theta! = 90 + slope! * 90
ELSE
Theta! = 180 + 90 * slope!
END IF
END IF
logo.speedx = logo.radius / (scale ^ 2) * COS(Theta! * 3.14159 / 180)
logo.speedy = logo.radius / (scale ^ 2) * SIN(Theta! * 3.14159 / 180)
END IF
b(0) = logo
b(1) = Polys(i%)
CalcVelocities b(), 0, 1, dimensionFlags%
Polys(i%) = b(1)
Position Polys(i%), dimensionFlags%
'* DrawPoly Polys(i%)
ELSE
Position Polys(i%), dimensionFlags%
IF 0 THEN
IF Polys(i%).x < _WIDTH / 2 - maxx / 2 THEN
DrawPoly Polys(i%)
'PAINT (Polys(i%).x, Polys(i%).y), Polys(i%).color
ELSEIF Polys(i%).x > maxx / 2 + _WIDTH / 2 THEN
DrawPoly Polys(i%)
'PAINT (Polys(i%).x, Polys(i%).y), Polys(i%).color
ELSE
m% = (m% + 1) MOD 2
IF m% THEN
Polys(i%).x = _WIDTH / 2 - maxx / 2 - 1
ELSE
Polys(i%).x = maxx / 2 + _WIDTH / 2 + 1
END IF
END IF
ELSE
DrawPoly Polys(i%)
END IF
GetPossibleIndexes i%, Polys(i%).x, Polys(i%).y, Polys(i%).radius, MinScreenX%, MaxScreenX%, MinScreenY%, MaxScreenY%
'CollidedWithPlayer% = Collision%(PlayerX%, PlayerY%, 100, Polys(i%).x, Polys(i%).y, Polys(i%).radius)
'IF CollidedWithPlayer% THEN
'END IF
END IF
NEXT
END IF
FOR ax% = 0 TO NXDivs%
FOR ay% = 0 TO NYDivs%
FOR xj% = 0 TO counts%(ax%, ay%) - 1
p1% = PolysInRegion%(ax%, ay%, xj%)
FOR aj% = xj% + 1 TO counts%(ax%, ay%) - 1
p2% = PolysInRegion%(ax%, ay%, aj%)
IF Collision%(Polys(p1%), Polys(p2%), dimensionFlags%) THEN
CalcVelocities Polys(), p1%, p2%, dimensionFlags%
END IF
NEXT

NEXT
counts%(ax%, ay%) = 0
NEXT
NEXT
REDIM PolysInRegion%(NXDivs%, NYDivs%, 0)
Dtime! = ABS(TIMER - Ltime!)
IF ABS(Dtime! - 1 / MaxFPS%) > .010 THEN
MaxPolys% = MaxPolys% + 1
REDIM _PRESERVE Polys(MaxPolys%) AS Polygons
Polys(MaxPolys%).nsides = SetRand(3, 5)
Polys(MaxPolys%).radius = MaxObjectRadius% '* SetRand%(0, MaxObjectRadius%)
IF MaxPolys% MOD 2 THEN
Polys(MaxPolys%).x = SetRand(MinScreenX% + Polys(i%).radius, MinScreenX% + Polys(i%).radius)
Polys(MaxPolys%).y = SetRand(MinScreenY% + Polys(i%).radius, MinScreenY% + Polys(i%).radius)
ELSE
Polys(MaxPolys%).x = SetRand(MaxScreenX% - Polys(i%).radius, MaxScreenX% - Polys(i%).radius)
Polys(MaxPolys%).y = SetRand(MaxScreenY% - Polys(i%).radius, MaxScreenY% - Polys(i%).radius)
END IF
Polys(MaxPolys%).speedx = SetRand(0, MaxObjectRadius% / 2)

Polys(MaxPolys%).z = SetRand(MinScreenZ% + Polys(i%).radius, MaxScreenZ% - Polys(i%).radius)
Polys(MaxPolys%).speedy = SetRand(0, MaxObjectRadius% / 2)
Polys(MaxPolys%).speedz = SetRand(0, MaxObjectRadius% / 2)
Polys(MaxPolys%).color = SetRand(43, 127)
Polys(MaxPolys%).mass = Polys(i%).nsides \ 2 + 1
Polys(i%).radius2 = Polys(i%).radius ^ 2
ELSEIF ABS(Dtime! - 1 / MaxFPS%) < .010 THEN
MaxPolys% = MaxPolys% - 100
REDIM _PRESERVE Polys(MaxPolys%) AS Polygons
END IF
_DISPLAY
'_LIMIT 20
LOOP UNTIL ABS(TIMER - time!) > 1
LOOP UNTIL INKEY$ > "" OR rmb%
SYSTEM

SUB Position (P AS Polygons, flags%)
IF flags% AND 4 THEN
IF P.z + P.speedz < MinScreenZ% THEN
P.speedz = -P.speedz
ELSEIF P.z + P.speedz > MaxScreenZ% THEN
P.speedz = -P.speedz
END IF
P.z = P.z + P.speedz
END IF

IF flags% AND 2 THEN
IF P.y + P.speedy < MinScreenY% THEN
P.speedy = -P.speedy
ELSEIF P.y + P.speedy > MaxScreenY% THEN
P.speedy = -P.speedy
END IF
P.y = P.y + P.speedy
END IF

IF flags% AND 1 THEN
IF P.x + P.speedx < MinScreenX% THEN
P.speedx = -P.speedx
ELSEIF P.x + P.speedx > MaxScreenX% THEN
P.speedx = -P.speedx
END IF
P.x = P.x + P.speedx
END IF

END SUB

FUNCTION Collision% (T1 AS Polygons, t2 AS Polygons, flags%)
IF (flags% AND 4) THEN
dx! = (T1.x - t2.x) ^ 2
dy! = (T1.y - t2.y) ^ 2
IF dx! + dy! > (T1.radius2 + t2.radius2) THEN
Collision% = 0
ELSE
IF ABS(T1.z - t2.z) > (T1.radius + t2.radius) THEN
Collision% = 0
ELSE
Collision% = -1
END IF
END IF
EXIT FUNCTION
END IF
IF (flags% AND 2) THEN
dx! = (T1.x - t2.x) ^ 2
dy! = (T1.y - t2.y) ^ 2
IF dx! + dy! > (T1.radius2 + t2.radius2) THEN
Collision% = 0
ELSE
Collision% = -1
END IF
EXIT FUNCTION
END IF
IF flags% AND 1 THEN
IF ABS(T1.x - t2.x) > T1.radius + t2.radius THEN
Collision% = 0
ELSE
Collision% = -1
END IF
EXIT FUNCTION
END IF
END FUNCTION

FUNCTION SetRand% (MinValue%, MaxValue%)
SetRand% = MinValue% + RND * (MaxValue% - MinValue%)
END FUNCTION

SUB GetPossibleIndexes (PolyNumber%, x%, y%, radius%, MinSX%, MaxSX%, MinSY%, MaxSY%)
IF radius% > 0 THEN
oldix% = -1
oldiy% = -1
FOR i% = -radius% TO radius% STEP radius%
SELECT CASE x%
CASE MinSX% + radius% TO MaxSX% - radius%
SELECT CASE y%
CASE MinSY% + radius% TO MaxSY% - radius%
ax% = (x% + i%) \ NxDivSize%
ay% = (y% + i%) \ NyDivSize%
IF ax% <> oldix% OR ay% <> oldiy% THEN
IF counts%(ax%, ay%) > UBOUND(PolysInRegion%, 3) THEN
REDIM _PRESERVE PolysInRegion%(NXDivs%, NYDivs%, counts%(ax%, ay%))
END IF
PolysInRegion%(ax%, ay%, counts%(ax%, ay%)) = PolyNumber%
counts%(ax%, ay%) = counts%(ax%, ay%) + 1
oldix% = ax%
oldiy% = ay%
END IF
END SELECT
END SELECT
NEXT
ELSE
ax% = (x%) \ NxDivSize%
ay% = (y%) \ NyDivSize%
PolysInRegion%(ax%, ay%, counts%(ax%, ay%)) = PolyNumber%
counts%(ax%, ay%) = counts%(ax%, ay%) + 1
END IF
END SUB

SUB CalcVelocities (b() AS Polygons, i&, j&, flags%)
IF flags% AND 1 THEN
temp1 = b(i&).speedx
temp2 = b(j&).speedx
totalMass = (b(i&).mass + b(j&).mass)
b(i&).speedx = (temp1 * (b(i&).mass - b(j&).mass) + (2 * b(j&).mass * temp2)) / totalMass
b(j&).speedx = (temp2 * (b(j&).mass - b(i&).mass) + (2 * b(i&).mass * temp1)) / totalMass
ELSE
EXIT SUB
END IF
IF flags% AND 2 THEN
temp1 = b(i&).speedy
temp2 = b(j&).speedy
b(i&).speedy = (temp1 * (b(i&).mass - b(j&).mass) + (2 * b(j&).mass * temp2)) / totalMass
b(j&).speedy = (temp2 * (b(j&).mass - b(i&).mass) + (2 * b(i&).mass * temp1)) / totalMass
ELSE
EXIT SUB
END IF
IF flags% AND 4 THEN
temp1 = b(i&).speedz
temp2 = b(j&).speedz
b(i&).speedz = (temp1 * (b(i&).mass - b(j&).mass) + (2 * b(j&).mass * temp2)) / totalMass
b(j&).speedz = (temp2 * (b(j&).mass - b(i&).mass) + (2 * b(i&).mass * temp1)) / totalMass
ELSE
EXIT SUB
END IF
END SUB

SUB DrawPoly (T AS Polygons)
IF T.nsides > 0 THEN
IF T.radius > 0 THEN
CircleStepDeg% = (ubst% + 1) / T.nsides
Newx = T.x + T.radius * CosTable!(0)
Newy = T.y + T.radius * SinTable!(0)
angle% = 0
fpx = Newx
fpy = Newy
angle% = CircleStepDeg%
DO
IF angle% > ubst% THEN
LINE (fpx, fpy)-(Newx, Newy), T.color
EXIT DO
ELSE
lastx = Newx
lasty = Newy
Newx = T.x + T.radius * CosTable!(angle%)
Newy = T.y + T.radius * SinTable!(angle%)
LINE (lastx, lasty)-(Newx, Newy), T.color
angle% = angle% + CircleStepDeg%
END IF
LOOP
ELSE
PSET (T.x, T.y), T.color
END IF
ELSE
PSET (T.x, T.y), T.color
END IF
END SUB

SUB analyse
COLOR 2: LOCATE 1, 1: PRINT text$

DIM px AS INTEGER, py AS INTEGER, cnt AS INTEGER, ltrcnt AS INTEGER

px = 1: py = 1

DO

word(px, py) = POINT(px, py)

PSET (px, py), 1
px = px + 1

IF px = LEN(text$) * 8 THEN

px = 1
py = py + 1

END IF

LOOP UNTIL py = 16

END SUB

Posted on Jan 28, 2011, 7:30 PM

Respond to this message   

Return to Index


Response TitleAuthor and Date
* It'll never run in Qbasic! You can't use color as a variable name!Clippy on Jan 29
 Interesting that it does work in QB64... on Jan 29
 oopsunseen machine on Jan 29
  * It cannot change DOT variable names after the TYPE either LOLClippy on Jan 29