Author Topic: BANANACOMP: Lame  (Read 2283 times)

0 Members and 1 Guest are viewing this topic.

Offline Jim

  • Founder Member
  • DBF Aficionado
  • ********
  • Posts: 5301
  • Karma: 402
    • View Profile
BANANACOMP: Lame
« on: July 05, 2007 »
Lame.  Sorry.

Code: [Select]
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

Jim
« Last Edit: July 05, 2007 by Jim »
Challenge Trophies Won:

Offline ninogenio

  • Pentium
  • *****
  • Posts: 1667
  • Karma: 133
    • View Profile
Re: BANANACOMP: Lame
« Reply #1 on: July 05, 2007 »
wow affine blits nanas yay!  O0
« Last Edit: July 05, 2007 by ninogenio »
Challenge Trophies Won:

Offline benny!

  • Senior Member
  • DBF Aficionado
  • ********
  • Posts: 4380
  • Karma: 228
  • in this place forever!
    • View Profile
    • bennyschuetz.com - mycroBlog
Re: BANANACOMP: Lame
« Reply #2 on: July 05, 2007 »
Nice 1h coding production.
[ mycroBLOG - POUET :: whatever keeps us longing - for another breath of air - is getting rare ]

Challenge Trophies Won:

Offline Inc0gnit0

  • Atari ST
  • ***
  • Posts: 159
  • Karma: 3
    • View Profile
Re: BANANACOMP: Lame
« Reply #3 on: July 05, 2007 »
 :clap: great!

Offline combatking0

  • JavaScript lives!
  • Senior Member
  • DBF Aficionado
  • ********
  • Posts: 4569
  • Karma: 235
  • Retroman!
    • View Profile
    • Combat King's Barcode Battler Home
Re: BANANACOMP: Lame
« Reply #4 on: July 05, 2007 »
It's better than 1 skin, 2 skin, etc. and that took me 4 hours.
 :clap: :clap:
You are our 9001st visitor.
Challenge Trophies Won:

Offline Shockwave

  • good/evil
  • Founder Member
  • DBF Aficionado
  • ********
  • Posts: 17378
  • Karma: 497
  • evil/good
    • View Profile
    • My Homepage
Re: BANANACOMP: Lame
« Reply #5 on: July 05, 2007 »
Wahey, fast coded linear textures :D Nice one Jim!
Shockwave ^ Codigos
Challenge Trophies Won:

Offline Yaloopy

  • Death From Above
  • DBF Aficionado
  • ******
  • Posts: 2869
  • Karma: 35
    • View Profile
    • UltraPaste
Re: BANANACOMP: Lame
« Reply #6 on: July 07, 2007 »
Sweet.
Fuck L. Ron Hubbard and fuck all his clones.
Challenge Trophies Won:

Offline Tetra

  • DBF Aficionado
  • ******
  • Posts: 2532
  • Karma: 83
  • Pirate Monkey!
    • View Profile
Re: BANANACOMP: Lame
« Reply #7 on: July 14, 2007 »
Not so lame for an hrs coding, classic effect :)
Challenge Trophies Won: