Iso View Sprite Demo by Fletchie

[Steven Picard]

Some very nice work with 2D sprites by Fletchie.  This was taken from the old forum.

Code Select Expand

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


[GWS]

That's a very clever effect with such a small amount of code ..ÂÃ, 

Impressive ..

Graham

[Kale]

Gah! One character variables hurt my eyes (and make beginners cry)!!!

[Barney]

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

[Rens]

@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)

Code Select Expand



'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


[mrainey]

Hope you don't mind if i post it on a FreeBasic Forum?

He wouldn't have minded.

[hugh]

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,

Code Select Expand


Paint spritebuffer,(mx,my),c,RGB(0,0,200)


is that not "lc", or am i wrong?.

Code Select Expand


Paint spritebuffer,(mx,my),c,lc

if i am wrong, then i stand corrected.

Regards

Hugh

[GWS]

'Er .. let's keep to EBasic code on this forum please.

http://www.codingmonkeys.com/

is the right place for comparison of different languages.


regards,

Graham

[pistol350]

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,

Code Select Expand


Paint spritebuffer,(mx,my),c,RGB(0,0,200)


is that not "lc", or am i wrong?.

Code Select Expand


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