Dark Bit Factory & Gravity
GENERAL => Challenges & Competitions => Topic started by: Jim on July 05, 2007
-
Lame. Sorry.
Graphics 640,480,0,2
Type EDGE
Field x#,z#
Field u#,v#
End Type
Type POINT
Field sx%,sy%
Field u#,v#
End Type
Type TEXTURE
Field width%
Field height%
Field bank%
End Type
Type VIEWP
Field rect_left%
Field rect_right%
Field rect_top%
Field rect_bottom%
End Type
Global current_view.VIEWP = New VIEWP
current_view\rect_left=0
current_view\rect_right=640
current_view\rect_top=0
current_view\rect_bottom=480
Global L.EDGE = New EDGE
Global R.EDGE = New EDGE
c0.POINT = New POINT
c1.POINT = New POINT
c2.POINT = New POINT
c3.POINT = New POINT
Global current_texture.TEXTURE = New TEXTURE
current_texture\width = texw
current_texture\height = texh
nana%=LoadAnimImage("bfuck.png",33,35,0,8)
Const texw%=33
Const texh%=35
Dim banks%(7)
For b%=0 To 7
banks(b)=CreateBank(texw*texh*4)
SetBuffer ImageBuffer(nana,b)
For h%=0 To texh-1
For w%=0 To texw-1
p%=ReadPixel(w,h)
If p%=$fffc02fc Then p%=$ff000000
PokeInt(banks(b),4*(w+h*texw),p)
Next
Next
Next
FreeImage(nana)
a#=0
f#=0
size#=100
Const ox%=320
Const oy%=240
uscale%=1
uscalei=-1
us%=0
fs%=0
c%=0
SetBuffer BackBuffer()
Repeat
c0\u=0
c0\v=0
c1\u=1*uscale
c1\v=0
c2\u=1*uscale
c2\v=1*uscale
c3\u=0
c3\v=1*uscale
c0\sx = ox+Sin(a)*size
c0\sy = oy+Cos(a)*size
c1\sx = ox+Sin(a+90)*size
c1\sy = oy+Cos(a+90)*size
c2\sx = ox+Sin(a+180)*size
c2\sy = oy+Cos(a+180)*size
c3\sx = ox+Sin(a+270)*size
c3\sy = oy+Cos(a+270)*size
current_texture\bank = banks(f)
Cls
LockBuffer BackBuffer()
textriangle(c0,c1,c2)
textriangle(c0,c2,c3)
UnlockBuffer BackBuffer()
Flip
a=a+5
a = a Mod 360
size=100+Abs(200*Sin(c))
c=c+2
If us Mod 10 = 0 Then
uscale=uscale+uscalei
If uscale=33 Or uscale=0 Then
uscalei=-uscalei
uscale=uscale+uscalei
End If
End If
us%=us%+1
If fs Mod 3= 0 Then
f=f+1
f=f Mod 8
EndIf
fs=fs+1
Until KeyDown(1)
For b=0 To 7
FreeBank(banks(b))
Next
End
;--------------------------------------------------------------------------------
; Textured triangle
;--------------------------------------------------------------------------------
Function texscan(y,EL.EDGE,ER.EDGE)
Local xl%,xr%
Local lu#,lv#
Local du#,dv#
Local tx%,ty%
Local xd%
;offscreen in Y?
If y<current_view\rect_top Return
If y>=current_view\rect_bottom Return
If EL\x > ER\x Then
tmp.EDGE = EL
EL = ER
ER = tmp
End If
xl% = Floor(EL\x)
xr% = Floor(ER\x)
;offscreen in X?
If xl >= current_view\rect_right Return
If xr < current_view\rect_left Return
lu# = EL\u
lv# = EL\v
If xl=xr Then
If xl < current_view\rect_left Return
du# = 0
dv# = 0
Else
dx# = 1.0/(xr-xl)
du# = (ER\u-lu)*dx
dv# = (ER\v-lv)*dx
;left clip?
If xl < current_view\rect_left Then
xd% = current_view\rect_left-xl
lu = lu + xd * du
lv = lv + xd * dv
xl = current_view\rect_left
End If
End If
;right clip?
If xr >= current_view\rect_right xr = current_view\rect_right-1
For x = xl To xr
tx% = Floor(lu * current_texture\width) Mod current_texture\width
ty% = Floor(lv * current_texture\height) Mod current_texture\height
If tx<0 tx=0
If ty<0 ty=0
WritePixelFast x,y,PeekInt(current_texture\bank,((ty * current_texture\width) + tx) Shl 2)
lu = lu + du
lv = lv + dv
Next
End Function
Function textriangle(p0.POINT, p1.POINT, p2.POINT)
If p0\sy<=p1\sy And p0\sy<=p2\sy Then
If p1\sy>p2\sy Then
tmp.POINT = p1
p1 = p2
p2 = tmp
End If
Else If p1\sy<=p0\sy And p1\sy<=p2\sy Then
tmp.POINT = p0
If p0\sy < p2\sy Then
p0 = p1
p1 = tmp
Else
p0 = p1
p1 = p2
p2 = tmp
End If
Else
tmp.POINT = p0
If p1\sy < p0\sy Then
p0 = p2
p2 = tmp
Else
p0 = p2
p2 = p1
p1 = tmp
End If
End If
;offscreen
If p2\sy < current_view\rect_top Return
If p0\sy >= current_view\rect_bottom Return
dyL# = p2\sy-p0\sy
If dyL=0 Return
Y% = p0\sy
dyT# = p1\sy-Y
L\x = p0\sx
L\u = p0\u
L\v = p0\v
dyL = 1.0/dyL
dxL# = (p2\sx-L\x)*dyL
duL# = (p2\u-L\u)*dyL
dvL# = (p2\v-L\v)*dyL
If dyT = 0 Goto bottom
R\x = L\x
R\u = L\u
R\v = L\v
dyT = 1.0/dyT
dxT# = (p1\sx-L\x)*dyT
duT# = (p1\u-L\u)*dyT
dvT# = (p1\v-L\v)*dyT
Ye%=p1\sy
If Ye >= current_view\rect_bottom Then
Ye = current_view\rect_bottom-1
End If
While (Y < Ye)
texscan(Y,L,R)
Y = Y + 1
L\x = L\x + dxL
L\u = L\u + duL
L\v = L\v + dvL
R\x = R\x + dxT
R\u = R\u + duT
R\v = R\v + dvT
Wend
.bottom
If Y>=current_view\rect_bottom Return
dyB# = p2\sy-p1\sy
If dyB=0 Goto done
R\x = p1\sx
R\u = p1\u
R\v = p1\v
dyB = 1.0/dyB
dxB# = (p2\sx-R\x)*dyB
duB# = (p2\u-R\u)*dyB
dvB# = (p2\v-R\v)*dyB
Ye%=p2\sy
If Ye >= current_view\rect_bottom Then
Ye = current_view\rect_bottom-1
End If
While (Y < Ye)
texscan(Y,L,R)
Y = Y + 1
L\x = L\x + dxL
L\u = L\u + duL
L\v = L\v + dvL
R\x = R\x + dxB
R\u = R\u + duB
R\v = R\v + dvB
Wend
.done
End Function
Best I could manage in an hour :(
Exe, media, source.
http://members.iinet.net.au/~jimshaw/lots.zip (http://members.iinet.net.au/~jimshaw/lots.zip)
Jim
-
wow affine blits nanas yay! O0
-
Nice 1h coding production.
-
:clap: great!
-
It's better than 1 skin, 2 skin, etc. and that took me 4 hours.
:clap: :clap:
-
Wahey, fast coded linear textures :D Nice one Jim!
-
Sweet.
-
Not so lame for an hrs coding, classic effect :)