Sorry your browser is not supported!

sync on

autocam off

fog on
fog color 0xFF001144
fog distance 60.0
color backdrop 0xFF001144

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
global dim predator(4) 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
    set object diffuse fish(i).id,0xFF00FF00
    set object emissive fish(i).id,0xFF115511
next i

for i = 0 to 4
    predator(i).id = make_fish()
    predator(i).position.x = rnd(20)-10
    predator(i).position.y = rnd(20)-10
    predator(i).position.z = rnd(20)-10
    predator(i).direction.x = rnd(10)-5
    predator(i).direction.y = rnd(10)-5
    predator(i).direction.z = rnd(10)-5
    predator(i).speed = rnd(10)*0.005+0.005
    position object predator(i).id,predator(i).position.x,predator(i).position.y,predator(i).position.z
    set object diffuse predator(i).id,0xFFFF0000
    set object emissive predator(i).id,0xFF551111
    scale object predator(i).id,500,300,100
next i

set ambient light 0
set directional light 0,0,-1,0
color light 0,255,255,200

do
    inc cam_rx#,mousemovey()*0.5
    cam_ry# = wrapvalue(cam_ry# + mousemovex()*0.5)
    
    for i = 0 to 4
        px# = predator(i).position.x
        py# = predator(i).position.y
        pz# = predator(i).position.z
        distsq2# = px#*px# + py#*py# + pz#*pz#
        dec predator(i).direction.x,distsq2#*0.000001*predator(i).position.x
        dec predator(i).direction.y,distsq2#*0.000001*predator(i).position.y
        dec predator(i).direction.z,distsq2#*0.000001*predator(i).position.z

        dird# = 1.0/dist(predator(i).direction.x,predator(i).direction.y,predator(i).direction.z)
        predator(i).direction.x = predator(i).direction.x*dird#
        predator(i).direction.y = predator(i).direction.y*dird#
        predator(i).direction.z = predator(i).direction.z*dird#

        inc predator(i).position.x,predator(i).direction.x*predator(i).speed
        inc predator(i).position.y,predator(i).direction.y*predator(i).speed
        inc predator(i).position.z,predator(i).direction.z*predator(i).speed
        
        position object predator(i).id,0.0,0.0,0.0
        point object predator(i).id,-predator(i).direction.x,-predator(i).direction.y,-predator(i).direction.z
        position object predator(i).id,predator(i).position.x,predator(i).position.y,predator(i).position.z

        inc predator(i).time,predator(i).speed*200.0
        swim_fish(predator(i).id,predator(i).time)
    next i
    
    for i = 0 to 40
        dirx# = 0.0
        diry# = 0.0
        dirz# = 0.0
        speed# = 0.0
        speed_n# = 0.0
        avgx# = 0.0
        avgy# = 0.0
        avgz# = 0.0
        avg_n# = 0.0
        for j = 0 to 40
            if j <> i
                dx# = fish(j).position.x - fish(i).position.x
                if dx#*dx# < 50.0
                    dy# = fish(j).position.y - fish(i).position.y
                    if dy#*dy# < 50.0
                        dz# = fish(j).position.z - fish(i).position.z
                        distsq# = dx#*dx#+dy#*dy#+dz#*dz#
                        if distsq < 30.0
                            inc avgx#,dx#
                            inc avgy#,dy#
                            inc avgz#,dz#
                            inc avg_n#
                        endif
                        rdistsq# = 1.0/distsq#
                        inc near_fish_count
                        inc dirx#,fish(j).direction.x*20.0*rdistsq#
                        inc diry#,fish(j).direction.y*20.0*rdistsq#
                        inc dirz#,fish(j).direction.z*20.0*rdistsq#
                        inc speed#,fish(j).speed*rdistsq#
                        inc speed_n#,rdistsq#
                        `remstart
                        if dx#*dx# > 16.0
                            inc dirx#,10.0/dx#
                        else
                            dec dirx#,1.0/dx#
                        endif
                        if dy#*dy# > 16.0
                            inc diry#,10.0/dy#
                        else
                            dec diry#,1.0/dy#
                        endif
                        if dz#*dz# > 16.0
                            inc dirz#,10.0/dz#
                        else
                            dec dirz#,1.0/dz#
                        endif
                        `remend
                    endif
                endif
            endif
        next j
        
        px# = fish(i).position.x
        py# = fish(i).position.y
        pz# = fish(i).position.z
        distsq2# = px#*px# + py#*py# + pz#*pz#
        dec dirx#,distsq2#*0.005*fish(i).position.x
        dec diry#,distsq2#*0.005*fish(i).position.y
        dec dirz#,distsq2#*0.005*fish(i).position.z
        
        if avg_n# > 0.0
            inc dirx#,avgx#*5.0/avg_n#
            inc diry#,avgy#*5.0/avg_n#
            inc dirz#,avgz#*5.0/avg_n#
        endif
        
        dird# = 0.02/dist(dirx#,diry#,dirz#)
        inc fish(i).direction.x,dirx#*dird#
        inc fish(i).direction.y,diry#*dird#
        inc fish(i).direction.z,dirz#*dird#
        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#
        
        if speed_n# > 0.0 
            speed# = speed#/speed_n#
            inc fish(i).speed,(speed#-fish(i).speed)*0.01
        endif
        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

sync on

#constant FISH_COUNT 40
#constant PREDATOR_COUNT 10
#constant CLOUD_COUNT 50

autocam off

fog on
fog color 0xFF001144
fog distance 30.0
color backdrop 0xFF001144

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

type cloud_type
    id as integer
    position as vec3
endtype

global fish_mesh_id
global fish_image_id
global cloud_image_id
global backdrop_image_id
global backdrop_object_id
global dim fish_vertex_x(-1) as float
global dim fish(FISH_COUNT) as fish_type
global dim predator(PREDATOR_COUNT) as fish_type
global dim clouds(CLOUD_COUNT) as cloud_type

init_backdrop()
init_clouds()
init_fish()

for i = 0 to FISH_COUNT
    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
    set object diffuse fish(i).id,0xFF00FF00
    set object emissive fish(i).id,0xFF115511
next i

for i = 0 to PREDATOR_COUNT
    predator(i).id = make_fish()
    predator(i).position.x = rnd(20)-10
    predator(i).position.y = rnd(20)-10
    predator(i).position.z = rnd(20)-10
    predator(i).direction.x = rnd(10)-5
    predator(i).direction.y = rnd(10)-5
    predator(i).direction.z = rnd(10)-5
    predator(i).speed = rnd(10)*0.01+0.01
    position object predator(i).id,predator(i).position.x,predator(i).position.y,predator(i).position.z
    set object diffuse predator(i).id,0xFFFF0000
    set object emissive predator(i).id,0xFF551111
    scale object predator(i).id,500,300,100
next i

set ambient light 0
set directional light 0,0,-1,0
color light 0,255,255,200

position camera 0,0,0

do
    inc cam_rx#,mousemovey()*0.5
    cam_ry# = wrapvalue(cam_ry# + mousemovex()*0.5)
    
    for i = 0 to PREDATOR_COUNT
        px# = predator(i).position.x
        py# = predator(i).position.y
        pz# = predator(i).position.z
        distsq2# = px#*px# + py#*py# + pz#*pz#
        dec predator(i).direction.x,distsq2#*0.000001*predator(i).position.x
        dec predator(i).direction.y,distsq2#*0.000001*predator(i).position.y
        dec predator(i).direction.z,distsq2#*0.000001*predator(i).position.z

        dird# = 1.0/dist(predator(i).direction.x,predator(i).direction.y,predator(i).direction.z)
        predator(i).direction.x = predator(i).direction.x*dird#
        predator(i).direction.y = predator(i).direction.y*dird#
        predator(i).direction.z = predator(i).direction.z*dird#

        inc predator(i).position.x,predator(i).direction.x*predator(i).speed
        inc predator(i).position.y,predator(i).direction.y*predator(i).speed
        inc predator(i).position.z,predator(i).direction.z*predator(i).speed
        
        position object predator(i).id,0.0,0.0,0.0
        point object predator(i).id,-predator(i).direction.x,-predator(i).direction.y,-predator(i).direction.z
        position object predator(i).id,predator(i).position.x,predator(i).position.y,predator(i).position.z

        inc predator(i).time,predator(i).speed*100.0
        swim_fish(predator(i).id,predator(i).time)
    next i
    
    for i = 0 to FISH_COUNT
        dirx# = 0.0
        diry# = 0.0
        dirz# = 0.0
        speed# = 0.0
        speed_n# = 0.0
        avgx# = 0.0
        avgy# = 0.0
        avgz# = 0.0
        avg_n# = 0.0
        for j = 0 to PREDATOR_COUNT
            dx# = predator(j).position.x - fish(i).position.x
            if dx#*dx# < 25.0
                dy# = predator(j).position.y - fish(i).position.y
                if dy#*dy# < 25.0
                    dz# = predator(j).position.z - fish(i).position.z
                    distsq# = dx#*dx#+dy#*dy#+dz#*dz#
                    rdistsq# = 400.0/distsq#
                    if distsq < 25.0
                        dec dirx#,dx#*rdistsq#
                        dec diry#,dy#*rdistsq#
                        dec dirz#,dz#*rdistsq#
                    endif
                endif
            endif
        next j
        for j = 0 to FISH_COUNT
            if j <> i
                dx# = fish(j).position.x - fish(i).position.x
                if dx#*dx# < 50.0
                    dy# = fish(j).position.y - fish(i).position.y
                    if dy#*dy# < 50.0
                        dz# = fish(j).position.z - fish(i).position.z
                        distsq# = dx#*dx#+dy#*dy#+dz#*dz#
                        if distsq < 30.0
                            inc avgx#,dx#
                            inc avgy#,dy#
                            inc avgz#,dz#
                            inc avg_n#
                        endif
                        rdistsq# = 1.0/distsq#
                        inc near_fish_count
                        inc dirx#,fish(j).direction.x*20.0*rdistsq#
                        inc diry#,fish(j).direction.y*20.0*rdistsq#
                        inc dirz#,fish(j).direction.z*20.0*rdistsq#
                        inc speed#,fish(j).speed*rdistsq#
                        inc speed_n#,rdistsq#
                        if dx#*dx# > 16.0
                            inc dirx#,10.0/dx#
                        else
                            dec dirx#,1.0/dx#
                        endif
                        if dy#*dy# > 16.0
                            inc diry#,10.0/dy#
                        else
                            dec diry#,1.0/dy#
                        endif
                        if dz#*dz# > 16.0
                            inc dirz#,10.0/dz#
                        else
                            dec dirz#,1.0/dz#
                        endif
                    endif
                endif
            endif
        next j
        
        px# = fish(i).position.x
        py# = fish(i).position.y
        pz# = fish(i).position.z
        distsq2# = px#*px# + py#*py# + pz#*pz#
        dec dirx#,distsq2#*0.005*fish(i).position.x
        dec diry#,distsq2#*0.005*fish(i).position.y
        dec dirz#,distsq2#*0.005*fish(i).position.z
        
        if avg_n# > 0.0
            inc dirx#,avgx#*5.0/avg_n#
            inc diry#,avgy#*5.0/avg_n#
            inc dirz#,avgz#*5.0/avg_n#
        endif
        
        dird# = 0.02/dist(dirx#,diry#,dirz#)
        inc fish(i).direction.x,dirx#*dird#
        inc fish(i).direction.y,diry#*dird#
        inc fish(i).direction.z,dirz#*dird#
        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#
        
        if speed_n# > 0.0 
            speed# = speed#/speed_n#
            inc fish(i).speed,(speed#-fish(i).speed)*0.01
        endif
        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
    
    update_clouds()
    
    rotate camera cam_rx#,cam_ry#,0
    sync
loop

function init_backdrop()
    backdrop_image_id = find_free_image()
    backdrop_object_id = find_free_object()

    lock pixels
    for y = 0 to 80
        dot 0,y,rgb(0,20-y/4,80-y)
    next y
    unlock pixels
    get image backdrop_image_id,0,0,1,81,1
    make object sphere backdrop_object_id,100
    texture object backdrop_object_id,backdrop_image_id
    disable object zwrite backdrop_object_id
    set object light backdrop_object_id,0
    set object fog backdrop_object_id,0
    set object cull backdrop_object_id,0
endfunction

function init_clouds()
    cloud_image_id = find_free_image()

    lock pixels
    for y = 0 to 255
        for x = 0 to 255
            dx = x-127
            dy = y-127
            col = 40-(dx*dx+dy*dy+rnd(100))/400
            if col < 0 then col = 0
            dot x,y,rgb(0,col,0)
        next x
    next y
    unlock pixels
    get image cloud_image_id,0,0,256,256

    for i = 0 to CLOUD_COUNT
        id = find_free_object()
        clouds(i).id = id
        
        repeat
            clouds(i).position.x = (rnd(100)-50)*0.1
            clouds(i).position.y = (rnd(100)-50)*0.1
            clouds(i).position.z = (rnd(100)-50)*0.1
            
            px# = clouds(i).position.x
            py# = clouds(i).position.y
            pz# = clouds(i).position.z
            d# = px#*px#+py#*py#+pz#*pz#
        until d# > 5.0
        
        make object plain id,5,5
        texture object id,cloud_image_id
        set object light id,0
        set object cull id,0
        disable object zwrite id
        set object transparency id,2
        ghost object on id
        position object id,clouds(i).position.x,clouds(i).position.y,clouds(i).position.z
    next i
endfunction

function update_clouds()
    x# = camera position x()
    y# = camera position y()
    z# = camera position z()
    for i = 0 to CLOUD_COUNT
        point object clouds(i).id,x#,y#,z#
    next i
    position object backdrop_object_id,x#,y#,z#
endfunction

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

`================================================
`   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

#constant FieldRadius           200
#constant SqrFieldRadius        40000

`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 ObstacleDistance      400
`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

type Obstacle
  Object      as integer
  Position    as Vector
  Radius#     as float
endtype

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

`Setup Field Sphere
make object sphere 1000,-2*FieldRadius
set object wireframe 1000,1

fog on
fog distance 400
fog color 0xFFBBBBBB

color backdrop 0xFFBBBBBB

`Setup Objects
SetupBoids()
SetupEnemies()
SetupObstacles()

`SetVec(0,0,0,1)
`Obstacles(0).Position=v
`position object Obstacles(0).Object,v.x,v.y,v.z

gosub SetupCamera

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

Paused=1
do
  `Print everything
  set cursor 0,0
  print "FPS: ";screen fps()
  print "Boids: ";BoidCount
  print "Enemies: ";EnemyCount
  print "Obstacles: ";ObstacleCount
  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:
  set camera range 0.01,1000
  global TargetGroup=0
  global CameraTarget=0
  global ControlType=0
  TargetFollowDist#=200 : FollowDist#=200
  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)
      BoidAvoidCrowding(a)
      MoveTowardsCenter(a)
      AvoidEnemies(a)
      BoidAvoidObstacles(a)
      TempB=Boids(a)
    endif
    OrientBoid(TempB)
    move object TempB.Object,TempB.Speed#
    `Store new position
    BoidWrapField(TempB)
    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)
      EnemyAvoidCrowding(a)
      EnemyAvoidObstacles(a)
      TempE=Enemies(a)
    endif
    OrientEnemy(TempE)
    move object TempE.Object,TempE.Speed#
    EnemyWrapField(TempE)
    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 and fog distances
  CameraTarget=0 : ControlType=0
  select TargetGroup
    case 0: TargetFollowDist#=200 : fog distance 400 : endcase
    case 1: TargetFollowDist#=30 : fog distance 300 : endcase
    case 2: TargetFollowDist#=50 : fog distance 320 : 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 BoidAvoidCrowding(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(Current.Look,v)        `Cross multiply Boid's Look vector with the vector containing the difference in positions to get the Right vector
      CrossVec(Current.Look,v)        `Cross mulitply Boid's Look vector with the the Right 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 BoidAvoidObstacles(obj)    `Works like pretty much like AvoidEnemies()
  Look as Vector
  Current as Boid
  Current=Boids(obj)
  Count=0
  for a=0 to ObstacleCount-1
    v=Obstacles(a).Position
    SubtractVec(v,Current.Position) : v.y=0
    Distance#=SqrLengthVec(v)
    Radius#=Obstacles(a).Radius#+20
    Radius#=Radius#*Radius#
    if Distance#<Radius#
      Look=Current.Look : Look.y=0
      CrossVec(Look,v)
      CrossVec(Look,v)
      NormalizeVec(v)
      ScaleVec(v,(Radius#-Distance#)/Radius#)
      AddVec(v,Look) : Look=v
      inc Count
    endif
  next a
  if Count
    NormalizeVec(Look)
    CurveVec(v,Current.Look,10) : NormalizeVec(v)
    Boids(obj).Look=v
  endif
endfunction

function BoidWrapField(Current as Boid)
  Distance#=SqrLengthVec(Current.Position)
  if Distance#>SqrFieldRadius
    NormalizeVec(Current.Position)
    ScaleVec(v,-(FieldRadius-1))
    Current.Position=v
    OrientBoid(Current)
  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 EnemyAvoidCrowding(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 EnemyAvoidObstacles(obj)
  Look as Vector
  Current as Enemy
  Current=Enemies(obj)
  Count=0
  for a=0 to ObstacleCount-1
    v=Obstacles(a).Position
    SubtractVec(v,Current.Position) : v.y=0
    Distance#=SqrLengthVec(v)
    Radius#=Obstacles(a).Radius#+20
    Radius#=Radius#*Radius#
    if Distance#<Radius#
      Look=Current.Look : Look.y=0
      CrossVec(Look,v)
      CrossVec(Look,v)
      NormalizeVec(v)
      ScaleVec(v,(Radius#-Distance#)/Radius#)
      AddVec(v,Look) : Look=v
      inc Count
    endif
  next a
  if Count
    NormalizeVec(Look)
    CurveVec(v,Current.Look,10) : NormalizeVec(v)
    Enemies(obj).Look=v
  endif
endfunction

function EnemyWrapField(Current as Enemy)
  Distance#=SqrLengthVec(Current.Position)
  if Distance#>SqrFieldRadius
    NormalizeVec(Current.Position)
    ScaleVec(v,-(FieldRadius-1))
    Current.Position=v
    OrientEnemy(Current)
  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(200)-100
    v.y=rnd(200)-100
    v.z=rnd(200)-100
    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
    `color object Temp.Object,0xFFFF0000
    v.x=rnd(200)-100
    v.y=rnd(200)-100
    v.z=rnd(200)-100
    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

function SetupObstacles()
  Temp as Obstacle
  for a=0 to ObstacleCount-1
    array insert at bottom Obstacles(0)
    Temp.Object=BoidCount+EnemyCount+2+a
    Temp.Radius#=5+rnd(5)
    make object cylinder Temp.Object,1
    scale object Temp.Object,2*Temp.Radius#*100,2*FieldRadius*100,2*Temp.Radius#*100
    v.x=rnd(300)-150
    v.y=0
    v.z=rnd(300)-150
    Temp.Position=v
    position object Temp.Object,v.x,v.y,v.z
    Obstacles(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
  `color object 1,0xFF008080
  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

#constant CHOICE_ROCK 0
#constant CHOICE_PAPER 1
#constant CHOICE_SCISSORS 2

sync on

print "Let the games... BEGIN!"
sync : sync
wait key

for i = 1 to 100
    rem Get the player guesses
    player1_choice = Player1_Guess()
    player2_choice = Player2_Guess()
    
    rem Validate the gueses
    if player1_choice > 2 or player1_choice < 0
        print "Invalid player 1 choice!"
        sync : sync
        wait key
    endif
    if player2_choice > 2 or player2_choice < 0
        print "Invalid player 2 choice!"
        sync : sync
        wait key
    endif
    
    rem Tell each player what the other chose
    Player1_Result(player1_choice,player2_choice)
    Player2_Result(player2_choice,player1_choice)
    
    rem Find the result of the round
    result = Choice_Winner(player1_choice,player2_choice)
    
    rem Output the result
    text$ = Choice_Name(player1_choice)
    if result = -1
        text$ = text$ + " is beaten by "
        inc player2_score
    else
        if result = 1
            text$ = text$ + " beats "
            inc player1_score
        else
            if result = 0
                text$ = text$ + " draws with "
            endif
        endif
    endif
    text$ = text$ + Choice_Name(player2_choice)
    print text$
    sync : sync
next i

print ""
print "SCORES:"
print "Player 1: " + str$(player1_score)
print "Player 2: " + str$(player2_score)
print ""
print "RESULT:"

rem Must win by at least 10 rounds
if abs(player2_score-player1_score) < 10
    print "It's a draw!"
else
    if player2_score > player1_score
        print "Player 2 wins!"
    else
        print "Player 1 wins!"
    endif
endif

sync : sync
wait key
end

rem Returns name of choice
function Choice_Name(a)
    name$ = ""
    select a
        case 0
            name$ = "ROCK"
        endcase
        case 1
            name$ = "PAPER"
        endcase
        case 2
            name$ = "SCISSORS"
        endcase
    endselect
endfunction name$

rem Returns +1 if 'a' wins, -1 if 'b' wins, 0 if they draw
function Choice_Winner(a,b)
    c = (a+3-b) mod 3
    if c = 2 then c = -1
endfunction c

rem PLAYER 1

function Player1_Guess()
    result = rnd(2)
endfunction result

function Player1_Result(choice,other_choice)
endfunction

rem PLAYER 2

function Player2_Guess()
    result = rnd(2)
endfunction result

function Player2_Result(choice,other_choice)
endfunction

c = (b+3-a) mod 3

c = (a+3-b) mod 3

////////////////////////////////////
//  AurumKnight's Entry
//  19/9/2009
//  {
global AK_gc
global AK_gs
global AK_g
global AK_ochoice
global AK_choice
global AK_shift
`dim AK_enemyshifts(99)
function Player1_Guess()
    result = AK_g
endfunction result

function Player1_Result(choice,other_choice)
    w = Choice_Winner(choice,other_choice)
    AK_ochoice = other_choice
    AK_choice = choice
    inc AK_gs, w
    if AK_gc = 0
        AK_g = choice
    else
        if w = -1 then dec AK_shift,2
        if w = 0 then inc AK_shift,2
    endif
    
    if AK_gs < -7 then if AK_gc > 10
        AK_shift = AK_gc mod 3
    endif
    AK_shift = AK_shift mod 3
    AK_g = AK_wrap(choice+AK_shift)


    inc AK_gc
endfunction

function AK_wrap(n)
    n = n mod 3
    if n < 0 then inc n,3
endfunction n

//   }
////////////////////////////////////

////////////////////////////////////
//  Valles first Entry
//  19/9/2009
global VA_guess : global VA_l
global VA_r : global VA_el : global VA_er

function Player1_Guess()
endfunction VA_guess

function Player1_Result(choice, other_choice)
   winr = Choice_Winner(choice, other_choice)
   if choice = VA_l then inc VA_r else VA_r = 1
   VA_l = choice
   if other_choice = VA_el then inc VA_er else VA_er = 1
   VA_el = other_choice
   if rnd(4)
      if winr >= 0
         VA_guess = VA_func(other_choice, 1+winr)
      else
         if rnd(3)=0 then VA_guess = rnd(2)
      endif
   else
      VA_guess = rnd(2)
   endif
   if VA_er >=3 or VA_r >= 3 then VA_guess = VA_func(other_choice, 1)
endfunction

function VA_func(choice, value)
   ret = choice : inc ret, value : if ret > 2 then dec ret, 3
endfunction ret
////////////////////////////////////

////////////////////////////////////
//  AurumKnight's Entry v0.1
//  19/9/2009

global AK_gc
global AK_gscore
global AK_g
global AK_lastw
global AK_lastchoice
global AK_initf

AK_init:
dim AK_moves(2,2)
AK_initf = 1
return

function Player1_Guess()
    if AK_initf=0 then gosub AK_init
endfunction AK_g

function Player1_Result(choice,other_choice)
    w = Choice_Winner(choice,other_choice)
    inc AK_gscore, w
    if AK_gc > 0 then inc AK_moves(AK_lastw+1,AK_wrap(other_choice-AK_lastchoice))
    bi = -1
    bs = 0
    for i = 0 to 2
        if AK_moves(w+1,i) > bs
            bi = i
            bs = AK_moves(w+1,i)
        endif
    next i
    if (bi = -1) or (AK_gc < 4) or (rnd(15) = 1) then bi = rnd(2)
    AK_g = AK_wrap(choice+bi+1)
    AK_lastchoice = choice
    AK_lastw = w
    inc AK_gc
endfunction

function AK_wrap(n)
    n = n mod 3
    if n < 0 then inc n,3
endfunction n
////////////////////////////////////

	type NFrpcvals
		rock as integer
		paper as integer
		scissors as integer
		rollnum as integer
		chanceweight as float
		losses as integer
	endtype
	
	global NF_rpc as NFrpcvals
	NF_rpc.chanceweight=0.3


function Player1_Guess()
    result=NF_rpcroll()
endfunction result

function Player1_Result(choice,other_choice)
	NF_judge(choice,other_choice)
endfunction



function NF_rpcroll()
	NF_lose#=NF_rpc.losses*1.0/NF_rpc.rollnum
	
	NF_roll as integer
	if NF_rpc.rollnum>0
		NF_value#=1.0/(NF_rpc.rollnum)
	else
		NF_value#=0
	endif
	NF_rock#=NF_rpc.rock*(1.0-NF_rpc.chanceweight)/(NF_rpc.rollnum)
	NF_paper#=NF_rpc.paper*(1.0-NF_rpc.chanceweight)/(NF_rpc.rollnum)
	NF_scissors#=NF_rpc.scissors*(1.0-NF_rpc.chanceweight)/(NF_rpc.rollnum)
	`if flag=1 `based solely upon past information
	`	NF_roll=NF_greatest(NF_rock#,NF_paper#,NF_scissors#)
	`else
	`	if flag=2
			NF_chance#=rnd(1000)/1000.0
			if NF_chance#=>NF_rock#+NF_paper#+NF_scissors#
				NF_roll=rnd(2)
				
			else
				if NF_chance#=>NF_rock#+NF_paper# and NF_chance#<NF_rock#+NF_paper#+NF_scissors#
					NF_roll=0 `a guess that the enemy will choose scissors
				else
					if NF_chance#>NF_rock# and NF_chance#<NF_rock#+NF_paper#
						NF_roll=2 `a guess that the enemy will choose paper
					else
						NF_roll=1 `if it's not random, or scissors, or paper,then the guess is that the enemy rolls rock
						
					endif
				endif
			endif
	`	endif
	`Endif
Endfunction NF_roll
function NF_judge(NF_a as integer, NF_b as integer)
	NF_deltascore=Choice_Winner(NF_a,NF_b)
	if NF_b=0 then inc NF_rpc.rock,1
	if NF_b=1 then inc NF_rpc.paper,1
	if NF_b=2 then inc NF_rpc.scissors,1
	inc NF_rpc.rollnum,1
	if NF_deltascore=-1 `if it loses, the program will become more random.
		NF_rpc.chanceweight=NF_rpc.chanceweight*1.1
		if NF_rpc.chanceweight>0.7 then NF_rpc.chanceweight=0.7
	Endif
	`if NF_deltascore=1 `if it wins, then we tell the program ta keep it up, and do more of what it's doing, instead of being random.
	`	NF_rpc.chanceweight=NF_rpc.chanceweight*0.9
	`Endif
Endfunction
function NF_greatest(NF_a,NF_b,NF_c)
	if NF_a=>NF_b and NF_a=>NF_c 
		exitfunction 0
	else
		if NF_b=>NF_a and NF_b=>NF_c
			exitfunction 1
		else
			if NF_c=>NF_a or NF_c=>NF_b
				exitfunction 2
			Endif
		endif
	endif
Endfunction 0

`//////////////////////////
`/// BMACZERO

global DIM BM_results(2) as dword
global BM_lastchoice as integer

function Player1_Guess()
    local temp as integer
    local override as integer
    temp=0
    for c=0 to 2
        if BM_results(c)>temp
            temp=BM_results(c)
            override=0
            if c=BM_lastchoice then override=c
            local DIM winners(1)
            winners(1)=c
        endif
        if BM_results(c)=temp and temp<>0
            array insert at top winners(0)
            winners(1)=c
        endif
    next c
    if array count(winners(0))>0
        if override>0
            result=BM_beat(c)
            else
            result=BM_beat(winners(rnd(array count(winners(0)))))
        endif
        else
        result=rnd(2)
    endif
    if result>2 or result<0 then result=rnd(2)
endfunction result

function Player1_Result(choice,other_choice)
    inc BM_results(other_choice)
    BM_lastchoice=other_choice
endfunction

function BM_beat(choice)
result=choice+1
if choice>=3 then choice=0
endfunction result

`\
`\\\\\\\\\\\\\

Global MyResult
MyResult = rnd(2)

function Player1_Guess()
If MyResult > 2 then MyResult = 0
result = MyResult
MyResult = MyResult + 1
endfunction result

#constant CHOICE_ROCK 0
#constant CHOICE_PAPER 1
#constant CHOICE_SCISSORS 2

global VA_guess
global VA_en_gs as string
global VA_round
global dim VA_arr(2)


sync on : sync

print "Let the games... BEGIN!"
sync
wait key

for t = 1 to 100
    player1_score = 0
    player2_score = 0
    for i = 1 to 100
        rem Get the player guesses
        player1_choice = Player1_Guess()
        player2_choice = Player2_Guess()
            
        rem Validate the gueses
        if player1_choice > 2 or player1_choice < 0
            print "Invalid player 1 choice!"
            sync
            wait key
        endif
        if player2_choice > 2 or player2_choice < 0
            print "Invalid player 2 choice!"
            sync
            wait key
        endif
        
        rem Tell each player what the other chose
        Player1_Result(player1_choice,player2_choice)
        Player2_Result(player2_choice,player1_choice)
        
        rem Find the result of the round
        result = Choice_Winner(player1_choice,player2_choice)
        
        rem Increase scores
        if result = -1
            inc player2_score
        else
            if result = 1
                inc player1_score
            endif
        endif
    next i
    
    cls
    print ""
    print "ROUND ";t;"/100:"
    print "Player 1: " + str$(player1_score)
    print "Player 2: " + str$(player2_score)
    print ""
    print "RESULT:"
    
    rem Must win by at least 10 rounds
    if abs(player2_score-player1_score) < 10
        print "It's a draw!"
    else
        if player2_score > player1_score
            print "Player 2 wins!"
            inc bigscore2
        else
            print "Player 1 wins!"
            inc bigscore1
        endif
    endif
    sync
next t

cls 
    print ""
    print "FINAL SCORE"
    print "Player 1 won ";bigscore1;" rounds"
    print "Player 2 won ";bigscore2;" rounds"
    print ""
sync
wait key

end

rem Returns name of choice
function Choice_Name(a)
    name$ = ""
    select a
        case 0
            name$ = "ROCK"
        endcase
        case 1
            name$ = "PAPER"
        endcase
        case 2
            name$ = "SCISSORS"
        endcase
    endselect
endfunction name$

rem Returns +1 if 'a' wins, -1 if 'b' wins, 0 if they draw
function Choice_Winner(a,b)
    c = (a+3-b) mod 3
    if c = 2 then c = -1
endfunction c


////////////////////////////////////
//  Valles Entry 2
//  21/9/2009

function Player1_Guess()
   if VA_round = 0 then VA_guess = rnd(2)
endfunction VA_guess

function Player1_Result(choice, other_choice)
   winr = Choice_Winner(choice, other_choice)
   VA_en_gs = VA_en_gs+str$(other_choice)
   if len(VA_en_gs) > 300 then VA_en_gs = right$(VA_en_gs,  300)
   best_guess = VA_get_bg(VA_en_gs)
   if best_guess >= 0
      VA_guess = VA_func(best_guess, 1)
   else
      VA_guess = 1
   endif
   inc VA_round
endfunction

function VA_get_bg(guess_list as string)
   search_length = 2
   result = -1
   matches = 0
   if len(guess_list) > search_length*2-1
      search_string$ = right$(guess_list, search_length)
   else
      exit
   endif
   for t = 0 to 2
      VA_arr(t) = 0
   next t
   for t = 1 to len(guess_list)-search_length*2-1
      temp$ = ""
      for i = 1 to search_length
         temp$ = temp$+mid$(guess_list, t+i)
      next i
      if temp$ = search_string$
         nxt = val(mid$(guess_list, t+search_length+1))
         inc VA_arr(nxt)
      endif
   next t
   temp = -1
   temp_index = -1
   for t = 0 to 2
      if VA_arr(t) > temp
         temp = VA_arr(t)
         temp_index = t
      endif
   next t
   if VA_arr(temp_index) > 0 then result = temp_index
endfunction result

function VA_func(choice, value)
   ret = choice : inc ret, value : if ret > 2 then dec ret, 3
endfunction ret

////////////////////////////////////ENEMY

function Player2_Guess()
    rand = rnd(2)
endfunction rand

function Player2_Result(choice,other_choice)
endfunction 

////////////////////////////////////
//  Valles Entry 2
//  21/9/2009

global VA_guess
global VA_en_gs as string
global VA_round
global dim VA_arr(2)

function Player1_Guess()
   if VA_round = 0 then VA_guess = rnd(2)
endfunction VA_guess

function Player1_Result(choice, other_choice)
   winr = Choice_Winner(choice, other_choice)
   VA_en_gs = VA_en_gs+str$(other_choice)
   if len(VA_en_gs) > 300 then VA_en_gs = right$(VA_en_gs,  300)
   best_guess = VA_get_bg(VA_en_gs)
   if best_guess >= 0
      VA_guess = VA_func(best_guess, 1)
   else
      VA_guess = 1
   endif
   inc VA_round
endfunction

function VA_get_bg(guess_list as string)
   search_length = 2
   result = -1
   matches = 0
   if len(guess_list) > search_length*2-1
      search_string$ = right$(guess_list, search_length)
   else
      exit
   endif
   for t = 0 to 2
      VA_arr(t) = 0
   next t
   for t = 1 to len(guess_list)-search_length*2-1
      temp$ = ""
      for i = 1 to search_length
         temp$ = temp$+mid$(guess_list, t+i)
      next i
      if temp$ = search_string$
         nxt = val(mid$(guess_list, t+search_length+1))
         inc VA_arr(nxt)
      endif
   next t
   temp = -1
   temp_index = -1
   for t = 0 to 2
      if VA_arr(t) > temp
         temp = VA_arr(t)
         temp_index = t
      endif
   next t
   if VA_arr(temp_index) > 0 then result = temp_index
endfunction result

function VA_func(choice, value)
   ret = choice : inc ret, value : if ret > 2 then dec ret, 3
endfunction ret
////////////////////////////////////

////////////////////////////////////
//  AurumKnight's Entry v0.2
//  21/9/2009
//
global AK_gc
global AK_gscore
global AK_g
global AK_lwinindex
global AK_lastchoice
global AK_elastchoice

global AK_initf
global AK_memb
global AK_mema as integer
global AK_track
global AK_mode
global AK_tbase
global AK_tdata
global AK_msize
AK_init:
    
    AK_track = 3

    repeat
        inc AK_memb
    until memblock exist(AK_memb) = 0
    AK_msize = (((3^AK_track)*3)+AK_track)* 2
    make memblock AK_memb,AK_msize*2
    
    AK_initf =1
return
function Player2_Guess()
    if AK_initf=0 then gosub AK_init
endfunction AK_g

function Player2_Result(choice,other_choice)
    w = Choice_Winner(choice,other_choice)
    inc AK_gscore, w
    AK_tbase = AK_mode*AK_msize
    if AK_track > 1
        for i = 1 to AK_track-1
            AK_mema=i*2+AK_tbase
            write memblock word AK_memb,AK_mema-2,memblock word(AK_memb,AK_mema)
        next i
    endif
    write memblock word AK_memb,(AK_track-1)*2,w+1
    for i = 0 to AK_track-1
        winindex = winindex+memblock word(AK_memb,i*2+AK_tbase)*(3^(i+1)) `````````````````````
    next i
    inc winindex,AK_track
    if AK_gc >= AK_track
        AK_mema = (AK_lwinindex+AK_wrap(other_choice-AK_lastchoice))*2
        wv = memblock word(AK_memb,AK_mema)
        inc wv,1
        write memblock word AK_memb,AK_mema,wv
        
        AK_mema = (AK_lwinindex+AK_wrap(choice-AK_elastchoice))*2+AK_msize
        wv = memblock word(AK_memb,AK_mema)
        inc wv,1
        write memblock word AK_memb,AK_mema,wv
    endif
    bi = -1
    bs = 0
    for i = 0 to 2
        AK_mema = (winindex+i)*2+AK_tbase
        wv = memblock word(AK_memb,AK_mema)
        if wv > bs
            bi=i
            bs = wv
        endif
    next i
    if (AK_gc < 3) or (bi = -1) then bi = rnd(2)
    AK_g = AK_wrap(choice+bi+1+AK_mode)
    AK_lastchoice = choice
    AK_elastchoice = other_choice
    AK_lwinindex = winindex
    inc AK_gc
endfunction

function AK_wrap(n)
    n = n mod 3
    if n < 0 then inc n,3
endfunction n
/////////////////////////