Posts: 1,688
Threads: 119
Joined: Jun 2003
here are the rules:
has to be stars coming at you, not left to right
no asm
no libs
try to make it look half decent 
Jumping Jahoolipers!
Posts: 1,752
Threads: 21
Joined: Jun 2002
Code: ' Some stars...moving...towards you...yeah. One of those things.
'
' By Plasma. Parts of this are from some other dude's C++ program, I forget
' the name/url.
DEFINT A-Z
'$DYNAMIC
' Monkey with this if it's too slow/fast
' Yeah I could just wait for vsync but this is more fun :)
CONST NumStars = 800
' Change to 0 if you get dizzy
CONST Rotate = 1
RANDOMIZE TIMER
DIM SHARED Cosine(360) AS SINGLE
DIM SHARED Sine(360) AS SINGLE
FOR i = 0 TO 359
Cosine(i) = COS(i * 3.14159265# / 180)
Sine(i) = SIN(i * 3.14159265# / 180)
NEXT
DIM StarX(1 TO NumStars) AS SINGLE
DIM StarY(1 TO NumStars) AS SINGLE
DIM StarZ(1 TO NumStars) AS SINGLE
DIM StarRealX(1 TO NumStars)
DIM StarRealY(1 TO NumStars)
DIM StarZV(1 TO NumStars) AS SINGLE
DIM StarOldX(1 TO NumStars)
DIM StarOldY(1 TO NumStars)
DIM AngleZ AS SINGLE
CenterX = 160
CenterY = 100
FOR i = 1 TO NumStars
StarX(i) = ((500 - -500) * RND - 500)
StarY(i) = ((500 - -500) * RND - 500)
StarZ(i) = ((1000 - 100) * RND + 100)
StarZV(i) = ((5 - .5) * RND + .5)
NEXT
SCREEN 13
OUT &H3C8, 0
FOR i = 0 TO 63
FOR attr = 0 TO 2
OUT &H3C9, i
NEXT
NEXT
DO WHILE INKEY$ = ""
AngleZ = AngleZ - 1
IF AngleZ <= 0 THEN AngleZ = 359
FOR i = 1 TO NumStars
LINE (StarRealX(i), StarRealY(i))-(StarOldX(i), StarOldY(i)), 0
StarZ(i) = StarZ(i) - StarZV(i)
TempX = StarX(i)
tempY = StarY(i)
tempZ = StarZ(i)
IF Rotate THEN
TempX = INT(StarX(i) * Cosine(AngleZ) - StarY(i) * Sine(AngleZ))
tempY = INT(StarX(i) * Sine(AngleZ) + StarY(i) * Cosine(AngleZ))
END IF
x = TempX / StarZ(i) * 100 + CenterX
y = tempY / StarZ(i) * 100 + CenterY
IF x < 0 OR x > 319 OR y < 0 OR y > 199 OR StarZ(i) < 1 THEN
StarX(i) = ((500 - -500) * RND - 500)
StarY(i) = ((500 - -500) * RND - 500)
StarZ(i) = ((1000 - 100) * RND + 100)
StarZV(i) = ((5 - .5) * RND + .5)
END IF
xd& = x - StarRealX(i)
yd& = y - StarRealY(i)
Length = SQR(xd& * xd& + yd& * yd&) / 6
Bright = (5000 * StarZV(i)) / StarZ(i) / 4
IF Length > 1 THEN Bright = (Bright / Length)
IF Bright > 63 THEN Bright = 63
LINE (x, y)-(StarRealX(i), StarRealY(i)), Bright
StarOldX(i) = StarRealX(i)
StarOldY(i) = StarRealY(i)
StarRealX(i) = x
StarRealY(i) = y
NEXT
LOOP
Posts: 2,765
Threads: 138
Joined: Nov 2002
cool ![[Image: KkatCool.txt]](http://www.geocities.com/edymnionii/KkatCool.txt)
![[Image: sig.php]](http://josh.whtiger.net/images/sig.php)
Back by popular demand!
I will byte and nibble you bit by bit until nothing remains but crumbs.
Posts: 1,688
Threads: 119
Joined: Jun 2003
nice  it's more like a vortex though. oh well.
Jumping Jahoolipers!
Posts: 1,752
Threads: 21
Joined: Jun 2002
nah, the pilot is just drunk and the ship is spinning out of control.
You can turn off the spin anyways...you'll still get the nice motion "blur".
Posts: 3,288
Threads: 167
Joined: Nov 2001
Vortex? as In like this?
Code: '3d vortex......2003
'Http://Relsoft.Ath.cx
'Here's my take on the starfield stuff...
1 IF I% = 0 THEN SCREEN 13 ELSE DIM Dist!(200), Rot!(200)
2 I% = (I% + 1) MOD 200
3 IF J% < 257 THEN J% = (J% + 1)
4 PSET (Dist!(I%) * COS(Rot!(I%) / 56.32716) + 160, Dist!(I%) * SIN(Rot!(I%) / 56.32716) + 100), 0
5 Rot!(I%) = (Rot!(I%) + .5 * (Dist!(I%) / 50)) * -(Rot!(I%) <= 360)
6 IF Dist!(I%) < 0 OR Dist!(I%) > 170 THEN Rot!(I%) = RND * 360
7 IF Dist!(I%) < 0 OR Dist!(I%) > 170 THEN Dist!(I%) = RND * 170 ELSE Dist!(I%) = Dist!(I%) - (2 - (Dist!(I%) / 150))
8 IF J% > 255 THEN PSET (Dist!(I%) * COS(Rot!(I%) / 56.32716) + 160, Dist!(I%) * SIN(Rot!(I%) / 56.32716) + 100), Dist!(I%) + 50 ELSE PALETTE J%, 65536 * (J% \ 4) + 256 * (J% \ 4) + (63 - (J% \ 4))
9 IF INKEY$ = "" THEN 2
Posts: 3,343
Threads: 83
Joined: Mar 2003
I thought I'd find this before you guys got all excited... this is not mine, it's the work of Antoni Gual in a previous thread.
Code: 'starfield
1 SCREEN 13
2 a$ = STRING$(400 * 6, CHR$(0))
3 IF CVI(MID$(a$, j + 5, 2)) = 0 THEN MID$(a$, j + 1, 6) = MKI$(RND * 20000 - 10000) + MKI$(RND * 20000 - 10000) + MKI$(100 * RND + 1)
4 PSET (160 + CVI(MID$(a$, j + 1, 2)) / CVI(MID$(a$, j + 5, 2)), 100 + CVI(MID$(a$, j + 3, 2)) / CVI(MID$(a$, j + 5, 2))), 0
5 MID$(a$, j + 5, 2) = MKI$(CVI(MID$(a$, j + 5, 2)) - 1)
6 IF CVI(MID$(a$, j + 5, 2)) > 0 THEN PSET (160 + CVI(MID$(a$, j + 1, 2)) / CVI(MID$(a$, j + 5, 2)), 100 + CVI(MID$(a$, j + 3, 2)) / CVI(MID$(a$, j + 5, 2))), 32 - CVI(MID$(a$, j + 5, 2)) \ 8
7 j = (j + 6) MOD (LEN(a$))
8 IF LEN(INKEY$) = 0 THEN 3
Posts: 1,688
Threads: 119
Joined: Jun 2003
you mean the 9 line long program thingy? i downloaded the package.
hmm.. rel, that seems more like a black hole.
Jumping Jahoolipers!
Posts: 3,343
Threads: 83
Joined: Mar 2003
Yeah... did you get the package from QBNZ, or somewhere else?
I thought I'd show everyone so someone can try to beat it, it's one of the best starfields ever!
Posts: 1,688
Threads: 119
Joined: Jun 2003
yep. qb new zealand (hope i spelt it right!)
well, here's several good ones that i found a long time ago.
note: i did not make these!
Code: '============================================================================
'|Fast & small starfield simulator by Aleksandar Stancic (stancic@doboj.net)|
'============================================================================
DECLARE SUB dl (x1!, y1!, z1!, x2!, y2!, z2!, c!)
DECLARE SUB drwvertex (x!, y!, z!, c!)
DECLARE SUB genex ()
DECLARE SUB handler ()
DIM SHARED x(400) AS INTEGER
DIM SHARED y(400) AS INTEGER
DIM SHARED z(400) AS INTEGER
DIM SHARED c(400) AS INTEGER
DEFINT A-Z
SCREEN 9
FOR i = 1 TO 400
z(i) = -500
NEXT
DO WHILE LEN(INKEY$) = 0
genex
handler
LOOP
'Peace.
DEFSNG A-Z
SUB dl (x1, y1, z1, x2, y2, z2, c)
IF z1 + 500 <= 0 THEN EXIT SUB
sx1 = INT(256 * (x1 / (z1 + 500)) + 320)
sy1 = INT(256 * (y1 / (z1 + 500)) + 200)
IF z2 + 500 <= 0 THEN EXIT SUB
sx2 = INT(256 * (x2 / (z2 + 500)) + 320)
sy2 = INT(256 * (y2 / (z2 + 500)) + 200)
IF sx1 > -50 AND sx1 < 700 AND sy1 > -50 AND sy1 < 500 THEN LINE (INT(sx1), INT(sy1))-(INT(sx2), INT(sy2)), c
END SUB
SUB genex
FOR i = 1 TO 400
IF z(i) > -500 THEN GOTO sk
con = con + 1
IF con > 5 THEN EXIT SUB
x(i) = INT(RND * 640 - 320)
y(i) = INT(RND * 400 - 200)
z(i) = 0
a = RND
IF a < .3 THEN c(i) = 15: GOTO sk
IF a < .6 THEN c(i) = 7: GOTO sk'INT(RND * 15 + 1)
c(i) = 8
sk:
NEXT
END SUB
SUB handler
FOR i = 1 TO 400
IF z(i) < -499 THEN GOTO skp
dl INT(x(i)), INT(y(i)), INT(z(i)), INT(x(i)), INT(y(i)), INT(z(i)) + 10, 0
z(i) = z(i) - 10
dl INT(x(i)), INT(y(i)), INT(z(i)), INT(x(i)), INT(y(i)), INT(z(i) + 10), INT(c(i))
skp:
NEXT
END SUB
Code: ' * * * * * * * * * * * * * *
' * *
' * 3D - Stars *
' * *
' * Written By Gerrit Heinz *
' * *
' * in October 1999 *
' * *
' * * * * * * * * * * * * * *
DECLARE SUB LoadBMP (pfad$, datei$)
SCREEN 13
WINDOW (0, 0)-(319, 199)
KEY(5) ON: KEY(1) ON
ON KEY(5) GOSUB Ende
ON KEY(1) GOSUB new
DIM map(64, 64)
DIM col(64, 64)
DIM x(2000), y(2000), z(2000), spd(2000)
DIM sx(2000), sy(2000), asx(2000), asy(2000)
vx = 0: vy = 0: vz = 0 'viewers pos.
srx = 320: sry = 200 'screen res.
zfac = 6
xfac = 1
yfac = 1
menge = 200 ' number of stars
pfad$ = ""
datei$ = "64map.bmp"
speed = 5 'speed : 2=slow 10=very fast
CALL LoadBMP(pfad$, datei$)
new:
LINE (0, 0)-(320, 200), 0, BF
FOR i = 1 TO menge
x(i) = INT(RND * 10000) - 5000
y(i) = INT(RND * 10000) - 5000
z(i) = INT(RND * 500)
spd(i) = INT(RND * speed) + 1
NEXT
LINE (0, 0)-(320, 200), 0, BF
DO
FOR i = 1 TO menge
IF ((z(i) / zfac) - vz) <> 0 THEN
asx(i) = sx(i): asy(i) = sy(i)
sx(i) = (((x(i) * xfac) - vx) / ((z(i) / zfac) - vz)) + (srx / 2)
sy(i) = (((y(i) / yfac) - vy) / ((z(i) / zfac) - vz)) + (sry / 2)
END IF
NEXT
FOR i = 2 TO menge
PSET (asx(i), asy(i)), 0
z(i) = z(i) - spd(i)
IF z(i) < vz THEN z(i) = 500
c = ((z(i) / 2) * -1) + 250
PSET (sx(i), sy(i)), c
NEXT
LOOP UNTIL INKEY$ <> ""
Ende: STOP: RETURN
SUB LoadBMP (pfad$, datei$)
CLS
OPEN pfad$ + datei$ FOR BINARY AS #1
header$ = SPACE$(14)
sizing$ = SPACE$(4)
GET #1, 1, header$
GET #1, 15, sizing$
bmpinfosize = CVI(sizing$)
IF bmpinfosize = 12 THEN
infoheader$ = SPACE$(12)
GET #1, 15, infoheader$
nbits = CVI(MID$(infoheader$, 15, 4))
IF nbits = 8 THEN
palet$ = SPACE$(768)
GET #1, bmpinfosize + 15, palet$
END IF
ELSEIF bmpinfosize = 40 THEN
infoheader$ = SPACE$(40)
GET #1, 15, infoheader$
nbits = CVI(MID$(infoheader$, 15, 4))
IF nbits = 8 THEN
palet$ = SPACE$(1024)
GET #1, bmpinfosize + 15, palet$
END IF
END IF
ft$ = MID$(header$, 1, 2)
filesize = CVL(MID$(header$, 3, 4))
r1 = CVI(MID$(header$, 7, 2))
r2 = CVI(MID$(header$, 9, 2))
offset = CVL(MID$(header$, 11, 4))
headersize = CVL(MID$(infoheader$, 1, 4))
picwidth = CVL(MID$(infoheader$, 5, 4))
picheight = CVL(MID$(infoheader$, 9, 4))
nplanes = CVI(MID$(infoheader$, 13, 4))
IF headersize = 40 THEN
comptype = CVL(MID$(infoheader$, 17, 4))
imagesize = CVL(MID$(infoheader$, 21, 4))
xsize = CVL(MID$(infoheader$, 25, 4))
ysize = CVL(MID$(infoheader$, 29, 4))
colorsused = CVL(MID$(infoheader$, 33, 4))
neededcolours = CVL(MID$(infoheader$, 37, 4))
END IF
IF nbits = 8 OR nbits = 24 THEN
SCREEN 13
END IF
IF bmpinfosize = 40 THEN ngroups = 4
IF bmpinfosize = 12 THEN ngroups = 3
FOR x = 1 TO LEN(palet$) STEP ngroups
zb# = INT((ASC(MID$(palet$, x, 1))) / 4)
zg# = INT((ASC(MID$(palet$, x + 1, 1))) / 4)
zr# = INT((ASC(MID$(palet$, x + 2, 1))) / 4)
zc# = zb# * 65536# + zg# * 256# + zr#
cres = ASC(MID$(palet$, x + 3, 1))
PALETTE ((x - 1) / ngroups), zc#
NEXT x
IF nbits = 8 THEN
y = picheight - 1
x = 0
dat$ = " "
WHILE y >= 0
WHILE x < picwidth
GET 1, , dat$
PSET (x, y), ASC(dat$)
x = x + 1
WEND
y = y - 1
x = 0
WEND
END IF
CLOSE
END SUB
Code: DECLARE SUB clrb ()
DECLARE SUB ffix
DEFINT A-Z
'eliminamos z, falla algo. Dimensiono de entrada buffer. estrellas segun radios
'pasamos a single,la sestrellas tienen velocidades aleatorias
'aparecen por toda la pantalla,velocidad funcion de punto aparicion
' color cero, aumentan de color al acercarse.Efecto correcto,salta,no persp.
'v1 antialiasing (wupixels)+velocidad radial variable.Persp correcta, parpadea 68fps
'usamos cint en antialiasing, ok!
'v2 cambiamos antialiasing por motion blur. Mejor velocidad, se doblan
'reducimos ddx y ddy para evitar doblado .ponemos dz en funcion de dx y dy
TYPE stype
x AS SINGLE
y AS SINGLE
z AS SINGLE
lx AS SINGLE
ly AS SINGLE
dx AS SINGLE
dy AS SINGLE
dz AS SINGLE
br AS SINGLE
END TYPE
RANDOMIZE TIMER
SCREEN 13
'b&w palette
OUT &H3C8, 0: FOR i = 0 TO 255: FOR j = 1 TO 3: OUT &H3C9, i \ 4: NEXT: NEXT
CONST nstars = 399
DIM s(nstars) AS stype
FOR i = 0 TO nstars: GOSUB newstar: NEXT
CONST maxx = 159, maxy = 99, maxz = -200, maxc = 255
REDIM SHARED b(-8 TO 31999) AS INTEGER
bseg = VARSEG(b(0)) + 1
DIM ylut(199) AS INTEGER
FOR i = 0 TO 199: ylut(i) = bseg + 20 * i: NEXT
t! = TIMER
DO
f = f + 1
clrb
FOR i = 0 TO nstars
'calc new pos and brihgtness
s(i).z = s(i).z + s(i).dz
IF s(i).z > maxc THEN s(i).z = maxc
s(i).lx = s(i).x
s(i).x = s(i).x + s(i).dx
IF ABS(s(i).x) >= maxx THEN GOSUB newstar ELSE s(i).dx = s(i).dx * 1.02
s(i).ly = s(i).y
s(i).y = s(i).y + s(i).dy
IF ABS(s(i).y) >= maxy THEN GOSUB newstar ELSE s(i).dy = s(i).dy * 1.02
s(i).dz = ABS(s(i).dx) + ABS(s(i).dy)
'render
c = s(i).z
lxx = CINT(s(i).lx) + maxx
lyy = CINT(s(i).ly) + maxy
DEF SEG = ylut(lyy)
POKE lxx, c
xx = CINT(s(i).x) + maxx
yy = CINT(s(i).y) + maxy
DEF SEG = ylut(yy)
POKE xx, c
NEXT
'WAIT &H3DA, 8
PUT (0, 0), b(-2), PSET
LOOP UNTIL LEN(INKEY$)
COLOR 255: PRINT f / (TIMER - t!)
a$ = INPUT$(1)
END
newstar:
s(i).x = RND * 2 * maxx - maxx
s(i).y = RND * 2 * maxy - maxy
s(i).z = RND * 112
s(i).dx = s(i).x / 100
s(i).dy = s(i).y / 100
s(i).dz = ABS(s(i).dx) + ABS(s(i).dy)
s(i).br = 0
RETURN
SUB clrb
CONST ww = 320 * 8
REDIM b(-8 TO 31999) AS INTEGER
b(-2) = ww
b(-1) = 200
END SUB
Code: DECLARE FUNCTION deg2rad# (deg#)
DECLARE SUB aline2 (x1#, y1#, x2#, y2#, col%)
DECLARE SUB aline (x#, y#, x2#, y2#, col%)
DECLARE FUNCTION fract# (i#)
DECLARE FUNCTION invfract# (i#)
DECLARE SUB apset (x#, y#, col%)
DECLARE SUB pal (colour%, r%, g%, b%)
DECLARE SUB grad1 (col1%, r1%, g1%, b1%, col2%, r2%, g2%, b2%)
DEFINT A-Z
TYPE starType
x AS DOUBLE
y AS DOUBLE
z AS DOUBLE
x2 AS DOUBLE
y2 AS DOUBLE
oldx2 AS DOUBLE
oldy2 AS DOUBLE
vel AS DOUBLE
END TYPE
CONST maxVel = 14.5, minVel = 2.5
DO
CLS : LOCATE 1, 1
COLOR 7
PRINT "hydroXide's starfield"
PRINT "ÃÃÃÃÃÃÃÃÃÃÃÃÃÃÃÃÃÃÃÃÃ"
INPUT "Amount of stars: ", amountOfStars
LOOP UNTIL amountOfStars > 0 AND amountOfStars < 10000
PRINT
PRINT "Keys:"
PRINT "a : anti-aliasing on/off."
PRINT "l : lines/pixels."
PRINT "p : randomize palette."
PRINT "r : restore palette."
PRINT "+/- : Maximum viewing distance (or star birth distance)."
PRINT "d : show variables (debug mode)."
PRINT "ESC : Guess. =)"
DO: LOOP WHILE INKEY$ = ""
maxDistance = 900
DIM star(1 TO amountOfStars) AS starType
RANDOMIZE TIMER
FOR i = 1 TO UBOUND(star)
star(i).x = RND * 1000 - 500
star(i).y = RND * 1000 - 500
star(i).z = RND * maxDistance + 100
star(i).vel = RND * maxVel + minVel
star(i).x2 = star(i).x / star(i).z * 100 + 160
star(i).y2 = star(i).y / star(i).z * 100 + 100
star(i).oldx2 = star(i).x2
star(i).oldy2 = star(i).y2
NEXT i
SCREEN 13
COLOR 255
grad1 0, 0, 0, 0, 255, 63, 63, 63
centerX = 160
centerY = 100
DEF SEG = &HA000
anti = 1
mode = 1
stats = 0
DO
FOR i = 1 TO UBOUND(star)
x# = star(i).oldx2
y# = star(i).oldy2
x2# = star(i).x2
y2# = star(i).y2
IF mode = 1 THEN
IF anti = 1 THEN
aline2 x#, y#, x2#, y2#, 0
ELSE
LINE (x#, y#)-(x2#, y2#), 0
END IF
ELSE
IF anti = 1 THEN
apset x#, y#, 0
ELSE
PSET (x#, y#), 0
END IF
END IF
star(i).z = star(i).z - star(i).vel
star(i).oldx2 = star(i).x2
star(i).oldy2 = star(i).y2
star(i).x2 = star(i).x / star(i).z * 100 + centerX
star(i).y2 = star(i).y / star(i).z * 100 + centerY
'LOCATE 1, 1: PRINT star(i).x2; star(i).y2
IF (star(i).z < 1) OR (star(i).x2 < 0) OR (star(i).x2 > 319) OR (star(i).y2 < 0) OR (star(i).y2 > 199) THEN
star(i).x = RND * 1000 - 500
star(i).y = RND * 1000 - 500
star(i).z = RND * maxDistance + 100
star(i).vel = RND * maxVel + minVel
star(i).x2 = star(i).x / star(i).z * 100 + 160
star(i).y2 = star(i).y / star(i).z * 100 + 100
star(i).oldx2 = star(i).x2
star(i).oldy2 = star(i).y2
END IF
x# = star(i).oldx2
y# = star(i).oldy2
x2# = star(i).x2
y2# = star(i).y2
b = 64 / star(i).z * maxDistance
IF b > 255 THEN b = 255
IF mode = 1 THEN
IF anti = 1 THEN
aline2 x#, y#, x2#, y2#, b
ELSE
LINE (x#, y#)-(x2#, y2#), b
END IF
ELSE
IF anti = 1 THEN
apset x#, y#, b
ELSE
PSET (x#, y#), b
END IF
END IF
'b = ((255 / 5) * star(i).vel) * (1000 / star(i).z)
'apset star(i).x2, star(i).y2, b
NEXT i
ar$ = LCASE$(INKEY$)
SELECT CASE ar$
CASE "p": grad1 0, 0, 0, 0, 255, CINT(RND * 63), CINT(RND * 63), CINT(RND * 63)
CASE "a": anti = 1 - anti: CLS
CASE "l": mode = 1 - mode: CLS
CASE "+": maxDistance = maxDistance + 10
CASE "-": maxDistance = maxDistance - 10
CASE "r": grad1 0, 0, 0, 0, 255, 63, 63, 63
CASE "d": stats = 1 - stats: CLS
CASE CHR$(27): logOutMode = 1
END SELECT
IF maxDistance > 5000 THEN maxDistance = 1
IF maxDistance < 1 THEN maxDistance = 5000
IF logOutMode = 1 THEN maxDistance = maxDistance - 10
IF logOutMode = 1 AND maxDistance <= 0 THEN logOut = 1
IF stats = 1 THEN
LOCATE 1, 1: PRINT LTRIM$(RTRIM$(STR$(amountOfStars))); " stars with "; LTRIM$(RTRIM$(STR$(maxDistance))); " viewining distance."
PRINT "Using ";
IF anti = 1 THEN PRINT "anti-aliased ";
IF mode = 1 THEN
PRINT "lines."
ELSE
PRINT "pixels."
END IF
END IF
LOOP WHILE logOut = 0
DEF SEG
SCREEN 0
WIDTH 80, 25
PALETTE
CLS
PRINT "hydroXide's starfield, 1999."
PRINT "Version.. 0.1 beta I think. =) Visit my site at"
PRINT "http://fly.to/hydroXide."
SLEEP
SUB aline (x#, y#, x2#, y2#, col)
xd# = x2# - x#
yd# = y2# - y#
IF ABS(xd#) > ABS(yd#) THEN ' Horizontal lines.
IF x# > x2# THEN
SWAP x#, x2#
SWAP y#, y2#
xd# = -xd#
yd# = -yd#
END IF
grad# = yd# / xd#
' End point 1.
xend# = FIX(x# + .5)
yend# = y#
xgap# = invfract(x# - .5)
ix = INT(xend#)
iy = INT(yend#)
brightness1# = invfract(yend#) * xgap#
brightness2# = fract(yend#) * xgap#
c1 = CINT(brightness1# * col)
c2 = CINT(brightness2# * col)
PSET (ix, iy), c1
PSET (ix, iy + 1), c2
yf# = yend + grad
' End point 2.
xend# = FIX(x2# + .5)
yend# = y2#
xgap# = invfract(x2# - .5)
ix2 = INT(xend#)
iy2 = INT(yend#)
brightness1# = invfract(yend#) * xgap#
brightness2# = fract(yend#) * xgap#
c1 = CINT(brightness1# * col)
c2 = CINT(brightness2# * col)
PSET (ix2, iy2), c1
PSET (ix2, iy2 + 1), c2
' Main loop.
FOR x = (ix + 1) TO (ix2 - 1)
brightness1# = invfract(yf#)
brightness2# = fract(yf#)
c1 = CINT(brightness1# * col)
c2 = CINT(brightness2# * col)
PSET (x, INT(yf#)), c1
PSET (x, INT(yf#) + 1), c2
yf# = yf# + grad#
NEXT x
ELSE
IF ABS(yd#) = 0 THEN
LINE (x#, y#)-(x2#, y2#), col
EXIT SUB
END IF
IF y# > y2# THEN
SWAP x#, x2#
SWAP y#, y2#
xd# = -xd#
yd# = -yd#
END IF
grad# = xd# / yd#
' End point 1.
yend# = FIX(y# + .5)
xend# = x# '+ grad * (xend - x#)
ygap# = invfract(y# - .5)
ix = INT(xend#)
iy = INT(yend#)
brightness1# = invfract(xend#) * ygap#
brightness2# = fract(xend#) * ygap#
c1 = CINT(brightness1# * col)
c2 = CINT(brightness2# * col)
PSET (ix, iy), c1
PSET (ix, iy + 1), c2
xf# = xend# + grad#
' End point 2.
yend# = FIX(y2# + .5)
xend# = x2# '+ grad * (xend - x2#)
ygap# = invfract(y2# - .5)
ix2 = INT(xend#)
iy2 = INT(yend#)
brightness1# = invfract(xend#) * ygap#
brightness2# = fract(xend#) * ygap#
c1 = CINT(brightness1# * col)
c2 = CINT(brightness2# * col)
PSET (ix2, iy2), c1
PSET (ix2, iy2 + 1), c2
xf# = xend# + grad#
' Main loop.
FOR y = (iy + 1) TO (iy2 - 1)
brightness1# = invfract(xf#)
brightness2# = fract(xf#)
c1 = CINT(brightness1# * col)
c2 = CINT(brightness2# * col)
PSET (INT(xf#), y), c1
PSET (INT(xf# + 1), y), c2
xf# = xf# + grad#
NEXT y
END IF
END SUB
SUB aline2 (x1#, y1#, x2#, y2#, col)
dx# = x2# - x1#
dy# = y2# - y1#
IF ABS(dx#) > ABS(dy#) THEN
IF SGN(dx#) = -1 THEN
SWAP x1#, x2#
SWAP y1#, y2#
dx# = -dx#
dy# = -dy#
END IF
y# = y1#
yg# = dy# / dx#
FOR x = x1# TO x2#
c1 = col * (INT(y#) + 1 - y#)
c2 = col * (y# - INT(y#))
IF c1 > col - 1 THEN c1 = col - 1
IF c2 > col - 1 THEN c2 = col - 1
IF c1 < 0 THEN c1 = 0
IF c2 < 0 THEN c2 = 0
'PSET (x, INT(y#)), c1
'PSET (x, INT(y#) + 1), c2
tempY = INT(y#) + 1: IF tempY > 199 THEN tempY = 199
POKE (INT(y#) * 320&) + x, c1
POKE (tempY * 320&) + x, c2
y# = y# + yg#
NEXT
ELSE
IF dy# = 0 THEN
c = col - 1
IF c < 0 THEN c = 0
LINE (x1#, y1#)-(x2#, y2#), c
EXIT SUB
END IF
IF SGN(dy#) = -1 THEN
SWAP x1#, x2#
SWAP y1#, y2#
dx# = -dx#
dy# = -dy#
END IF
x# = x1#
xg# = dx# / dy#
FOR y = y1# TO y2#
c1 = col * (INT(x#) + 1 - x#) '+ POINT(INT(x#), y)
c2 = col * (x# - INT(x#)) '+ POINT(INT(x#) + 1, y)
IF c1 > (col - 1) THEN c1 = (col - 1)
IF c2 > (col - 1) THEN c2 = (col - 1)
IF c1 < 0 THEN c1 = 0
IF c2 < 0 THEN c2 = 0
'PSET (INT(x#), y), c1
'PSET (INT(x#) + 1, y), c2
tempX = INT(x#) + 1: IF tempX > 319 THEN tempX = 319
POKE (y * 320&) + x#, c1
POKE (y * 320&) + tempX, c2
x# = x# + xg#
NEXT
END IF
END SUB
SUB apset (x#, y#, col)
' Let's find out the four pixels the particle
' covers: the first two we get by stripping the
' decimal partion from the n! value, and the rest
' two by adding 1 to the n% value.
x1 = FIX(x#)
y1 = FIX(y#)
x2 = x1 + 1
y2 = y1 + 1
' Here we find out how bright each of the four
' pixels should be. If n! is how much of the particle
' is placed in that pixel, and col% the brighntess
' of the particle, the formula is:
' brightness% = n! * col%
' How do we get the n!, then? Well, if xm! and
' ym! are the decimal portions of the coordinates,:
' (1 - xm!) * (1 - ym!) * col%
' does the job for the first pixel.
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
FUNCTION deg2rad# (deg#)
deg2rad = deg# * 3.141593 / 180
END FUNCTION
FUNCTION fract# (i#)
fract# = ABS(i# - INT(i#))
END FUNCTION
'Makes a palette gradient
SUB grad1 (col1%, r1%, g1%, b1%, col2%, r2%, g2%, b2%)
cols% = col2% - col1% + 1
rstep# = (r2% - r1% + 1) / cols%
gstep# = (g2% - g1% + 1) / cols%
bstep# = (b2% - b1% + 1) / cols%
r# = r1%
g# = g1%
b# = b1%
FOR col% = col1% TO col2%
r# = r# + rstep#
g# = g# + gstep#
b# = b# + bstep#
IF r# > 63 THEN r# = 63
IF r# < 0 THEN r# = 0
IF g# > 63 THEN g# = 63
IF g# < 0 THEN g# = 0
IF b# > 63 THEN b# = 63
IF b# < 0 THEN b# = 0
pal col%, CINT(r#), CINT(g#), CINT(b#)
NEXT
END SUB
FUNCTION invfract# (i#)
invfract# = 1 - ABS(i# - INT(i#))
END FUNCTION
'change palette
SUB pal (colour%, r%, g%, b%)
OUT &H3C8, colour%
OUT &H3C9, r%
OUT &H3C9, g%
OUT &H3C9, b%
END SUB
Jumping Jahoolipers!
|
![[Image: anya2.jpg]](http://rel.betterwebber.com/Mypics/anya2.jpg)