Here you goby 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 |
| Response Title | Author 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 |
| oops | unseen machine on Jan 29 |
| * It cannot change DOT variable names after the TYPE either LOL | Clippy on Jan 29 |