Interesting Graphics

Post your FreeBASIC tips and tricks here. Please don’t post your code without including an explanation.
Deleter
Posts: 975
Joined: Jun 22, 2005 22:33

Interesting Graphics

Postby Deleter » Jul 30, 2007 14:57

This was inspired by zamaster's spider walk, but the code is 100% original.

The original:

Code: Select all

#ifndef null
const null=0
#endif

type bla
    as single x,y
    as single vx,vy
    as bla ptr prey,hunter
end type

const MAX_BLA=200
const MAX_SPEED=20000

screenres 640,480,32
dim shared as any ptr mypix
mypix=imagecreate(1,1,255)

dim shared as bla mybla(MAX_BLA)

sub MakeAll()
    dim as integer ind
   
    for tmp as integer = 0 to MAX_BLA
        mybla(tmp).prey=null
        mybla(tmp).hunter=null
    next
   
    for tmp as integer = 0 to MAX_BLA
        with mybla(tmp)
            .x=rnd*640
            .y=rnd*480
            ind=int(rnd*(MAX_BLA+1))
           
            if mybla(ind).hunter=null then
                .prey=@mybla(ind)
                mybla(ind).hunter=@mybla(tmp)
            else
                for tmp2 as integer=ind+1 to MAX_BLA
                    if mybla(tmp2).hunter=null then
                        .prey=@mybla(tmp2)
                        mybla(tmp2).hunter=@mybla(tmp)
                        exit for
                    end if
                next
                if .prey=null then
                    for tmp2 as integer=0 to ind-1
                        if mybla(tmp2).hunter=null then
                            .prey=@mybla(tmp2)
                            mybla(tmp2).hunter=@mybla(tmp)
                            exit for
                        end if
                    next
                end if
            end if
        end with
    next
end sub

sub UpdateAll(tm as double)
    dim as single mymod,d
    for tmp as integer=0 to MAX_BLA
        with mybla(tmp)
            if .prey<>null then
                .vx=.prey->x-.x
                .vy=.prey->y-.y
                d=(.vx*.vx+.vy*.vy)+.01

                if d > MAX_SPEED then mymod=MAX_SPEED/d else mymod=1
               
                .vx*=mymod
                .vy*=mymod
               
                .x+=.vx*tm
                .y+=.vy*tm
               
                if .x>640 then .x=0
                if .y>480 then .y=0
                if .x<0 then .x=639
                if .y<0 then .y=479
               
            end if
        end with
    next
end sub

sub DisplayAll()
    for tmp as integer=0 to MAX_BLA
        with mybla(tmp)
            put (.x,.y),mypix,alpha,10
        end with
    next
   
end sub

dim as double tm=timer
dim as integer mk28
MakeAll
do
    tm=timer-tm
    UpdateAll(tm)
    DisplayAll()
    tm=timer
   
    sleep 5,1
    if multikey(28)=0 and mk28=1 then
        cls
        MakeAll()
        mk28=0
    elseif multikey(28)=-1 then
        mk28=1
    end if
   
loop until multikey(1)


imagedestroy(mypix)


Same as above, except now we make sure every pixel is chasing the next pixel in the list:

Code: Select all

#ifndef null
const null=0
#endif

type bla
    as single x,y
    as single vx,vy
    as bla ptr prey,hunter
end type

const MAX_BLA=200
const MAX_SPEED=20000

screenres 640,480,32
dim shared as any ptr mypix
mypix=imagecreate(1,1,255)

dim shared as bla mybla(MAX_BLA)

sub MakeAll()
    dim as integer ind
   
    for tmp as integer = 0 to MAX_BLA
        mybla(tmp).prey=null
        mybla(tmp).hunter=null
    next
   
    for tmp as integer = 0 to MAX_BLA
        with mybla(tmp)
            .x=rnd*640
            .y=rnd*480
            ind=tmp+1'int(rnd*(MAX_BLA+1))
            if tmp=MAX_BLA then ind=0
           
            if mybla(ind).hunter=null then
                .prey=@mybla(ind)
                mybla(ind).hunter=@mybla(tmp)
            else
                for tmp2 as integer=ind+1 to MAX_BLA
                    if mybla(tmp2).hunter=null then
                        .prey=@mybla(tmp2)
                        mybla(tmp2).hunter=@mybla(tmp)
                        exit for
                    end if
                next
                if .prey=null then
                    for tmp2 as integer=0 to ind-1
                        if mybla(tmp2).hunter=null then
                            .prey=@mybla(tmp2)
                            mybla(tmp2).hunter=@mybla(tmp)
                            exit for
                        end if
                    next
                end if
            end if
        end with
    next
end sub

sub UpdateAll(tm as double)
    dim as single mymod,d
    for tmp as integer=0 to MAX_BLA
        with mybla(tmp)
            if .prey<>null then
                .vx=.prey->x-.x
                .vy=.prey->y-.y
                d=(.vx*.vx+.vy*.vy)+.01
               
                if d > MAX_SPEED then mymod=MAX_SPEED/d else mymod=1
               
               
                .vx*=mymod
                .vy*=mymod
               
                .x+=.vx*tm
                .y+=.vy*tm
               
                if .x>640 then .x=0
                if .y>480 then .y=0
                if .x<0 then .x=639
                if .y<0 then .y=479
               
            end if
        end with
    next
end sub

sub DisplayAll()
    for tmp as integer=0 to MAX_BLA
        with mybla(tmp)
            put (.x,.y),mypix,alpha,10
        end with
    next
   
end sub

dim as double tm=timer
dim as integer mk28
MakeAll
do
    tm=timer-tm
    UpdateAll(tm)
    DisplayAll()
    tm=timer
   
    sleep 5,1
    if multikey(28)=0 and mk28=1 then
        cls
        MakeAll()
        mk28=0
    elseif multikey(28)=-1 then
        mk28=1
    end if
   
loop until multikey(1)


imagedestroy(mypix)


And an odd result following a few tweaks:

Code: Select all

#ifndef null
const null=0
#endif

type bla
    as single x,y
    as single vx,vy
    as bla ptr prey,hunter
end type

const MAX_BLA=2000
const MAX_SPEED=20000

screenres 640,480,32
dim shared as any ptr mypix(1)
mypix(0)=imagecreate(4,4,255)
mypix(1)=imagecreate(4,14,0)

dim shared as bla mybla(MAX_BLA)

sub MakeAll()
    dim as integer ind
   
    for tmp as integer = 0 to MAX_BLA
        mybla(tmp).prey=null
        mybla(tmp).hunter=null
    next
   
    for tmp as integer = 0 to MAX_BLA
        with mybla(tmp)
            .x=cos(tmp/MAX_BLA*6.28+3.14*(tmp mod 1))*300+320'rnd*640
            .y=sin(tmp/MAX_BLA*6.28+3.14*(tmp mod 3))*220+240'rnd*480
            ind=tmp+1'int(rnd*(MAX_BLA+1))
            if tmp=MAX_BLA then ind=1
           
            if mybla(ind).hunter=null then
                .prey=@mybla(ind)
                mybla(ind).hunter=@mybla(tmp)
            else
                for tmp2 as integer=ind+1 to MAX_BLA
                    if mybla(tmp2).hunter=null then
                        .prey=@mybla(tmp2)
                        mybla(tmp2).hunter=@mybla(tmp)
                        exit for
                    end if
                next
                if .prey=null then
                    for tmp2 as integer=0 to ind-1
                        if mybla(tmp2).hunter=null then
                            .prey=@mybla(tmp2)
                            mybla(tmp2).hunter=@mybla(tmp)
                            exit for
                        end if
                    next
                end if
            end if
        end with
    next
end sub

sub UpdateAll(tm as double)
    dim as single mymod,d
    for tmp as integer=0 to MAX_BLA
        with mybla(tmp)
            if .prey<>null then
                .vx=.prey->x-.x
                .vy=.prey->y-.y
                d=(.vx*.vx+.vy*.vy)+.01
               
                if d > MAX_SPEED then mymod=MAX_SPEED/d else mymod=1
                .vx*=mymod
                .vy*=mymod
                .x+=.vx*tm
                .y+=.vy*tm
               
                if .x>640 then .x=0
                if .y>480 then .y=0
                if .x<0 then .x=639
                if .y<0 then .y=479
               
            end if
        end with
    next
end sub

sub DisplayAll()
    for tmp as integer=0 to MAX_BLA
        with mybla(tmp)
            put (.x,.y),mypix(tmp mod 2),alpha,10
        end with
    next
   
end sub

dim as double tm=timer
dim as integer mk28
MakeAll
do
    tm=timer-tm
    UpdateAll(tm)
    DisplayAll()
    tm=timer
   
    sleep 5,1
    if multikey(28)=0 and mk28=1 then
        cls
        MakeAll()
        mk28=0
    elseif multikey(28)=-1 then
        mk28=1
    end if
   
loop until multikey(1)


imagedestroy(mypix(0))
imagedestroy(mypix(1))


edit:

For those who want to see without running:

Image

more tinkering:

Code: Select all

#ifndef null
const null=0
#endif

type bla
    as single x,y
    as single vx,vy
    as bla ptr prey,hunter
end type

const MAX_BLA=150
const MAX_SPEED=200000

screenres 640,480,32
dim shared as any ptr mypix
mypix=imagecreate(1,1,255)

dim shared as bla mybla(MAX_BLA)

sub MakeAll()
    dim as integer ind
   
    for tmp as integer = 0 to MAX_BLA
        mybla(tmp).prey=null
        mybla(tmp).hunter=null
    next
   
    for tmp as integer = 0 to MAX_BLA
        with mybla(tmp)
            .x=rnd*640
            .y=rnd*480
            ind=tmp+1'int(rnd*(MAX_BLA+1))
            if tmp=MAX_BLA then ind=0
           
            if mybla(ind).hunter=null then
                .prey=@mybla(ind)
                mybla(ind).hunter=@mybla(tmp)
            else
                for tmp2 as integer=ind+1 to MAX_BLA
                    if mybla(tmp2).hunter=null then
                        .prey=@mybla(tmp2)
                        mybla(tmp2).hunter=@mybla(tmp)
                        exit for
                    end if
                next
                if .prey=null then
                    for tmp2 as integer=0 to ind-1
                        if mybla(tmp2).hunter=null then
                            .prey=@mybla(tmp2)
                            mybla(tmp2).hunter=@mybla(tmp)
                            exit for
                        end if
                    next
                end if
            end if
        end with
    next
end sub

sub UpdateAll(tm as double)
    dim as single mymod,mymod2,d,d2,vx,vy
    for tmp as integer=0 to MAX_BLA
        with mybla(tmp)
            if .prey<>null then
                .vx=.prey->x-.x
                .vy=.prey->y-.y
                d=(.vx*.vx+.vy*.vy)+.01
               
                vx=.x-.hunter->x
                vy=.y-.hunter->y
                d2=(vx*vx+vy*vy)+.01
                if d2 > MAX_SPEED then mymod2=MAX_SPEED/d2 else mymod2=1
                vx*=mymod2
                vy*=mymod2
                if d > MAX_SPEED then mymod=MAX_SPEED/d else mymod=1
               
                .vx*=mymod
                .vy*=mymod
               
                .vx=(.vx*.75+vx*.25)
                .vy=(.vy*.75+vy*.25)
               
               
                .x+=.vx*tm
                .y+=.vy*tm
               
                if .x>640 then .x=0
                if .y>480 then .y=0
                if .x<0 then .x=639
                if .y<0 then .y=479
               
            end if
        end with
    next
end sub

sub DisplayAll()
    for tmp as integer=0 to MAX_BLA
        with mybla(tmp)
            put (.x,.y),mypix,alpha,10
        end with
    next
   
end sub

dim as double tm=timer
dim as integer mk28
MakeAll
do
    tm=timer-tm
    UpdateAll(tm)
    DisplayAll()
    tm=timer
   
    sleep 5,1
    if multikey(28)=0 and mk28=1 then
        cls
        MakeAll()
        mk28=0
    elseif multikey(28)=-1 then
        mk28=1
    end if
   
loop until multikey(1)


imagedestroy(mypix)
Pritchard
Posts: 5492
Joined: Sep 12, 2005 20:06
Location: Ohio, USA

Postby Pritchard » Jul 30, 2007 20:23

Whee! ^.^;; Pretteh!
Zamaster
Posts: 1024
Joined: Jun 20, 2005 21:40
Contact:

Postby Zamaster » Jul 31, 2007 16:38

cool! I like the spirals.
redcrab
Posts: 619
Joined: Feb 07, 2006 15:29
Location: France / Luxemburg
Contact:

Postby redcrab » Jul 31, 2007 16:46

Keeeewl ! Spider ? it looks smoky ! Or galaxy style ...


That's fun !
badmrbox
Posts: 659
Joined: Oct 27, 2005 14:40
Location: Sweden
Contact:

Postby badmrbox » Jul 31, 2007 17:42

Very pretty :D
maddogg6
Posts: 824
Joined: Dec 07, 2005 22:58
Contact:

Postby maddogg6 » Jul 31, 2007 17:48

MMMMMmmmmm - Yummy - FB Eye candy
tinram
Posts: 88
Joined: Nov 30, 2006 13:35
Location: UK

Postby tinram » Aug 01, 2007 20:56

Excellent effect, and intriguing - quite fractal-like.
shockwave
Posts: 65
Joined: May 14, 2006 14:27
Location: UK
Contact:

Postby shockwave » Aug 27, 2007 18:10

Very Attractor like result :)

Return to “Tips and Tricks”

Who is online

Users browsing this forum: No registered users and 2 guests