The QBasic Forum      Other Subforums, Links and Downloads
 
  << Previous Topic | Next Topic >>Return to Index  

Swarm Intelligence Program

June 1 2008 at 8:54 AM
  (no login)
from IP address 74.210.69.42

DECLARE SUB setupBug (bug AS INTEGER, x AS INTEGER, y AS INTEGER, c AS INTEGER)
DECLARE SUB DrawBugs ()
DECLARE SUB UpdateBugs ()
DECLARE SUB MoveBug (bug AS INTEGER, xMove AS INTEGER, yMove AS INTEGER)
DECLARE FUNCTION AI% (bug AS INTEGER)
DECLARE FUNCTION CheckCollision% (xTo AS INTEGER, yTo AS INTEGER)
DECLARE FUNCTION Stats% (number AS INTEGER)
DECLARE FUNCTION Dist2& (x1 AS INTEGER, y1 AS INTEGER, x2 AS INTEGER, y2 AS INTEGER)

CONST numBugs = 20 'If running fast raise this number and vise-versa

'Commands:
CONST U = 1
CONST UR = 11
CONST R = 10
CONST DR = 9
CONST D = -1
CONST DL = -11
CONST L = -10
CONST UL = -9

'Messages:
CONST BLOCKED = 1

CONST False = 0
CONST TRUE = NOT False

DIM a AS INTEGER
DIM b AS INTEGER

TYPE bugStats
x AS INTEGER
y AS INTEGER
clr AS INTEGER
xold AS INTEGER
yold AS INTEGER
command AS INTEGER
m1 AS INTEGER
m2 AS INTEGER
message AS INTEGER
END TYPE

DIM SHARED Bugs(1 TO numBugs) AS bugStats

FOR a = 1 TO numBugs
setupBug a, INT(RND * 440) + 100, INT(RND * 280) + 100, 14
NEXT

SCREEN 12
WINDOW SCREEN (0, 0)-(639, 479)

DrawBugs
DO
UpdateBugs
DrawBugs
LOOP

FUNCTION AI% (bug AS INTEGER)
DIM a AS INTEGER
DIM total AS INTEGER
FOR a = 1 TO numBugs
IF Bugs(bug).x = Bugs(bug).m1 AND Bugs(bug).y = Bugs(bug).m2 OR Bugs(bug).message = BLOCKED THEN
Bugs(bug).m1 = INT(RND * 640)
Bugs(bug).m2 = INT(RND * 480)
END IF
IF ABS(Bugs(bug).x - Bugs(a).x) < 50 AND ABS(Bugs(bug).y - Bugs(a).y) < 50 THEN total = total + 1
NEXT a

IF total > 10 THEN
AI% = -SGN(Stats%(1) - Bugs(bug).x) * 10 - SGN(Stats%(2) - Bugs(bug).y)
ELSEIF total > 3 THEN
AI% = SGN(Bugs(bug).m1 - Bugs(bug).x) * 10 + SGN(Bugs(bug).m2 - Bugs(bug).y)
ELSE
AI% = SGN(Stats%(1) - Bugs(bug).x) * 10 + SGN(Stats%(2) - Bugs(bug).y)
Bugs(bug).m1 = INT(RND * 640)
Bugs(bug).m2 = INT(RND * 480)
END IF
END FUNCTION

FUNCTION CheckCollision% (xTo AS INTEGER, yTo AS INTEGER)
DIM a AS INTEGER
IF xTo > 639 OR xTo < 0 OR yTo > 479 OR yTo < 0 THEN
CheckCollision% = TRUE
EXIT FUNCTION
END IF
FOR a = 1 TO numBugs
IF Bugs(a).x = xTo AND Bugs(a).y = yTo THEN
CheckCollision% = TRUE
EXIT FUNCTION
END IF
NEXT a
CheckCollision% = False
END FUNCTION

FUNCTION Dist2& (x1 AS INTEGER, y1 AS INTEGER, x2 AS INTEGER, y2 AS INTEGER)
Dist2& = (x2 - x1) ^ 2 + (y2 - y1) ^ 2
END FUNCTION

SUB DrawBugs
DIM a AS INTEGER

FOR a = 1 TO numBugs
PSET (Bugs(a).xold, Bugs(a).yold), 0
PSET (Bugs(a).x, Bugs(a).y), Bugs(a).clr
NEXT a
END SUB

SUB MoveBug (bug AS INTEGER, xMove AS INTEGER, yMove AS INTEGER)
IF NOT CheckCollision(Bugs(bug).x + xMove, Bugs(bug).y + yMove) THEN
IF Bugs(bug).message = BLOCKED THEN Bugs(bug).message = 0
Bugs(bug).xold = Bugs(bug).x
Bugs(bug).yold = Bugs(bug).y
Bugs(bug).x = Bugs(bug).x + xMove
Bugs(bug).y = Bugs(bug).y + yMove
ELSE
Bugs(bug).message = BLOCKED
END IF
END SUB

SUB setupBug (bug AS INTEGER, x AS INTEGER, y AS INTEGER, c AS INTEGER)
Bugs(bug).x = x
Bugs(bug).y = y
Bugs(bug).clr = c
END SUB

FUNCTION Stats% (number AS INTEGER)
DIM a AS INTEGER
DIM total AS INTEGER

SELECT CASE number
CASE 1 'X Coord of center of swarm
FOR a = 1 TO numBugs
total = total + Bugs(a).x
NEXT a
Stats% = total / numBugs
CASE 2 'Y Coord of center of swarm
FOR a = 1 TO numBugs
total = total + Bugs(a).y
NEXT a
Stats% = total / numBugs
END SELECT
END FUNCTION

SUB UpdateBugs
DIM a AS INTEGER
FOR a = 1 TO numBugs
Bugs(a).command = AI%(a)
NEXT a
FOR a = 1 TO numBugs
SELECT CASE Bugs(a).command
CASE U
MoveBug a, 0, 1
CASE UR
MoveBug a, 1, 1
CASE R
MoveBug a, 1, 0
CASE DR
MoveBug a, 1, -1
CASE D
MoveBug a, 0, -1
CASE DL
MoveBug a, -1, -1
CASE L
MoveBug a, -1, 0
CASE UL
MoveBug a, -1, 1
END SELECT
NEXT a
END SUB


 
 Respond to this message   
Current Topic - Swarm Intelligence Program
  << Previous Topic | Next Topic >>Return to Index  

Newbies usually go to www.qbasic.com and click on The QBasic Forum
Forum regulars have their own ways, which include The QBasic Community Forums