How to check a list of types against the same list of types? Can it be done in a dual for each loop? I made a simple test prog here to show what it is I mean. Anyone who can get this working without the use of Arrays?
;Probewars with Types
Type Probe
Field X%,Y%
Field health%
End Type
For NR = 1 To 100
P.Probe = New Probe
P\X = Rnd(0,300)
P\Y = Rnd(0,400)
P\Health = Rnd(0,10)
Next
Graphics 400,300,16,0 ;Window ;use frontbuffer
SetBuffer FrontBuffer()
SeedRnd = MilliSecs()
While Not KeyDown(1)
Cls
;Move the Probe-Ps randomly
For P.Probe = Each Probe
P\X = P\X + Rnd( -1,1 )
P\Y = P\Y + Rnd( -1,1 )
Plot P\X,P\Y
Next
For P.Probe = Each Probe
; ;Do another loop or somehow check collisions against each P
;
; IF P\X = AnotherP\X and P\Y = AnotherP\Y then delete Probe
;
; If RectsOverlap(P\X,P\Y,1,1,???\X,???\Y,1,1)
; Delete Probe;in this example delete one of the Ps
; EndIf
Next
Flip
Wend
Any comments are welcome! - Wave
For P.Probe = Each Probe
For P2.Probe = Each Probe
If P\X = P2\X
;Do something
EndIf
Next
Next
Well I changed the code after what you said but now it says object does not exist..
[Code]
;Probewars with Types v2
Type Probe
Field X%,Y%
Field health%
Field r,g,b
End Type
For NR = 1 To 30
P.Probe = New Probe
;Possition
P\X = Rnd(0,800): P\Y = Rnd(0,600)
;Colors
P\r = Rnd(0,255): P\g = Rnd(0,255): P\b = Rnd(0,255)
Next
Graphics 800,600,16,0 ;Window
SetBuffer BackBuffer()
SeedRnd = MilliSecs()
While Not KeyDown(1)
;Cls
;Move the Probe randomly
For P.Probe = Each Probe
P\X = P\X + Rnd( -1,1 )
P\Y = P\Y + Rnd( -1,1 )
Color P\r,P\g,P\b ;add color
Plot P\X,P\Y
Next
;Check if any Probe overlaps any other probe
For P.Probe = Each Probe
For P2.Probe = Each Probe
If P\X = P2\X And P\Y = P2\Y
Delete P.Probe
EndIf
Next
Next
Flip
Wend
[/Code]
UPDATED TO VERSION 4
;Probewars with Types v4
Type Probe
Field X%,Y%
Field health%
Field r,g,b
End Type
For NR = 1 To 30
P.Probe = New Probe
;Possition
P\X = Rnd(0,800): P\Y = Rnd(0,600)
;Colors
P\r = Rnd(0,255): P\g = Rnd(0,255): P\b = Rnd(0,255)
Next
Graphics 800,600,16,0 ;Window
SetBuffer BackBuffer()
SeedRnd = MilliSecs()
While Not KeyDown(1)
;Cls
;Move the Probe randomly
For P.Probe = Each Probe
P\X = P\X + Rnd( -1,1 )
P\Y = P\Y + Rnd( -1,1 )
Color P\r,P\g,P\b ;add color
Rect P\X,P\Y ,3,3
Next
;Check if any Probe overlaps any other probe
For P.Probe = Each Probe
p2.probe = After p
While p2 <> Null
If P\X = P2\X And P\Y = P2\Y
Delete P2
EndIf
p2 = After p2
Wend
Next
Flip :Cls
Wend
V4 helped me. Then somehow it just came to me. That u can do it as Chris said, BUT you have to check that p <> p2 which was the technique I used. This program doesn't do much but it is little fun for a little while and I quess other people can learn from it(It is a possibility) so here it goes:
[Code]
;----------------------------------------------
;Probewars v8
AppTitle "ProbeWars v8"
;- SampleProgram to test Types And to Test Ai / Movement
;- The Probes just randomly fly around from one location to another
;-------------------------
;Change Constants to alter behavior of the program
Const NumberOfProbes = 7
Const ProbeSpeed# = 3.001
Const ProbeTurnSpeed% = 5
Const ProbeSeize = 3
Const WIDTH=400,HEIGHT=400 ;Sets Graphics mode to this seize + arena
Const ProbeHealth = 10
Const ExplosionSeize=30
Type Probe
;Dx,Dy is DestinationX,DestinationY
Field X#,Y#,Dx#,Dy#
Field Xvel#,Yvel#
Field iDir#,Dir
Field health%
Field r%,g%,b%
End Type
For NR = 1 To NumberOfProbes
P.Probe = New Probe
P\Health = ProbeHealth
;Possition
P\X = Rnd(0,WIDTH): P\Y = Rnd(0,HEIGHT)
P\DX = Rnd(0,WIDTH): P\DY = Rnd(0,HEIGHT)
;Colors
P\r = Rnd(0,255): P\g = Rnd(0,255): P\b = Rnd(0,255)
Next
Graphics WIDTH,HEIGHT,16,2 ;Window
SetBuffer BackBuffer()
SeedRnd = 55
; P2.Probe = After P ;Checks P against all P's after it, then all efter next P etc
; While p2 <> Null
; p2 = After p2
; Wend
While Not KeyDown(1) ;------------------------------------------------------
For P.Probe = Each Probe
Color P\r,P\g,P\b ;add color
Rect P\X,P\Y ,ProbeSeize,ProbeSeize;DrawProbe
If P\dir > 359 P\dir = 0
If P\dir < 0 P\dir = 359
P\X = P\X + P\Xvel
P\Y = P\Y + P\Yvel
; ;Move the Probe
If RectsOverlap(P\X,P\Y,15,15,P\Dx,P\Dy,15,15);If the destination to Dx,Dy is ~30
;Set a new destination
P\Dx = Rnd(0,WIDTH)
P\Dy = Rnd(0,HEIGHT)
;
Else
P\iDir = ATan2((P\Y-P\DY),(P\X-P\DX))
If P\iDir = 0 Then P\iDir = P\Dir;--> if no target go forward
TE# = rotarydir#(P\dir,P\idir#)
If TE > 0 Then P\dir = P\dir - ProbeTurnSpeed
If TE < 0 Then P\dir = P\dir + ProbeTurnSpeed
P\Xvel = ProbeSpeed#*Cos(P\dir)
P\Yvel = ProbeSpeed#*Sin(P\dir)
EndIf
;Check if any Probe overlaps any other probe
;Collisiondetection START;
For P2.Probe = Each Probe
If P2 <> P
If RectsOverlap(P\X,P\Y,ProbeSeize,ProbeSeize,P2\X,P2\Y,ProbeSeize,ProbeSeize)
Color 255,0,0 : Oval(P\X-ExplosionSeize/2,P\Y-ExplosionSeize/2,ExplosionSeize,ExplosionSeize,0) ;Draw explosion
P\Health=P\Health-1
EndIf
EndIf
Next
;Collisiondetection END;
If P\Health=5 ;Splitt probe into 2 Probes
P2.Probe=New Probe
;First Let's set new destinations for both
P2\Dx=P\Dx+Rnd(0,WIDTH):P2\Dy=Rnd(0,HEIGHT)
P\Health=4:P2\Health=2
P2\X=P\X+Rnd(-1,1):P2\Y=P\Y+Rnd(-1,1)
P2\r=P\r:P2\g=P\g:P2\b=P\b
EndIf
If P\X > WIDTH+80 Or P\Y > HEIGHT+80 Or P\X<-80 Or P\Y<-80 P\Health=-1
If P\Health <0 Delete P
Next;P.Probe
Flip :Cls;Flip N Clear
Wend ;-----------------------------------------------------------------------
Delete Each Probe
End ;;
;This funktion is from codearchives
;I can't say I really understand it :) but who cares, it works!
;------------------------------------------------------------------
;Function : RotaryDir
;Purpose : Calculate the Angle to turn to new DIR
;Params : ScourceDir = The starting dir, DestDir = The dir to turn to
;----------------------------------------------------------------------
Function RotaryDir#(SourceDir#,DestDir#,smooth#=1)
If SourceDir#>DestDir#
Diff1#=SourceDir-DestDir
diff2#=(360.0-SourceDir)+DestDir
If diff2<diff1
dir#=diff2/smooth
Else
dir#=diff1/smooth*-1
EndIf
Else
If SourceDir#<DestDir#
diff1=DestDir-SourceDir
diff2=(360.0-DestDir)+SourceDir
If diff2<diff1
dir#=diff2/smooth*-1
Else
dir#=diff1/smooth
EndIf
Else
dir=0
EndIf
EndIf
Return dir
End Function
[/Code]