Sorry your browser is not supported!

REM *** Coding Challenge: 2D Spaceship game
REM *** By: Martin 'eLeit' Enderleit
REM *** Started: 15. August, 2009.

ScreenWidth = 1280      REM - Screen Width (set to something that works for you)
ScreenHeight = 800     REM - Screen Depth (set to something that works for you)
ScreenDepth = 32        REM - Screen Depth (set to something that works for you)
NumStars = 500          REM - Number of stars in the starfield. (decrease if it runs slow)
MaxRoids = 50
NumRoids = 0
RoidSprite = 2
roidTimer = 0
speedTimer = 0
MaxBullets = 50
BulletSprite = 100
shotTimer = 0
Score = 0

REM - Create a user type to hold the info for the stars.
type star
    xpos as FLOAT
    ypos as FLOAT
    col as INTEGER
endtype

type asteroid
    xpos as FLOAT
    ypos as FLOAT
    angle as FLOAT
    active as BOOLEAN
endtype

REM - Create a user type to hold the info for the player ship.
type ship
    xpos as FLOAT
    ypos as FLOAT
    turnspeed as FLOAT
    angle as FLOAT
    hp as INTEGER
    speed as FLOAT
endtype

type shot
    xpos as FLOAT
    ypos as FLOAT
    speed as FLOAT
    active as BOOLEAN 
endtype

set display mode ScreenWidth,ScreenHeight,32
sync on : sync rate 0
hide mouse
color backdrop 0

randomize timer()

player as ship
gosub CreateShip                    REM - Create the Ship image.
dim starfield(NumStars) as star     REM - Create an array to hold the Starfield info.
gosub CreateStarfield               REM - Create the Starfield.
gosub CreateAsteroid                REM - Create the Asteroid image.
dim roid(MaxRoids) as asteroid      REM - Create an array to hold the Roids info.
gosub SetupRoids                    REM - Create the Roids.
dim bullet(MaxBullets) as shot      REM - Create an array to hold the bullet info.

sprite 1,player.xpos,player.ypos,1
offset sprite 1,15,15

REM - Main Loop.
oldTime = timer()
do
    difTime = timer() - oldTime
    oldTime = timer()

    inc speedTimer,difTime
    inc roidTimer,difTime
    
    if speedTimer > 100
        inc player.speed,0.0001
        if player.speed > 1.0 then player.speed = 1.0
        speedTimer = 0
    endif
    
    if roidTimer > 64/player.speed
        roidActivate = rnd(5)
        if NumRoids<MaxRoids and roidActivate>0
            roidDone = 0
            for i=0 to MaxRoids
                if roid(i).active = 0 and roidDone = 0
                    roid(i).active = 1
                    roid(i).xpos = rnd(ScreenWidth-31)+15.0
                    roid(i).ypos = -15.0
                    roid(i).angle = rnd(359)
                    roidDone = 1
                    inc NumRoids,1
                    show sprite RoidSprite+i
                endif
            next i
        endif
        roidTimer = 0
    endif
        
    gosub DrawStarfield
    gosub UpdateRoids
    sprite 1,player.xpos,player.ypos,1
    rotate sprite 1,player.angle

    for i=0 to MaxRoids
        if roid(i).active
            sprite RoidSprite+i,roid(i).xpos,roid(i).ypos,2
            rotate sprite RoidSprite+i,roid(i).angle
            inc roid(i).angle,0.1*difTime
            roid(i).angle = wrapvalue(roid(i).angle)
        else
            hide sprite RoidSprite+i
        endif
    next i

    gosub CheckAsteroidHitShip    
    gosub Controls
    
    ink rgb(255,255,255),0    
    text 0,0,"FPS: "+str$(screen fps())
    text 0,15,"Score: "+str$(Score)
    text 0,30,"Health: "+str$(player.hp)
    sync
loop

REM - Control the Ship.
Controls:
    LK = leftkey()
    RK = rightkey()
    
    if LK
        dec player.turnspeed,0.001*difTime
        if player.turnspeed<-1.0 then player.turnspeed = -1.0
        dec player.angle,0.035*difTime
        if player.angle<-35.0 then player.angle = -35.0
    endif
    if RK
        inc player.turnspeed,0.001*difTime
        if player.turnspeed>1.0 then player.turnspeed = 1.0
        inc player.angle,0.035*difTime
        if player.angle>35.0 then player.angle = 35.0
    endif
    if LK=0 and RK=0
        if player.turnspeed<0.0
            inc player.turnspeed,0.001*difTime
            inc player.angle,0.035*difTime
            if player.turnspeed>0.0
                player.turnspeed = 0.0
                player.angle = 0.0
            endif
        endif
        if player.turnspeed>0.0
            dec player.turnspeed,0.001*difTime
            dec player.angle,0.035*difTime
            if player.turnspeed<0.0
                player.turnspeed = 0.0
                player.angle = 0.0
            endif
        endif
    endif

    inc player.xpos,player.turnspeed
    if player.xpos < 15
        player.xpos = 15
        if player.turnspeed < 0.0
            player.turnspeed = 0.0
            player.angle = 0.0
        endif
    endif
    if player.xpos > ScreenWidth-16
        player.xpos = ScreenWidth-16
        if player.turnspeed > 0.0
            player.turnspeed = 0.0
            player.angle = 0.0
        endif
    endif
return

REM - Draw and move the stars.
DrawStarfield:
    lock pixels
    for i=0 to NumStars
        ink rgb(starfield(i).col,starfield(i).col,255),0
        dot starfield(i).xpos,starfield(i).ypos
        inc starfield(i).ypos,player.speed*difTime
        if starfield(i).ypos > ScreenHeight then starfield(i).ypos = 0.0
    next i
    unlock pixels
return

REM - Create the ship image.
CreateShip:
    width as FLOAT
    width = 0.0
    col = 255

    for y=0 to 31
        ink rgb(col,0,0),0
        line 15-int(width),y,15+int(width),y
        inc width,0.5
        dec col,4
    next y

    ink rgb(255,255,255),0
    box 14,10,16,20
    box 13,11,17,20

    get image 1,0,0,32,32
    cls
    
    player.xpos = ScreenWidth/2
    player.ypos = ScreenHeight - 64
    player.hp = 100
    player.speed = 0.01
    player.turnspeed = 0.0
return

REM - Create the asteroid image.
CreateAsteroid:
    xpos as FLOAT
    ypos as FLOAT
    size as FLOAT
    xpos=15.0
    ypos=15.0
    startsize = 15
    size=startsize
    col=63
    while xpos>8.0
        while size>1.0
            ink rgb(col,col,col),0
            circle int(xpos),int(ypos),int(size)
            circle int(xpos)+1,int(ypos),int(size)
            dec size,0.1
        endwhile
        dec xpos,0.5
        dec ypos,0.5
        inc col,20
        startsize = startsize - 2
        size = startsize
    endwhile
    
    get image 2,0,0,32,32
    cls
return


REM - Create the random starfield.
CreateStarfield:
    for i=0 to NumStars
        starfield(i).xpos = rnd(ScreenWidth-1)
        starfield(i).ypos = rnd(ScreenHeight-1)
        starfield(i).col = rnd(128)+127
    next i
return

SetupRoids:
    for i=0 to MaxRoids
        roid(i).xpos=0.0
        roid(i).ypos=0.0
        roid(i).angle=0.0
        roid(i).active=0
        sprite RoidSprite+i,roid(i).xpos,roid(i).ypos,2
        offset sprite RoidSprite+i,15,15
        hide sprite RoidSprite+i
    next i
return

UpdateRoids:
    for i=0 to MaxRoids
        if roid(i).active = 1
            inc roid(i).ypos,(player.speed*1.5)*difTime
            if roid(i).ypos > ScreenHeight+16
                roid(i).active = 0
                dec NumRoids,1
                inc Score,1
            endif
        endif
    next i
return

SetupBullets:
    for i=0 to MaxBullets
    next i
return

CheckAsteroidHitShip:
    for i=0 to MaxRoids
        if roid(i).active=1 and sprite collision (RoidSprite+i,1)
            dec player.hp,1
            roid(i).active = 0
            hide sprite RoidSprite+i
        endif        
    next i
return

CLS
Print "I have lost the challenge, dang i hate when that happens"

set display mode 1024,768,32
backdrop on
color backdrop 0
hide mouse
dim txtr(8,4)
dim c(5)
c(1)=32
c(2)=32
c(3)=64
c(4)=64
c(5)=254
dim emisv(5)
emisv(1)=rgb(40,16,16)
emisv(2)=rgb(16,40,16)
emisv(3)=rgb(16,16,40)
emisv(4)=rgb(16,16,16)
emisv(5)=rgb(40,16,40)
dim st(17)
global next_obj=0
global next_txtr=0
side=400
rem Create textures for building
create bitmap 1,250,400
ink 0,0
box 0,0,250,400
blank=next_texture()
get image blank,0,0,250,400
for t=1 to 8
  height=t*10+10
  ink 0,0
  box 0,0,250,400
  for u=1 to 4
    txtr(t,u)=next_texture()
    for x=5 to 230 step 20
      for y=5 to height*4-20 step 20
        col=rnd(4)+1
        ink rgb(c(col)/4,c(col)/4,c(col)/4),0
        box x,y,x+18,y+18
        ink rgb(c(col)/2,c(col)/2,c(col)/2),0
        box x+1,y+1,x+17,y+17
        ink rgb(c(col),c(col),c(col)),0
        box x+2,y+2,x+16,y+16
      next y
    next x
    ink rgb(128,128,255),0
    get image txtr(t,u),0,0,250,height*4
  next u
next t
delete bitmap 1
set current bitmap 0
rem Make buildings
for x=-660 to 800 step 60
  if x<280 or x>320
    for y=-200 to 800 step 100
      building=next_object()
      build=rnd(7)+1
      height=build*10+10
      make object box building,50,10,50
      texture object building,blank
      make mesh from object 2,building
      make object plain side,50,height
      make mesh from object 1,side
      delete object side
      add limb building,1,1
      add limb building,2,1
      add limb building,3,1
      add limb building,4,1
      delete mesh 1
      texture limb building,1,txtr(build,1)
      texture limb building,2,txtr(build,2)
      texture limb building,3,txtr(build,3)
      texture limb building,4,txtr(build,4)
      rotate limb building,2,0,90,0
      rotate limb building,3,0,180,0
      rotate limb building,4,0,270,0
      sh=(height+10)/2
      offset limb building,1,0,sh,25
      offset limb building,2,25,sh,0
      offset limb building,3,0,sh,-25
      offset limb building,4,-25,sh,0
      add limb building,5,2
      texture limb building,5,blank
      offset limb building,5,0,sh*2,0
      glow=rnd(4)+1
      set object emissive building,emisv(glow)
      position object building,x,5,y
    next y
  endif
next x
rem Make street
create bitmap 1,600,30
ink 0,0
box 0,0,600,30
ink rgb(255,255,255),0
for x=0 to 600 step 10
  dot x,1
  dot x,29
next x
ist1=next_texture()
get image ist1,0,0,600,30
ink 0,0
box 0,0,600,30
ink rgb(255,255,255),0
for x=0 to 600 step 100
  for y=0 to 60 step 10
    dot x+y,1
    dot x+y,29
  next y
next x
ist2=next_texture()
get image ist2,0,0,600,30
delete bitmap 1
set current bitmap 0
street=next_object()
make object plain street,600,30
texture object street,ist1
rotate object street,270,0,0
fix object pivot street
for x=1 to 16
  st(x)=next_object()
  instance object st(x),street
next x
hide object street
for x=1 to 8
  position object st(x),-25,10,x*100-150
  position object st(x+8),610,10,x*100-150
next
street2=next_object()
make object plain street2,600,30
texture object street2,ist2
rotate object street2,270,0,0
fix object pivot street2
x=7
st(x)=next_object()
instance object st(x),street2
yrotate object st(x),90
position object st(7),295,10,270

cama#=0.0
camy#=200.0
camd#=400.0
while not escapekey()
  camx#=camd#*sin(cama#)
  camz#=camd#*cos(cama#)
  position camera camx#+300,camy#,camz#+300
  point camera 300,0,300
  cama#=wrapvalue(cama#+0.5)
  camy#=sin(cama#)*100+300
endwhile

function next_object()
  inc next_obj
endfunction next_obj

function next_texture()
  inc next_txtr
endfunction next_txtr

REM Projekt: stadt
REM erstellt: 25.08.2009 23:18:30
REM
REM ***** Haupt-Quelldatei *****
#CONSTANT SCREENW 1280
#CONSTANT SCREENH 1024

set display mode SCREENW, SCREENH, 32
sync on : sync rate 0 : sync

create bitmap 2, 300, 1000
set current bitmap 0

b_line as integer : b_line = SCREENH*0.66

create_corona(3, 50)

repeat
   cls : sync
   `sky
   render_sky(b_line)

   `layer1
   for t = 1 to 30
      x = rnd(SCREENW) : height = 50+sin((x*1.0/SCREENW)*180)*150+rnd(100)
      offset_angle = height*0.025
      render_random_house(b_line, x, height, offset_angle, 4)
      sync
   next t

   `layer2
   for t = 1 to 10
      x = 200+rnd(SCREENW-400) : height = 150+sin((x*1.0/SCREENW)*180)*200+rnd(250)
      offset_angle = height*0.025
      render_random_house(b_line, x, height, offset_angle, 0)
      sync
   next t

   draw_ground(rgb(5,5,5), b_line, 30, 10, 0)

   `layer3
   for t = 1 to 20
      x = rnd(SCREENW) : height = 50+sin((x*1.0/SCREENW)*180)*150+rnd(100)
      offset_angle = height*0.025
      render_random_house(b_line, x, height, offset_angle, 4)
      sync
   next t

   draw_ground(rgb(0,0,0), b_line, 20, 13, 1)
   sync


   `Wasserreflektion
   get image 2, 0, 2*b_line-SCREENH, SCREENW, b_line, 1
   wave_image(2)
   for t = 1 to 10
      blur_image(2)
   next t
   sprite 1, 0, 0, 2 : set sprite 1, 0, 1 : hide sprite 1
   if sprite flipped(1)=0 then flip sprite 1
   paste sprite 1, 0, b_line
   delete image 2
   sync

   `Kontraste verbessern
   get image 2, 0, 0, SCREENW, SCREENH, 1
   increase_contrast(2)
   paste image 2, 0, 0
   sync

   wait key
until escapekey()
end

function render_sky(horizont)
   local dist as float
   local fac1 as float
   local fac2 as float
   local lit_angle as integer
   local lit_angle_size as integer
   `--
   :``box 0, horizont-400, SCREENW, horizont, rgb(65,74,0), rgb(1, 1, 1), rgb(65,74,0), rgb(1,1,1)
   cls
   lit_angle = rnd(180)
   lit_angle_size = 10+rnd(60)
   lock pixels
   for x = 0 to SCREENW
      for y = 0 to horizont
         dist = sqrt((x-SCREENW*0.5)^2+(y-horizont+50)^2)
         angle = atan_full(x-SCREENW*0.5, y-horizont+50)
         if angle_is_between(angle, lit_angle-lit_angle_size*0.5, lit_angle+lit_angle_size*0.5)
            fac1 = (1000-dist)*1.0/1000
         else
            fac1 = (800-dist)*1.0/800
         endif
         fac2 = (300-horizont+y)*1.0/300
         if fac2 < 0 then fac2 = 0
         if fac2 > 1 then fac2 = 1
         if fac1 > 1 then fac1 = 1
         fac1 = bv(fac1, fac2)
         color = interpolate_color(rgb(0, 0, 0), rgb(255, 255, 128), fac1)
         dot x, y, color
      next y
   next x
   unlock pixels
endfunction

function draw_ground(color, horizon, av_height, amp, lights as boolean)
   local y as float
   `--
   ink color, 0
   ny = horizon-av_height-amp+rnd(amp*2)
   for t = 0 to SCREENW step 100
      oy = ny
      ny = horizon-av_height-amp+rnd(amp*2)
      if rnd(4)>0 and lights
         y = oy-20
         size = 80+rnd(30)
         draw_corona(t, y, 3, size, size, rgb(255,0,0))
      endif
      for x = 0 to 100
         y = oy+(ny-oy)*x*0.01
         line t+x, y, t+x, horizon
      next x
   next t
endfunction

function bv(a as float, b as float)
   if a > b then exitfunction a
endfunction b

function render_random_house(hy, hx, height, offset_angle, blurs)
   local window_color as dword
   local logo_color as dword
   local color1 as dword
   local color2 as dword
   local line_dead as boolean
   local top_line_color as dword
   local color as dword
   local fx as float
   local fy as float
   `--
   set current bitmap 2

   width = 80+rnd(70)
   depth = 20+rnd(40)
   color1 = building_color1()
   color2 = building_color2()
   top_line_color = top_line_color()
   `Fassade Hintergrund
   x_window_border = 6+rnd(4)
   y_window_border = 20+rnd(20)
   x_win_dist = 2+rnd(2)
   x_windows = 5+rnd(4)
   y_win_dist = 2+rnd(3)
   y_win_size = 4+rnd(2)
   color_selection = 0

   if rnd(2)=1
      top_lines = 2+rnd(6)
      top_lines_dist = rnd(3)*2
   endif
   cls color1
   ink top_line_color, 0
   for t = 1 to top_lines
      line x_window_border, 10+t*top_lines_dist, width-x_window_border, 10+t*top_lines_dist
   next t
   for y = 0 to height*0.5
      color = interpolate_color(color1, color2, y*1.0/(height*0.5))
      ink color, 0
      line 0, y+height*0.5, width, y+height*0.5
   next y

   `Fenster Fassade
   fy = y_window_border
   repeat
      if rnd(10) = 4 then line_dead = 1 else line_dead = 0
      for x = 0 to x_windows-1
         fx = x_window_border+(x*1.0/x_windows)*(width-x_window_border*2)
         if rnd(6)=2 or line_dead
            ink rgb(1, 1, 1), 0
            box fx, fy, fx+(width-x_win_dist*2)/x_windows-x_win_dist, fy+y_win_size
         else
            ink rgb(255, 255, 255), 0
            box fx, fy, fx+(width-x_win_dist*2)/x_windows-x_win_dist, fy+y_win_size, window_color(color_selection), window_color(color_selection), window_color(color_selection), window_color(color_selection)
         endif
      next x
      inc fy, y_win_size+y_win_dist
   until fy >= height
   get image 1, 0, 0, width, height, 1
   set current bitmap 0



   for t = 1 to blurs
      blur_image(1)
   next t
   offset_image(1, offset_angle)

   ``paste image 1, hx-width*0.5, hy-height, 1
   sprite 2, 0, 0, 1 : set sprite 2, 0, 1 : hide sprite 2
   size sprite 2, image width(1), image height(1)
   if sprite mirrored(2) then mirror sprite 2
   paste sprite 2, hx-width*0.5, hy-height
   size sprite 2, width*0.25, sprite height(2)
   mirror sprite 2
   paste sprite 2, hx-width*0.75+1, hy-height

   `Coronas
   if top_lines > 0
      x = hx-width*0.5+x_window_border : y = hy-height+10+sin(offset_angle)*y_window_border
      size = 30+rnd(80)
      draw_corona(x, y, 3, size, size, top_line_color)
      x = hx-width*0.5+cos(offset_angle)*(width-x_window_border) : y = hy-height+10+sin(offset_angle)*y_window_border+sin(offset_angle)*(width-x_window_border)
      draw_corona(x, y, 3, size, size, top_line_color)
   endif

   delete image 1
endfunction


function interpolate_color(color1 as dword, color2 as dword, value as float)
   local color as dword
   `--
   r1 = rgbr(color1) : g1 = rgbg(color1) : b1 = rgbb(color1)
   r2 = rgbr(color2) : g2 = rgbg(color2) : b2 = rgbb(color2)
   r = r1+(r2-r1)*value
   g = g1+(g2-g1)*value
   b = b1+(b2-b1)*value
   color = rgb(r, g, b)
endfunction color

function building_color1()
   local color as dword
   `--
   select rnd(2)
      case 0 : color = rgb(1, 1, 1) : endcase
      case 1 : color = rgb(4, 4, 4) : endcase
      case 2 : color = rgb(8, 8, 8) : endcase
   endselect
endfunction color

function building_color2()
   local color as dword
   `--
   select rnd(2)
      case 0 : color = rgb(255, 255, 180) : endcase
      case 1 : color = rgb(255, 255, 128) : endcase
      case 2 : color = rgb(230, 255, 128) : endcase
      case 3 : color = rgb(3 , 38, 41) : endcase
      case 4 : color = rgb(140,0,0)    : endcase
      case 5 : color = rgb(0,128,0)    : endcase
      case 6 : color = rgb(0,0,0)      : endcase
   endselect
endfunction color

function window_color(selection)
   local color as dword
   `--
   select selection
      case 0:
         select rnd(4)
            case 0 : color = rgb(255, 255, 255) : endcase
            case 1 : color = rgb(255, 255, 128) : endcase
            case 2 : color = rgb(230, 255, 128) : endcase
            case 3 : color = rgb(128,128,128)   : endcase
            case 4 : color = rgb(230, 255, 128) : endcase
         endselect
      endcase
   endselect
endfunction color

function top_line_color()
   local color as dword
   `--
   select selection
      case 0:
         select rnd(2)
            case 0 : color = rgb(255, 0, 0) : endcase
            case 1 : color = rgb(0, 255, 0) : endcase
            case 2 : color = rgb(0, 0, 255) : endcase
         endselect
      endcase
   endselect
endfunction color

function wave_image(img)
   local r as float
   local g as float
   local b as float
   local xsin as float
   local ysin as float
   `--
   mem1 = get_free_memblock()
   make memblock from image mem1, img
   mem2 = get_free_memblock()
   make memblock mem2, get memblock size(mem1)
   copy memblock mem1, mem2, 0, 0, 12
   width = memblock dword(mem1, 0)
   height = memblock dword(mem1, 4)
   alpha = 100+rnd(100)
   for x = 0 to width-1
      for y = 0 to height-1
         xsin = sin(y*y*y*0.0001)
         ysin = sin(sin(x+alpha)*x*y*0.1)
         rx = x+xsin*(height-y)*0.1
         ry = y+ysin*(height-y)*0.1
         if rx >= 0 and rx <= width-1
            if ry >= 0 and ry <= height-1
               rpos = 12+(ry*width+rx)*4
               wpos = 12+(y*width+x)*4
               b = memblock byte(mem1, rpos)
               g = memblock byte(mem1, rpos+1)
               r = memblock byte(mem1, rpos+2)
               ``b = b*(y*1.0/height) : g = g*(y*1.0/height) : r = r*(y*1.0/height)
               b = b*(0.8+ysin*0.2)*(y*1.0/height)
               g = g*(0.8+ysin*0.2)*(y*1.0/height)
               r = r*(0.8+ysin*0.2)*(y*1.0/height)
               write memblock dword mem2, wpos, rgb(r, g, b)
            endif
         endif
      next y
   next x

   delete memblock mem1
   delete image img
   make image from memblock img, mem2
   delete memblock mem2
endfunction

function offset_image(img, angle)
   mem1 = get_free_memblock()
   make memblock from image mem1, img
   width = memblock dword(mem1, 0)
   height1 = memblock dword(mem1, 4)
   y_offset = tan(angle)*width
   height2 = height1+y_offset
   mem2 = get_free_memblock()
   make memblock mem2, 12+(width*height2)*4
   write memblock dword mem2, 0, width
   write memblock dword mem2, 4, height2
   write memblock dword mem2, 8, 32

   for x = 0 to width-1
      for y = 0 to height1-1
         wy = y+(x*1.0/width)*y_offset
         rpos = 12+(y*width+x)*4
         wpos = 12+(wy*width+x)*4
         write memblock dword mem2, wpos, memblock dword(mem1, rpos)
      next y
   next x

   delete memblock mem1
   delete image img
   make image from memblock img, mem2
   delete memblock mem2
endfunction

function increase_contrast(img)
   local r as float
   local g as float
   local b as float
   local bp as float
   local gp as float
   local rp as float
   `--
   mem1 = get_free_memblock()
   make memblock from image mem1, img
   width = memblock dword(mem1, 0)
   height = memblock dword(mem1, 4)
   mem2 = get_free_memblock()
   make memblock mem2, get memblock size(mem1)
   copy memblock mem1, mem2, 0, 0, 12

   if rnd(2)=1 then bp = 0.1
   if rnd(2)=1 then gp = 0.1
   if rnd(2)=1 then rp = 0.1

   for x = 0 to width-1
      for y = 0 to height-1
         pos = 12+(y*width+x)*4
         b = memblock byte(mem1, pos)
         b = b*1.0/255 : b = b*b*1.6+bp
         if b > 1 then b = 1
         b = b*255
         write memblock byte mem2, pos, int(b)
         g = memblock byte(mem1, pos+1)
         g = g*1.0/255 : g = g*g*1.6+gp
         if g > 1 then g = 1
         g = g*255
         write memblock byte mem2, pos+1, int(g)
         r = memblock byte(mem1, pos+2)
         r = r*1.0/255 : r = r*r*1.6+rp
         if r > 1 then r = 1
         r = r*255
         write memblock byte mem2, pos+2, int(r)
         copy memblock mem1, mem2, pos+3, pos+3, 1
      next y
   next x

   delete memblock mem1
   delete image img
   make image from memblock img, mem2
   delete memblock mem2
endfunction


function blur_image(img as integer)
   mem1 = get_free_memblock()
   make memblock from image mem1, img
   mem2 = get_free_memblock()
   make memblock mem2, get memblock size(mem1)
   copy memblock mem1, mem2, 0, 0, 12
   width = memblock dword(mem1, 0)
   height = memblock dword(mem1, 4)
   copy memblock mem1, mem2, 12, 12, width*4
   copy memblock mem1, mem2, 12+width*(height-1)*4, 12+width*(height-1)*4, width*4
   for y = 0 to height-1
      pos = 12+(y*width)*4
      copy memblock mem1, mem2, pos, pos, 4
      pos = 12+(y*width+width-1)*4
      copy memblock mem1, mem2, pos, pos, 4
   next y
   for x = 1 to width-2
      for y = 1 to height-2
         pos = 12+(y*width+x)*4
         pos1 = pos-4
         pos2 = pos
         pos3 = pos+4
         pos4 = pos-width*4
         pos5 = pos+width*4
         newval = (memblock byte(mem1, pos1) + memblock byte(mem1, pos2) + memblock byte(mem1, pos3) + memblock byte(mem1, pos4) + memblock byte(mem1, pos5))*0.2
         write memblock byte mem2, pos, newval
         newval = (memblock byte(mem1, pos1+1) + memblock byte(mem1, pos2+1) + memblock byte(mem1, pos3+1) + memblock byte(mem1, pos4+1) + memblock byte(mem1, pos5+1))*0.2
         write memblock byte mem2, pos+1, newval
         newval = (memblock byte(mem1, pos1+2) + memblock byte(mem1, pos2+2) + memblock byte(mem1, pos3+2) + memblock byte(mem1, pos4+2) + memblock byte(mem1, pos5+2))*0.2
         write memblock byte mem2, pos+2, newval
         write memblock byte mem2, pos+3, 255
      next y
   next x

   delete memblock mem1
   delete image img
   make image from memblock img, mem2
   delete memblock mem2
endfunction

function get_free_memblock()
   local index as integer
   `--
   repeat
      inc index
   until memblock exist(index)=0
endfunction index

function create_corona(img, rad)
   local dist as float
   local fac as float
   `--
   mem = get_free_memblock()
   make memblock mem, 12+(rad*rad*4)*4
   write memblock dword mem, 0, rad*2
   write memblock dword mem, 4, rad*2
   write memblock dword mem, 8, 32
   for x = 0 to rad*2-1
      for y = 0 to rad*2-1
         pos = 12+(y*rad*2+x)*4
         dist = sqrt((x-rad)^2+(y-rad)^2)
         fac = (rad-dist)*1.0/rad
         if fac < 0 then fac = 0
         fac = fac*fac
         for t = 0 to 3
            write memblock byte mem, pos+t, int(fac*255)
         next t
      next y
   next x
   make image from memblock img, mem
   delete memblock mem
endfunction

function draw_corona(x, y, img, width, height, color)
   sprite 4, 0, 0, img : set sprite 4, 0, 1 : hide sprite 4
   set sprite image 4, img
   size sprite 4, width, height
   set sprite diffuse 4, rgbr(color), rgbg(color), rgbb(color)
   paste sprite 4, x-width*0.5, y-height*0.5
endfunction

function atan_full(dist_x as float, dist_y as float)
   local angle as float
   `--
   if dist_y >= 0
      if dist_x > 0 then angle = 180.0 + abs(Atan(dist_y/dist_x))
      if dist_x < 0 then angle = 360.0 - abs(Atan(dist_y/dist_x))
      if dist_x = 0 then angle = 270.0
   else
      if dist_x > 0 then angle = Atan(dist_y/dist_x) + 180.0
      if dist_x < 0 then angle = Atan(dist_y/dist_x)
      if dist_x = 0 then angle = 90.0
   endif
endfunction angle

function angle_is_between(angle as float, angle1 as float, angle2 as float)
   angle = wrapvalue(angle)
   angle1 = wrapvalue(angle1)
   angle2 = wrapvalue(angle2)
   if angle2 < angle1 then inc angle2, 360
   if angle < angle1 then inc angle, 360
   if angle >= angle1 and angle <= angle2 then exitfunction 1
endfunction 0

function create_corona(img, rad)
   local dist as float
   local fac as float
   `--
   mem = get_free_memblock()
   make memblock mem, 12+(rad*rad*4)*4
   write memblock dword mem, 0, rad*2
   write memblock dword mem, 4, rad*2
   write memblock dword mem, 8, 32
   for x = 0 to rad*2-1
      for y = 0 to rad*2-1
         pos = 12+(y*rad*2+x)*4
         dist = sqrt((x-rad)^2+(y-rad)^2)
         fac = (rad-dist)*1.0/rad
         if fac < 0 then fac = 0
         fac = fac*fac
         for t = 0 to 3
            write memblock byte mem, pos+t, int(fac*255)
         next t
      next y
   next x
   make image from memblock img, mem
   delete memblock mem
endfunction

set display mode 1024,768,32
backdrop on
color backdrop 0
hide mouse
dim txtr(10,4)
dim c(5)
c(1)=32
c(2)=32
c(3)=64
c(4)=64
c(5)=254
dim emisv(5)
emisv(1)=rgb(192,128,128)
emisv(2)=rgb(128,192,128)
emisv(3)=rgb(128,128,192)
emisv(4)=rgb(128,128,128)
emisv(5)=rgb(192,128,192)
dim st(17)
global next_obj=0
global next_txtr=0
side=400
set image colorkey 250,250,250
transparent=rgb(250,250,250)
rem Create textures for building
create bitmap 1,250,480
ink 0,0
box 0,0,250,250
blank=next_texture()
get image blank,0,0,250,250
winx=15
winy=12
for t=1 to 10 rem Create sides of building for all heights of buildings
  height=t*10+10
  ink 0,0
  box 0,0,250,400
  for u=1 to 4
    txtr(t,u)=next_texture()
    for x=5 to 230 step 20
      for y=5 to height*4-20 step 20
        col=rnd(4)+1
        ink rgb(c(col)/7,c(col)/7,c(col)/7),0
        box x,y,x+winx,y+winy
        ink rgb(c(col)/5,c(col)/5,c(col)/5),0
        box x+1,y+1,x+winx-1,y+winy-1
        ink rgb(c(col)/3,c(col)/3,c(col)/3),0
        box x+2,y+2,x+winx-2,y+winy-2
        ink rgb(c(col),c(col),c(col)),0
        box x+3,y+3,x+winx-3,y+winy-3
      next y
    next x
    ink rgb(128,128,255),0
    get image txtr(t,u),0,0,250,height*4
  next u
next t
rem Make signs
total_signs=3
dim sign$(total_signs)
dim col(total_signs,3)
dim isign(total_signs)
sign$(1)="AceLepage Co.":col(1,1)=rgb(64,64,255):col(1,2)=240:col(1,3)=300
sign$(2)="Skyluke Inc.":col(2,1)=rgb(255,64,64):col(2,2)=360:col(2,3)=400
sign$(3)="thegamecreators":col(3,1)=rgb(64,255,64):col(3,2)=360:col(3,3)=300
for x=1 to total_signs
  ink 0,0
  box 0,0,250,250
  ink col(x,1),0
  set text font "arial"
  set text size 20
  set text to bold
  set cursor 10,0
  print sign$(x)
  isign(x)=next_texture()
  get image isign(x),0,0,150,30
next x
delete bitmap 1
set current bitmap 0
rootobj=next_object()
rem Make buildings
make object box rootobj,50,10,50
make mesh from object 2,rootobj
hide object rootobj
for x=-660 to 800 step 60
  if x<280 or x>320 rem Avoid putting buildings on main street
    for y=-200 to 800 step 100
      building=next_object()
      build=rnd(9)+1
      width=rnd(1)*25+25
      height=build*10+10
      sh=(height+10)/2
      clone object building,rootobj
      texture object building,blank
      make object plain side,50,height
      make mesh from object 1,side
      delete object side
      scale limb building,0,100,height*10,width*2
      offset limb building,0,0,height/2+15,(50-width)/2.0
      add limb building,1,1
      add limb building,2,1
      add limb building,3,1
      add limb building,4,1
      texture limb building,1,txtr(build,1)
      texture limb building,2,txtr(build,2)
      texture limb building,3,txtr(build,3)
      texture limb building,4,txtr(build,4)
      rotate limb building,2,0,90,0
      rotate limb building,3,0,180,0
      rotate limb building,4,0,270,0
      offset limb building,1,0.1,sh,25.1
      offset limb building,2,25.1,sh,(50-width)/2.0+0.1
      offset limb building,3,0.1,sh,-width+24.9
      offset limb building,4,-25.1,sh,(50-width)/2.0+0.1
      scale limb building,2,width*2,100,100
      scale limb building,4,width*2,100,100
      scale limb texture building,2,width/50.0,1
      scale limb texture building,4,width/50.0,1
      nextlimb=5
      rem If building is narrow, add an addition, if building is close to camera viewing area
      if width=25 and build>2 and (x>0 and x<600 and y>0 and y<600)
        add limb building,5,1
        add limb building,6,1
        add limb building,7,1
        texture limb building,5,txtr(build,1)
        texture limb building,6,txtr(build,2)
        texture limb building,7,txtr(build,1)
        rotate limb building,5,0,90,0
        rotate limb building,6,0,180,0
        rotate limb building,7,0,270,0
        scale limb building,5,50,50,100
        scale limb building,6,50,50,100
        scale limb building,7,50,50,100
        offset limb building,5,0,sh/2+5,-12.5
        offset limb building,6,-12.5,sh/2+5,-25
        offset limb building,7,-25,sh/2+5,-12.5
        scale limb texture building,5,width/50.0,0.5
        scale limb texture building,6,width/50.0,0.5
        scale limb texture building,7,width/50.0,0.5
        add limb building,8,2
        texture limb building,8,blank
        scale limb building,8,50,50,50
        offset limb building,8,-12.5,sh+5,-12.5
        orient=rnd(3)*90
        yrotate object building,orient
        nextlimb=9
      endif
      delete mesh 1
      for signs=1 to total_signs
        if x=col(signs,2) and y=col(signs,3)
          nextsign=next_object()
          make object plain nextsign,48,10
          texture object nextsign,isign(signs)
          set object emissive nextsign,rgb(255,255,255)
          if x<300
            yrotate object building,90
            yrotate object nextsign,90
            position object nextsign,x+25.5,sh*2+5,y
          else
            yrotate object building,270
            yrotate object nextsign,270
            position object nextsign,x-25.5,sh*2+5,y
          endif
        endif
      next signs
      glow=rnd(4)+1
      set object emissive building,emisv(glow)
      position object building,x,5,y
    next y
  endif
next x

rem Make street
create bitmap 1,600,30
ink transparent,0
box 0,0,600,30
ink rgb(255,255,255),0
for x=0 to 600 step 10
  box x,0,x+1,1
  box x,29,x+1,30
next x
ist1=next_texture()
get image ist1,0,0,600,30
ink transparent,0
box 0,0,600,30
ink rgb(255,255,255),0
for x=0 to 600 step 100
  for y=0 to 60 step 10
    box x+y,0,x+y+1,1
    box x+y,29,x+y+1,30
  next y
next x
ist2=next_texture()
get image ist2,0,0,600,30
delete bitmap 1
set current bitmap 0
street=next_object()
make object plain street,600,30
texture object street,ist1
rotate object street,270,0,0
fix object pivot street
set object transparency street,1
for x=1 to 16
  st(x)=next_object()
  instance object st(x),street
next x
hide object street
for x=1 to 8
  position object st(x),-25,25,x*100-150
  position object st(x+8),610,25,x*100-150
next
street2=next_object()
make object plain street2,600,30
texture object street2,ist2
rotate object street2,270,0,0
fix object pivot street2
set object transparency street2,1
x=7
st(x)=next_object()
instance object st(x),street2
yrotate object street2,90
yrotate object st(x),90
position object street2,295,30,-30
position object st(7),295,25,570
rem Make cars
create bitmap 1,20,10
ink 0,0
box 0,0,20,10
create_fuzzy(0,0,10,255,255,255)
create_fuzzy(10,0,10,255,255,255)
headlights=next_texture()
get image headlights,0,0,20,10
create_fuzzy(0,0,10,255,0,0)
create_fuzzy(10,0,10,255,0,0)
taillights=next_texture()
get image taillights,0,0,20,10
delete bitmap 1
set current bitmap 0
total_cars=40
dim car(total_cars)
dim carmove(total_cars,2) as float
dim cardir(total_cars,2)
for x=1 to total_cars
  car(x)=next_object()
  make object plain car(x),4,4
  make mesh from object 1,car(x)
  add limb car(x),1,1
  add limb car(x),2,1
  delete mesh 1
  offset limb car(x),1,0,0,-2
  rotate limb car(x),1,0,180,0
  offset limb car(x),2,0,0,2
  texture limb car(x),1,headlights
  texture limb car(x),2,taillights
  set object emissive car(x),rgb(255,255,255)
  cardir(x,1)=2
  if (x<total_cars/2)
    cardir(x,2)=1
    carmove(x,1)=300
    carmove(x,2)=x*50+rnd(25)-300
  else
    cardir(x,2)=-1
    carmove(x,1)=290
    carmove(x,2)=(x-(total_cars)/2)*50+rnd(45)
    yrotate object car(x),0
  endif
  hide limb car(x),0
next x

cama#=0.0
top#=50.0
camd#=200.0
camspeed#=15 rem Degress per second
carspeed#=10 rem Units per second
while not escapekey()
  speed#=carspeed#*elapsed/1000.0
  for x=1 to total_cars
    carmove(x,cardir(x,1))=carmove(x,cardir(x,1))+speed#*cardir(x,2)
    if carmove(x,cardir(x,1))>800
      carmove(x,cardir(x,1))=carmove(x,cardir(x,1))-1200
    endif
    if carmove(x,cardir(x,1))<-400
      carmove(x,cardir(x,1))=carmove(x,cardir(x,1))+1200
    endif
    position object car(x),carmove(x,1),20,carmove(x,2)
  next x
  camx#=camd#*sin(cama#)
  camy#=sin(cama#+180)*top#+300
  camz#=camd#*cos(cama#)
  position camera camx#+300,camy#,camz#+300
  point camera 300,100,300
  cama#=wrapvalue(cama#+camspeed#*elapsed/1000.0)
  elapsed=timer()-time
  time=timer()
endwhile
end

function next_object()
  inc next_obj
endfunction next_obj

function next_texture()
  inc next_txtr
endfunction next_txtr
rem Fuzzy lights function c/o Valle
function create_fuzzy(xpos,ypos,rad,red,green,blue)
   for x = 0 to rad*2-1
      for y = 0 to rad*2-1
         dist# = sqrt((x-rad)^2+(y-rad)^2)
         illum# = (rad-dist#)*1.0/rad
         if illum# < 0 then illum# = 0
         illum#=illum# ^ 2
         ink rgb(red*illum#,green*illum#,blue*illum#),0
         dot xpos+x,ypos+y
      next y
   next x
endfunction

// Procedural city
//By Monk

//scale = 10 units to a city block - rough guide

set display mode 1024,768,32
autocam off
backdrop off
randomize 2

//Make a variety of 5 buildings

for b = 1 to 6
   h = (b + 2)*2
   make object box b, 4, h, 4       // 4 width so that can have 4 to a city block
   make mesh from object b,b
   delete object b
next b

print "Buildings made"

//make a city map
create bitmap 1, 98,98
set current bitmap 1
//roads
for col = 1 to 9
   for x = 10 to 98 step 10
      line x,0,x,98
   next x
next col

for row = 1 to 9
   for y = 10 to 98 step 10
      line 0,y,98,y
   next y
next row

set current bitmap 0
print "roads laid"
set current bitmap 1

//randomly colour the city map in ten colours
dim c(5) as integer
c(0) = 240
c(1) = 200
c(2) = 160
c(3) = 120
c(4) = 80
c(5) = 40

for col = 1 to 20
   for row = 1 to 20
      if row <= 5 and col <= 5
         colour = rnd(2)
      else
         if row >5 and row <=15 and col <=5
            colour = rnd(3)
         else
            if row <= 5 and col > 5 and col <=15
               colour = rnd(3)
            else
               if row > 5 and row < 15 and col > 5 and col < 15
                  colour = rnd(5)
               else
                  if row >= 15 and col <= 15 and col > 5
                     colour = rnd(3)
                  else
                     if row <= 15 and row > 5 and col >= 15
                        colour = rnd(3)
                     else
                        if row >=15 and col >=15
                           colour = rnd(2)
                        endif
                     endif
                  endif
               endif
            endif
         endif
      endif

      ink rgb(c(colour),0,0),rgb(c(colour),0,0)
      xp = (col-1)*5
      yp = (row-1)*5

      box xp,yp,xp+4,yp+4
   next row
next col

set current bitmap 0
print "Map made"

//textures
//building
create bitmap 2, 40,80
set current bitmap 2
x = 5 : y = 5
ink rgb(255,255,255), rgb(255,255,255)

repeat
   box x,y,x+4,y+6
   inc x,(rnd(5)+1)* 5

   if x >= 40 then inc y,10 : x = rnd(2)*5 + 5
until y >= 80

get image 2, 0,0,40,80
set current bitmap 0
delete bitmap 2

//sky
create bitmap 3, 500,500
set current bitmap 3

repeat
   dot rnd(500), rnd(500)
   inc star
until star >= 1000

get image 3, 0,0,100,100
set current bitmap 0
delete bitmap 3

// ground
create bitmap 4,100,100
set current bitmap 4
ink rgb(50,50,50),rgb(50,50,50)
box 0,0,100,100
get image 4,0,0,100,100
set current bitmap 0
delete bitmap 4

print "Textures made"

//position buildings according to colour map
x = 0 : y = 0 : obj = 10
repeat
   set current bitmap 1
   colour = rgbr(point(x,y))
   set current bitmap 0

   select colour
      case 40
         make object obj, 6
         position object obj, x,object size y(obj)/2,y
         texture object obj, 2
         inc obj : inc x,4
      endcase
      case 80
         make object obj, 5
         position object obj, x,object size y(obj)/2,y
         texture object obj, 2
         inc obj : inc x,4
      endcase
      case 120
         make object obj, 4
         position object obj, x,object size y(obj)/2,y
         texture object obj, 2
         inc obj : inc x,4
      endcase
      case 160
         make object obj, 3
         position object obj, x,object size y(obj)/2,y
         texture object obj, 2
         inc obj : inc x,4
      endcase
      case 200
         make object obj, 2
         position object obj, x,object size y(obj)/2,y
         texture object obj, 2
         inc obj : inc x,4
      endcase
      case 240
         make object obj, 1
         position object obj, x,object size y(obj)/2,y
         texture object obj, 2
         inc obj : inc x,4
      endcase
      case 0,255
         inc x,2
      endcase
   endselect

   if x >= 98
      inc y,4 : x = 0
   endif
until y >=98

set current bitmap 0
delete bitmap 1

//make sky
make object sphere 9, -1000
texture object 9,3
position object 9,50,0,50

//make ground
make object plain 8,1000,1000
xrotate object 8,90
texture object 8,4


//main loop
backdrop on
sync on
position camera 50,20,-100
position mouse 512, 384

do

yrotate camera camera angle y()+mousemovex()
xrotate camera camera angle x()+mousemovey()

if mouseclick() = 1 then move camera 0.5
if mouseclick() = 2 then move camera -0.5

text 0,0,str$(screen fps())


sync
loop

end

sync on : sync rate 60
randomize timer()

type unittype
    locx as float
    locy as float
    ang as float
endtype

`Dummy Sprite
get image 1,0,0,2,2
sprite 1,0,0,1
hide sprite 1

DIM units(100) as unittype
DIM predators(3) as unittype

`Constants
effectdist = 20
rand = 200
radius = 3
vel = 3

pradius = 20
pvel = 2
peffectdist = 50

`Prepare units with random values
for c=1 to array count(units(0))
    units(c).locx = rnd(screen width())
    units(c).locy = rnd(screen height())
    units(c).ang  = rnd(360)
next c

`Ditto for predators
for c=1 to array count(predators(0))
    predators(c).locx = rnd(screen width())
    predators(c).locy = rnd(screen height())
    predators(c).ang  = rnd(360)
next c


do
cls

for c=1 to array count(predators(0))
    `Predators move randomly for now
    inc predators(c).ang,(rnd(rand)-rand/2)/10
    inc predators(c).locx,cos(predators(c).ang)*pvel
    inc predators(c).locy,sin(predators(c).ang)*pvel

    `Wrap around if off the screen
    if predators(c).locx<0-pradius
        predators(c).locx = screen width()+pradius
    endif
    if predators(c).locy<0-pradius
        predators(c).locy = screen height()+pradius
    endif
    if predators(c).locx>screen width()+pradius
        predators(c).locx = 0-pradius
    endif
    if predators(c).locy>screen height()+pradius
        predators(c).locy = 0-pradius
    endif    

    ink rgb(255,255,255)
    circle predators(c).locx,predators(c).locy,pradius
next c

for c=1 to array count(units(0))
    angtot#=0
    angqty =0
    override#=0
    
    `This averages the angles of all the units within the effectdist from the current one, and gives it that angle
    for d=1 to array count(units(0))
        temp=dist(c,d)
        if temp<effectdist
            inc angtot#,units(d).ang
            inc angqty,1
        endif
        
        `Push away from collisions
        if temp<=radius
            override#=wrapvalue(pointsprite(units(c).locx,units(c).locy,units(d).locx,units(d).locy)+0)
        endif
    next d
    
    `Pushing away from predators is top priority
    for d=1 to array count(predators(0))
        temp=dist(c,d)
        if temp<peffectdist
            override#=wrapvalue(pointsprite(units(c).locx,units(c).locy,predators(d).locx,predators(d).locy)+0)
        endif
    next d
    
    if override>0
        units(c).ang=override#
        else
        units(c).ang=angtot#/angqty + (rnd(rand)-rand/2)/10
    endif
    
    `Adjust location based on velocities
    inc units(c).locx,cos(units(c).ang)*vel
    inc units(c).locy,sin(units(c).ang)*vel
    
    `Wrap around if off the screen
    if units(c).locx<0-radius
        units(c).locx = screen width()+radius
    endif
    if units(c).locy<0-radius
        units(c).locy = screen height()+radius
    endif
    if units(c).locx>screen width()+radius
        units(c).locx = 0-radius
    endif
    if units(c).locy>screen height()+radius
        units(c).locy = 0-radius
    endif
    
    `Draw
    ink rgb(255,255,255)
    circle units(c).locx,units(c).locy,radius
    ink rgb(255,0,0)
    line units(c).locx,units(c).locy,units(c).locx+cos(units(c).ang)*15,units(c).locy+sin(units(c).ang)*15
next c

sync
loop


function dist(u1,u2)
remstart
temp = (screen width()-max(units(u1).locx,units(u2).locx))+(min(units(u2).locx,units(u2).locx))
if temp<screen width()/2
    distx=temp
    else
    distx=max(units(u1).locx,units(u2).locx) - min(units(u2).locx,units(u2).locx)
endif

temp = (screen height()-max(units(u1).locy,units(u2).locy))+(min(units(u2).locy,units(u2).locy))
if temp<screen height()/2
    disty=temp
    else
    disty=max(units(u1).locy,units(u2).locy) - min(units(u2).locy,units(u2).locy)
endif

dist = SQRT(distx*distx+disty*disty)
remend

dist = SQRT((units(u1).locx-units(u2).locx)^2 + (units(u1).locy-units(u2).locy)^2)
endfunction dist


`I hate atanfull
function pointsprite(x1,y1,x,y)

dx = x1 - x
dy = x1 - y
ang# = wrapvalue(atanfull(dx,dy)*-1)

endfunction ang#

`I hate atanfull
function pointsprite(x1,y1,x,y)

dx = x1 - x
dy = [u]x1[/u] - y
ang# = wrapvalue(atanfull(dx,dy)*-1)

endfunction ang#

`I hate atanfull
function pointsprite(x1,y1,x,y)

dx = x1 - x
dy = [b][u]y1[/u][/b] - y
ang# = wrapvalue(atanfull(dx,dy)*-1)

endfunction ang#

`================================================
`   Boids Simulation
`   Written by Kira Vakaan
`================================================

`Setup Environment
set display mode 1024,768,32,1
sync on
autocam off
hide mouse

`In a fit of rage at DBPro's vector and matrix command set, I wrote many of my own some time back.
`I've included only the one's I need for this project. 
type Vector
  x                     as float
  y                     as float
  z                     as float
  w                     as float
endtype
`Global vector used for returning
global v as Vector

`Constants for Boid behavior (all squared to avoid using sgrt())
#constant CohesionDistance      900   `Head towards Boids up to 30 units away
#constant AlignmentDistance     225   `Align with Boids up to 15 units away
#constant BoidCrowdingDistance  169   `Stay away from Boids up to 13 units away
#constant EnemyDistance         400   `Avoid enemies up to 20 units away
`Constant for Enemy behavior
#constant EnemyCrowdingDistance 256   `Stay away from Enemies up to 16 units away 

type Boid
  Object      as integer
  Position    as Vector
  Look        as Vector
  Speed#      as float
endtype

type Enemy
  Object      as integer
  Position    as Vector
  Look        as Vector
  Speed#      as float
  Radius#     as float
endtype

`Dynamic Arrays
global BoidCount=100
dim Boids(0) as Boid : empty array Boids(0)
global EnemyCount=10
dim Enemies(0) as Enemy : empty array Enemies(0)

`Setup Field Sphere
make object sphere 1000,-400
set object wireframe 1000,1
set object light 1000,0

`Setup Objects
SetupBoids()
SetupEnemies()

gosub SetupCamera

`Temporary variables used mainly to avoid excessive array access
TempB as Boid
TempE as Enemy
Temp as Vector

Paused=1
do
  `Print everything
  set cursor 0,0
  print "FPS: ";screen fps()
  print "Boids: ";BoidCount
  print "Enemies: ";EnemyCount
  print
  select Paused
    case 0 : print "Simulation Running" : endcase
    case 1 : print "Simulation Paused" : endcase
  endselect
  print
  print "Target Group: ";
  select TargetGroup
    case 0: print "None" : endcase
    case 1: print "Boids" : print "Target: ";CameraTarget+1 : endcase
    case 2: print "Enemies" : print "Target: ";CameraTarget+1 : endcase
  endselect
  print "Follow Distance: ";TargetFollowDist#
  print
  if TargetGroup>0
    print "Control Type: ";
    select ControlType
      case 0: print "Automatic" : endcase
      case 1: print "Manual" : endcase
    endselect
    if TargetGroup=1
      TempB=Boids(CameraTarget)
      print "Position: ( ";TempB.Position.x;" , ";TempB.Position.y;" , ";TempB.Position.z;" )"
      print "Look Vector: ( ";TempB.Look.x;" , ";TempB.Look.y;" , ";TempB.Look.z;" )"
      print "Speed: ";TempB.Speed#
    endif
    if TargetGroup=2
      TempE=Enemies(CameraTarget)
      print "Position: ( ";TempE.Position.x;" , ";TempE.Position.y;" , ";TempE.Position.z;" )"
      print "Look Vector: ( ";TempE.Look.x;" , ";TempE.Look.y;" , ";TempE.Look.z;" )"
      print "Speed: ";TempE.Speed#
    endif
    print
  endif
  if keystate(35)=0
    print "Hold 'H' to display control help"
  else
    print "Spacebar - Pause/Unpause Simulation"
    print "Mouse Movement - Move camera around target."
    print "Mouse Scroll Wheel - Change Follow Distance to Target"
    print "Up, Down - Cycle through Target Groups: None, Boids, Enemies"
    print "Right, Left - Cycle through members of current Target Group"
    print "Tab - Toggle between Automatic and Manual control of current Target"
    print "Manual Controls:"
    print "  W, S - Pitch Target"
    print "  A, D - Rotate Target"
    print "  Left Mouse Button - Increase Target speed"
    print "  Right Mouse Button - Decrease Target speed"
  endif
  
  `Toggle pause
  if spacekey()=1 and SpaceHold=0 then SpaceHold=1 : Paused=(Paused+1)%%2
  if spacekey()=0 and SpaceHold=1 then SpaceHold=0
  
  if not Paused
    gosub ControlBoids
    gosub ControlEnemies
  endif
  gosub ControlCamera
  
  sync
loop

end

SetupCamera:
  global TargetGroup=0
  global CameraTarget=0
  global ControlType=0
  TargetFollowDist#=150 : FollowDist#=150
  TargetXAng#=0 : TargetYAng#=0
  XAng#=0 : YAng#=0
  return
  
ControlBoids:
  for a=0 to BoidCount-1
    if TargetGroup=1 and CameraTarget=a and ControlType=1   `Manual control of the current Boid
      TempB=Boids(a)
      `Turn Boid
      if keystate(17) then pitch object down TempB.Object,2
      if keystate(31) then pitch object up TempB.Object,2
      if keystate(30) then turn object left TempB.Object,2
      if keystate(32) then turn object right TempB.Object,2
      `Get new look vector
      position object TempB.Object,0,0,0
      move object TempB.Object,1
      SetVec(object position x(TempB.Object),object position y(TempB.Object),object position z(TempB.Object),1)
      TempB.Look=v
      `Change speed
      if mouseclick()=1 then inc TempB.Speed#,0.01 : if TempB.Speed#>1.5 then TempB.Speed#=1.5
      if mouseclick()=2 then dec TempB.Speed#,0.01 : if TempB.Speed#<0.0 then TempB.Speed#=0.0
    else  `Automatic control
      `Apply Rules
      CohereToFlock(a)
      AlignWithFlock(a)
      AvoidBoidCrowding(a)
      MoveTowardsCenter(a)
      AvoidEnemies(a)
      TempB=Boids(a)
    endif
    OrientBoid(TempB)
    move object TempB.Object,TempB.Speed#
    `Store new position
    TempB.Position.x=object position x(TempB.Object)
    TempB.Position.y=object position y(TempB.Object)
    TempB.Position.z=object position z(TempB.Object)
    Boids(a)=TempB
  next a
  return
  
ControlEnemies:
  for a=0 to EnemyCount-1
    if TargetGroup=2 and CameraTarget=a and ControlType=1   `Manual
      TempE=Enemies(a)
      if keystate(17) then pitch object down TempE.Object,2
      if keystate(31) then pitch object up TempE.Object,2
      if keystate(30) then turn object left TempE.Object,2
      if keystate(32) then turn object right TempE.Object,2
      position object TempE.Object,0,0,0
      move object TempE.Object,1
      SetVec(object position x(TempE.Object),object position y(TempE.Object),object position z(TempE.Object),1)
      TempE.Look=v
      if mouseclick()=1 then inc TempE.Speed#,0.01 : if TempE.Speed#>1.5 then TempE.Speed#=1.5
      if mouseclick()=2 then dec TempE.Speed#,0.01 : if TempE.Speed#<0.0 then TempE.Speed#=0.0
    else    `Automatic
      `Apply Rules
      PickTarget(a)
      AvoidEnemyCrowding(a)
      TempE=Enemies(a)
    endif
    OrientEnemy(TempE)
    move object TempE.Object,TempE.Speed#
    TempE.Position.x=object position x(TempE.Object)
    TempE.Position.y=object position y(TempE.Object)
    TempE.Position.z=object position z(TempE.Object)
    Enemies(a)=TempE
  next a
  return

ControlCamera:  
  select TargetGroup
    `None
    case 0: SetVec(0,0,0,1) : Temp=v : endcase  `Focus around the world's center
    `Boids
    case 1
      if BoidCount>0
        `if Camera's target no longer exists, take the last available
        if CameraTarget>BoidCount-1 then CameraTarget=BoidCount-1 : ControlType=0
        Temp=Boids(CameraTarget).Position
      else
        `No more Boids
        TargetGroup=0 : gosub ChangeTargetGroup
      endif
    endcase
    `Enemies
    case 2: Temp=Enemies(CameraTarget).Position : endcase
  endselect
  
  FollowDist#=curvevalue(TargetFollowDist#,FollowDist#,10)
  XAng#=curveangle(TargetXAng#,XAng#,10)
  YAng#=curveangle(TargetYAng#,YAng#,10)
  
  position camera 0,Temp.x,Temp.y,Temp.z
  rotate camera 0,XAng#,YAng#,0
  move camera 0,-FollowDist#
  inc TargetXAng#,mousemovey()  `Rotate camera around
  inc TargetYAng#,mousemovex()  `-
  dec TargetFollowDist#,mousemovez()/20.0   `Scroll wheel zooms
  
  if upkey()=1 and UpHold=0
    UpHold=1
    TargetGroup=(TargetGroup+1)%%3
    if TargetGroup=1 and BoidCount=0 then TargetGroup=2   `If there aren't any Boids, change group to Enemies
    if TargetGroup=2 and EnemyCount=0 then TargetGroup=0  `If there aren't any Enemies, change group to None
    gosub ChangeTargetGroup
  endif
  if upkey()=0 and UpHold=1 then UpHold=0
  if downkey()=1 and DownHold=0
    DownHold=1
    dec TargetGroup
    if TargetGroup<0 then TargetGroup=2
    if TargetGroup=1 and BoidCount=0 then TargetGroup=2
    if TargetGroup=2 and EnemyCount=0 then TargetGroup=0
    gosub ChangeTargetGroup
  endif
  if downkey()=0 and DownHold=1 then DownHold=0
  
  `Cycle through members of current group
  if rightkey()=1 and RightHold=0 then RightHold=1 : gosub ChangeTarget
  if rightkey()=0 and RightHold=1 then RightHold=0
  if leftkey()=1 and LeftHold=0 then LeftHold=1 : gosub ChangeTarget
  if leftkey()=0 and LeftHold=1 then LeftHold=0
  
  if TargetGroup>0  `If group is not None,
    if keystate(15)=1 and TabHold=0 then TabHold=1 : ControlType=(ControlType+1)%%2   `Toggle ControlType
    if keystate(15)=0 and TabHold=1 then TabHold=0
  endif
  return
  
ChangeTargetGroup:  `Set default following distances
  CameraTarget=0 : ControlType=0
  select TargetGroup
    case 0: TargetFollowDist#=150 : endcase
    case 1: TargetFollowDist#=30 : endcase
    case 2: TargetFollowDist#=50 : endcase
  endselect
  return
  
ChangeTarget:
  if RightHold
    select TargetGroup
      case 1: if BoidCount>0 : ControlType=0 : CameraTarget=(CameraTarget+1)%%BoidCount : endif : endcase
      case 2: if EnemyCount>0 : ControlType=0 : CameraTarget=(CameraTarget+1)%%EnemyCount : endif : endcase
    endselect
  endif
  if LeftHold
    select TargetGroup
      case 1: if BoidCount>0 : ControlType=0 : dec CameraTarget : if CameraTarget<0 : CameraTarget=BoidCount-1 : endif : endif : endcase
      case 2: if EnemyCount>0 : ControlType=0 : dec CameraTarget : if CameraTarget<0 : CameraTarget=EnemyCount-1 : endif : endif : endcase
    endselect
  endif
  return

function CohereToFlock(obj)
  Look as Vector
  Current as Boid
  Current=Boids(obj)
  Count=0
  for a=0 to BoidCount-1
    if a<>obj `Skip current Boid
      v=Boids(a).Position
      SubtractVec(v,Current.Position)  `Get difference in position
      Distance#=SqrLengthVec(v)        `Get distance^2
      if Distance#<CohesionDistance    `If within the range, add it to the new Look vector
        AddVec(v,Look) : Look=v
        inc Count
      endif
    endif
  next a
  if Count  `If there were any Boids in range,
    NormalizeVec(Look)
    CurveVec(v,Current.Look,40) : NormalizeVec(v)   `Blend current Look vector with the new one
    Boids(obj).Look=v
  endif
endfunction

function AlignWithFlock(obj)  `Average Look vectors and speeds of near-by Boids
  Look as Vector
  Speed# as float
  Current as Boid
  Current=Boids(obj)
  Count=0
  for a=0 to BoidCount-1
    if a<>obj
      v=Boids(a).Position
      SubtractVec(v,Current.Position)
      Distance#=SqrLengthVec(v)
      if Distance#<AlignmentDistance
        v=Boids(a).Look
        AddVec(v,Look) : Look=v
        inc Speed#,Boids(a).Speed#
        inc Count
      endif
    endif
  next a
  if Count
    NormalizeVec(Look)
    Speed#=Speed#/Count
    CurveVec(v,Current.Look,30) : NormalizeVec(v) : Current.Look=v
    Current.Speed#=curvevalue(Speed#,Current.Speed#,30)
    Boids(obj)=Current
  endif
endfunction

function AvoidBoidCrowding(obj)   `Point current Boid away from close crowds of Boids, taking into account distance to neighbors
  Look as Vector
  Current as Boid
  Current=Boids(obj)
  Count=0
  for a=0 to BoidCount-1
    if a<>obj
      v=Boids(a).Position
      SubtractVec(Current.Position,v)
      Distance#=SqrLengthVec(v)
      if Distance#<BoidCrowdingDistance
        ScaleVec(v,(BoidCrowdingDistance-Distance#)/BoidCrowdingDistance)
        AddVec(v,Look) : Look=v
        inc Count
      endif
    endif
  next a
  if Count
    NormalizeVec(Look)
    CurveVec(v,Current.Look,20) : NormalizeVec(v) 
    Boids(obj).Look=v
  endif
endfunction

function MoveTowardsCenter(obj)   `Lightly encourage Boid to stay somewhere around the field
  Current as Boid
  Current=Boids(obj)
  Distance#=SqrLengthVec(Current.Position)
  ScaleVec(Current.Position,-1.0)
  NormalizeVec(v)
  CurveVec(v,Current.Look,80) : NormalizeVec(v)
  Boids(obj).Look=v
endfunction

function AvoidEnemies(obj)     `Average escape vectors from close-by enemies
  Look as Vector
  Current as Boid
  Current=Boids(obj)
  Count=0
  for a=0 to EnemyCount-1
    v=Enemies(a).Position
    SubtractVec(v,Current.Position)   `Get difference in position between Boid and Enemy
    Distance#=SqrLengthVec(v)         `Get distance^2
    if Distance#<EnemyDistance        `Enemy's in range
      CrossVec(v,Current.Look)        `Cross multiply vector containing the difference in positions with the Boid's Look vector to get the Right vector
      CrossVec(v,Current.Look)        `Cross mulitply the Right vector with the Boid's Look vector to get it's Up Vector, a good escape route.
      NormalizeVec(v)                 `Normalize the new escape vector
      ScaleVec(v,(EnemyDistance-Distance#)/EnemyDistance)   `Factor in the "urgency" due to the proximity of the enemy
      AddVec(v,Look) : Look=v         `Add it to the new Look vector
      inc Count
    endif
  next a
  if Count  `If any enemies were in range,
    NormalizeVec(Look)
    CurveVec(v,Current.Look,15) : NormalizeVec(v)
    Boids(obj).Look=v
  endif
endfunction

function PickTarget(obj)    `Go after the closest Boid
  Look as Vector
  Current as Enemy
  Current=Enemies(obj)
  ShortestDistance#=1000000
  for a=0 to BoidCount-1
    v=Boids(a).Position
    SubtractVec(v,Current.Position)
    Distance#=SqrLengthVec(v)
    if Distance#<ShortestDistance#
      if Distance#<(Current.Radius#*Current.Radius#)  `The enemy has hit a Boid.  Destroy the Boid.
        delete object Boids(a).Object
        array delete element Boids(0),a
        if TargetGroup=1 and CameraTarget=a then ControlType=0  `If the dead Boid was being controlled by the user, set control to automatic for the next
        dec BoidCount
        dec a
      else
        ShortestDistance#=Distance#
        Look=v
      endif
    endif
  next a
  if BoidCount>0
    NormalizeVec(Look)
    CurveVec(v,Current.Look,10) : NormalizeVec(v)
    Enemies(obj).Look=v
  endif
endfunction

function AvoidEnemyCrowding(obj)    `Works just like the Boid version of this function
  Look as Vector
  Current as Enemy
  Current=Enemies(obj)
  Count=0
  for a=0 to EnemyCount-1
    if a<>obj
      v=Enemies(a).Position
      SubtractVec(Current.Position,v)
      Distance#=SqrLengthVec(v)
      if Distance#<EnemyCrowdingDistance
        ScaleVec(v,(EnemyCrowdingDistance-Distance#)/EnemyCrowdingDistance)
        AddVec(v,Look) : Look=v
        inc Count
      endif
    endif
  next a
  if Count
    NormalizeVec(Look)
    CurveVec(v,Current.Look,20) : NormalizeVec(v) 
    Enemies(obj).Look=v
  endif
endfunction

function SetupBoids()   `Initialize Boids
  `randomize 0
  Temp as Boid
  CreateBoidObject()    `Manually create object 1, containing the Boid mesh
  for a=0 to BoidCount-1
    array insert at bottom Boids(0)
    instance object a+2,1   `Copy the Boid mesh
    Temp.Object=a+2
    v.x=rnd(100)-50
    v.y=rnd(100)-50
    v.z=rnd(100)-50
    Temp.Position=v   `Randomize position
    v.x=rnd(1000)-500
    v.y=rnd(1000)-500
    v.z=rnd(1000)-500
    NormalizeVec(v) : Temp.Look=v   `Randomize the Look vector
    Temp.Speed#=0.5+rnd(5)/10.0
    OrientBoid(Temp)    `Place Boid in its initial position
    Boids(a)=Temp
  next a
endfunction

function SetupEnemies()   `Essentially do everything the Boid version does, but sets up a Radius# for collision detection
  Temp as Enemy
  for a=0 to EnemyCount-1
    array insert at bottom Enemies(0)
    Temp.Object=BoidCount+2+a
    Temp.Radius#=8.0
    make object sphere Temp.Object,2*Temp.Radius#,6,6
    v.x=rnd(100)-50
    v.y=rnd(100)-50
    v.z=rnd(100)-50
    Temp.Position=v
    v.x=rnd(1000)-500
    v.y=rnd(1000)-500
    v.z=rnd(1000)-500
    NormalizeVec(v) : Temp.Look=v
    Temp.Speed#=0.3+rnd(3)/10.0
    OrientEnemy(Temp)
    Enemies(a)=Temp
  next a
endfunction

`The next two functions place an object in space and orient it according to its Look vector
function OrientBoid(obj as Boid)
  position object obj.Object,obj.Position.x,obj.Position.y,obj.Position.z
  point object obj.Object,obj.Position.x+obj.Look.x,obj.Position.y+obj.Look.y,obj.Position.z+obj.Look.z
endfunction

function OrientEnemy(obj as Enemy)
  position object obj.Object,obj.Position.x,obj.Position.y,obj.Position.z
  point object obj.Object,obj.Position.x+obj.Look.x,obj.Position.y+obj.Look.y,obj.Position.z+obj.Look.z
endfunction

function AddVertex(Memblock,Vertex,x as float,y as float,z as float)  `Adds a vertex to a memblock mesh
  Position=12+Vertex*32
  `Position
  write memblock float Memblock,Position+4*0,x
  write memblock float Memblock,Position+4*1,y
  write memblock float Memblock,Position+4*2,z
  `Normal (We'll calculate all of these later)
  write memblock float Memblock,Position+4*3,0.0
  write memblock float Memblock,Position+4*4,0.0
  write memblock float Memblock,Position+4*5,0.0
  `UV (Unnecessary, so just set to 0.0) 
  write memblock float Memblock,Position+4*6,0.0
  write memblock float Memblock,Position+4*7,0.0
endfunction

function CalculateNormals(Memblock) `Go through an entire memblock mesh, adding in the normals
  VertexCount=memblock dword(Memblock,8)
  FaceCount=VertexCount/3
  Edge1 as Vector
  Edge2 as Vector
  for Face=0 to FaceCount-1
    FaceStart=12+32*(3*Face)
    `Basically, for each set of three vertices, cross multiply the edges together to get the normal
    SetVec(memblock float(Memblock,FaceStart+0*32+0),memblock float(Memblock,FaceStart+0*32+4),memblock float(Memblock,FaceStart+0*32+8),1) : Edge1=v
    SetVec(memblock float(Memblock,FaceStart+1*32+0),memblock float(Memblock,FaceStart+1*32+4),memblock float(Memblock,FaceStart+1*32+8),1) : Edge2=v
    SubtractVec(Edge2,Edge1) : Edge1=v
    SetVec(memblock float(Memblock,FaceStart+2*32+0),memblock float(Memblock,FaceStart+2*32+4),memblock float(Memblock,FaceStart+2*32+8),1)
    SubtractVec(v,Edge2) : Edge2=v
    NormalizeVec(Edge1) : Edge1=v
    NormalizeVec(Edge2) : Edge2=v
    CrossVec(Edge1,Edge2)
    for Vertex=0 to 2
      write memblock float Memblock,FaceStart+Vertex*32+12,v.x
      write memblock float Memblock,FaceStart+Vertex*32+16,v.y
      write memblock float Memblock,FaceStart+Vertex*32+20,v.z
    next Vertex
  next Face
endfunction

function CreateBoidObject()   `Setup the Boid mesh to be used by the Boid objects
  if memblock exist(1) then delete memblock 1
  if mesh exist(1) then delete mesh 1
  if object exist(1) then delete object 1
  make memblock 1,12+32*24
  write memblock dword 1,0,274
  write memblock dword 1,4,32
  write memblock dword 1,8,24
  AddVertex(1,0,0,0,3) : AddVertex(1,1,2,0,0) : AddVertex(1,2,0,1,0)
  AddVertex(1,3,0,0,3) : AddVertex(1,4,0,1,0) : AddVertex(1,5,-2,0,0)
  AddVertex(1,6,0,0,3) : AddVertex(1,7,0,-1,0) : AddVertex(1,8,2,0,0)
  AddVertex(1,9,0,0,3) : AddVertex(1,10,-2,0,0) : AddVertex(1,11,0,-1,0)
  AddVertex(1,12,0,1,0) : AddVertex(1,13,2,0,0) : AddVertex(1,14,0,0,-0.5)
  AddVertex(1,15,0,1,0) : AddVertex(1,16,0,0,-0.5) : AddVertex(1,17,-2,0,0)
  AddVertex(1,18,0,0,-0.5) : AddVertex(1,19,2,0,0) : AddVertex(1,20,0,-1,0)
  AddVertex(1,21,0,0,-0.5) : AddVertex(1,22,0,-1,0) :AddVertex(1,23,-2,0,0)
  CalculateNormals(1)
  make mesh from memblock 1,1
  make object 1,1,0
  hide object 1
endfunction

`A few necessary commands to use my system of vectors
`v is a global return vector because DBPro can't return UDTs from functions
function SetVec(x as float,y as float,z as float,w as float)
  v.x=x : v.y=y : v.z=z : v.w=w
endfunction

function AddVec(vec1 as Vector,vec2 as Vector)
  v.x=vec1.x+vec2.x
  v.y=vec1.y+vec2.y
  v.z=vec1.z+vec2.z
  v.w=1.0
endfunction

function SubtractVec(vec1 as Vector,vec2 as Vector)
  v.x=vec1.x-vec2.x
  v.y=vec1.y-vec2.y
  v.z=vec1.z-vec2.z
  v.w=1.0
endfunction

function ScaleVec(vec as Vector,scale as float)
  v.x=vec.x*scale
  v.y=vec.y*scale
  v.z=vec.z*scale
  v.w=1.0
endfunction

function CrossVec(vec1 as Vector,vec2 as Vector)
  v.x=vec1.y*vec2.z-vec1.z*vec2.y
  v.y=vec1.z*vec2.x-vec1.x*vec2.z
  v.z=vec1.x*vec2.y-vec1.y*vec2.x
  v.w=1.0
endfunction

function NormalizeVec(vec as Vector)
  Length#=sqrt(vec.x*vec.x+vec.y*vec.y+vec.z*vec.z)
  v.x=vec.x/Length#
  v.y=vec.y/Length#
  v.z=vec.z/Length#
  v.w=1.0
endfunction

function SqrLengthVec(vec as Vector)
  Length#=vec.x*vec.x+vec.y*vec.y+vec.z*vec.z
endfunction Length#

function CurveVec(dest as Vector,cur as Vector,speed as float)
  v.x=curvevalue(dest.x,cur.x,speed)
  v.y=curvevalue(dest.y,cur.y,speed)
  v.z=curvevalue(dest.z,cur.z,speed)
  v.w=1.0
endfunction

sync on : sync rate 60
randomize timer()

type unittype
    locx as float
    locy as float
    ang as float
endtype

`Dummy Sprite
get image 1,0,0,2,2
sprite 1,0,0,1
hide sprite 1

DIM units(100) as unittype
DIM predators(3) as unittype

`Constants
effectdist = 20
rand = 200
radius = 5
vel = 3

pradius = 20
pvel = 2
peffectdist = 40

`Prepare units with random values
for c=1 to array count(units(0))
    units(c).locx = rnd(screen width())
    units(c).locy = rnd(screen height())
    units(c).ang  = rnd(360)
next c

`Ditto for predators
for c=1 to array count(predators(0))
    predators(c).locx = rnd(screen width())
    predators(c).locy = rnd(screen height())
    predators(c).ang  = rnd(360)
next c


do
cls

for c=1 to array count(predators(0))
    `Predators move randomly for now
    inc predators(c).ang,(rnd(rand)-rand/2)/10
    inc predators(c).locx,cos(predators(c).ang)*pvel
    inc predators(c).locy,sin(predators(c).ang)*pvel

    `Wrap around if off the screen
    if predators(c).locx<0-pradius
        predators(c).locx = screen width()+pradius
    endif
    if predators(c).locy<0-pradius
        predators(c).locy = screen height()+pradius
    endif
    if predators(c).locx>screen width()+pradius
        predators(c).locx = 0-pradius
    endif
    if predators(c).locy>screen height()+pradius
        predators(c).locy = 0-pradius
    endif    

    ink rgb(255,255,255),0
    circle predators(c).locx,predators(c).locy,pradius
next c

for c=1 to array count(units(0))
    angtot#=0
    angqty =0
    override#=0
    
    `This averages the angles of all the units within the effectdist from the current one, and gives it that angle
    for d=1 to array count(units(0))
        temp=abs(dist(c,d))
        if temp<effectdist
            inc angtot#,units(d).ang
            inc angqty,1
        endif
        
        `Push away from collisions
        if temp<=radius
            override#=wrapvalue(pointsprite(units(c).locx,units(c).locy,units(d).locx,units(d).locy)+0)
        endif
    next d
    
    `Pushing away from predators is top priority
    for d=1 to array count(predators(0))
        temp=abs(dist(c,d))
        if temp<peffectdist
            override#=wrapvalue(pointsprite(units(c).locx,units(c).locy,predators(d).locx,predators(d).locy)+180)
        endif
    next d
    
    if override>0
        units(c).ang=override#
        else
        units(c).ang=angtot#/angqty + (rnd(rand)-rand/2)/10
    endif
    
    `Adjust location based on velocities
    inc units(c).locx,cos(units(c).ang)*vel
    inc units(c).locy,sin(units(c).ang)*vel
    
    `Wrap around if off the screen
    if units(c).locx<0-radius
        units(c).locx = screen width()+radius
    endif
    if units(c).locy<0-radius
        units(c).locy = screen height()+radius
    endif
    if units(c).locx>screen width()+radius
        units(c).locx = 0-radius
    endif
    if units(c).locy>screen height()+radius
        units(c).locy = 0-radius
    endif
    
    `Draw
    ink rgb(255,255,255),0
    circle units(c).locx,units(c).locy,radius
    ink rgb(255,0,0),0
    line units(c).locx,units(c).locy,units(c).locx+cos(units(c).ang)*15,units(c).locy+sin(units(c).ang)*15
next c

sync
loop


function dist(u1,u2)
remstart
temp = (screen width()-max(units(u1).locx,units(u2).locx))+(min(units(u2).locx,units(u2).locx))
if temp<screen width()/2
    distx=temp
    else
    distx=max(units(u1).locx,units(u2).locx) - min(units(u2).locx,units(u2).locx)
endif

temp = (screen height()-max(units(u1).locy,units(u2).locy))+(min(units(u2).locy,units(u2).locy))
if temp<screen height()/2
    disty=temp
    else
    disty=max(units(u1).locy,units(u2).locy) - min(units(u2).locy,units(u2).locy)
endif

dist = SQRT(distx*distx+disty*disty)
remend

dist = int((SQRT((units(u1).locx-units(u2).locx)^2 + (units(u1).locy-units(u2).locy)^2)))
endfunction dist


`I hate atanfull
function pointsprite(x1#,y1#,x2#,y2#)

dx# = x1# - x2#
dy# = y2# - y1#
ang# = wrapvalue(atanfull(dx#,dy#))

endfunction ang#

sync on

autocam off

fog on
fog color 0xFF000066
fog distance 20.0
color backdrop 0xFF000066

type vec3
    x as float
    y as float
    z as float
endtype

type fish_type
    id as integer
    time as float
    direction as vec3
    speed as float
    position as vec3
endtype

global fish_mesh_id
global fish_image_id
global dim fish_vertex_x(-1) as float
global dim fish(40) as fish_type

init_fish()

for i = 0 to 40
    fish(i).id = make_fish()
    fish(i).position.x = rnd(10)-5
    fish(i).position.y = rnd(10)-5
    fish(i).position.z = rnd(10)-5
    fish(i).direction.x = rnd(10)-5
    fish(i).direction.y = rnd(10)-5
    fish(i).direction.z = rnd(10)-5
    fish(i).speed = rnd(10)*0.02+0.01
    position object fish(i).id,fish(i).position.x,fish(i).position.y,fish(i).position.z
next i


do
    inc cam_rx#,mousemovey()*0.5
    cam_ry# = wrapvalue(cam_ry# + mousemovex()*0.5)
    
    
    for i = 0 to 40
        for j = 0 to 40
            if j <> i
                dx# = fish(j).position.x - fish(i).position.x
                if dx#*dx# < 20.0
                    dy# = fish(j).position.y - fish(i).position.y
                    if dy#*dy# < 20.0
                        dz# = fish(j).position.z - fish(i).position.z
                        distsq# = dx#*dx#+dy#*dy#+dz#*dz#
                        rdistsq# = 1.0/distsq#
                        inc near_fish_count
                        inc fish(i).direction.x,fish(j).direction.x*0.001*rdistsq#
                        inc fish(i).direction.y,fish(j).direction.y*0.001*rdistsq#
                        inc fish(i).direction.z,fish(j).direction.z*0.001*rdistsq#
                        inc fish(i).speed,(fish(j).speed-fish(i).speed)*0.001*rdistsq#
                        
                        if dx#*dx# < 4.0
                            inc fish(i).direction.x,0.001/dx#
                        else
                            dec fish(i).direction.x,0.001/dx#
                        endif
                        if dy#*dy# < 4.0
                            inc fish(i).direction.y,0.001/dy#
                        else
                            dec fish(i).direction.y,0.001/dy#
                        endif
                        if dz#*dz# < 4.0
                            inc fish(i).direction.z,0.001/dz#
                        else
                            dec fish(i).direction.z,0.001/dz#
                        endif
                    endif
                endif
            endif
        next j
        
        dird# = 1.0/dist(fish(i).direction.x,fish(i).direction.y,fish(i).direction.z)
        fish(i).direction.x = fish(i).direction.x*dird#
        fish(i).direction.y = fish(i).direction.y*dird#
        fish(i).direction.z = fish(i).direction.z*dird#
        
        speed# = fish(i).speed
        inc fish(i).position.x,fish(i).direction.x*speed#
        inc fish(i).position.y,fish(i).direction.y*speed#
        inc fish(i).position.z,fish(i).direction.z*speed#
        
        position object fish(i).id,0.0,0.0,0.0
        point object fish(i).id,-fish(i).direction.x,-fish(i).direction.y,-fish(i).direction.z
        position object fish(i).id,fish(i).position.x,fish(i).position.y,fish(i).position.z

        inc fish(i).time,fish(i).speed*100.0
        swim_fish(fish(i).id,fish(i).time)
    next i
    
    position camera 0,0,0
    rotate camera cam_rx#,cam_ry#,0
    move camera -5
    sync
loop

function dist(x#,y#,z#)
    set vector3 1,x#,y#,z#
    d# = length vector3(1)
endfunction d#

function make_fish()
    id = find_free_object()
    make object id,fish_mesh_id,fish_image_id
endfunction id

function swim_fish(id,time#)
    lock vertexdata for limb id,0
    
    vertex_count = get vertexdata vertex count()
    
    for i = 0 to vertex_count
        x# = get vertexdata position x(i)
        y# = get vertexdata position y(i)
        z# = get vertexdata position z(i)
        x# = fish_vertex_x(i) + sin(time#-z#*90.0)*(z#+0.8)*(z#+0.8)*0.12
        set vertexdata position i,x#,y#,z#
    next i
    
    unlock vertexdata
    
endfunction

function init_fish()
    null = make vector3(1)
    
    id = find_free_object()
    fish_mesh_id = find_free_mesh()
    fish_image_id = find_free_image()
    make object sphere id,1,10,10
    
    lock vertexdata for limb id,0
    
    a# = 0.112
    b# = -0.32
    c# = 0.24
    
    vertex_count = get vertexdata vertex count()
    global dim fish_vertex_x(vertex_count) as float
    for i = 0 to vertex_count
        x# = get vertexdata position x(i)
        y# = get vertexdata position y(i)
        z# = get vertexdata position z(i)
        v# = (z#+0.5)*1.8
        y# = (a#*v#^3 + b#*v#^2 + c#*v#)*get_sgn(y#)*sin(acos(x#*2.0))*5.0
        set vertexdata position i,x#*0.2,y#,z#*2.5
        set vertexdata uv i,z#*80.0,y#*10.0
        fish_vertex_x(i) = x#*0.2
    next i
    
    unlock vertexdata
    
    set object normals id
    
    make mesh from object fish_mesh_id,id
    delete object id
    
    ink 0xFF888888,0
    box 0,0,16,32
    ink 0xFFFFFFFF,0
    filled_ellipse(0,16,7,14)
    filled_ellipse(16,16,7,14)
    filled_ellipse(8,0,7,14)
    filled_ellipse(8,32,7,14)
    get image fish_image_id,0,0,16,32,1
endfunction

function filled_ellipse(x,y,rx,ry)
    ry = ry/2
    rx# = rx
    ry# = ry
    for ny = 0 to ry
        ny# = ny
        nx = sin(acos(ny#/ry#))*rx
        line x-nx,y-ny,x+nx,y-ny
        line x-nx,y+ny,x+nx,y+ny
    next ny
endfunction

function get_sgn(v#)
    v# = (v# > 0.0) - (v# < 0.0)
endfunction v#

function find_free_object()
    id = rnd(256)+1
    while object exist(id)
        inc id
    endwhile
endfunction id

function find_free_mesh()
    id = rnd(32)+1
    while mesh exist(id)
        inc id
    endwhile
endfunction id

function find_free_image()
    id = rnd(256)+1
    while image exist(id)
        inc id
    endwhile
endfunction id