07-07-2003, 05:38 AM
I substituted all your PI * whatever / whatever things with constants and compiled in QB4, and it just looked like a glitchy line. Cool unoptomized in the IDE though.
'3d cube
'polygon filled using paint. ;*)
'I could probably shorten the code in less than 20 lines but
'I'd rather make another 25 liner. ;*)
'Relsoft 2003
1 IF C& = 0 THEN SCREEN 9, , 1, 0 ELSE DIM CubeM!(8, 7), CubeV(12, 2)
2 FOR V = 1 TO 8 + 12
3 IF V < 9 THEN READ CubeM!(V, 0), CubeM!(V, 1), CubeM!(V, 2) ELSE READ CubeV(V - 8, 0), CubeV(V - 8, 1), CubeV(V - 8, 2)
4 NEXT V
5 DO
6 ax! = (ax! + .01) * -(ax! < 6.283186)
7 ay! = (ay! + .01) * -(ay! < 6.283186)
8 az! = (az! + .01) * -(az! < 6.283186)
9 FOR I = 1 TO 8
10 CubeM!(I, 6) = (256 * ((CubeM!(I, 0) * (COS(ay!) * COS(az!)) + CubeM!(I, 1) * (COS(ax!) * -SIN(az!) + SIN(ax!) * SIN(ay!) * COS(az!)) + CubeM!(I, 2) * (-SIN(ax!) * -SIN(az!) + COS(ax!) * SIN(ay!) * COS(az!)))) \ (256 - ((CubeM!(I, 0) * ( _
-SIN(ay!)) + CubeM!(I, 1) * (SIN(ax!) * COS(ay!)) + CubeM!(I, 2) * (COS(ax!) * COS(ay!)))))) + 320
11 CubeM!(I, 7) = -(256 * ((CubeM!(I, 0) * (COS(ay!) * SIN(az!)) + CubeM!(I, 1) * (COS(ax!) * COS(az!) + SIN(ax!) * SIN(ay!) * SIN(az!)) + CubeM!(I, 2) * (-SIN(ax!) * COS(az!) + COS(az!) * SIN(ay!) * SIN(az!)))) \ (256 - ((CubeM!(I, 0) * (- _
SIN(ay!)) + CubeM!(I, 1) * (SIN(ax!) * COS(ay!)) + CubeM!(I, 2) * (COS(ax!) * COS(ay!)))))) + 175
12 NEXT I
13 LINE (0, 0)-(639, 350), 0, BF
14 FOR I = 1 TO 12
15 IF (CubeM!(CubeV(I, 2), 6) - CubeM!(CubeV(I, 0), 6)) * (CubeM!(CubeV(I, 1), 7) - CubeM!(CubeV(I, 0), 7)) - (CubeM!(CubeV(I, 1), 6) - CubeM!(CubeV(I, 0), 6)) * (CubeM!(CubeV(I, 2), 7) - CubeM!(CubeV(I, 0), 7)) < -256 THEN
16 LINE (CubeM!(CubeV(I, 0), 6), CubeM!(CubeV(I, 0), 7))-(CubeM!(CubeV(I, 1), 6), CubeM!(CubeV(I, 1), 7)), I + 2
17 LINE (CubeM!(CubeV(I, 1), 6), CubeM!(CubeV(I, 1), 7))-(CubeM!(CubeV(I, 2), 6), CubeM!(CubeV(I, 2), 7)), I + 2
18 LINE (CubeM!(CubeV(I, 2), 6), CubeM!(CubeV(I, 2), 7))-(CubeM!(CubeV(I, 0), 6), CubeM!(CubeV(I, 0), 7)), I + 2
19 PAINT ((CubeM!(CubeV(I, 0), 6) + CubeM!(CubeV(I, 1), 6) + CubeM!(CubeV(I, 2), 6)) \ 3, (CubeM!(CubeV(I, 0), 7) + CubeM!(CubeV(I, 1), 7) + CubeM!(CubeV(I, 2), 7)) \ 3), I + 2
20 END IF
21 NEXT I
22 PCOPY 1, 0
23 LOOP UNTIL INKEY$ <> ""
DATA -80,-80,-80,80,-80,-80,80, 80,-80,-80, 80,-80,-80,-80, 80,80,-80, 80,80, 80, 80, -80, 80, 80
DATA 5,1,8,1,4,8,6,5,7,5,8,7,2,6,3,6,7,3,1,2,4,2,3,4,4,3,8,3,7,8,5,6,1,6,2,1
'///Non Palette rotated plasma
'///Relsoft 2003
'///Compile and see the speed. Didn't optimize it as much as I want though...
1 SCREEN 13
2 DIM Lsin1%(-1024 TO 1024), Lsin2%(-1024 TO 1024), Lsin3%(-1024 TO 1024)
3 FOR I% = -1024 TO 1024
4 Lsin1%(I%) = SIN(I% / (128)) * 256 'Play with these values
5 Lsin2%(I%) = SIN(I% / (64)) * 128 'for different types of fx
6 Lsin3%(I%) = SIN(I% / (32)) * 64 ';*)
7 IF I% > -1 AND I% < 256 THEN PALETTE I%, 65536 * (INT(32 - 31 * SIN(I% * 3.14151693# / 128))) + 256 * (INT(32 - 31 * SIN(I% * 3.14151693# / 64))) + (INT(32 - 31 * SIN(I% * 3.14151693# / 32)))
8 NEXT I%
9 DEF SEG = &HA000
10 Dir% = 1
11 DO
12 Counter& = (Counter& + Dir%)
13 IF Counter& > 600 THEN Dir% = -Dir%
14 IF Counter& < -600 THEN Dir% = -Dir%
15 Rot% = 64 * (((Counter& AND 1) = 1) OR 1)
16 StartOff& = 0
17 FOR y% = 0 TO 199
18 FOR x% = 0 TO 318
19 Rot% = -Rot%
20 C% = Lsin3%(x% + Rot% - Counter&) + Lsin1%(x% + Rot% + Counter&) + Lsin2%(y% + Rot%)
21 POKE StartOff& + x%, C%
22 NEXT x%
23 StartOff& = StartOff& + 320
24 NEXT y%
25 LOOP UNTIL INKEY$ <> ""
''Water simulation
''relsoft 2003
''why it even works without a dampen factor is dumbfounding
''as i didn't even know how. This used to have a dampen factor but
''i accindentally erased the code and it still works. ;*)
1 IF C& = 0 THEN DIM Vpage%((128 * 128 + 4) \ 2), w1%(127, 127), w2%(127, 127), Average%(8 * 255) ELSE SCREEN 13
2 IF C& > 0 THEN GET (0, 0)-(127, 127), Vpage%(0) ELSE DEF SEG = VARSEG(Vpage%(0))
3 C& = C& + 1
4 IF C& < 3 THEN 1 ELSE LINE (88, 44)-STEP(129, 129), 255, B
5 FOR I% = 0 TO 255 * 8
6 Average%(I%) = I% \ 4
7 IF I% > -1 AND I% < 256 THEN PALETTE I%, 65536 * INT((I% / 4) AND 63) + 256 * INT((I% / 1.2) AND 63) + INT((I% / 1.4) AND 63)
8 NEXT I%
9 C& = C& + 1
10 IF C& MOD 3 = 0 THEN w1%(1 + INT(RND * 125), 1 + INT(RND * 125)) = 254
11 FOR y% = 1 TO 126
12 FOR x% = 1 TO 126
13 C% = w1%(x% - 1, y%) + w1%(x% + 1, y%) + w1%(x%, y% + 1) + w1%(x%, y% - 1) + w1%(x% + 1, y% - 1) + w1%(x% - 1, y% - 1) + w1%(x% - 1, y% + 1) + w1%(x% + 1, y% + 1)
14 w2%(x%, y%) = (ABS((Average%(C%) - w2%(x%, y%))))
15 NEXT x%, y%
16 P& = VARPTR(Vpage%(2))
17 FOR y% = 1 TO 126
18 FOR x% = 1 TO 126
19 POKE P& + x%, w1%(x%, y%)
20 SWAP w1%(x%, y%), w2%(x%, y%)
21 NEXT x%
22 P& = P& + 128
23 NEXT y%
24 PUT (89, 45), Vpage%(0), PSET
25 IF INKEY$ = "" THEN 9
''Water simulation
''relsoft 2003
''why it even works without a dampen factor dumbfounding
''as i didn't even know how. This used to have a dampen factor but
''i accindentally erased the code and it still works. ;*)
''This version comes with a texture
1 IF C& = 0 THEN DIM Vpage%((128 * 128 + 4) \ 2), w1%(127, 127), w2%(127, 127), Average%(-255 TO 8 * 255) ELSE SCREEN 13
2 IF C& > 0 THEN GET (0, 0)-(127, 127), Vpage%(0) ELSE DEF SEG = VARSEG(Vpage%(0))
3 C& = C& + 1
4 IF C& < 3 THEN 1
5 FOR I% = -255 TO 255 * 8
6 Average%(I%) = I% \ 4
7 IF I% > -1 AND I% < 256 THEN PALETTE I%, 65536 * INT((I% \ 8)) + 256 * INT((I% \ 4)) + INT((I% \ 4))
8 NEXT I%
9 C& = C& + 1
10 IF C& MOD 3 = 0 THEN w1%(1 + INT(RND * 125), 1 + INT(RND * 125)) = 254
11 FOR y% = 1 TO 126
12 FOR x% = 1 TO 126
13 C% = w1%(x% - 1, y%) + w1%(x% + 1, y%) + w1%(x%, y% + 1) + w1%(x%, y% - 1) + w1%(x% + 1, y% - 1) + w1%(x% - 1, y% - 1) + w1%(x% - 1, y% + 1) + w1%(x% + 1, y% + 1)
14 w2%(x%, y%) = (ABS((Average%(C%) - w2%(x%, y%))))
15 NEXT x%, y%
16 P& = VARPTR(Vpage%(2))
17 FOR y% = 1 TO 126
18 FOR x% = 1 TO 126
19 POKE P& + x%, (50 + ((x% + Average%(w1%(x%, y% - 1) - w1%(x%, y% + 1))) OR (y% + Average%(w1%(x% - 1, y%) - w1%(x% + 1, y%))))) AND 255
20 SWAP w1%(x%, y%), w2%(x%, y%)
21 NEXT x%
22 P& = P& + 128
23 NEXT y%
24 PUT (89, 45), Vpage%(0), PSET
25 IF INKEY$ = "" THEN 9
1 TYPE j
x AS INTEGER
y AS INTEGER
z AS INTEGER
END TYPE
1 TYPE j
2 x AS INTEGER
3 y AS INTEGER
4 z AS INTEGER
5 END TYPE
'This is my starfield entry hacked down to 25 lines
'It needs a pretty fast computer...looks OK on my 1.5 GHz
'JKC 2003
1 TYPE star
x AS INTEGER
y AS INTEGER
z AS INTEGER
END TYPE
6 DIM astar(0 TO 300) AS star
7 DIM oldstar(0 TO 300) AS star
8 FOR i = 0 TO 300
9 astar(i).x = RND * 640
10 astar(i).y = RND * 480
11 astar(i).z = RND * 300
12 NEXT i
13 SCREEN 11
14 DO
15 FOR i = 0 TO 300
16 IF astar(i).z < 1 THEN astar(i).z = 300 ELSE astar(i).z = astar(i).z - 1
17 FOR p% = 0 TO oldstar(i).z
18 CIRCLE (oldstar(i).x, oldstar(i).y), p%, 0
19 IF astar(i).z <> 300 THEN CIRCLE (INT(2 * astar(i).z + astar(i).x / (1 + astar(i).z / 30)), INT(astar(i).z + astar(i).y / (1 + astar(i).z / 30))), p%
20 NEXT p%
21 oldstar(i).x = INT(2 * astar(i).z + astar(i).x / (1 + astar(i).z / 30))
22 oldstar(i).y = INT(astar(i).z + astar(i).y / (1 + astar(i).z / 30))
23 oldstar(i).z = 5 / (1 + astar(i).z / 20)
24 NEXT i
25 LOOP UNTIL INKEY$ <> ""
DEFINT A-Z
SCREEN 13
DEF fnFormula (a)
IF a < 64 * 3 AND (a MOD 3) <> 0 THEN b = ABS(FIX(63.5 - a \ 3)) * (ABS(FIX(ABS(FIX(63.5 - a \ 3)) - 31.5)) / 31) * ((b / 63) + (1 - b / 63) * (-(a < 32 * 3 OR a >= 96 * 3))) ELSE b = ABS(FIX(63.5 - a \ 3))
IF a >= 64 * 3 AND (a MOD 3) <> 2 THEN b = ABS(FIX(63.5 - a \ 3)) * (ABS(FIX(ABS(FIX(63.5 - a \ 3)) - 31.5)) / 31) * ((b / 63) + (1 - b / 63) * (-(a < 32 * 3 OR a >= 96 * 3)))
fnFormula = b
END DEF
FOR y = 0 TO 191
FOR x = 0 TO 319
PSET (x, y), ((x XOR y) AND 127) + 1
NEXT x
NEXT y
DO
o = (o + 1) AND 127
WAIT &H3DA, 8
OUT 968, 1
FOR a = o * 3 TO 127 * 3 + 2
OUT 969, fnFormula(a)
NEXT a
FOR a = 0 * 3 TO o * 3 - 1
OUT 969, fnFormula(a)
NEXT a
LOOP UNTIL LEN(INKEY$)