Some very nice work with 2D sprites by Fletchie. This was taken from the old forum.
autodefine "off"
def p:pointer
def k[10,10]:int
def x,y:int
def sx,sy:int
def an:float
def f,l:int
def h:int
createscreen 640,480,32
p=createsprite(41,400,1)
spritedrawmode p,@trans
spritetobuffer p
fillscreen 0,spritebuffer
h=150
face(20,0,40,10,20,20,0,10,rgb(200,0,0))
face(40,10,40,h,20,h+10,20,20,rgb(200,100,0))
face(0,10,20,20,20,h+10,0,h,rgb(160,60,0))
do
fillscreen 0
for y=0 to 9
for x=0 to 9
k[x,y]=50+sind(an+x*40f)*20
an=an+.05
next x
an=an+180f
if an>360f then an=an-360f
next y
for f=0 to 9
for l=0 to f
sx=l
sy=f-l
drawspritexy p,300+l*40-f*20,f*10+k[sx,sy]
next l
next f
for f=1 to 9
for l=f to 9
sx=l
sy=9-(l-f)
drawspritexy p,100+l*40-f*20+20,90+f*10+k[sx,sy]
next l
next f
flip
until keydown(1)
end
'---------------------------------------------------------------------------------------
sub face(x1:int,y1:int,x2:int,y2:int,x3:int,y3:int,x4:int,y4:int,c:int)
def mx,my:int
def lc:int
lc=rgb(0,0,200)
line spritebuffer,x1,y1,x2,y2,lc
line spritebuffer,x2,y2,x3,y3,lc
line spritebuffer,x3,y3,x4,y4,lc
line spritebuffer,x4,y4,x1,y1,lc
mx=(x1+x3)/2
my=(y2+y4)/2
floodfill spritebuffer,mx,my,c
return
endsub
That's a very clever effect with such a small amount of code ..ÂÃ, :)
Impressive ..
Graham
Gah! One character variables hurt my eyes (and make beginners cry)!!!
But they do bring a lot of memories... For us who started programming back in the (very) early 70's of the last century, single letter variables are just as easily readable as any other kind. Actually I find them easier to work with. ;)
Barney
@Fletchie
I was so impressed by the program that i couldn't resist converting it to FreeBasic (use it the most of all the computer languages i know).
Almost a conversion one on one. Hope you don't mind if i post it on a FreeBasic Forum?! Greetz, Rens van Schie (rensvanschie at gmail.com)
'Thanks to Fletchie
'autodefine "off"
'variables must be defined before use
'Needed for using subroutines later on in the program
Declare Sub face(x1 As Integer,y1 As integer,x2 As Integer,y2 As Integer,x3 As Integer,y3 As Integer,x4 As Integer,y4 As Integer,c As Integer)
'Needed for using functions later on in the program
Declare Function sind(degrees As double) As double
'use shared for global variables
'def p:pointer
Dim Shared As Any Ptr p
'def k[10,10]:Int
Dim Shared As Integer k(10,10)
'Def x,y:int
Dim Shared As integer x,y
'def sx,sy:int
Dim Shared As integer sx,sy
'def an:float
Dim Shared As Double an
'def f,l:int
Dim Shared As Integer f,l
'def h:int
Dim Shared As Integer h
'createscreen 640,480,32
'Screen 18,32,,1 (screen stablize after >500mSec WHY?) So we use:
ScreenRes 640,480,32
'p=createsprite(41,400,1)
P=ImageCreate(41,400,RGB(0,0,0))
'spritetobuffer p
Dim Shared As Any Ptr spritebuffer:spritebuffer=p
'spritedrawmode p,@trans and fillscreen 0,spritebuffer (fill sprite buffer with color 0 (black))
Paint spritebuffer,(0,0),RGB(255,0,255)
h=150
face(20,0,40,10,20,20,0,10,rgb(200,0,0))
face(40,10,40,h,20,h+10,20,20,rgb(200,100,0))
face(0,10,20,20,20,h+10,0,h,rgb(160,60,0))
Do
'no flickering
ScreenLock
'fillscreen 0
Cls
for y=0 to 9
for x=0 to 9
'k(x,y)=50+sind(an+x*40f)*20
k(x,y)=50+sind(an+x*40)*20
an=an+.05
next x
'an=an+180f
an=an+180
'if an>360f then an=an-360f
if an>360 then an=an-360
next y
for f=0 to 9
for l=0 to f
sx=l
sy=f-l
' drawspritexy p,300+l*40-f*20,f*10+k(sx,sy)
Put (300+l*40-f*20,f*10+k(sx,sy)),spritebuffer,trans
next l
next f
for f=1 to 9
for l=f to 9
sx=l
sy=9-(l-f)
' drawspritexy p,100+l*40-f*20+20,90+f*10+k(sx,sy)
put (100+l*40-f*20+20,90+f*10+k(sx,sy)),spritebuffer,trans
next l
next f
'flip
ScreenUnLock
'until keydown(1)
Loop Until MultiKey(&H01)
end
'sub face(x1:int,y1:int,x2:int,y2:int,x3:int,y3:int,x4:int,y4:int,c:int)
Sub face(x1 As Integer,y1 As integer,x2 As Integer,y2 As Integer,x3 As Integer,y3 As Integer,x4 As Integer,y4 As Integer,c As Integer)
'def mx,my:int
Dim As Integer mx,my
'def lc:int
Dim As Integer lc
lc=rgb(0,0,200)
'line spritebuffer,x1,y1,x2,y2,lc
line spritebuffer,(x1,y1)-(x2,y2),lc
'line spritebuffer,x2,y2,x3,y3,lc
line spritebuffer,(x2,y2)-(x3,y3),lc
'line spritebuffer,x3,y3,x4,y4,lc
line spritebuffer,(x3,y3)-(x4,y4),lc
'line spritebuffer,x4,y4,x1,y1,lc
line spritebuffer,(x4,y4)-(x1,y1),lc
mx=(x1+x3)/2
my=(y2+y4)/2
'floodfill spritebuffer,(mx,my),c
Paint spritebuffer,(mx,my),c,RGB(0,0,200)
End Sub
' added function for handling sind
Function sind(degrees As double) As Double
Const pi=4*Atn(1)
Return Sin(degrees*(pi/180))
End Function
QuoteHope you don't mind if i post it on a FreeBasic Forum?
He wouldn't have minded.
Hello mrainey,
That is a gem piece of code you posted , By, "Fletchie", (R.I.P.),congratulations to him, so much, in so little code.
Reminded me of a piece of code in early eighties, "Last Century", simulation of car pistons in motion"
Hello to you as well, Ren.
nice conversion, was going through it and , it may be something or nothing, the line,
Paint spritebuffer,(mx,my),c,RGB(0,0,200)
is that not "lc", or am i wrong?.
Paint spritebuffer,(mx,my),c,lc
if i am wrong, then i stand corrected.
Regards
Hugh
'Er .. let's keep to EBasic code on this forum please.
http://www.codingmonkeys.com/ (http://www.codingmonkeys.com/)
is the right place for comparison of different languages.
regards, :)
Graham
Quote from: hugh on September 24, 2008, 06:39:07 PM
Hello mrainey,
That is a gem piece of code you posted , By, "Fletchie", (R.I.P.),congratulations to him, so much, in so little code.
Reminded me of a piece of code in early eighties, "Last Century", simulation of car pistons in motion"
Hello to you as well, Ren.
nice conversion, was going through it and , it may be something or nothing, the line,
Paint spritebuffer,(mx,my),c,RGB(0,0,200)
is that not "lc", or am i wrong?.
Paint spritebuffer,(mx,my),c,lc
if i am wrong, then i stand corrected.
Regards
Hugh
Now that you mention it.
Larry (Larry Adcock) wrote something similar by the past.
It's attached to my post