Another Question:
Im trying to set up my program so the units arrange themselves in a box but I think I may be doing something wrong. Can anyone take a look at this and tell me why it doesn't work?
rem UNIT NUMBER ASSIGNMENT CHART
rem TYPE COLOR RANGE
rem unit blue 501-600
rem unit yellow 601-700
rem unit green 701-800
rem bldng blue 801-850
rem bldng yellow 851-900
rem bldng green 901-950
rem rsrce nature 951-1100
rem circle blue 1101-1150
` Set sync rate and cam settings
Sync on
sync rate 60
set camera range 100,9000
autocam off
Gosub Init_Display_mode_arrays
Gosub Create_Circles
` Set display mode and aquire data
Set_Display_mode(1024,768,16,0,0,1024,768)
` Create selected units memblock
make memblock 1,51
` Create Sam Site data memblock
make memblock 2,31
` Create unit health memblocks
make memblock 3,150
make memblock 4,300
` Create unit retaliation memblock
remstart
If the players unit comes under attack and this
value is set to 1 for the unit then the unit will
change its priority so it attacks the enemy unit
remend
make memblock 5,100
` Make tile image for matrix
freeimage=1
Create bitmap 1,256,256
Make_Grass_Texture(FreeImage,128,47)
delete bitmap 1
set current bitmap 0
` Initiate Matrix size
world_width#=20000
world_height#=15000
world_depth#=20000
` Number Of Tiles of Height Map/Matrix Width/DepthIN
MatrixTilesX=50
MatrixTilesZ=50
` Calculate the distance between each vertex
MatrixVertexSpacingX#=World_width#/MatrixTilesX
MatrixVertexSpacingZ#=World_Depth#/MatrixTilesZ
` Create the matrix
make matrix 1,world_width#,world_depth#,MatrixTilesX,MatrixTilesZ
prepare matrix texture 1,freeimage,1,1
set matrix 1,1,1,1,1,1,1,1
` Position camera
position camera world_width#/2,0,world_depth#/2
point camera world_width#/2,0,world_depth#/2
xrotate camera 55
` Create impact point arrays
Dim Terrain_los_impact_pointX#(1)
Dim Terrain_los_impact_pointY#(1)
Dim Terrain_los_impact_pointZ#(1)
Dim RotatedVertToCamera_Xpos#(1)
Dim RotatedVertToCamera_Ypos#(1)
Dim RotatedVertToCamera_Zpos#(1)
Dim MAtrixSelection_Xpos#(1)
Dim MAtrixSelection_Ypos#(1)
Dim MAtrixSelection_Zpos#(1)
` Create unit selection array
Dim Selected_Units(0)
Dim Destination_pos(100,1)
Dim Enemy_Health(200)
`
` Impact object
impact_obj=2
make object sphere impact_obj,25
color object impact_obj,255
for x=1 to 100
make object sphere 500+x,50
position object 500+x,world_width#/2+rnd(2000),25,world_depth#/2+rnd(2000)
Destination_pos(x,0)=object position x(500+x)
Destination_pos(x,1)=object position z(500+x)
next x
make object sphere 601,50
position object 601,world_width#/2+3000+100,25,world_depth#/2+400
color object 601,rgb(255,0,0)
` write memblock byte 2,1,1 write here to set sam site as existing
Enemy_Health(1)=100
` Main loop
do
rem show data
set cursor 0,0:print " Framerate: ",Screen FPS()
set cursor 0,15:print "Number of Units Selected: ",Selected_Units(0)
if Selected_Units(0)<>0
for x=1 to Selected_Units(0)
y=15*(x-1)
set cursor 1000,y
id=memblock byte(1,x)+500
print id
next x
endif
` increment the game timer
time=time+1
if time=10000 then time=0
` Camera controls
Control_Camera(active)
` Check For intersection with matrix
result=Handle_Matrix_Selection(5000)
if result=1
` Position the Blue Ball as a pointer object so we can see
` the intersection point with the matrix
Show object impact_obj
position object impact_obj,MAtrixSelection_Xpos#(1),MAtrixSelection_Ypos#(1),MAtrixSelection_Zpos#(1)
else
hide object impact_obj
endif
` Handle user input functions
active=Unit_Selection()
Get_Destination()
` Show and position rings around
` selected units
Show_Unit_Rings()
` Move units towards destination
Move_Units()
` Sam site AI
Find_New_Target()
Attack_Target()
sync
loop
Init_Display_mode_arrays:
Dim ScreenMode_Width#(1)
Dim ScreenMode_Height#(1)
Dim Camera_View_X1#(1)
Dim Camera_View_Y1#(1)
Dim Camera_View_X2#(1)
Dim Camera_View_Y2#(1)
Dim Camera_ViewPort_Width#(1)
Dim Camera_ViewPort_Height#(1)
Dim Camera_ViewPort_WidthScaler#(1)
Dim Camera_ViewPort_HeightScaler#(1)
Dim Camera_ViewPort_Xprojection#(1)
Dim Camera_ViewPort_YProjection#(1)
return
Function Set_Display_mode(ScreenWidth,ScreenHEight,ScreenDepth,x1,y1,x2,y2)
ScreenMode_Width#(1)=ScreenWidth
ScreenMode_Height#(1)=Screenheight
ScreenWidth2=ScreenWidth/2
ScreenHeight2=ScreenHeight/2
Camera_ViewPort_Xprojection#(1)=(ScreenWidth2*1000)/800
Camera_ViewPort_YProjection#(1)=(ScreenHeight2*1000)/600
` Set the View port..
Camera_View_X1#(1)=x1
Camera_View_Y1#(1)=y1
Camera_View_X2#(1)=x2
Camera_View_Y2#(1)=y2
` Calc the size and scalers
Camera_ViewPort_Width#(1)=Camera_View_X2#(1)-Camera_View_X1#(1)
Camera_ViewPort_Height#(1)=Camera_View_Y2#(1)-Camera_View_Y1#(1)
Camera_ViewPort_WidthScaler#(1)=ScreenWidth/Camera_ViewPort_Width#(1)
Camera_ViewPort_HeightScaler#(1)=Screenheight/Camera_ViewPort_Height#(1)
` Set DB's camera view
set display mode screenwidth,screenheight,ScreenDepth
set camera view Camera_View_X1#(1),Camera_View_Y1#(1),Camera_View_X2#(1),Camera_View_y2#(1)
endfunction
Function Handle_Matrix_Selection(MaxSelectDepth)
mx=mousex()
my=mousey()
Xprojection#=Camera_ViewPort_Xprojection#(1)
Yprojection#=Camera_ViewPort_Yprojection#(1)
ScreenWidth2=ScreenMode_Width#(1)/2
ScreenHeight2=ScreenMode_height#(1)/2
` Clip The Mouse Position To the View port Edges
if mx<Camera_View_X1#(1) then mx=Camera_View_X1#(1)
if mx>Camera_View_X2#(1) then mx=Camera_View_X2#(1)
if my<Camera_View_Y1#(1) then my=Camera_View_Y1#(1)
if my>Camera_View_Y2#(1) then my=Camera_View_Y2#(1)
` Translate 2d to 3d
mx=mx-Camera_View_X1#(1)
my=my-Camera_View_Y1#(1)
mx=mx*Camera_ViewPort_WidthScaler#(1)
my=my*Camera_ViewPort_HeightScaler#(1)
dx#=ScreenWidth2-mx
dy#=my-ScreenHeight2
` Near point to the camera
z#=10
` Calc the 3d Space positions for this mouse click
x#=(dx#*z#)/XProjection#
y#=(dy#*z#)/YProjection#
Rotate_Vector_To_camera(x#,y#,z#)
px1#=RotatedVertToCamera_Xpos#(1)
py1#=RotatedVertToCamera_Ypos#(1)
pz1#=RotatedVertToCamera_Zpos#(1)
` Far point from the camera
z#=MaxSelectDepth
` Calc the 3d Space positions for this mouse click
x#=(dx#*z#)/XProjection#
y#=(dy#*z#)/YProjection#
Rotate_Vector_To_camera(x#,y#,z#)
px2#=RotatedVertToCamera_Xpos#(1)
py2#=RotatedVertToCamera_Ypos#(1)
pz2#=RotatedVertToCamera_Zpos#(1)
` Calc Matrix Intersection
` Test Line Of Sight Between Camera (Axis) and the target object)
LOS_Ray_Step_Size#=20
` Low For LOS and show the impact point (if any) between the 2 points
result=Check_Los_Over_Terrain_get_Location(1,px1#,py1#,pz1#,px2#,py2#,pz2#,LOS_Ray_Step_Size#)
MAtrixSelection_Xpos#(1)=Terrain_los_impact_pointX#(1)
MAtrixSelection_Ypos#(1)=Terrain_los_impact_pointY#(1)
MAtrixSelection_Zpos#(1)=Terrain_los_impact_pointZ#(1)
endfunction result
Function Rotate_Vector_To_camera(xpos#,ypos#,zpos#)
` invert angles
anglex#=360-Camera angle x()
angley#=wrapvalue(90-Camera angle y())
anglez#=360-Camera angle z()
` precalc cos+sin for rotation
cx#=cos(anglex#)
sx#=sin(anglex#)
cy#=cos(angley#)
sy#=sin(angley#)
cz#=cos(anglez#)
sz#=sin(anglez#)
` Around Z axis
x#=((cz#*Xpos#)-(sz#*Ypos#))
Y#=((cz#*Ypos#)+(sz#*Xpos#))
` Around X axis
z#=(cx#*Zpos#)+(sx#*y#)
y#=(cx#*Y#)-(sx#*zpos#)
` Around Y axis
x2#=(cY#*Z#)-(sy#*X#)
z#=((cy#*X#)+(sy#*Z#))
` Calc the Ray Origin point
RotatedVertToCamera_Xpos#(1)=camera position x()+x2#
RotatedVertToCamera_Ypos#(1)=camera position y()-y#
RotatedVertToCamera_Zpos#(1)=camera position z()+z#
endfunction
Function Check_Los_Over_Terrain_get_Location(TerrainNumber,px1#,py1#,pz1#,px2#,py2#,pz2#,intervalsize#)
` Ray vector
Dx#=px2#-px1#
Dy#=py2#-py1#
Dz#=pz2#-pz1#
` Scale to unit vector
h#=sqrt((dx#*dx#)+(dy#*dy#)+(dz#*dz#))
sx#=dx#/h#
sy#=dy#/h#
sz#=dz#/h#
Checks#=(h#/IntervalSize#)
` Calc the stepping values
ray_sx#=sx#*IntervalSize#
ray_sy#=sy#*IntervalSize#
ray_sz#=sz#*IntervalSize#
x#=px1#
y#=py1#
z#=pz1#
For lp=0 to Checks#
if get ground height(terrainNumber,X#,Z#)=>y#
LastSafeDist#=(lp-1)*IntervalSize#
NotSafeDist#=lp*IntervalSize#
low#=LastSafeDist#
High#=NotSafeDist#
repeat
OldMidpoint#=Midpoint#
midpoint#=(low#+high#)/2
if get ground height(terrainNumber,px1#+(sx#*midpoint#),pz1#+(sz#*midpoint#))=>(py1#+(sy#*midpoint#))
high#=midpoint#
else
Low#=midpoint#
endif
until OldMidpoint#=Midpoint#
Terrain_los_impact_pointx#(1)=px1#+(sx#*low#)
Terrain_los_impact_pointy#(1)=py1#+(sy#*low#)
Terrain_los_impact_pointz#(1)=pz1#+(sz#*low#)
exitfunction 1
endif
x#=x#+ray_sx#
y#=y#+ray_sy#
z#=z#+ray_sz#
next lp
endfunction 0
Function Control_Camera(active)
` Scroll Screen
if active=0
camxang#=camera angle x()
camyang#=camera angle y()
xrotate camera 0
if mousex()<25
yrotate camera wrapvalue(camyang#-90)
move camera ( 25-mousex() )
yrotate camera camyang#
endif
if mousex()>999
yrotate camera wrapvalue(camyang#-90)
move camera 0-( ( mousex()-999 ) )
yrotate camera camyang#
endif
if mousey()<25
move camera ( 25-mousey() )
endif
if mousey()>743
move camera 0-( ( mousey()-743 ) )
endif
set cursor 0,0
xrotate camera camxang#
x=camera position x()
z=camera position z()
g=get ground height(1,x,z)+1000
position camera x,g,z
endif
endfunction
function unit_selection()
ink 0,0
if mouseclick()=1 and prevclick=0
prevclick=1
ulx=mousex()
uly=mousey()
endif
if mouseclick()=0 and prevclick=1
prevclick=0
if abs(ulx-lrx)*abs(ulx-lrx)>8
get_units(ulx,uly,mousex(),mousey() )
else
get_unit(mousex(),mousey() )
endif
endif
if prevclick=1
lrx=mousex()
lry=mousey()
line ulx,uly,lrx,uly
line ulx,lry,lrx,lry
line ulx,uly,ulx,lry
line lrx,uly,lrx,lry
endif
endfunction prevclick
function get_units(ulx,uly,lrx,lry)
` Hide previous selection circles
for x=1 to 50
if object visible(1150+x)=1 then hide object 1150+x
next x
rx=lrx:lx=ulx:ly=lry:uy=uly
if lrx<ulx then lrx=lx:ulx=rx
if lry>uly then lry=uy:uly=ly
` Check units
Selected_Units(0)=0
for x=1 to 100
if object exist(x+500)=1
xpos=object screen x(x+500)
ypos=object screen y(x+500)
if xpos>ulx and xpos<lrx and ypos<uly and ypos>lry
write memblock byte 1,Selected_Units(0)+1,x
Selected_Units(0)=Selected_Units(0)+1
if Selected_Units(0)=50 then exitfunction
endif
endif
next x
endfunction
function get_unit(lrx,lry)
` Hide previous selection circles
for x=1 to 50
if object visible(1150+x)=1 then hide object 1150+x
next x
` Check units
Selected_Units(0)=0
for x=1 to 100
if object exist(x+500)=1
xpos=object screen x(x+500)
ypos=object screen y(x+500)
if xpos>lrx-12 and xpos<lrx+12 and ypos<lry+12 and ypos>lry-12
write memblock byte 1,Selected_Units(0)+1,x
Selected_Units(0)=1
exitfunction
endif
endif
next x
endfunction
function Make_Grass_Texture(ImageNumber,Size,Seed)
randomize seed
o=0
For ylp=0 to size-1
For xlp=0 to size-1
g=32+rnd(64)
ink rgb(rnd(10),(g+o)/2,rnd(30)),0
o=g
dot xlp,ylp
next xlp
next ylp
get image ImageNumber,0,0,size-1,size-1
endfunction
Create_Circles:
` Make tile image for circles
create bitmap 1,64,64
ink rgb(255,255,0),0
circle 32,32,32
get image 2,0,0,63,63
delete bitmap 1
set current bitmap 0
` Create circles
for x=1 to 50
make object plain 1150+x,64,64
xrotate object 1150+x,90
texture object 1150+x,2
hide object 1150+x
set object 1150+x,1,0,1
next x
delete image 2
return
function Show_Unit_Rings()
if Selected_Units(0)>0
for x=1 to Selected_Units(0)
id=memblock byte(1,x)+500
if object exist(id)=1
position object 1150+x,object position x(id),object position y(id)+1-(object size y(id)/2),object position z(id)
show object 1150+x
endif
next x
endif
endfunction
function Move_Units()
for x=1 to 100
id=x+500
if object exist(id)=1
xpos=object position x(id)
zpos=object position z(id)
ypos=get ground height(1,xpos,zpos)+(object size y(id)/2)
position object id,xpos,ypos,zpos
if Destination_pos(x,0)=-1 then asdo=0 : ` Create attack routine
if (((object position x(id)-Destination_pos(x,0))^2)+(object position z(id)-Destination_pos(x,1))^2)>4
point object id,Destination_pos(x,0),object position y(id),Destination_pos(x,1)
move object id,2
endif
endif
next x
exitfunction
return
endfunction
function Get_Destination()
if mouseclick()<2 then newdest=1
if mouseclick()=2 and newdest=1 and Selected_Units(0)>0
newdest=0
counter=1
size=sqrt(Selected_Units(0))+1
posx=size/2
posz=size/2
for x=1 to Selected_Units(0)
unit=memblock byte(1,x)
if object exist(unit+500)=1
Destination_pos(unit,0)=MAtrixSelection_Xpos#(1)
Destination_pos(unit,1)=MAtrixSelection_Zpos#(1)
point object unit+500,Destination_pos(unit,0),object position y(unit+500),Destination_pos(unit,1)
goto breakloop
endif
next x
breakloop:
for y=1 to size
for x=1 to size
restart:
counter=counter+1
if counter>Selected_Units(0) then exitfunction
xdist=100*(x-posx) : ydist=100*(y-ypos)
obj=memblock byte(1,counter)
if object exist(obj+500)=1
Destination_pos(obj,0)=MAtrixSelection_Xpos#(1)+(xdist*cos(wrapvalue(object angle y(unit+500)+90)))+(ydist*cos(object angle y(unit+500)))
Destination_pos(obj,1)=MAtrixSelection_Zpos#(1)+(xdist*sin(wrapvalue(object angle y(unit+500)+90)))+(ydist*sin(object angle y(unit+500)))
endif
next x
next y
endif
endfunction
function Find_New_Target()
counter=counter+1
if counter>1 then counter=0
if counter=0
start=600
else
start=700
endif
for x=1 to 15
obj=memblock byte(2,x)+800
if obj>800
if memblock byte(2,15+x)=0
posx=object position x(obj)
posy=object position z(obj)
for y=1 to 100
obj2=start+y
if object exist(obj2)=1
posx2=object position x(obj2) : posy2=object position z(obj2)
dist=sqrt((posx-posx2)^2+(posy-posy2)^2)
if dist<500 and dist>0
write memblock byte 2,15+x,obj2-600
goto breakloop
endif
endif
next y
breakloop:
endif
endif
next x
endfunction
function Attack_Target()
fire=fire+1
if fire>50 then fire=1
for x=1 to 15
obj=memblock byte(2,x)+800
if object exist(obj)=1
unit=memblock byte(2,15+x)+600
if object exist(unit)=1
if unit<>600
objang=object angle y(obj)
point object obj,object position x(unit),0,object position z(unit)
destang=object angle y(obj)
rotate object obj,0,objang,0
yrotate object obj,curvevalue(objang,destang,10)
set cursor 100,0 : print destang," ",objang," ",curvevalue(objang,destang,10)
if fire=50 then Enemy_Health(unit-600)=Enemy_Health(unit-600)-10
if Enemy_Health(unit-600)<=0 then delete object unit
endif
else
write memblock byte 2,15+x,0
endif
endif
next x
endfunction
function Hide_Objects()
for x=0 to 1200
if object exist(x)=1 and object in screen(x)=0
hide object x
else
show object x
endif
next x
endfunction
function Set_To_Target_Unit(lrx,lry)
` Check units
for x=1 to 200
id=x+600
if object exist(id)=1
xpos=object screen x(id)
ypos=object screen y(id)
if xpos>lrx-12 and xpos<lrx+12 and ypos<lry+12 and ypos>lry-12
for x=1 to Selected_Units(0)
unit=memblock byte(1,x)
if object exist(unit+500)=1
Destination_pos(unit,0)=-1
Destination_pos(unit,1)=id
endif
next x
endif
endif
next x
endfunction
The function that controls the formations is under Get_Destination() but I included more so you can see how the unit formations work now.
EDIT:
the program requires no outside media so you can just copy the code into DB but uses the enhancement pack
