Here's the source for my entry to the
reduced resolution comp. The comments saying 'white' should be changed to 'orange', I changed palettes right at the last minute
Press Space for a new random palette (why did I forget that was there for the comp!?)
#include "tinyptc_ext.bi"
#include "windows.bi"
const SXD = 640
const SYD = 480
const XD = 160
const YD = 120
const N = 128
ptc_setdialog(1,"You need to run this fullscreen",0,0)
ptc_open( "Plasma", SXD,SYD)
'ptc_setflip(0)
dim shared as uinteger buffer(SXD*SYD)
dim shared as ubyte cbuffer(XD*YD)
declare function perlin(byval x as single, byval y as single) as single
declare function colour(byval c as single) as uinteger
declare function matchrgb(byval r as single, byval g as single, byval b as single) as ubyte
declare function matchrgb_col(byval r as single, byval g as single, byval b as single) as uinteger
declare function matchhsv(byval r as single, byval g as single, byval b as single) as ubyte
declare function matchhsv_col(byval r as single, byval g as single, byval b as single) as uinteger
declare sub rgb2hsv(byval r as single, byval g as single, byval b as single, byref h as single, byval s as single, byval v as single)
declare sub rgbmix(byval c0 as uinteger, byval c1 as uinteger, byref r as single, byref g as single, byref b as single)
declare function makergb(byval r as uinteger, byval g as uinteger, byval b as uinteger) as uinteger
declare sub init_colours()
declare sub init_noise()
declare sub init_sincos()
declare sub dofx()
dim shared as single noise(N,N)
init_noise()
Randomize
dim shared as single rater, rateg, rateb
rater=0.1
rateg=0.3
rateb=0.4
dim shared as single rx,ry,gx,gy,bx,by
rx=0
ry=0
gx=10
gy=10
bx=20
by=20
const MOVESCALE=0.1
dim shared as single rxi,ryi,gxi,gyi,bxi,byi
rxi=2*MOVESCALE
ryi=2*MOVESCALE
gxi=-3*MOVESCALE
gyi=3*MOVESCALE
bxi=-5*MOVESCALE
byi=-5*MOVESCALE
const SINSIZE=1024
dim shared as single zin(SINSIZE)
dim shared as single coz(SINSIZE)
init_sincos()
dim shared framecols(16,2) as uinteger
dim shared realcols(10,3) as single
dim shared realcolshsv(10,3) as single
Const Red=0
Const Green=1
Const Blue=2
Const White=3
dim shared as uinteger col0, col1, col2, col3
col0=&Hffff0000
col1=&Hff00ff00
col2=&Hff0000ff
col3=&Hffff7f00
init_colours()
dofx()
end
sub dofx()
dim as uinteger a,x,y
while GetAsyncKeyState(VK_ESCAPE) = 0
if GetAsyncKeyState(VK_SPACE) <> 0 then
col0=&hff000000+rnd*&hffffff
col1=&hff000000+rnd*&hffffff
col2=&hff000000+rnd*&hffffff
col3=&hff000000+rnd*&hffffff
init_colours()
End If
dim as single rp,gp,bp
dim as uinteger r,g,b
for y = 0 to YD-1
for x=0 to XD-1
rp=(zin(((perlin(rx+x,ry+y)*rater)) mod SINSIZE)+1.0)*0.5
gp=(zin(((perlin(gx+x,gy+y)*rateg)) mod SINSIZE)+1.0)*0.5
bp=(zin(((perlin(bx+x,by+y)*rateb)) mod SINSIZE)+1.0)*0.5
'r = Int(rp*255) shl 16
'g = Int(gp*255) shl 8
'b = Int(bp*255)
'buffer(x+y*SXD)=&Hff000000+r+g+b
'buffer(x+y*SXD)=matchhsv_col(rp,gp,bp)
'buffer(x+y*SXD)=matchrgb_col(rp,gp,bp)
cbuffer(x+y*XD)=matchhsv(rp,gp,bp)
next
next
'ptc_update(@buffer(0))
dim as uinteger u,v,c,f
for f=0 to 1
for y = 0 to SYD-1 step 4
for x = 0 to SXD-1 step 4
c=framecols(cbuffer((x shr 2)+(y shr 2)*XD),f)
for v=0 to 3
for u=0 to 3
buffer(x+u+(y+v)*SXD)=c
next
next
next
next
ptc_update(@buffer(0))
next
'for f=0 to 1
' for y = 0 to YD-1
' for x = 0 to XD-1
' c=framecols(cbuffer((x )+(y )*XD),f)
' buffer(x+u+(y+v)*SXD)=c
' next
' next
' ptc_update(@buffer(0))
'next
rx += rxi
ry += ryi
gx += gxi
gy += gyi
bx += bxi
by += byi
'rater = Sqr(Sin(a/10.0)+1.0)*3000
'rateg = Sqr(Sin(a/10.0)+1.0)*3000*2
'rateb = Sqr(Sin(a/10.0)+1.0)*3000*3
rater = sqr(Sin(a/32.0)*0.2+0.8)*10000
rateg = sqr(Sin(a/32.0)*0.2+0.8)*10000*2
rateb = sqr(Sin(a/32.0)*0.2+0.8)*10000*3
a = a+1
wend
End Sub
function getnoise(byval x as single, byval y as single) as single
dim as single fx,fy
dim as uinteger xx,yy
xx = Int(x)
yy = Int(y)
fx = x-xx
fy = y-yy
xx = xx mod N
yy = yy mod N
dim as single px0,px1
px0 = noise(xx,yy ) + fx * (noise(xx+1,yy ) - noise(xx,yy ))
px1 = noise(xx,yy+1) + fx * (noise(xx+1,yy+1) - noise(xx,yy+1))
return px0 + fy * (px1-px0)
End Function
function perlin(byval x as single, byval y as single) as single
dim as single p
dim as single xx,yy
dim as single fx,fy
'if x < 0 then x = (x mod 1024) + 1024 end if
'if y < 0 then y = (y mod 1024) + 1024 end if
x=Abs(x)
y=Abs(y)
fx = x / 256.0
fy = y / 256.0
p = getnoise(fx,fy)*0.5
fx=fx*2
fy=fy*2
p+= getnoise(fx,fy)*0.3
'fx=fx*2
'fy=fy*2
'p+= getnoise(fx,fy)*0.15
'fx=fx*2
'fy=fy*2
'p+= getnoise(xx,yy)*0.05
return p
End function
function matchrgb(byval r as single, byval g as single, byval b as single) as ubyte
dim as single md=20000000000.0, dr,dg,db,d
dim as uinteger i, idx
for i = 0 to 9
dr = realcols(i,0)-r
dg = realcols(i,1)-g
db = realcols(i,2)-b
d = dr*dr+db*db+dg*dg
if d<md then
md=d
idx = i
End If
Next
return idx
End Function
function matchrgb_col(byval r as single, byval g as single, byval b as single) as uinteger
dim as single md=20000000000.0, dr,dg,db,d
dim as uinteger i, idx
for i = 0 to 9
dr = realcols(i,0)-r
dg = realcols(i,1)-g
db = realcols(i,2)-b
d = dr*dr+db*db+dg*dg
if d<md then
md=d
idx = i
End If
Next
dim as uinteger rr,gg,bb
rr=Int(realcols(idx,0)*255) shl 16
gg=Int(realcols(idx,1)*255) shl 8
bb=Int(realcols(idx,2)*255)
return &hff000000+rr+gg+bb
End Function
function matchhsv(byval r as single, byval g as single, byval b as single) as ubyte
dim as single md=200000000000.0, dr,dg,db,d
dim as uinteger i, idx
dim as single h,s,v
for i = 0 to 9
rgb2hsv(r,g,b, h,s,v)
dr = realcolshsv(i,0)-h
dg = realcolshsv(i,1)-s
db = realcolshsv(i,2)-v
d = dr*dr+db*db+dg*dg
if d<md then
md=d
idx = i
End If
Next
return idx
End Function
function matchhsv_col(byval r as single, byval g as single, byval b as single) as uinteger
dim as single md=200000000000.0, dr,dg,db,d
dim as uinteger i, idx
dim as single h,s,v
for i = 0 to 9
rgb2hsv(r,g,b, h,s,v)
dr = realcolshsv(i,0)-h
dg = realcolshsv(i,1)-s
db = realcolshsv(i,2)-v
d = dr*dr+db*db+dg*dg
if d<md then
md=d
idx = i
End If
Next
dim as uinteger rr,gg,bb
rr=Int(realcols(idx,0)*255) shl 16
gg=Int(realcols(idx,1)*255) shl 8
bb=Int(realcols(idx,2)*255)
return &hff000000+rr+gg+bb
End Function
sub rgb2hsv(byval r as single, byval g as single, byval b as single, byref h as single, byval s as single, byval v as single)
dim as single mn, mx
dim as single d
dim as single ht
if r <= g And r <= b then
mn = r
elseif g <= r And g <= b then
mn = g
else
mn = b
end if
if r >= g And r >= b then
mx = r
elseif g >= r And g >= b then
mx = g
else
mx = b
end if
d = mx - mn
v = mx
if mx = 0.0 Or (mx-mn) = 0.0 then
s = 0.0
h = 0.0
else
s = d/mx
if mx = r then
ht = (g-b)/d
elseif mx = g then
ht = 2.0+(b-r)/d
else
ht = 4.0+(r-g)/d
end if
ht = ht*60.0
if ht < 0.0 then
ht += 360.0
end if
h = ht
end if
end sub
sub rgbmix(byval c0 as uinteger, byval c1 as uinteger, byref r as single, byref g as single, byref b as single)
dim as uinteger r0
dim as uinteger r1
dim as uinteger g0
dim as uinteger g1
dim as uinteger b0
dim as uinteger b1
r0=(c0 shr 16) and 255
g0=(c0 shr 8) and 255
b0=c0 and 255
r1=(c1 shr 16) and 255
g1=(c1 shr 8) and 255
b1=c1 and 255
r = (r0+r1)*(1.0/510.0)
g = (g0+g1)*(1.0/510.0)
b = (b0+b1)*(1.0/510.0)
end sub
function makergb(byval r as uinteger, byval g as uinteger, byval b as uinteger) as uinteger
return &hff000000+(r shl 16)+(g shl 8)+b
end function
sub init_colours()
dim x as uinteger
'red
framecols(Red,0)=col0
framecols(Red,1)=framecols(Red,0)
'green
framecols(Green,0)=col1
framecols(Green,1)=framecols(Green,0)
'blue
framecols(Blue,0)=col2
framecols(Blue,1)=framecols(Blue,0)
'white
framecols(White,0)=col3
framecols(White,1)=framecols(White,0)
'yellow
framecols(4,0)=framecols(Red,0)
framecols(4,1)=framecols(Green,0)
'magenta
framecols(5,0)=framecols(Red,0)
framecols(5,1)=framecols(Blue,0)
'cyan
framecols(6,0)=framecols(Green,0)
framecols(6,1)=framecols(Blue,0)
'pale red
framecols(7,0)=framecols(White,0)
framecols(7,1)=framecols(Red,0)
'pale green
framecols(8,0)=framecols(White,0)
framecols(8,1)=framecols(Green,0)
'pale blue
framecols(9,0)=framecols(White,0)
framecols(9,1)=framecols(Blue,0)
for x=0 to 9
rgbmix(framecols(x,0),framecols(x,1), realcols(x,0),realcols(x,1),realcols(x,2))
next
for x=0 to 9
rgb2hsv(realcols(x,0),realcols(x,1),realcols(x,2), realcolshsv(x,0),realcolshsv(x,1),realcolshsv(x,2))
next
End Sub
sub init_noise()
dim as uinteger x,y
for y=0 to N-1
for x=0 to N-1
noise(x,y)=Rnd
next
noise(N,y)=noise(0,y)
next
for x=0 to N
noise(x,N)=noise(x,0)
next
End Sub
sub init_sincos()
dim as single astep = 3.141592653589/SINSIZE
dim as single angle=0
dim as uinteger x
for x=0 to SINSIZE
zin(x)=Sin(angle)
coz(x)=Cos(angle)
angle += astep
next
End Sub
[code]
Jim
[/code]
