Author Topic: Small Effect  (Read 3017 times)

0 Members and 1 Guest are viewing this topic.

Offline Deleter

  • C= 64
  • **
  • Posts: 73
  • Karma: 11
    • View Profile
    • Deleter's Rants
Small Effect
« on: August 12, 2007 »
I felt bad posting requests here and not giving anything back really, so here is a small graphical effect just using fbgfx. It uses the latest version of fb, so I've included an exe. I'm not really that great at graphics stuff so go easy ;).

http://deleter.phatcode.net/smpfx.rar

Here's the code:

Code: [Select]
'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

'*                             Constants and basic stuff                       *

'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

const sX=640,sY=480
const pi=3.1415926
const numpoints=5

enum see
    cX
    cY
end enum

type coord
    as integer x,y
end type

'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

'*                             Interpolation subs                              *

'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

function LinearInterpolate(pts() as coord,it as double,bla as see) as integer
    if bla=cX then
        return int(pts(0).x*(1-it) + pts(ubound(pts)).x*it)
    else
        return int(pts(0).y*(1-it) + pts(ubound(pts)).y*it)
    end if
end function


function recurvBX(pts() as coord,it as double,s as integer,f as integer) as double
    if f-s=1 then return (1-it)*pts(s).x+it*pts(f).x
    return (1-it)*recurvBX(pts(),it,s,f-1)+it*recurvBX(pts(),it,s+1,f)
end function

function recurvBY(pts() as coord,it as double,s as integer,f as integer) as double
    if f-s=1 then return (1-it)*pts(s).y+it*pts(f).y
    return (1-it)*recurvBY(pts(),it,s,f-1)+it*recurvBY(pts(),it,s+1,f)
end function


function BezierInterpolate(pts() as coord,it as double,bla as see) as integer
    if bla=cX then
        return (1-it)*recurvBX(pts(),it,0,ubound(pts)-1)+_
                   it*recurvBX(pts(),it,1,ubound(pts))
    else
        return (1-it)*recurvBY(pts(),it,0,ubound(pts)-1)+_
                   it*recurvBY(pts(),it,1,ubound(pts))
    end if
end function



'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

'*                          Sprite Chain code                                  *

'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *


type SpriteChain
    private:
        as integer numlinks
        as double across,myval
        as double rawval,rv2
       
    public:
        declare constructor(numlinks as integer)
        declare destructor()
       
        declare sub Display()
        declare sub Update(tm as double)
       
        dim iop as function(c() as coord,ival as double,c as see) as integer
        as coord pts(numpoints)
end type

constructor SpriteChain(numlinks as integer)
    this.numlinks=numlinks
    across=0
    rawval=-pi/2
end constructor

destructor SpriteChain()
end destructor

sub SpriteChain.Display()
    dim as integer x,y',lx=pts(0).x,ly=pts(0).y
    dim as double across=this.across,add
    if across>1 then across=1-(this.across-1)
    if this.across>1 then add=this.across-1
    for tmp as double = 1/numlinks to .99 step 1/numlinks
        x=iop(pts(),tmp*across+add,cX)
        y=iop(pts(),tmp*across+add,cY)
        x=sX/2+abs(sX/2-x)*(myval)*sgn(x)
        y=sY/2+abs(sY/2-y)*(myval)*sgn(x)
        circle(x,y),13,&h00006f,,,,f
        circle(x,y),10,&h00008f,,,,f
        circle(x,y),7,&h0000af,,,,f       
        circle(x,y),4,&h0000cf,,,,f
       
        circle(y*4/3,x*3/4),13,&h00006f,,,,f
        circle(y*4/3,x*3/4),10,&h00008f,,,,f
        circle(y*4/3,x*3/4),7,&h0000af,,,,f       
        circle(y*4/3,x*3/4),4,&h0000cf,,,,f
       
        circle(sX-x,y),13,&h00006f,,,,f
        circle(sX-x,y),10,&h00008f,,,,f
        circle(sX-x,y),7,&h0000af,,,,f
        circle(sX-x,y),4,&h0000cf,,,,f
       
       
        circle(sX-y*4/3,x*3/4),13,&h00006f,,,,f
        circle(sX-y*4/3,x*3/4),10,&h00008f,,,,f
        circle(sX-y*4/3,x*3/4),7,&h0000af,,,,f
        circle(sX-y*4/3,x*3/4),4,&h0000cf,,,,f
       
       
       
        circle(x,sY-y),13,&h00006f,,,,f
        circle(x,sY-y),10,&h00008f,,,,f
        circle(x,sY-y),7,&h0000af,,,,f       
        circle(x,sY-y),4,&h0000cf,,,,f
       
        circle(y*4/3,sY-x*3/4),13,&h00006f,,,,f
        circle(y*4/3,sY-x*3/4),10,&h00008f,,,,f
        circle(y*4/3,sY-x*3/4),7,&h0000af,,,,f       
        circle(y*4/3,sY-x*3/4),4,&h0000cf,,,,f
       
        circle(sX-x,sY-y),13,&h00006f,,,,f
        circle(sX-x,sY-y),10,&h00008f,,,,f
        circle(sX-x,sY-y),7,&h0000af,,,,f
        circle(sX-x,sY-y),4,&h0000cf,,,,f
       
       
        circle(sX-y*4/3,sY-x*3/4),13,&h00006f,,,,f
        circle(sX-y*4/3,sY-x*3/4),10,&h00008f,,,,f
        circle(sX-y*4/3,sY-x*3/4),7,&h0000af,,,,f
        circle(sX-y*4/3,sY-x*3/4),4,&h0000cf,,,,f
       
     next
   
    for tmp as integer = 0 to ubound(pts)
        circle (pts(tmp).x,pts(tmp).y),3,&h00ff00
    next
end sub

sub SpriteChain.Update(tm as double)
    rawval+=tm*pi
    rv2+=tm*pi/2'/4
    across=sin(rawval)+1
    myval=1-((sin(rv2)+1)/2)^3
end sub

'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

'*                                   Main Code                                 *

'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *


dim as SpriteChain sc=SpriteChain(30)

'set up a test path
sc.pts(0).x=20
sc.pts(0).y=20

sc.pts(1).x=125
sc.pts(1).y=350

sc.pts(2).x=250
sc.pts(2).y=80

sc.pts(3).x=375
sc.pts(3).y=450

sc.pts(4).x=500
sc.pts(4).y=120

sc.pts(5).x=600
sc.pts(5).y=480

sc.iop=@LinearInterpolate
'sc.iop=@BezierInterpolate

screenres 640,480,8

dim as double myrawval,myval
dim as double tm=timer
dim as double stm=timer
do
   
    tm=timer-tm
    myrawval+=tm*17
    myval=((cos(myrawval)+1)/2)
    for tmp as integer = 0 to 255
        palette tmp,0,tmp*(1-myval),tmp*myval
    next

    sc.Update(tm)
    tm=timer
   
    if timer-stm> 1*4.5*2 then sc.iop=@BezierInterpolate'-pi/2+pi*2*2
           
   
    screenlock
    cls
    sc.Display()
    screenunlock
    sleep 5,1
loop until multikey(1)
sleep

Offline Deleter

  • C= 64
  • **
  • Posts: 73
  • Karma: 11
    • View Profile
    • Deleter's Rants
Re: Small Effect
« Reply #1 on: August 12, 2007 »
Hmm, and another one as well

Code: [Select]
const screenx=320
const screeny=240

screenres screenx,screeny,8


randomize 42
dim as ubyte col
screenlock

for tmp as integer = 0 to 127
    palette tmp,tmp*2
    palette 255-tmp,tmp*2
   
next


for tmpx as integer=0 to screenx-1 step 2
    for tmpy as integer = 0 to screeny-1 step 2
        pset(tmpx,tmpy),int(rnd*255)
    next
next
color 250

for tmp as integer = screenx/16 to screenx/16+screenx/32 step 2
    circle (screenx/2,screeny/2),tmp,255
    circle (screenx/2,screeny/2),tmp*2,255
    circle (screenx/2,screeny/2),tmp*3,255
    circle (screenx/2,screeny/2),tmp*4,255   
next

draw string (screenx/2-len("deleter")*4,screeny/2-4),"DELETER",255

screenunlock

'dim as single primary=.3,secondary=.6/4,tertiary=.1/4
dim as single primary=.2,secondary=.3/4,tertiary=.5/4

for loops as integer = 1 to 10
    screenlock
    draw string (screenx/2-len("deleter")*4,screeny/2-4),"DELETER",255
    for tmpx as integer = 1 to screenx-2
        for tmpy as integer = 1 to screeny-2
            col=point(tmpx,tmpy)*primary+point(tmpx-1,tmpy)*secondary+point(tmpx+1,tmpy)*secondary+_
            point(tmpx,tmpy-1)*secondary+point(tmpx,tmpy+1)*secondary+point(tmpx-1,tmpy-1)*tertiary+_
            point(tmpx+1,tmpy-1)*tertiary+point(tmpx-1,tmpy+1)*tertiary+point(tmpx+1,tmpy+1)*tertiary
            pset(tmpx,tmpy),col
        next
    next
    draw string (screenx/2-len("deleter")*4,screeny/2-4),"DELETER",255
    screenunlock
next
sleep
'end
dim as integer tm
do
    tm=int(timer*100)
    for tmp as integer = 0 to 127
        palette tmp, ((tm+tmp) mod 127)*2,0,0
        palette 255-tmp, ((tm+tmp) mod 127)*2,0,0
    next
    sleep 5,1
loop until multikey(1)
« Last Edit: August 12, 2007 by Deleter »

Offline Jim

  • Founder Member
  • DBF Aficionado
  • ********
  • Posts: 5301
  • Karma: 402
    • View Profile
Re: Small Effect
« Reply #2 on: August 12, 2007 »
I wonder if effect 1 could be turned into an infinite-bob demo?  Thanks for the code!

Jim
Challenge Trophies Won:

Offline Shockwave

  • good/evil
  • Founder Member
  • DBF Aficionado
  • ********
  • Posts: 17412
  • Karma: 498
  • evil/good
    • View Profile
    • My Homepage
Re: Small Effect
« Reply #3 on: August 12, 2007 »
That's interesting code actually, it's got some nice bezier stuff in there. Thank you for posting it :) If I had a suggestion I'd only say to slow it down a little bit.

Shockwave ^ Codigos
Challenge Trophies Won:

Offline DrewPee

  • I Toast Therefore I am
  • Pentium
  • *****
  • Posts: 563
  • Karma: 25
  • Eat Cheese - It's good for you!
    • View Profile
    • Retro Computer Museum
Re: Small Effect
« Reply #4 on: August 13, 2007 »
Deleter,
Fast code - nice effect! Im only running .15 so could only run your .exe!
Thanks for sharing the code though - I need to upgrade to .17 soon!

Drew
DrewPee
aka Falcon of The Lost Boyz (Amiga)
Ex-Amiga Coder and Graphic Designer
Administrator of > www.retrocomputermuseum.co.uk