Here's a code I found somewhere - I don't know who made it, but it works
remstart
DarkBASIC Demo
Illustrates RTS-style mouse selection of the tanks, and fast screen scrolling
To try it out:
a) Click on an individual unit to select or deselect it
b) Hold down Ctrl, then click on individual units, to select more than one
c) Hold down the left mouse button, and "draw" a box around the units you
want to select
d) Once you have units selected, move the mouse to the edge of the screen -
you'll see it quickly scroll across the playing area
e) Click elsewhere on the playing area and the selected tanks will move to
that point. Well, more or less.
remend
rem *** Standard manual sync approach
sync on
sync rate 0
autocam off
rem *** It can make code easier to read if we set up "True" and "False"
rem *** variables here.
true = 1
false = 0
rem *** Make our ground
make matrix 1,10000,10000,10,10
Rem *** Load an image
Load Image "baked01.bmp", 1
Rem *** Use the image to add a texture to the matrix
Prepare Matrix Texture 1,1,1,1
rem *** position the camera, point it at the matrix
position camera 500,1000,-500
point camera 500,10,500
xRotate Camera 45
rem *** Set up these arrays to hold our tank information
Dim Team(4,4)
Dim Hit(4)
rem *** The central starting coordinates for our four tanks
XPos = 100
ZPos = 500
rem *** Load the sound we'll use for our tanks
TankMoving = 1
Load Sound "TankMoving.wav", TankMoving
rem *** Load all the tanks
For Tank = 1 To 4
Load Object "tank2.x",Tank
Scale Object Tank,2000,2000,2000
rem *** Position the tanks evenly around the starting position
XPos = 500+((Tank-2)*150)
ZPos = 500+((2-Tank)*150)
Position Object Tank,XPos,40,ZPos
YRotate Object Tank,180
Fix Object Pivot Tank
rem *** Make and colour the "Health bar" for each tank
Make Object Plain Tank+5,100,5
Color Object Tank+5,RGB(0,255,0)
YRotate Object Tank+5,90
Fix Object Pivot Tank
Hide Object Tank+5
Next Tank
Set Camera Range 1, 15000
CamX = 500
CamY = 500
CamZ = -500
Do
rem *** Move camera position according to cursor keys pressed
If Upkey() Then CamZ = CamZ + 5
If DownKey() Then CamZ = CamZ - 5
If LeftKey() Then CamX = CamX - 5
If RightKey() Then CamX = CamX + 5
rem *** Better still, use the current mouse position to move quickly.
rem *** MouseX() and MouseY() return the horizontal and vertical
rem *** screen position of the mouse cursor; if they are close to the
rem *** edge of the screen, move the camera quickly in that direction.
If MouseX() < 5 Then CamX = CamX - 50
If MouseX() > (Screen Width()-5) Then CamX = CamX + 50
If MouseY() < 5 Then CamZ = CamZ + 50
If MouseY() > (Screen Height()-5) Then CamZ = CamZ - 50
rem *** Make sure the player can't move the camera totally off the map,
rem *** by limiting the camera position.
If CamX < 0 Then CamX = 0
If CamX > 9500 Then CamX = 9500
If CamZ < -500 Then CamZ = -500
If CamZ > 9500 Then CamZ = 9500
Position Camera CamX, CamY, CamZ
rem *** Handle all the mouse-related things we can do
GoSub HandleMouse
Moving = 0
rem *** process what happens when the tanks are moving
For i = 1 To 4
If (Team(i,2) > 0) Or (Team(i,3) > 0)
rem *** move forward, then back if we hit something
Move Object i,5
If Colliding(i)=True
Move Object i,-5
Hit(i) = Hit(i) + 1
If Hit(i) > 30
Halt(i)
EndIf
EndIf
rem *** position the health bar for each tank
PositionHealthBar(i+5)
rem *** stop the tank if it's within 6 world units of its final
rem *** destination
For j = 1 to 4
If (Team(j,2) > 0) Or (Team(j,3) > 0)
dx# = Abs(Team(j,2) - Object Position X(j))
dz# = Abs(Team(j,3) - Object Position Z(j))
If (dx# < 6) And (dz# < 6)
Halt(j)
EndIf
EndIf
Next j
EndIf
Next i
rem *** How many tanks are still moving?
T = TotalMoving()
rem *** If none, turn down the sound
If (T = 0) And (Sound Looping(TankMoving)=1)
Volume = Get Sound Volume(TankMoving)
If Volume > 3
Set Sound Volume TankMoving, Volume - 1
Else
Stop Sound TankMoving
EndIf
Else
rem *** Otherwise, set the sound volume according to the number
rem *** of tanks visible on screen.
Set Sound Volume TankMoving, 60+(TotalMovingOnScreen()*10)
EndIf
rem *** Update the screen
Sync
rem *** And go around the loop again
Loop
End
HandleMouse:
rem *** It's the first mouse click, so record the click positions
if mouseclick()=true and mp = false
firstx = mousex()
firsty = mousey()
lastx = mousex()
lasty = mousey()
mp = true
Else
rem *** If we right-click the mouse, deselect all the tanks
If mouseclick()= 2
For t = 1 to 4
Deselect(t)
Next t
EndIf
endif
rem *** If the left mouse cursor is still down, then we may be dragging.
rem *** Record the last mouse position, and draw a box on the screen.
if mouseclick()=true and mp = true
lastx = mousex()
lasty = mousey()
DrawBox(firstx,firsty,lastx,lasty)
endif
SelectedSomething = False
rem *** If the left mouse button is released...
if mouseclick()=false
rem *** but we've recorded a click earlier...
If mp = true
rem *** and the user hasn't dragged the mouse to form a selection box...
If Dragging(firstx,firsty,lastx,lasty)=False
rem *** Then they might have clicked on a single tank. If they have,
rem *** then select it, and deselect everything else.
For t = 1 to 4
If ClickedOnObject(firstx, firsty, t)=True
SelectOnly(t)
SelectedSomething = True
Exit
EndIf
Next t
rem *** They didn't click on a tank, so move any currently selected units
rem *** to the point they chose. Note that the formula we use to locate
rem *** this point isn't really accurate, but translating a click on a
rem *** screen, to a point in 3D game space, is no trivial matter.
If SelectedSomething = False
SetUpMove(CamX+((MouseX()-320)*1.5),(CamZ+500)+((240-MouseY())*2.0))
EndIf
EndIf
mp = False
EndIf
EndIf
rem *** If we're clicking...
If mp = true
rem *** Then for each tank...
for t = 1 to 4
rem *** If we're still dragging...
if (mouseclick() = True) And (Dragging(firstx,firsty,lastx,lasty) = True)
rem *** and this tank (t) is inside the box we're dragging...
If IsInBox(firstx,firsty,lastx,lasty,t)
rem *** then select it...
Select(t)
SelectedSomething = True
rem *** otherwise, deselect it.
else
DeSelect(t)
endif
endif
next t
EndIf
Return
rem *** Select a specific member of the team
Function Select(t)
PositionHealthBar(t+5)
Show Object t+5
rem *** Setting this variable lets us know the unit is selected
Team(t,1)=1
EndFunction
rem *** Select a specific member of the team
rem *** and deselect everyone else
Function SelectOnly(t)
Select(t)
If ControlKey() <> 1
For i = 1 To 4
If i <> t then DeSelect(i)
Next i
EndIf
EndFunction
rem *** Deselect a specific member of the team
Function DeSelect(t)
Hide Object t+5
rem *** Setting this variable lets us know the unit is deselected
Team(t,1)=0
EndFunction
rem *** Return the number of team members selected
Function TotalSelected()
i = 0
For t = 1 To 4
If Team(t,1) = 1 Then i = i + 1
Next t
EndFunction i
rem *** Return the number of team members moving
Function TotalMoving()
i = 0
For t = 1 To 4
If (Team(t,2) <> 0) Or (Team(t,3)<>0) Then i = i + 1
Next t
EndFunction i
rem *** Return the number of team members moving, and currently displayed
rem *** on the screen
Function TotalMovingOnScreen()
i = 0
For t = 1 To 4
If (Team(t,2) <> 0) Or (Team(t,3)<>0)
If Object In Screen(t) Then i = i + 1
EndIf
Next t
EndFunction i
rem *** Move all the selected units to the given coordinates
Function SetupMove(X#,Y#)
SumX# = 0
SumY# = 0
Total = 0
rem *** For each tank...
For i = 1 to 4
rem *** If the tank is selected...
If Team(i,1) = 1
rem *** Then add its position to the total
SumX# = SumX# + Object Position X(i)
SumY# = SumY# + Object Position Z(i)
Total = Total + 1
EndIf
Next i
rem *** If at least one tank was selected...
If Total > 0
rem *** then calculate the average of all selected tank positions.
MeanX# = SumX# / Total
MeanY# = SumY# / Total
rem *** For each selected tank...
For i = 1 to 4
If Team(i,1) = 1
rem *** Calculate its target position as an offset from the average.
rem *** This allows the tanks to automatically move in formation.
Team(i,2) = MatrixLimit(X# + (Object Position X(i) - MeanX#))
Team(i,3) = MatrixLimit(Y# + (Object Position Z(i) - MeanY#))
rem *** And use the "Point" command to point the tank in the direction
rem *** of its target.
Point Object i, Team(i,2), 40, Team(i,3)
EndIf
Next i
EndIf
rem *** Start the "tank moving" sound
Loop Sound 1
EndFunction
rem *** Returns True (1) if the specified team member has been clicked
Function ClickedOnObject(xclick,yclick,t)
xpos = object screen x(t)
ypos = object screen y(t)
If (Abs(xpos-xclick) < 20) And (Abs(ypos-yclick) < 20)
i = 1
else
i = 0
EndIf
EndFunction i
Rem *** Returns true if the specified team member lies within a given box
Function IsInBox(firstx,firsty,lastx,lasty,t)
xpos = object screen x(t)
ypos = object screen y(t)
if xpos > firstx and xpos < lastx or xpos > lastx and xpos < firstx
if ypos > firsty and ypos < lasty or ypos > lasty and ypos < firsty
i = 1
else
i = 0
endif
else
i = 0
endif
EndFunction i
Rem *** Returns true if the four coordinates vary enough to qualify
Rem *** as a mouse selection box
Function Dragging(x1,y1,x2,y2)
If (Abs(x1 - x2)>3) Or (Abs(y1-y2)>3)
i = 1
Else
i = 0
EndIf
EndFunction i
Rem *** Draw a box given two sets of coordinates
Function DrawBox(firstx,firsty,lastx,lasty)
line firstx,firsty,firstx,lasty
line lastx,firsty,lastx,lasty
line firstx,firsty,lastx,firsty
line firstx,lasty,lastx,lasty
EndFunction
rem *** Don't let the tanks move off the matrix edge
Function MatrixLimit(X#)
I = X#
If I < 50 Then I = 50
If I > 9500 Then I = 9500
EndFunction I
Rem *** Detects whether any of the tanks are colliding with each other
Function Colliding(ObjID)
i = 0
x = Object Position X(ObjID)
z = Object Position Z(ObjID)
For j = 1 to 4
If j <> ObjID
x1 = Object Position X(j)
z1 = Object Position Z(j)
xdiff = x-x1
zdiff = z-z1
If Sqrt((xdiff*xdiff)+(zdiff*zdiff)) < 180
i = 1
Exit
EndIf
EndIf
next j
EndFunction i
Rem *** Stops the specified tank in its tracks (ha ha ha)
Function Halt(ObjID)
Team(ObjID,2)=0
Team(ObjID,3)=0
Hit(ObjID)=0
EndFunction
rem *** Position the health bar on the tank
Function PositionHealthBar(ObjID)
Set Object To Camera Orientation ObjID
Position Object ObjID, Object Position X(ObjID-5), Object Position Y(ObjID-5)+60, Object Position Z(ObjID-5)
EndFunction
Hope this helps
RED GENERAL
My computer melts regulary - perhaps it likes being fondue
