Games [x2][solved] Help needed regarding Object Collision

fredo

Well-Known Member
Licensed User
Longtime User
This is a follow-up request to https://www.b4x.com/android/forum/threads/x2-solved-help-needed-regarding-object-movement.108390/

The enclosed test project is supposed to be a turn-based top down RPG board game for 2 characters.
Planned course: Players shall roll their dice alternately and advance the corresponding number of fields, sometimes choosing which way to go.

Since the interaction of the X2 framework components has not yet been sufficiently understood, concrete references to the required "best practices" would be needed.

The x2 examples were used to create the basic structures and load the graphics.

I read the article "CollideOrNotToCollide" and think I almost understood it.

The collision of the characters with the objects is correctly registered and evaluated in "World_BeginContact()".

What confuses me is the fact that the object "p1" triggers an event twice, although only 1 character collided with it.

But this does not occur regularly, as you can see with "p3" and "p4".

B4X:
#-Sub World_BeginContact
#-  x614, bodies.OtherBody.Name = p1
#-Sub game.Touch_Object_P, Object_px.Name = p1
#-
#-Sub World_BeginContact
#-  x614, bodies.OtherBody.Name = p1
#-Sub game.Touch_Object_P, Object_px.Name = p1
#-
#-Sub World_BeginContact
#-  x614, bodies.OtherBody.Name = p2
#-Sub game.Touch_Object_P, Object_px.Name = p2
#-
#-Sub World_BeginContact
#-  x614, bodies.OtherBody.Name = p2
#-Sub game.Touch_Object_P, Object_px.Name = p2
#-
#-Sub World_BeginContact
#-  x614, bodies.OtherBody.Name = p3
#-Sub game.Touch_Object_P, Object_px.Name = p3
#-
#-Sub World_BeginContact
#-  x614, bodies.OtherBody.Name = p4
#-Sub game.Touch_Object_P, Object_px.Name = p4



B4X:
'
' Java source --> file:///.\Objects\src\b4j\gametest\sn\game.java
'
' ------- -------------- ------
'#CustomBuildAction: folders ready, %WINDIR%\System32\Robocopy.exe,"..\..\Shared Files" "..\Files"

' This is required to copy all files from the "Shared Files" folder to the "Files" folder of the respective platform.
'     Erel --> https://www.b4x.com/android/forum/threads/xui2d-cross-platform-tips.96815/#content
' ------- -------------- ------

' ------- -------------- ------
' X2Test1 "Basic structures"
'     x2notes    --> https://www.b4x.com/android/forum/threads/some-notes-to-better-understand-the-xui2d-examples.107702/
'     x2examples --> https://www.b4x.com/android/forum/threads/xui2d-example-pack.96454/
'   @Gunter’s roadmap into the game dev world --> https://www.b4x.com/android/forum/threads/video-tutorial.99172/#post-624377
' ------- -------------- ------

#if B4A
'ignore DIP related warnings as they are not relevant when working with BitmapCreator.
#IgnoreWarnings: 6
#end if

Sub Class_Globals
    '
    Private ISDEBUG As Boolean = True ' It's easier to change it here instead of find it further down
    '
    ' Collision filtering
    ' Gunther --> https://www.b4x.com/android/forum/threads/tool-collision-bits-and-masks-calculator-collision-filtering.103320/
    Public const COLL_CATEGORY_PLAYER As Int  = 0x0001 ' 0000000000000001 in binary
    Public const COLL_CATEGORY_MONSTER As Int = 0x0002 ' 0000000000000010 in binary
    Public const COLL_CATEGORY_SCENERY As Int = 0x0004 ' 0000000000000100 in binary
   
    Public const COLL_MASK_PLAYERHITS_MONSTERORSCENERY As Int  = 0xFFFE ' 1111111111111110 in binary
    Public const COLL_MASK_MONSTERHITS_PLAYER As Int           = 0xFFF9 ' 1111111111111001 in binary
    Public const COLL_MASK_SCENERYHITS_PLAYER As Int           = 0xFFF9 ' 1111111111111001 in binary
   
    ' The group index can be used to override the category/mask settings for a given set of fixtures.
    ' --> https://www.iforce2d.net/b2dtut/collision-filtering
    Public const COLL_GROUP_PLAYER As Int = -1
    Public const COLL_GROUP_MONSTER As Int = -2
    Public const COLL_GROUP_SCENERY As Int = 1
   
    ' Basic x2 libraries that are needed in every game
    Public  xui As XUI 'ignore
    Public X2 As X2Utils
    Public world As B2World
   
    ' TileMap specific definitions
    Public TileMap As X2TileMap
    Public Const ObjectLayer As String = "Object Layer 1"
   
    ' ExtraClasses
    Private mChar1 As Figure
    Private mChar2 As Figure
   
    ' Gamestate
    Private GameOverState As Boolean
    Private ActiveCharIndex As Int = 1
    Private LastDiceRollVal As Int = 0
    Private CharLastPositionIndex(3) As Int
    Private Char1Points As List
    Private Char2Points As List
    Type PointXy(x As Float, y As Float)
   
    ' Bodies and joints
    Private Border As X2BodyWrapper
    Private MotorChar1 As B2MotorJoint
    Private MotorChar2 As B2MotorJoint
   
    Private PathMainBCForward As BCPath
    Private PathMainBCBackwards As BCPath
    Private PathWorld As List
    Private BrushRed As BCBrush
   
   
    ' Templates
    Type FigureTemplates(Template As X2TileObjectTemplate, XPosition As Float)
    Private FigureTemplatesList As List
   
    Type PointTemplates(Template As X2TileObjectTemplate, XPosition As Float)
    Private PointTemplatesList As List
    Private PointTemplatesListLoop0 As List
   
    Type TextTemplates (Template As X2TileObjectTemplate, XPosition As Float)
    Private TextTemplatesList As List
   
    Type LocationTemplates(Template As X2TileObjectTemplate, XPosition As Float)
    Private LocationTemplatesList As List
   

    ' Layout elements
    Private ivForeground As B4XView
    Private ivBackground As B4XView
    Public lblStats As B4XView
    Private pnlTouch As B4XView
    Private RadioButton1 As RadioButton' ####testingonly
    Private RadioButton2 As RadioButton' ####testingonly
    Private Button1 As Button' ####testingonly
    Private Label2 As Label' ####testingonly
    Private Pane1 As Pane' ####testingonly
    Private fx As JFX' ####testingonly
    Private TempTestPane As Pane' ####testingonly
    Private Label5 As Label' ####testingonly
End Sub

Public Sub Initialize (Parent As B4XView)
    '
    ' ──────────────────────────────────
    ' Preparations for Layout and Views
    ' ──────────────────────────────────
    Parent.LoadLayout("GameLayout")
    lblStats.TextColor = xui.Color_Black
    lblStats.Color = 0x88ffffff
    lblStats.Font = xui.CreateDefaultBoldFont(20)
   
    CSSUtils.SetBackgroundColor(Pane1, fx.Colors.LightGray)' ####testingonly
   
    ' ──────────────────────────────────
    ' Preparations for World
    ' ──────────────────────────────────
    world.Initialize("world", world.CreateVec2(0, 0))
    X2.Initialize(Me, ivForeground, world)
   
    Dim WorldWidth As Float = 36 'meters
    Dim WorldHeight As Float = WorldWidth / 1 'same ratio as in the designer script (in GameLayout.bjl)!!!
    X2.ConfigureDimensions(world.CreateVec2(WorldWidth / 2, WorldHeight / 2), WorldWidth)
   
    ' ──────────────────────────────────
    ' Preparations for movements
    ' ──────────────────────────────────
    PathMainBCForward.Initialize(0, 0)
    PathMainBCBackwards.Initialize(0, 0)
    PathWorld.Initialize
    BrushRed = X2.MainBC.CreateBrushFromColor(xui.Color_Red)
    CharLastPositionIndex(0) = -1 ' not used
    CharLastPositionIndex(1) = 0 ' for Char1
    CharLastPositionIndex(2) = 0 ' for Char2
   
    Char1Points.Initialize
    Char2Points.Initialize
   
    ' ──────────────────────────────────
    ' Preparations for graphics
    ' ──────────────────────────────────
    GraphicCache_Put_Characters
   
    ' ──────────────────────────────────
    ' Preparations for screen
    ' ──────────────────────────────────
    SetBackground
    'CreateStaticBackground
    'CreateBorder
   
   
    ' ──────────────────────────────────
    ' Preparations for sounds
    ' ──────────────────────────────────
    X2.SoundPool.AddSound("rolldice", File.DirAssets, "dice-4.wav")
    X2.SoundPool.AddSound("stepstone_1", File.DirAssets, "stepstone_1.wav")
    X2.SoundPool.AddSound("metal-clash", File.DirAssets, "metal-clash.wav")
   
   
    ' ──────────────────────────────────
    ' Debug settings
    ' ──────────────────────────────────
    If ISDEBUG Then
        X2.EnableDebugDraw    ' Comment out to disable debug drawing
    End If
   
End Sub

Private Sub SetWorldCenter
    ' The map size will not be identical to the screen size.
    ' This happens because the tile size in (bc) pixels needs to be a whole number.
    ' So we need to update the world center and move the map to the center.
    X2.UpdateWorldCenter(TileMap.MapAABB.Center)
End Sub
Public Sub WorldCenterUpdated (gs As X2GameStep)
    'CreateEnemies
End Sub
private Sub SetBackground
    'X2.SetBitmapWithFitOrFill(ivBackground, xui.LoadBitmapResize(File.DirAssets, "mybackgroundimage.jpg", ivBackground.Width / 2, ivBackground.Height / 2, False))
End Sub
 
Private Sub GraphicCache_Put_Characters
    Log("#-Sub game.GraphicCache_Put_Characters")

    ' Use bitmap without the transparency placeholdercolor:
    Dim bc As BitmapCreator = X2.BitmapToBC( xui.LoadBitmap(File.DirAssets, "RPGCharacterSprites32x32.png"), 1)
    RemovePseudoTransparentColor(bc, "#ff00ff") ' pink, magenta
    Dim bmp As B4XBitmap = bc.Bitmap
   
    Dim NumberOfSprites As Int = 12
    Dim RowWidth As Int = 32
    Dim RowHeight As Int = 32
    Dim CharHeightMeters As Int = 3
    '
    Dim RowOfChar1 As Int = 2
    Dim character1 As B4XBitmap = bmp.Crop(0, RowHeight * RowOfChar1, NumberOfSprites * RowWidth, RowHeight)
    Dim AllChar1 As List = X2.ReadSprites(character1, 1, NumberOfSprites, CharHeightMeters, CharHeightMeters)
    X2.GraphicCache.PutGraphic("character1 front walking", Array(AllChar1.Get(0), AllChar1.Get(1), AllChar1.Get(2), AllChar1.Get(3)))
    X2.GraphicCache.PutGraphic("character1 front standing", Array(AllChar1.Get(3)))
    X2.GraphicCache.PutGraphic("character1 back walking", Array(AllChar1.Get(4), AllChar1.Get(5), AllChar1.Get(6), AllChar1.Get(7)))
    X2.GraphicCache.PutGraphic("character1 back standing", Array(AllChar1.Get(7)))
    X2.GraphicCache.PutGraphic("character1 side walking", Array(AllChar1.Get(8), AllChar1.Get(9), AllChar1.Get(10)) )
    X2.GraphicCache.PutGraphic("character1 side standing", Array(AllChar1.Get(9)) )
    '
    Dim RowOfChar2 As Int = 3
    Dim character2 As B4XBitmap = bmp.Crop(0, RowHeight * RowOfChar2, NumberOfSprites * RowWidth,  RowHeight)
    Dim AllChar2 As List = X2.ReadSprites(character2, 1, NumberOfSprites, CharHeightMeters, CharHeightMeters)
    X2.GraphicCache.PutGraphic("character2 front walking", Array(AllChar2.Get(0), AllChar2.Get(1), AllChar2.Get(2), AllChar2.Get(3)))
    X2.GraphicCache.PutGraphic("character2 front standing", Array(AllChar2.Get(3)))
    X2.GraphicCache.PutGraphic("character2 back walking", Array(AllChar2.Get(4), AllChar2.Get(5), AllChar2.Get(6), AllChar2.Get(7)))
    X2.GraphicCache.PutGraphic("character2 back standing", Array(AllChar2.Get(7)))
    X2.GraphicCache.PutGraphic("character2 side walking", Array(AllChar2.Get(8), AllChar2.Get(9), AllChar2.Get(10)) )
    X2.GraphicCache.PutGraphic("character2 side standing", Array(AllChar2.Get(9)) )
    '
   
End Sub

Private Sub RemovePseudoTransparentColor(TilesBC As BitmapCreator, clrstring As String)
    ' Erel --> https://www.b4x.com/android/forum/threads/x2-how-to-use-transparent-color.108173/#post-676534
    Dim clr As Int = 0xff000000 + Bit.ParseInt(clrstring.SubString(1), 16)
    Dim ptranspm As PremultipliedColor
    Dim trans As PremultipliedColor
    Dim pm As PremultipliedColor
    Dim argb As ARGBColor
    TilesBC.ColorToARGB(clr, argb)
    TilesBC.ARGBToPremultipliedColor(argb, ptranspm)
    For y = 0 To TilesBC.mHeight - 1
        For x = 0 To TilesBC.mWidth - 1
            TilesBC.GetPremultipliedColor(x, y, pm)
            If Bit.And(0xff, pm.r) = ptranspm.r And Bit.And(0xff, pm.g) = ptranspm.g And Bit.And(0xff, pm.b) = ptranspm.b And Bit.And(0xff, pm.a) = ptranspm.a Then
                TilesBC.SetPremultipliedColor(x, y, trans)
            End If
        Next
    Next
End Sub


Private Sub PositionObjects
    For Each LocationTemplateX As LocationTemplates In LocationTemplatesList
        ' Initial position on location-objects (works ok)
        Select Case True
            Case LocationTemplateX.Template.Name.ToLowerCase.EndsWith("c1")
'                mChar1.bw.Body.SetTransform(LocationTemplateX.Template.Position, 0)
            Case LocationTemplateX.Template.Name.ToLowerCase.EndsWith("c2")
'                mChar2.bw.Body.SetTransform(LocationTemplateX.Template.Position, 0)
        End Select
    Next
End Sub
private Sub CreateObjects
    Log("#-Sub game.CreateObjects")
    FigureTemplatesList.Initialize
    PointTemplatesList.Initialize
    PointTemplatesListLoop0.Initialize
    TextTemplatesList.Initialize
    LocationTemplatesList.Initialize

    TempTestPane.RemoveAllNodes    ' ####testingonly

    Dim tempcounter_pt0 As Int = 0'####temp
    Dim ol As X2ObjectsLayer = TileMap.Layers.Get(ObjectLayer)
    For Each TileMapTemplateX As X2TileObjectTemplate In ol.ObjectsById.Values
        'Log("#-    x203, TileMapTemplateX.Name = " & TileMapTemplateX.Name)
       
        If TileMapTemplateX.FirstTime And TileMapTemplateX.Name.ToLowerCase.StartsWith("p") Then
            Dim pt As PointTemplates
            pt.Template = TileMapTemplateX
            pt.XPosition = TileMapTemplateX.Position.X
            pt.Template.FixtureDef.SetFilterBits(COLL_CATEGORY_SCENERY, COLL_MASK_SCENERYHITS_PLAYER)
            PointTemplatesList.Add(pt)
            TileMap.CreateObject(TileMapTemplateX)
            If Not(TileMapTemplateX.Name.Contains(".")) And Not(TileMapTemplateX.Name.Contains("x")) Then
                Log("#-    x250, " & $"${TileMapTemplateX.Name} --> PointTemplatesListLoop0(${tempcounter_pt0})= $1.0{pt.Template.Position.X}, $1.0{pt.Template.Position.Y}  "$)
                Dim xy0 As PointXy
                xy0.Initialize
                xy0.x = pt.Template.Position.X
                xy0.y = pt.Template.Position.y
                PointTemplatesListLoop0.Add(xy0)
                tempcounter_pt0 = tempcounter_pt0 +1
            End If
           
            ' ####testingonly
            ' Show the labels of points
            Dim lblx As Label
            lblx.Initialize("")
            lblx.Text = TileMapTemplateX.Name
            lblx.TextColor = fx.Colors.Yellow
            lblx.Alignment = "CENTER"
            Dim bp As B2Vec2 = X2.WorldPointToMainBC( TileMapTemplateX.Position.X, TileMapTemplateX.Position.Y)
            Private DebugScale As Float = 1.1 ' found by trial and error
            bp.MultiplyThis(DebugScale)
            TempTestPane.AddNode(lblx, bp.X, bp.Y, 40dip, 40dip)
            ' /####testingonly
           
           
        else If TileMapTemplateX.FirstTime And TileMapTemplateX.Name.ToLowerCase.StartsWith("text") Then
            Dim tt As TextTemplates
            tt.Template = TileMapTemplateX
            tt.XPosition = TileMapTemplateX.Position.X
            tt.Template.FixtureDef.SetFilterBits(COLL_CATEGORY_SCENERY, COLL_MASK_SCENERYHITS_PLAYER)
            TextTemplatesList.Add(tt)
            TileMap.CreateObject(TileMapTemplateX)
           
            ' ####testingonly
            ' Show the labels of text
            Dim lblx As Label
            lblx.Initialize("")
            lblx.Text = TileMapTemplateX.Name.Replace("TextVal","")
            lblx.TextColor = fx.Colors.Magenta
            lblx.Alignment = "CENTER_RIGHT"
            Dim bp As B2Vec2 = X2.WorldPointToMainBC( TileMapTemplateX.Position.X, TileMapTemplateX.Position.Y)
            Private DebugScale As Float = 1.1 ' found by trial and error
            bp.MultiplyThis(DebugScale)
            TempTestPane.AddNode(lblx, bp.X, bp.Y, 40dip, 40dip)
            ' /####testingonly          
           
       
        else If TileMapTemplateX.FirstTime And TileMapTemplateX.Name.ToLowerCase.StartsWith("char") Then
            Dim ft As FigureTemplates
            ft.Template = TileMapTemplateX
            ft.XPosition = TileMapTemplateX.Position.X
            ft.Template.FixtureDef.SetFilterBits(COLL_CATEGORY_PLAYER, COLL_MASK_PLAYERHITS_MONSTERORSCENERY)
            FigureTemplatesList.Add(ft)
           
            Dim bwChX As X2BodyWrapper = TileMap.CreateObject(TileMapTemplateX)
            bwChX.Body.BodyType = bwChX.Body.TYPE_DYNAMIC   ' not "TYPE_KINEMATIC": You cannot use forces and motors with kinematic types.
           
            If TileMapTemplateX.Name.ToLowerCase.EndsWith("1") Then
                mChar1.Initialize(bwChX) ' Set the delegate (the class "Figure")
                mChar1.FigureNameAndId = TileMapTemplateX.Name & "~" & TileMapTemplateX.id
                mChar1.bw.Body.LinearDamping = 0.01
                mChar1.bw.Body.SleepingAllowed = False
                MotorChar1 = CreateMotor(mChar1)

            else If TileMapTemplateX.Name.ToLowerCase.EndsWith("2") Then
                mChar2.Initialize(bwChX) ' Set the delegate (the class "Figure")
                mChar2.FigureNameAndId = TileMapTemplateX.Name & "~" & TileMapTemplateX.id
                mChar2.bw.Body.LinearDamping = 0.01
                mChar2.bw.Body.SleepingAllowed = False
                MotorChar2 = CreateMotor(mChar2)
               
            End If
       
        else If TileMapTemplateX.FirstTime And TileMapTemplateX.Name.ToLowerCase.StartsWith("loc") Then
            Dim lt As LocationTemplates
            lt.Template = TileMapTemplateX
            lt.XPosition = TileMapTemplateX.Position.X
            tt.Template.FixtureDef.SetFilterBits(COLL_CATEGORY_SCENERY, COLL_MASK_SCENERYHITS_PLAYER)
            LocationTemplatesList.Add(lt)
            TileMap.CreateObject(TileMapTemplateX)
           
        else If TileMapTemplateX.FirstTime And TileMapTemplateX.Name.ToLowerCase = "border" Then
            'nothing to do here. It is created in StartGame()
       
        else If TileMapTemplateX.FirstTime And TileMapTemplateX.Name.ToLowerCase.StartsWith("area") Then
            TileMap.CreateObject(TileMapTemplateX)
           
        Else
            Log("#-  x313, " & $"Unhandled object --> id=${TileMapTemplateX.Id}, ${TileMapTemplateX.Name}"$)
        End If
    Next
   
    FigureTemplatesList.SortType("XPosition", True)
    PointTemplatesList.SortType("XPosition", True)
    TextTemplatesList.SortType("XPosition", True)
    LocationTemplatesList.SortType("XPosition", True)
   
    '    Log("#-  x206, FigureTemplatesList.size   = " & FigureTemplatesList.Size)
    '    Log("#-  x207, PointTemplatesList.size    = " & PointTemplatesList.Size)
    '    Log("#-  x208, TextTemplatesList.size     = " & TextTemplatesList.Size)
    '    Log("#-  x209, LocationTemplatesList.size = " & LocationTemplatesList.Size)
   
End Sub
Private Sub CreateStaticBackground
    Dim bc As BitmapCreator
    bc.Initialize(ivBackground.Width / xui.Scale / 2, ivBackground.Height / xui.Scale / 2)
    bc.FillGradient(Array As Int(0xFF001AAC, 0xFFC5A400), bc.TargetRect, "TOP_BOTTOM")
    X2.SetBitmapWithFitOrFill(ivBackground, bc.Bitmap)
End Sub
Private Sub CreateBorder
    TileMap.CreateObject(TileMap.GetObjectTemplateByName(ObjectLayer, "border"))
End Sub
private Sub CreateMotor(character As Figure) As B2MotorJoint
    ' Erel --> https://www.b4x.com/android/forum/threads/x2-help-needed-regarding-object-movement.108390/#post-677540
    Dim MotorDefChar2 As B2MotorJointDef
    MotorDefChar2.Initialize(Border.Body, character.bw.Body)
    MotorDefChar2.MaxMotorForce = 500
    MotorDefChar2.CollideConnected = True 'let the Char collide with the borders
    Dim mc As B2MotorJoint = X2.mWorld.CreateJoint(MotorDefChar2)
    mc.CorrectionFactor = 0.02
    Return mc
End Sub


' ────────────────────────────────────────────────────────────────────────────────────────────────
Public Sub Resize
    X2.ImageViewResized
End Sub

Public Sub DrawingComplete
    TileMap.DrawingComplete
End Sub

'Return True to stop the game loop.
Public Sub BeforeTimeStep (GS As X2GameStep) As Boolean
    If GameOverState Then
        Return True
    End If

    Return False
End Sub

Public Sub Tick (GS As X2GameStep)
'    Log("#-Sub game.Tick, gs.GameTimeMs = " & GS.GameTimeMs)
    TileMap.DrawScreen(Array("Tile Layer 1"), GS.DrawingTasks)

    Select Case ActiveCharIndex
        Case 1
            If Char1Points.Size > 0 Then
                If Char1Points.Size = 1 Then
                    'MotorChar1.CorrectionFactor = 0.02
                    MotorChar1.CorrectionFactor = 0.03
                Else
                    'MotorChar1.CorrectionFactor = 0.05
                    MotorChar1.CorrectionFactor = 0.04
                End If
                Dim NextPoint As B2Vec2 = Char1Points.Get(0)
                Dim vec As B2Vec2 = mChar1.bw.Body.Position.CreateCopy
                vec.SubtractFromThis(NextPoint)
                If vec.Length < 1 Then
                    Char1Points.RemoveAt(0)
                Else
                    MoveCharByMotorTo(ActiveCharIndex , NextPoint.CreateCopy)
                End If
            End If
           
        Case 2
            ' ~~  ~~  ~~  ~~  ~~  ~~  ~~
            ' duplikate code from "case 1" in order to avoid a timeconsuming call to a separate sub
            ' ~~  ~~  ~~  ~~  ~~  ~~  ~~
            If Char2Points.Size > 0 Then
                If Char2Points.Size = 2 Then
                    MotorChar2.CorrectionFactor = 0.02
                Else
                    MotorChar2.CorrectionFactor = 0.05
                End If
                Dim NextPoint As B2Vec2 = Char2Points.Get(0)
                Dim vec As B2Vec2 = mChar2.bw.Body.Position.CreateCopy
                vec.SubtractFromThis(NextPoint)
                If vec.Length < 2 Then
                    Char2Points.RemoveAt(0)
                Else
                    MoveCharByMotorTo(ActiveCharIndex , NextPoint.CreateCopy)
                End If
            End If

    End Select

End Sub

' ────────────────────────────────────────────────────────────────────────────────────────────────
Public Sub GameOver
    X2.SoundPool.StopMusic
'    X2.SoundPool.PlaySound("gameover")
    X2.AddFutureTask(Me, "Set_GameOver", 3500, Null)
End Sub
Private Sub Set_GameOver (ft As X2FutureTask)
    GameOverState = True
    Sleep(500)
    StartGame
End Sub
Public Sub StopGame
    X2.SoundPool.StopMusic
    X2.Stop
End Sub
Public Sub StartGame
    If X2.IsRunning Then Return
    X2.Reset
    X2.UpdateWorldCenter(X2.CreateVec2(X2.ScreenAABB.Width / 2, X2.ScreenAABB.Height / 2))
    GameOverState = False

    ' ──────────────────────────────────
    ' Preparations for Tilemap
    ' ──────────────────────────────────
    TileMap.Initialize(X2, File.DirAssets, "TiledMapFile_proj01.json", ivBackground)
    Dim TileSizeMeters As Float = X2.ScreenAABB.Height / TileMap.TilesPerColumn
    TileMap.SetSingleTileDimensionsInMeters(TileSizeMeters, TileSizeMeters)
    SetWorldCenter    ' Update the world center based on the map size
    TileMap.PrepareObjectsDef(ObjectLayer)

    Border = TileMap.CreateObject2ByName(ObjectLayer, "border")
   
    ' ──────────────────────────────────
    ' Draw Tilemap
    ' ──────────────────────────────────
    Dim tasks As List
    tasks.Initialize
    TileMap.Draw(Array("Tile Layer 1"), TileMap.MapAABB, tasks)
    For Each dt As DrawTask In tasks
        If dt.IsCompressedSource Then
            TileMap.CurrentBC.DrawCompressedBitmap(dt.Source, dt.SrcRect, dt.TargetX, dt.TargetY)
        End If
    Next
       
    ' ──────────────────────────────────
    ' Preparations for bodies
    ' ──────────────────────────────────
    CreateObjects
    PositionObjects
'    ActiveCharacterFigure = mChar1
   
    ' ──────────────────────────────────
    ' Start the Main loop
    ' ──────────────────────────────────
    X2.Start
   
End Sub
 
Sub pnlTouch_Touch (Action As Int, X As Float, Y As Float)
    ' Click is on a "FormPoint": x and y are the form-coordinates topleft=0,0 and bottomright=formheight,formwidth
    '
    If Action = pnlTouch.TOUCH_ACTION_MOVE_NOTOUCH Then Return
    Log("#-Sub pnlTouch_Touch, Action=" & Action & ", x=" & x & ", y=" & y)
   
    Dim WorldPoint As B2Vec2 = X2.ScreenPointToWorld(X, Y)
    Dim MainBCPoint As B2Vec2 = X2.WorldPointToMainBC(WorldPoint.X, WorldPoint.Y)
   
'    If Action = pnlTouch.TOUCH_ACTION_DOWN Then
'        Dim FirstPointBC As B2Vec2 = X2.WorldPointToMainBC(ActiveCharacterFigure.bw.Body.Position.X, ActiveCharacterFigure.bw.Body.Position.Y)
'      
'        ' CLONE the paths before modifying them.
'        PathMainBCForward = PathMainBCForward.Clone
'        PathMainBCForward.Reset(FirstPointBC.X, FirstPointBC.Y)
'        PathMainBCBackwards = PathMainBCBackwards.Clone
'        PathMainBCBackwards.Reset(FirstPointBC.X, FirstPointBC.Y)
'        PathWorld.Clear
'      
'    End If
   
    If PathWorld.Size > 0 Then
        Dim PrevPoint As B2Vec2 = PathWorld.Get(PathWorld.Size - 1)
        Dim distance As B2Vec2 = PrevPoint.CreateCopy
        distance.SubtractFromThis(WorldPoint)
        'to improve performance we skip very close points.
        If distance.LengthSquared < 0.1 Then
            Return
        End If
    End If
   
    PathMainBCForward = PathMainBCForward.Clone
    PathMainBCForward.LineTo(MainBCPoint.X, MainBCPoint.Y)
    PathWorld.Add(WorldPoint)
   
End Sub

Sub MoveCharByMotorTo (CharIndex As Int, vec As B2Vec2)
    vec.SubtractFromThis(Border.Body.Position)
    Select Case CharIndex
        Case 1
            MotorChar1.LinearOffset = vec
        Case 2
            MotorChar2.LinearOffset = vec
    End Select
End Sub

'Sub MoveChar(gs As X2GameStep)
'  
'    'This loop might be a bit confusing. The loop ends after the first far enough point.
'    Do While PathWorld.Size > 0
'        Dim NextPoint As B2Vec2 = PathWorld.Get(0)
'        Dim CurrentPoint As B2Vec2 = ActiveCharacterFigure.bw.Body.Position
'        Dim distance As B2Vec2 = NextPoint.CreateCopy
'        distance.SubtractFromThis(CurrentPoint)
'        If (distance.Length < 0.3 And PathWorld.Size > 1) Or (distance.Length < 0.1) Then
'            PathWorld.RemoveAt(0)
'          
'            Dim v As B2Vec2 = X2.WorldPointToMainBC(NextPoint.X, NextPoint.Y)
'          
'            'clone the paths before modifying them as they are being drawn asynchronously.
'            PathMainBCForward = PathMainBCForward.Clone
'            PathMainBCBackwards = PathMainBCBackwards.Clone
'          
'            'remove the first point from the "forward" path and add it to the "backwards" path.
'            PathMainBCForward.Points.RemoveAt(0)
'            PathMainBCForward.Invalidate 'need to call Invalidate after we directly access the points list.
'            PathMainBCBackwards.LineTo(v.X, v.Y)
''            Continue 'skip to the next point
'        End If
'      
''        Log("#-  x467, ActiveCharacterBody = " & ActiveCharacterBody.Name)
'        CharMotor.AngularOffset = FindAngleToTarget(ActiveCharacterFigure.bw.Body, NextPoint)
'      
'        Dim delta As B2Vec2 = NextPoint.CreateCopy
'        delta.SubtractFromThis(Border.Body.Position)
'        CharMotor.LinearOffset = delta
'      
'        'draw the small red circle
'        v = X2.WorldPointToMainBC(NextPoint.X, NextPoint.Y)
'        gs.DrawingTasks.Add(X2.MainBC.AsyncDrawCircle(v.X, v.Y, 5,  BrushRed, True, 0))
'      
''        Exit '<-----
'    Loop
'End Sub
Sub FindAngleToTarget(Body As B2Body, Target As B2Vec2) As Float
    If Abs(Body.Angle) > 2 * cPI Then
        'make sure that the current angle is between -2*cPI to 2*cPI
        Body.SetTransform(Body.Position, X2.ModFloat(Body.Angle, 2 * cPI))
    End If
    Dim angle As Float = ATan2(Target.Y - Body.Position.Y, Target.X - Body.Position.X) + cPI / 2
    Dim CurrentAngle As Float = Body.Angle
    'find the shortest direction
    Dim anglediff As Float = angle - CurrentAngle
    If anglediff > cPI Then
        angle = -(2 * cPI - angle)
    Else If anglediff < -cPI Then
        angle = angle + 2 * cPI
    End If
    Return angle
End Sub


'must handle this event if we want to handle the PreSolve event.
Private Sub World_BeginContact (Contact As B2Contact)
    Log("#-")
    Log("#-Sub World_BeginContact")

    If ActiveCharIndex = 1 Then
        Dim bodies As X2BodiesFromContact = X2.GetBodiesFromContact(Contact, "char1")
    else If ActiveCharIndex = 2 Then
        Dim bodies As X2BodiesFromContact = X2.GetBodiesFromContact(Contact, "char2")
    End If
   
    If bodies <> Null Then
    Log("#-  x614, bodies.OtherBody.Name = " & bodies.OtherBody.Name)
        If bodies.OtherBody.Name.ToLowerCase.StartsWith("p") Then
            'we cannot modify the world state inside these events. So we add a future task with time = 0.
            X2.AddFutureTask(Me, "Touch_Object_P", 0, bodies.OtherBody)
        End If
    End If
   
    '    Dim bodies As X2BodiesFromContact = X2.GetBodiesFromContact(Contact, "left edge")
    '    If bodies <> Null And bodies.OtherBody.DelegateTo Is Enemy Then
    '        X2.AddFutureTask(Me, "Delete_Enemy", 0, bodies.OtherBody)
    '        Return
    '    End If
   
End Sub
Private Sub World_PreSolve (Contact As B2Contact, OldManifold As B2Manifold)
    Log("#-Sub World_PreSolve")
    Dim BodyA As X2BodyWrapper = Contact.FixtureA.Body.Tag
    Dim BodyB As X2BodyWrapper = Contact.FixtureB.Body.Tag
    If BodyA.IsVisible = False Or BodyB.IsVisible = False Then Return
    Log("#-  x637, BodyA.Name=" & BodyA.Name &", BodyB.Name=" & BodyB.Name)
    '    CheckMarioCollisions (Contact, X2.GetBodiesFromContact(Contact, "mario"))
    '    CheckEnemyCollisions(Contact, X2.GetBodiesFromContact(Contact, "enemy bug"))
    '    CheckEnemyCollisions(Contact, X2.GetBodiesFromContact(Contact, "enemy turtle"))
End Sub
Private Sub World_PostSolve (Contact As B2Contact, Impulse As B2ContactImpulse)
    Log("#-Sub World_PostSolve")
    Dim BodyA As X2BodyWrapper = Contact.FixtureA.Body.Tag
    Dim BodyB As X2BodyWrapper = Contact.FixtureB.Body.Tag
    If BodyA.IsVisible = False Or BodyB.IsVisible = False Then Return
    Log("#-  x649, BodyA.Name=" & BodyA.Name &", BodyB.Name=" & BodyB.Name)
End Sub

Sub ActiveCharacterSelect_SelectedChange(Selected As Boolean) ' ####testingonly
    LastDiceRollVal = 0
    Label2.Text = "..."
    If Not(Selected) Then Return
    Dim rbx As RadioButton = Sender
    Dim tagx As String = rbx.Tag
    Select Case True
        Case tagx.ToLowerCase = "rbc1"
            ActiveCharIndex = 1
        Case tagx.ToLowerCase = "rbc2"
            ActiveCharIndex = 2
    End Select
End Sub
Sub Button1_Click ' ####testingonly
    X2.SoundPool.PlaySound("rolldice")
'    Sleep(500)
    LastDiceRollVal = Rnd(2,6)
    Label2.Text = LastDiceRollVal
    ActiveCharAdvance(LastDiceRollVal)
End Sub

Sub ActiveCharAdvance(NumberOfSteps As Int)
    Dim NewPointTemplatesListIndex As Int =    CharLastPositionIndex(ActiveCharIndex) +NumberOfSteps
    Dim GotToPosIndex As Int = NewPointTemplatesListIndex Mod PointTemplatesListLoop0.Size

    '####temp  
    Dim xy0 As PointXy = PointTemplatesListLoop0.Get(GotToPosIndex)
    Label5.Text = $"ActiveCharIndex=${ActiveCharIndex}, ${CRLF}DiceRollVal=${LastDiceRollVal}, ${CRLF}MoveCharTo p${(GotToPosIndex +1)}  = $1.0{xy0.x}, $1.0{xy0.y}  "$    '####test
    Log("#-  x593, Label5.Text = " & Label5.Text.Replace(CRLF, TAB))
    '/####temp  
   
    Dim TempList As List
    TempList.Initialize
    For i = CharLastPositionIndex(ActiveCharIndex) To NewPointTemplatesListIndex
        Dim GotToPosIndex As Int = i Mod PointTemplatesListLoop0.Size
        Dim xy0 As PointXy = PointTemplatesListLoop0.Get(GotToPosIndex)
        TempList.Add(X2.CreateVec2(xy0.x, xy0.y))
    Next
    Select Case ActiveCharIndex
        Case 1
            Char1Points.Initialize2(TempList)
        Case 2
            Char2Points.Initialize2(TempList)
    End Select
    CharLastPositionIndex(ActiveCharIndex) = GotToPosIndex
End Sub

Sub Touch_Object_P(ft As X2FutureTask)
    Dim Object_px As X2BodyWrapper = ft.Value
    Log("#-Sub game.Touch_Object_P, Object_px.Name = " & Object_px.Name)
   
    If Object_px.Name.ToLowerCase.StartsWith("p") Then
        X2.SoundPool.PlaySound("stepstone_1")

    Else If Object_px.Name.ToLowerCase.StartsWith("text") Then
        X2.SoundPool.PlaySound("metal-clash")
   
    End If

    ' Object should Glow for a short moment
    ' ... ???

End Sub


1. What can be the reason for the double triggering of the contact and how can i avoid it?

2. How can I assign a temporarily animated graphic to the collided objects (e.g. a stone that lights up briefly)?

 

Erel

B4X founder
Staff member
Licensed User
Longtime User


Create the collision graphics in the initialize sub:
B4X:
Dim collision As List
collision.Initialize
For Each clr As Int In Array(0xFFFF3000, 0xFFFF7100, 0xFFFFC700, 0xFFFFE700)
   Dim bc As BitmapCreator
   bc.Initialize(X2.MetersToBCPixels(1.5), X2.MetersToBCPixels(1.5))
   bc.DrawRect(bc.TargetRect, clr, True, 0)
   collision.Add(bc)
Next
X2.GraphicCache.PutGraphicBCs("collision", collision, False, 360)

Contact code:
B4X:
Private Sub World_BeginContact (Contact As B2Contact)
   Log("#-")
   Log("#-Sub World_BeginContact")

   If ActiveCharIndex = 1 Then
       Dim bodies As X2BodiesFromContact = X2.GetBodiesFromContact(Contact, "char1")
   else If ActiveCharIndex = 2 Then
       Dim bodies As X2BodiesFromContact = X2.GetBodiesFromContact(Contact, "char2")
   End If
   
   If bodies <> Null Then
       Log("#-  x614, bodies.OtherBody.Name = " & bodies.OtherBody.Name)
       If bodies.OtherBody.Name.ToLowerCase.StartsWith("p") And bodies.OtherBody.GraphicName = "" Then
           bodies.OtherBody.GraphicName = "collision"
           bodies.OtherBody.SwitchFrameIntervalMs = 100
           X2.SoundPool.PlaySound("stepstone_1")
           X2.AddFutureTask2(Me, "StopPoint_Highlight", 1000, bodies.OtherBody, True)
       End If
   End If
End Sub

Sub StopPoint_Highlight (ft As X2FutureTask)
   Dim point As X2BodyWrapper = ft.Value
   point.GraphicName = ""   
End Sub
 
Cookies are required to use this site. You must accept them to continue using the site. Learn more…