# Qbasicnews.com

You're currently viewing a stripped down version of our content. View the full version with proper formatting.
Pages: 1 2 3 4
Make the BEST simulation...

the point here is to make the BEST simulation you can think of.

1. it can be 2D or 3D.
2. the sorta thing I am talking about would be a star-field or fireworks. I made a snow simulation
3. I would reccomend that you add some kid of hummor to spice it up.
4. make sure that it is 100% appropriate.
5. try and leave a lot of remarks in the code
6. make sure that you don't need a really new version of QBASIC to run it...
7. Make it INTERESTING and possibly ENTERTANING.

:roll: :roll: :roll: :roll: :roll: :roll: :roll: :roll: :roll:
here is a 3D fireworks program I made. copy it and then hit F5 (you know). hold space-bar to rotate the image. tell me how you like it... oh, and I used my own 3D formula, and so the 3D is a little off.

Code:
```DIM bx3(20, 150) DIM bz3(20, 150) DIM c!(360), s!(360) DIM bx(20, 150) DIM by(20, 150) DIM bz(20, 150) DIM bxs(20, 150) DIM bys(20, 150) DIM bzs(20, 150) DIM colr(20, 150) DIM bx1(20, 150) DIM by1(20, 150) DIM boom\$(20) DIM bom(20) DIM x(20) DIM y(20) DIM z(20) DIM colm(20) SCREEN 12 RANDOMIZE TIMER bnom = 150 '********************* number of explosion particals... lower it for speed nom = 4  '*********************** number of fireworks coln = 7 FOR num = 1 TO nom boom\$(num) = "S" NEXT num FOR der = 1 TO coln READ Rer(der) READ Ger(der) READ Ber(der) NEXT der DATA 1,33,33 DATA 33,1,33 DATA 33,33,1 DATA 1,1,33 DATA 33,1,1 DATA 1,33,1 DATA 1,1,1 BEEP FOR i = 1 TO 360 c!(i) = COS(i * 3.14 / 180) s!(i) = SIN(i * 3.14 / 180) NEXT cx = 320 cy = 240 cz = 350 angle = 90 time = TIMER FOR ferx = 1 TO 660 FOR fery = 1 TO 480 PSET (1, 1), back NEXT fery NEXT ferx etime = TIMER back = 0 bol = 0 gol = 0 rol = 0 DO Key\$ = INKEY\$ bol = bol + .03 OUT &H3C8, 0 OUT &H3C9, rol OUT &H3C9, gol OUT &H3C9, bol tim = TIMER IF (angle >= 359) THEN angle = 1 END IF IF (Key\$ = " ") THEN angle = angle + 2 END IF FOR num = 1 TO nom IF (boom\$(num) = "S") THEN FOR bnum = 1 TO bnom bom(num) = 63 bx(num, bnum) = x(num) by(num, bnum) = y(num) bz(num, bnum) = z(num) bxs(num, bnum) = (RND * 3) - 1.5 bys(num, bnum) = (RND * 3) - 1.5 bzs(num, bnum) = (RND * 3) - 1.5 colr(num, bnum) = num NEXT bnum colm(num) = (INT(RND * (coln))) + 1 x(num) = (INT(RND * 620)) + 20 y(num) = 470 z(num) = (INT(RND * 700)) boom\$(num) = "Y" END IF IF (boom\$(num) = "Y") THEN FOR bnum = 1 TO bnom bx3(num, bnum) = (bx(num, bnum) - cx) * c!(angle) + (bz(num, bnum) - cz) * s!(angle) bz3(num, bnum) = (bz(num, bnum) - cz) * c!(angle) - (bx(num, bnum) - cx) * s!(angle) bz3(num, bnum) = bz3(num, bnum) + cz bx3(num, bnum) = bx3(num, bnum) + cx bom(num) = bom(num) - .003 OUT &H3C8, num OUT &H3C9, ((bom(num) / Rer(colm(num))) - 62) OUT &H3C9, ((bom(num) / Ger(colm(num))) - 62) OUT &H3C9, ((bom(num) / Ber(colm(num))) - 62) PSET (bx1(num, bnum), by1(num, bnum)), back IF (bz3(num, bnum) > 1000) THEN bz3(num, bnum) = 1 ELSEIF (bz3(num, bnum) < 1) THEN bz3(num, bnum) = 0 END IF bx1(num, bnum) = bx3(num, bnum) + ((320 - bx3(num, bnum)) / 1000) * bz3(num, bnum) by1(num, bnum) = by(num, bnum) + ((240 - by(num, bnum)) / 1000) * bz3(num, bnum) bys(num, bnum) = bys(num, bnum) + .03 bx(num, bnum) = bx(num, bnum) + bxs(num, bnum) by(num, bnum) = by(num, bnum) + bys(num, bnum) bz(num, bnum) = bz(num, bnum) + bzs(num, bnum) PSET (bx1(num, bnum), by1(num, bnum)), colr(num, bnum) IF (bom(num) <= 4) THEN PSET (bx1(num, bnum), by1(num, bnum)), back boom\$(num) = "E" fuel(num) = (INT(RND * 400)) + 100 END IF NEXT bnum END IF IF (boom\$(num) = "E") THEN olx3(num) = x1(num) oly3(num) = y1(num) x3(num) = (x(num) - cx) * c!(angle) + (z(num) - cz) * s!(angle) z3(num) = (z(num) - cz) * c!(angle) - (x(num) - cx) * s!(angle) z3(num) = z3(num) + cz x3(num) = x3(num) + cx x1(num) = x3(num) + ((320 - x3(num)) / 1000) * z3(num) y1(num) = y(num) + ((240 - y(num)) / 1000) * z3(num) LINE (olx3(num), oly3(num))-(olx3(num), (oly3(num) + (fuel(num) / 20))), back fuel(num) = fuel(num) - .65 y(num) = y(num) - (fuel(num) / 300) LINE (x1(num), y1(num))-(x1(num), (y1(num) + (fuel(num) / 20))), 14 IF (fuel(num) < -6) THEN boom\$(num) = "S" PSET (x(num), (y(num) + (fuel(num) / 20))), 0 END IF END IF IF (boom\$(num) <> "Y") THEN FOR ford = 1 TO (bnom * 2) PSET (1, 1), 1 NEXT ford END IF NEXT num etim = TIMER LOOP UNTIL Key\$ = "q" PRINT "start:"; etime; "end:"; time; "fps:"; etime - time; "It takes "; (INT(etime - time) / (100 * 100)); " to set a pixel."```

hope you enjoy it... oh, and the farther away the thing gets, the worst the 3D works.... ......... and I was rushing, so the explosion is shaped somewhat like a cube! [/code]
my entry
1. 2D
2. Not that but it's creative =P
3. It itself is humour
4. Done and done
5. done
6. done
7. er... sure... why not?

Code:
```'The switch simulation! CLS 'title and information print LOCATE 1, 29 PRINT "THE SWITCH!" PRINT "By whitetiger0990" PRINT PRINT "Press space to toggle the switch" DO LOCATE 5, 1 press\$ = INKEY\$ 'check if space is pressed IF press\$ = CHR\$(32) THEN toggle = toggle XOR 1 'print the switch IF toggle = 1 THEN PRINT "On " ELSE PRINT "Off" END IF LOOP```

maybe I'll do something better later =P
Code:
```'///A lil particle demo I made using WuPixels '///Y-axis rotation but could rotate on any axis '///tried to add wind but the fx sucked terribly. '///SetVideoSeg by Plasma '///FFIX by v1ctor, Plasma and Dav '/// '///Funny how I get a *lot* done using someone else's comp that using mine. ;*) '///Relsoft '///Rel.BetterWebber.com DECLARE SUB FFIX (Mode%) DECLARE SUB WuPixel (x!, y!, col%) DECLARE SUB SetVideoSeg (Segment%) DEFINT A-Z TYPE point3d     x       AS SINGLE     y       AS SINGLE     z       AS SINGLE     xv      AS SINGLE     yv      AS SINGLE     zv      AS SINGLE     counter AS INTEGER END TYPE CONST NUMPARTS = 300 CONST LENS = 256 CONST xMID = 160, yMID = 100 CONST PI = 3.141593 CONST GRAV = .01 CONST WIND = 0 'Floor CONST XMAX = 25, YMAX = 25 RANDOMIZE TIMER REDIM SHARED Vpage(32009)  AS INTEGER DIM Parts(NUMPARTS) AS point3d DIM Floor(XMAX * YMAX) AS point3d DIM SHARED Lcos(359) AS SINGLE DIM SHARED Lsin(359) AS SINGLE FFIX 0  'Secret formula that makes Floating Point cals faster. :*) 'Spherical coordinate system '///    x =  p SIN(Phi) COS(theta) '///    y =  p SIN(Phi) SIN(theta) '///    z =  p COS(Phi) FOR i = 0 TO NUMPARTS     Parts(i).x = 0     Parts(i).y = -50     Parts(i).z = 0     theta! = INT(RND * 360) * PI / 180     Phi! = INT(RND * 360) * PI / 180     Speed! = .1 + RND     Parts(i).xv = SIN(Phi!) * COS(theta!) * (Speed! / 3)     Parts(i).yv = ABS(SIN(Phi!) * SIN(theta!) * Speed! * 2)     Parts(i).zv = COS(Phi!) * (Speed! / 3)     Parts(i).counter = 0 NEXT i 'Floor model FScale! = 10 xm = XMAX \ 2 ym = YMAX \ 2 i = 0 FOR x = -xm TO xm - 1     FOR z = -ym TO ym + 1         Floor(i).x = x * FScale!         Floor(i).z = z * FScale!         Floor(i).y = -50         i = i + 1     NEXT z NEXT x FOR i = 0 TO 359     a! = i * PI / 180     Lcos(i) = COS(a!)     Lsin(i) = SIN(a!) NEXT i CLS SCREEN 13 FOR i = 0 TO 255   OUT &H3C8, i   OUT &H3C9, i \ 4   OUT &H3C9, i \ 4   OUT &H3C9, i \ 4 NEXT i Vpage(6) = 2560 Vpage(7) = 200 Layer = VARSEG(Vpage(0)) + 1 SetVideoSeg Layer DO     SetVideoSeg Layer     LINE (0, 0)-(319, 199), 0, BF     AngleY = (AngleY + 1) MOD 360     cx! = Lcos(AngleX)     sx! = Lsin(AngleX)     cy! = Lcos(AngleY)     sy! = Lsin(AngleY)     cz! = Lcos(AngleZ)     sz! = Lsin(AngleZ)     xx! = cy! * cz!     xy! = sx! * sy! * cz! - cx! * sz!     xz! = cx! * sy! * cz! + sx! * sz!     yx! = cy! * sz!     yy! = cx! * cz! + sx! * sy! * sz!     yz! = -sx! * cz! + cx! * sy! * sz!     zx! = -sy!     zy! = sx! * cy!     zz! = cx! * cy!         'Floor     FOR i = 0 TO UBOUND(Floor) - 2         RotX! = (Floor(i).x * xx! + Floor(i).y * xy! + Floor(i).z * xz!) - camx%         RotY! = (Floor(i).x * yx! + Floor(i).y * yy! + Floor(i).z * yz!) - camy%         RotZ! = (Floor(i).x * zx! + Floor(i).y * zy! + Floor(i).z * zz!) - camz%         'Project         Distance% = (LENS - RotZ!)         IF Distance% THEN             x2d! = xMID + (LENS * RotX! / Distance%)             y2d! = yMID - (LENS * RotY! / Distance%)         END IF         WuPixel x2d!, y2d!, 255     NEXT i         'particles     FOR i = 0 TO NUMPARTS         Parts(i).x = Parts(i).x + Parts(i).xv         Parts(i).y = Parts(i).y + Parts(i).yv         Parts(i).z = Parts(i).z + Parts(i).zv         Parts(i).yv = Parts(i).yv - GRAV         IF Parts(i).y < -51 THEN             Parts(i).xv = 0             Parts(i).yv = 0             Parts(i).zv = 0             Parts(i).counter = Parts(i).counter + 1         ELSE             Parts(i).x = Parts(i).x + WIND         END IF         IF Parts(i).counter > 100 THEN             Parts(i).x = 0             Parts(i).y = -50             Parts(i).z = 0             theta! = INT(RND * 360) * PI / 180             Phi! = INT(RND * 360) * PI / 180             Speed! = .1 + RND             Parts(i).xv = SIN(Phi!) * COS(theta!) * (Speed! / 3)             Parts(i).yv = ABS(SIN(Phi!) * SIN(theta!) * Speed! * 2)             Parts(i).zv = COS(Phi!) * (Speed! / 3)             Parts(i).counter = 0         END IF         RotX! = (Parts(i).x * xx! + Parts(i).y * xy! + Parts(i).z * xz!) - camx%         RotY! = (Parts(i).x * yx! + Parts(i).y * yy! + Parts(i).z * yz!) - camy%         RotZ! = (Parts(i).x * zx! + Parts(i).y * zy! + Parts(i).z * zz!) - camz%         'Project         Distance% = (LENS - RotZ!)         IF Distance% THEN             x2d! = xMID + (LENS * RotX! / Distance%)             y2d! = yMID - (LENS * RotY! / Distance%)         END IF         WuPixel x2d!, y2d!, 255     NEXT i     SetVideoSeg &HA000     WAIT &H3DA, 8     PUT (0, 0), Vpage(6), PSET LOOP UNTIL INKEY\$ <> "" FFIX -1 END SUB FFIX (Mode%) STATIC IF Mode% = 0 THEN     DIM isr(0 TO 5) AS LONG                     'FFix by Dav,Plasma and v1ctor     isr(0) = &H53EC8B55: isr(1) = &H83025E8B     isr(2) = &H8E0602EB: isr(3) = &HC7260446     isr(4) = &H79B9007: isr(5) = &HCF9B5D5B     DEF SEG = 0     OldISR1 = PEEK(&HF4)     OldISR2 = PEEK(&HF5)     OldISR3 = PEEK(&HF6)     OldISR4 = PEEK(&HF7)     POKE &HF4, VARPTR(isr(0)) AND 255     POKE &HF5, (CLNG(VARPTR(isr(0))) AND &HFF00&) \ 256     POKE &HF6, VARSEG(isr(0)) AND 255     POKE &HF7, (CLNG(VARSEG(isr(0))) AND &HFF00&) \ 256 ELSE DEF SEG = 0 POKE &HF4, OldISR1 POKE &HF5, OldISR2 POKE &HF6, OldISR3 POKE &HF7, OldISR4 END IF END SUB SUB SetVideoSeg (Segment) STATIC 'By Plasma 357 (Jon Petrosky) DEF SEG IF VideoAddrOff& = 0 THEN ' First time the sub is called ' We need to find the location of b\$AddrC, which holds the graphics ' offset (b\$OffC) and segment (b\$SegC). Since b\$AddrC is in the default ' segment, we can find it by setting it to a certain value, and then ' searching for that value. SCREEN 13 ' Set b\$SegC to A000 (00A0 in memory) PSET (160, 100), 0 ' Set b\$OffC to 7DA0 (not needed in the IDE) FOR Offset& = 0 TO 32764 ' Search for b\$AddrC, which is IF PEEK(Offset&) = &HA0 THEN ' in the default segment and IF PEEK(Offset& + 1) = &H7D THEN ' should have a value of IF PEEK(Offset& + 2) = &H0 THEN ' A0 7D 00 A0. IF PEEK(Offset& + 3) = &HA0 THEN VideoAddrOff& = Offset& + 2 ' If we found it, record the EXIT FOR ' offset of b\$SegC and quit END IF ' looking. (Oddly, changing END IF ' the b\$OffC doesn't seem to END IF ' do anything, so this is why END IF ' this sub only changes b\$SegC) NEXT END IF ' Change b\$SegC to the specified Segment POKE VideoAddrOff&, Segment AND &HFF POKE VideoAddrOff& + 1, (Segment AND &HFF00&) \ &H100 END SUB SUB WuPixel (x!, y!, col) x1 = FIX(x!) y1 = FIX(y!) x2 = x1 + 1 y2 = y1 + 1 xm! = x! - x1 ym! = y! - y1 xm2! = (1 - xm!) ym2! = (1 - ym!) c1 = xm2! * ym2! * col c2 = xm! * ym2! * col c3 = xm2! * ym! * col c4 = xm! * ym! * col PSET (x1, y1), c1 PSET (x2, y1), c2 PSET (x1, y2), c3 PSET (x2, y2), c4 END SUB```
Here ya go. Bump map with two light sources and lens flare. I don't think I met all of the requirements though. Sorry. :oops:

Code:
```'Compile me. I am slow. And I need more memory. ' 'Thanks, 'This Program ' 'P.S. If you do not compile me and attempt to run me in the IDE, I will 'crash your computer. Sorry.                                  DECLARE SUB setupcrap () DECLARE SUB setpal () DECLARE SUB circbob (x%, y%, r%, col%) DECLARE SUB doflare (x!, y!, col%) DECLARE SUB ffix (Mode%) DECLARE FUNCTION shd% (x%, y%) SCREEN 13 ffix 0 RANDOMIZE TIMER '\$DYNAMIC DIM SHARED luy(199) AS LONG FOR i = 0 TO 199   luy(i) = i * 320 NEXT DEFINT A-Z DIM SHARED luc(15) DIM SHARED rad(10, 1) DIM SHARED bump(319, 99) DIM SHARED shade(-159 TO 159, -100 TO 0) DIM SHARED shade2(-159 TO 159, 0 TO 100) DIM SHARED dist(319, 99) DIM SHARED dists(319, 99) CONST pi = 3.14159 'Screen buffer REDIM scrn(16001) scrn(0) = 2560 scrn(1) = 100 DEF SEG = VARSEG(scrn(2)) DIM SHARED offset AS LONG offset = VARPTR(scrn(2)) setupcrap setpal t! = TIMER DO f = f + 1 a! = a! - .01 b! = b! - .03 c! = c! - .04 d! = d! - .02 x1 = SIN(a!) * 150 + 160 y1 = SIN(b!) * 50 + 50 x2 = SIN(c!) * 150 + 160 y2 = SIN(d!) * 50 + 50 'Update bumpmap 'xv = xv + 1 FOR x = 0 TO 319   FOR y = 0 TO 99    bump(x, y) = SIN(dist(x, y) * pi / 180 + a! * 5) * 200 + 200    'Use this for a little more speed.    'bump(x, y) = (x + xv) XOR y   NEXT NEXT 'Draw bumpmap FOR x = 1 TO 318   FOR y = 1 TO 98    bx = bump(x - 1, y) - bump(x + 1, y)    by = bump(x, y - 1) - bump(x, y + 1)    nx = (x - x1) + bx    ny = (y - y1) + by    IF nx < -159 THEN nx = -159    IF ny < -100 THEN ny = -100    IF nx > 159 THEN nx = 159    IF ny > 100 THEN ny = 100    orange = shd(nx, ny)    nx = (x - x2) + bx    ny = (y - y2) + by    IF nx < -159 THEN nx = -159    IF ny < -100 THEN ny = -100    IF nx > 159 THEN nx = 159    IF ny > 100 THEN ny = 100    blue = shd(nx, ny)    POKE offset + x + luy(y), luc(orange) + blue   NEXT NEXT 'Draw lens flare x! = x1 - 160 y! = y1 - 50 doflare x!, y!, 1 x! = x2 - 160 y! = y2 - 50 doflare x!, y!, 0 PUT (0, 50), scrn, PSET REDIM scrn(16001) scrn(0) = 2560 scrn(1) = 100 LOOP UNTIL LEN(INKEY\$) fps! = f / (TIMER - t!) ffix -1 SCREEN 0 PRINT fps! SLEEP REM \$STATIC SUB circbob (x, y, r, col) x1 = x - r IF x1 < 0 THEN x1 = 0 x2 = x + r IF x2 > 319 THEN x2 = 319 y1 = y - r IF y1 < 0 THEN y1 = 0 y2 = y + r IF y2 > 99 THEN y2 = 99 IF col THEN 'if orange FOR xx = x1 TO x2   FOR yy = y1 TO y2    IF dists(ABS(xx - x), ABS(yy - y)) < r THEN     o& = offset + xx + luy(yy)     c = PEEK(o&) \ 16 + 1     c2 = PEEK(o&) AND 15     IF c > 15 THEN c = 15     POKE o&, luc(c) + c2    END IF   NEXT NEXT ELSE 'if blue FOR xx = x1 TO x2   FOR yy = y1 TO y2    IF dists(ABS(xx - x), ABS(yy - y)) < r THEN     o& = offset + xx + luy(yy)     c = PEEK(o&) \ 16     c2 = (PEEK(o&) AND 15) + 1     IF c2 > 15 THEN c2 = 15     POKE o&, luc(c) + c2    END IF   NEXT NEXT END IF END SUB SUB doflare (x!, y!, col) x2 = -x! \ 2 y2 = -y! \ 2 xv! = (x2 - x!) / 10 yv! = (y2 - y!) / 10 FOR i = 0 TO 10   z = i * 20   rx = 256 * (x! / (256 + z)) + 160   ry = 256 * (y! / (256 + z)) + 50   circbob rx, ry, rad(i, col), col   x! = x! + xv!   y! = y! + yv! NEXT END SUB SUB ffix (Mode%) STATIC 'FFix by Dav,Plasma and v1ctor IF Mode% = 0 THEN     DIM isr(0 TO 5) AS LONG     isr(0) = &H53EC8B55: isr(1) = &H83025E8B     isr(2) = &H8E0602EB: isr(3) = &HC7260446     isr(4) = &H79B9007: isr(5) = &HCF9B5D5B     DEF SEG = 0     OldISR1 = PEEK(&HF4)     OldISR2 = PEEK(&HF5)     OldISR3 = PEEK(&HF6)     OldISR4 = PEEK(&HF7)     POKE &HF4, VARPTR(isr(0)) AND 255     POKE &HF5, (CLNG(VARPTR(isr(0))) AND &HFF00&) \ 256     POKE &HF6, VARSEG(isr(0)) AND 255     POKE &HF7, (CLNG(VARSEG(isr(0))) AND &HFF00&) \ 256 ELSE DEF SEG = 0 POKE &HF4, OldISR1 POKE &HF5, OldISR2 POKE &HF6, OldISR3 POKE &HF7, OldISR4 END IF END SUB SUB setpal FOR i = 0 TO 15 FOR j = 0 TO 15   OUT 968, luc(i) + j   OUT 969, i * 4   OUT 969, i * 2 + j * 2   OUT 969, j * 4 NEXT NEXT END SUB SUB setupcrap 'Look up color table FOR i = 0 TO 15 luc(i) = i * 16 NEXT 'Radiuses (or is it radii?) of the flares FOR j = 0 TO 1 FOR i = 0 TO 10   rad(i, j) = RND * 20 + (11 - i) * 3 NEXT NEXT 'Shade table for the bumpmap FOR x = -159 TO 159 FOR y = -100 TO 0   shade(x, y) = 15 - SQR(x ^ 2 + y ^ 2) \ 6   IF shade(x, y) < 0 THEN shade(x, y) = 0   shade2(x, y + 100) = 15 - SQR(x ^ 2 + (y + 100) ^ 2) \ 6   IF shade2(x, y + 100) < 0 THEN shade2(x, y + 100) = 0 NEXT NEXT 'Distances used by the wavy bumpmap effect FOR x = 0 TO 319 FOR y = 0 TO 99   dist(x, y) = SQR((x - 160) ^ 2 + (y - 50) ^ 2) * 10 NEXT NEXT 'Distances used by the lens flare FOR x = 0 TO 319 FOR y = 0 TO 99   dists(x, y) = SQR(x ^ 2 + y ^ 2) NEXT NEXT END SUB 'This is inefficient as hell but I really don't feel like fixing it :P FUNCTION shd (x, y) IF y < 0 THEN shd = shade(x, y) ELSE shd = shade2(x, y) END FUNCTION```
I tried the IDE and compiled; both crashed.
Quote:I tried the IDE and compiled; both crashed.

hmm... Use qb 7.1 maybe. I never tired with 4.5. HTH
Whitetiger: That is the most realistic simulation I have ever seen. Good job.

Rel: Nice, as always. =)
DefHo: Wow... That's really really cool. For you lazy ones:
http://quickhost.qbtk.justicejuice.com/d....php?id=68 (compiled qb71 exe)
oooooooooooooooh.

....

sparkly

....

you're quite deft at proggin, er.. def_ho.

;D
Pages: 1 2 3 4