Spider Walk!

Post your FreeBASIC tips and tricks here. Please don’t post your code without including an explanation.
Zamaster
Posts: 1024
Joined: Jun 20, 2005 21:40
Contact:

Spider Walk!

Postby Zamaster » Jul 21, 2007 20:22

Theoretically, this is what happens if you throw 200 spiders onto a torus and they all chase their closest neighbor not already chasing. Its best to let it run for a little while, it makes pretty sweet patterns, I added just a little fluff.

Code: Select all

CONST SCRX AS INTEGER = 640
CONST SCRY AS INTEGER = 480

CONST HSCRX AS INTEGER = SCRX/2
CONST HSCRY AS INTEGER = SCRY/2


CONST MaxSpiders as integer = 200
#define Dist(x1,y1,x2,y2) SQR((x1-x2)^2+(y1-y2)^2)

#macro MixUp()
    For i = 1 to MaxSpiders
        Spiders(i).x = int(rnd * SCRX)
        Spiders(i).y = int(rnd * SCRY)
    Next i
#endmacro
#macro ResetSpiders()
    For i = 1 to MaxSpiders
        Spiders(i).CanUse = 0
    Next i
#endmacro
#macro FindShortest()
    sd = &H7FFFFFFF
    For a = 1 to MaxSpiders
        If Spiders(a).CanUse = 0 Then
            If a <> i Then
                Tx1 = Spiders(i).x: Ty1 = Spiders(i).y
                Tx2 = Spiders(a).x: Ty2 = Spiders(a).y
                If Tx1 >= HSCRX Then
                    If Tx1 - Tx2 > HSCRX Then Tx2 += SCRX
                ElseIf Tx1 <= HSCRX Then
                    If Tx2 - Tx1 > HSCRX Then Tx2 -= SCRX
                Endif
                If Ty1 >= HSCRY Then
                    If Ty1 - Ty2 > HSCRY Then Ty2 += SCRY
                ElseIf Ty1 <= HSCRY Then
                    If Ty2 - Ty1 > HSCRY Then Ty2 -= SCRY
                Endif
                b = Dist(Tx1, Ty1, Tx2, Ty2)
                If b < sd Then
                    sd = b
                    sdi = a
                Endif
            Endif
        ENdif
    Next a
    If sd = &H7FFFFFFF Then sdi = -1
#endmacro

#define SplitR(col1) ((col1 Shr 16) and &HFF)
#define SplitG(col1) ((col1 Shr 8) And &HFF)
#define SplitB(col1) (col1 And &HFF)
#define RGBF(RR,GG,BB) (((RR)Shl 16) Or ((GG)Shl 8) Or (BB))

Function AdditiveMix(colr1 As Integer, rr As Integer, gg As Integer, bb As Integer) As Integer
    Dim As Integer r,g,b
    r = SplitR(colr1) + rr
    g = SplitG(colr1) + gg
    b = SplitB(colr1) + bb
    If r > 255 Then
        r = 255
    elseif r < 0 then
        r = 0
    Endif
    If g > 255 Then
        g = 255
    elseif g < 0 then
        g = 0
    Endif
    If b > 255 Then
        b = 255
    elseif b < 0 Then
        b = 0
    endif
    Return RGBF(r,g,b)
End Function


Randomize Timer


Type SPType
    as integer CanUse
    as double  x      ,_
               y
End Type

Dim as SPType Spiders(1 to MaxSpiders)
Dim as integer i, a
Dim as double b, sd, sdi, Tx1, Ty1, Tx2, Ty2
screenres SCRX, SCRY, 32, ,1
setmouse ,,0

MixUp()
Do
    ResetSpiders()
    If inkey$ <> "" Then
        cls
        MixUp()
    Endif
    i = 1
    screenlock
 
    Do
        FindShortest()
        If sdi = -1 Then Exit Do
        Spiders(i).CanUse = 1
        Spiders(i).x += (Spiders(sdi).x-Spiders(i).x)/sd
        If Spiders(i).x > SCRX-1 Then
            Spiders(i).x -= SCRX
        Elseif Spiders(i).x < 0 Then
            Spiders(i).x += SCRX
        Endif
        Spiders(i).y += (Spiders(sdi).y-Spiders(i).y)/sd
        If Spiders(i).y > SCRY-1 Then
            Spiders(i).y -= SCRY
        Elseif Spiders(i).y < 0 Then
            Spiders(i).y += SCRY
        Endif
        Pset (Spiders(i).x,Spiders(i).y), AdditiveMix(Point(Spiders(i).x,Spiders(i).y), 15, 10, 15)
        i = sdi
    Loop
    screenunlock
Loop until multikey(&h01)
Last edited by Zamaster on Jul 21, 2007 21:41, edited 4 times in total.
Pritchard
Posts: 5492
Joined: Sep 12, 2005 20:06
Location: Ohio, USA

Postby Pritchard » Jul 21, 2007 20:25

Gooooo! *guuu* Awesome! ^.^;; Looks neat with all the goo. Goo Goo Power Spiders... Goo Goo Power Spiders, mighty webbing Power Spiders.
Deleter
Posts: 975
Joined: Jun 22, 2005 22:33

Postby Deleter » Jul 21, 2007 23:35

cool
Frank Dodd
Posts: 444
Joined: Mar 10, 2006 19:22

Postby Frank Dodd » Jul 22, 2007 10:34

Very pretty displays with lots of spiders
Hezad
Posts: 469
Joined: Dec 17, 2006 23:37
Contact:

Postby Hezad » Jul 22, 2007 15:15

Weird and awesome :)
duke4e
Posts: 717
Joined: Dec 04, 2005 0:16
Location: Varazdin, Croatia, Europe
Contact:

Postby duke4e » Jul 22, 2007 18:48

this is awesome!
TbbW
Posts: 348
Joined: Aug 19, 2005 10:08
Contact:

Postby TbbW » Jul 22, 2007 19:10

*sings*
spider pig! spider pig! does what ever a spider-pig does!
look out! here comes the spider pig!
http://www.youtube.com/watch?v=yZM8VO9GCps
attacke
Posts: 55
Joined: Mar 19, 2006 11:57
Contact:

Postby attacke » Jul 22, 2007 19:25

asjhfalkmgvklsdkgmasökgjasdflkgalsdfgmadögm

well, i increased the resolution to 1280x980 and removed the CLS...

let them run for a while and when they all were chasing in a line i just mix them up.

took a screen shot...

place it as background...

now i got the coolest background on the internet...
and i havent have a background for like 15 years. now i find one i like :)
Zamaster
Posts: 1024
Joined: Jun 20, 2005 21:40
Contact:

Postby Zamaster » Jul 23, 2007 1:45

neat! Can we see?
nobozoz
Posts: 238
Joined: Nov 17, 2005 6:24
Location: Chino Hills, CA, USA

Postby nobozoz » Jul 23, 2007 4:05

Tried to compile your code as listed with fbc v0.17b and got this:

spiderwalk.o:fake:(.text+0x27a): undefined reference to `fb_SetMouse@12'
Pritchard
Posts: 5492
Joined: Sep 12, 2005 20:06
Location: Ohio, USA

Postby Pritchard » Jul 23, 2007 4:51

nobozoz wrote:spiderwalk.o:fake:(.text+0x27a): undefined reference to `fb_SetMouse@12'
Weeird. O.o;; You aren't linking to FBgfx lib for some reason? Is your fbc properly installed?

Try adding #inclib "fbgfx" at the top of the program to see if that'll work.
nobozoz
Posts: 238
Joined: Nov 17, 2005 6:24
Location: Chino Hills, CA, USA

Postby nobozoz » Jul 23, 2007 7:10

#include fbgfx.bi didn't fix the problem for me. I ended up re-installing v0.17b and that alone fixed the problem (#include fbgfx.bi wasn't necessary after the re-install).
Compiled w/: fbc -lang fb -v -s console -e -mt -arch 686 -w all

My problems may have been related to installing the nightly v0.18b's over the previous v0.17b install - the new install is still v0.17b only.
Pritchard
Posts: 5492
Joined: Sep 12, 2005 20:06
Location: Ohio, USA

Postby Pritchard » Jul 23, 2007 9:05

#inclib <> #include
cha0s
Site Admin
Posts: 5317
Joined: May 27, 2005 6:42
Location: Illinois
Contact:

Postby cha0s » Jul 23, 2007 9:36

Pritchard, you never need to #inclib "fbgfx".

You got that error because your compiler was a different version than your graphics library. Make sure when you install/extract a nightly build, that you replace ALL the files included.
Pritchard
Posts: 5492
Joined: Sep 12, 2005 20:06
Location: Ohio, USA

Postby Pritchard » Jul 23, 2007 10:20

okay cha0s :D

Return to “Tips and Tricks”

Who is online

Users browsing this forum: No registered users and 1 guest