If the character objects are moved in the course of the game, the touched steppad should briefly take on another graphic and then look like before again.
This works very well so far with "World_BeginContact()" and "AddFutureTask".
After adding code elsewhere ("Figure.Collision_WithCoin"), the figure appears behind the steppad.
What is to be done to keep the arrangement of the objects on top of each other under control?
This works very well so far with "World_BeginContact()" and "AddFutureTask".
After adding code elsewhere ("Figure.Collision_WithCoin"), the figure appears behind the steppad.
The order of the objects was also not deliberately changed.
B4X:
----------------
game.bas
----------------
#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 = False ' 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
' Parameters
Public const MotorCorrFacInitVal As Float = 0.03
Public const MotorCorrFacNormal As Float = 0.07
Public const MotorCorrFacEnd As Float = 0.06
' Gamestate
Private GameOverState As Boolean = False
Private CharIsMoving As Boolean = False
Private ActiveCharIndex As Int = 1
Private LastDiceRollVal As Int = 0
Private CharLastPositionIndex(3) As Int
Type PointXy(x As Float, y As Float)
Private Char1Points As List
Private Char2Points As List
' 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
' Font
Private ScoreFont As B4XFont
' 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 Pane2 As Pane' ####testingonly
Private fx As JFX' ####testingonly
Private TempTestPane As Pane' ####testingonly
Private Label5 As Label' ####testingonly
' Private TextArea1 As TextArea ' Restitution
' Private TextArea3 As TextArea ' Friction
' Private TextArea4 As TextArea ' Density
' Private TextArea5 As TextArea ' Category bits
' Private TextArea6 As TextArea ' Mask bits
' Private TextArea7 As TextArea ' mcfA
' Private TextArea8 As TextArea ' mcfB
Private Label4 As Label ' coll pl1
Private Label12 As Label ' coll pl2
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
CSSUtils.SetBackgroundColor(Pane2, 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)
' TextArea8.Text = MotorCorrFacNormal ' ####testingonly
' TextArea7.Text = MotorCorrFacEnd ' ####testingonly
' ──────────────────────────────────
' 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_Objects
GraphicCache_Put_Characters
#if B4J
Dim fx As JFX
ScoreFont = fx.LoadFont(File.DirAssets, "Fixedsys500c.ttf", 30)
#else if B4i
ScoreFont = Font.CreateNew2("FixedsysTTF", 30)
#else
ScoreFont = xui.CreateFont(Typeface.LoadFromAssets("Fixedsys500c.ttf"), 30 / xui.Scale)
#End If
' ──────────────────────────────────
' 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")
X2.SoundPool.AddSound("Pickup__008", File.DirAssets, "Pickup__008.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_Objects
Log("#-Sub game.GraphicCache_Put_Objects")
'
Dim RowWidthPixel As Int = 32
Dim RowHeightPixel As Int = 32
Dim CollGraphHeightMeters As Int = 2
' -------------------------------
' Step-pads
' -------------------------------
Dim bc1 As BitmapCreator = X2.BitmapToBC(xui.LoadBitmap(File.DirAssets, "dungeon_tilesetmodrollo.png"), 1)
Dim bmp As B4XBitmap = bc1.Bitmap
Dim CollGraph1 As B4XBitmap = bmp.Crop(1 * 32, 18 * RowHeightPixel, 2 * RowWidthPixel, 2 * RowHeightPixel)
Dim CollGraph1List As List = X2.ReadSprites(CollGraph1, 1, 1, CollGraphHeightMeters, CollGraphHeightMeters)
X2.GraphicCache.PutGraphic("steppad_collision", Array(CollGraph1List.Get(0)) )
Dim bc2 As BitmapCreator = X2.BitmapToBC(xui.LoadBitmap(File.DirAssets, "dungeon_tilesetmodrollo.png"), 1)
Dim bmp As B4XBitmap = bc2.Bitmap
Dim CollGraph1 As B4XBitmap = bmp.Crop(5 * 32, 18 * RowHeightPixel, 2 * RowWidthPixel, 2 * RowHeightPixel)
Dim CollGraph1List As List = X2.ReadSprites(CollGraph1, 1, 1, CollGraphHeightMeters, CollGraphHeightMeters)
X2.GraphicCache.PutGraphic("steppad_normal", Array(CollGraph1List.Get(0)) )
End Sub
Private Sub GraphicCache_Put_Characters
Log("#-Sub game.GraphicCache_Put_Characters")
' -------------------------------
' 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)
Dim bwobj As X2BodyWrapper = TileMap.CreateObject(TileMapTemplateX)
bwobj.Graphicname = "steppad_normal"
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("textval") 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","")
If TileMapTemplateX.Name.ToLowerCase.StartsWith("textval") Then
lblx.TextSize = 20
Else
lblx.TextSize = 10
End If
lblx.TextColor = fx.Colors.Magenta
'lblx.Alignment = "CENTER_RIGHT"
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("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, CreateMap()) ' 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, CreateMap()) ' 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
Border = TileMap.CreateObject2ByName(ObjectLayer, "border")
else If TileMapTemplateX.FirstTime And TileMapTemplateX.Name.ToLowerCase = "scoretemplate" Then
TileMap.CreateObject(TileMapTemplateX)
else If TileMapTemplateX.FirstTime And TileMapTemplateX.Name.ToLowerCase.StartsWith("area") Then
TileMap.CreateObject(TileMapTemplateX)
else If TileMapTemplateX.FirstTime And TileMapTemplateX.Name.ToLowerCase.StartsWith("coin") Then
' Creates the 1 and only object with the animated coin
' It will be moved out of sight after all "coin" clones are redy
Dim CoinTemplate As X2TileObjectTemplate = TileMapTemplateX
Dim CoinBodywrapper As X2BodyWrapper = 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)
' After all positions of the "TextVal" objects are determined
For Each tt As TextTemplates In TextTemplatesList
CreateCloneFromBw(CoinTemplate, tt.Template.Position.CreateCopy) ' CLONE the 1 animated "coin" object to all postions of "TextVal" objects
CreateScoreGraphics(tt.Template.Name.SubString(7)) ' Cached graphic for coin collisions
Next
CoinBodywrapper.Body.SetTransform(X2.CreateVec2(-1, -1), 0) ' This object is no longer needed
End Sub
private Sub CreateScoreGraphics(TextValue As String)
Dim GraphicName As String = "ScoreValue" & TextValue
' Log("#-Sub gm.CreateScoreGraphics, TextValue=" & TextValue & ", GraphicName=" & GraphicName)
If X2.GraphicCache.GetGraphicsCount(GraphicName) = 0 Then
Dim cvs As B4XCanvas = X2.GraphicCache.GetCanvas(50)
Dim bmps As List
bmps.Initialize
Dim FontSize As Float = 30 / xui.Scale
Dim fnt As B4XFont = xui.CreateDefaultBoldFont(FontSize)
Dim r As B4XRect = cvs.MeasureText(TextValue, fnt)
Dim BaseLine As Int = cvs.TargetRect.CenterY - r.Height / 2 - r.Top
'Creating new graphics is a relatively heavy operation. Use cached graphics whenever possible.
For Each clr As Int In Array(0xFF00B2FF, xui.Color_White)
cvs.ClearRect(cvs.TargetRect)
cvs.DrawText(TextValue, cvs.TargetRect.CenterX, BaseLine, fnt, clr, "CENTER")
Dim sb As X2ScaledBitmap
sb.Scale = 1
'Use X2.CreateImmutableBitmap if not cropping.
sb.Bmp = cvs.CreateBitmap.Crop(cvs.TargetRect.CenterX - r.Width / 2, cvs.TargetRect.CenterY - r.Height / 2, r.Width + 1, r.Height + 1)
bmps.Add(sb)
Next
X2.GraphicCache.PutGraphic2(GraphicName, bmps, False, 5) 'no antialiasing.
End If
End Sub
Private Sub CreateCloneFromBw(template As X2TileObjectTemplate, TargetPosition As B2Vec2)
template.BodyDef.Position = TargetPosition
TileMap.CreateObject(template)
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")
bc.FillGradient(Array As Int(0xFF61584C, 0xFF61584C), bc.TargetRect, "TOP_BOTTOM") ' brownish
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 MotorDefForChar As B2MotorJointDef
MotorDefForChar.Initialize(Border.Body, character.bw.Body)
MotorDefForChar.MaxMotorForce = 1500
MotorDefForChar.CollideConnected = True 'let the Char collide with the borders
Dim mc As B2MotorJoint = X2.mWorld.CreateJoint(MotorDefForChar)
'mc.CorrectionFactor = 0.02
mc.CorrectionFactor = MotorCorrFacInitVal
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)
#region ---Move active character by motor
' Dim voff As B2Vec2 = X2.CreateVec2(0, 1.1) ' offset, so that the char is slightly beneath the pad
Dim voff As B2Vec2 = X2.CreateVec2(0, 0) ' offset, so that the char is slightly beneath the pad
Select Case ActiveCharIndex
Case 1
If Char1Points.Size > 0 Then
Dim NextPoint As B2Vec2 = Char1Points.Get(0)
NextPoint = NextPoint.CreateCopy
If Char1Points.Size < 2 Then
MotorChar1.CorrectionFactor = MotorCorrFacEnd
NextPoint.AddToThis(voff)
Else
MotorChar1.CorrectionFactor = MotorCorrFacNormal
End If
Dim vec As B2Vec2 = mChar1.bw.Body.Position.CreateCopy
vec.SubtractFromThis(NextPoint)
If vec.Length < 1 Then
Char1Points.RemoveAt(0)
If Char1Points.Size = 0 Then
PlayerFinished
End If
Else
MoveCharByMotorTo(ActiveCharIndex , NextPoint)
End If
End If
Case 2
' ~~ ~~ ~~ ~~ ~~ ~~ ~~
' duplicate code from "case 1" in order to avoid a timeconsuming call to a separate sub
' ~~ ~~ ~~ ~~ ~~ ~~ ~~
If Char2Points.Size > 0 Then
Dim NextPoint As B2Vec2 = Char2Points.Get(0)
NextPoint = NextPoint.CreateCopy
Dim vec As B2Vec2 = mChar2.bw.Body.Position.CreateCopy
If Char2Points.Size < 2 Then
MotorChar2.CorrectionFactor = MotorCorrFacEnd
NextPoint.AddToThis(voff)
Else
MotorChar2.CorrectionFactor = MotorCorrFacNormal
End If
vec.SubtractFromThis(NextPoint)
If vec.Length < 2 Then
Char2Points.RemoveAt(0)
If Char2Points.Size = 0 Then
PlayerFinished
End If
Else
MoveCharByMotorTo(ActiveCharIndex , NextPoint)
End If
End If
End Select
#end region
End Sub
private Sub PlayerFinished
Log("#-Sub gm.PlayerFinished")
CharIsMoving = False
SwapPlayer
Log("#- x546, ~~~~")
Log("#-")
Log("#-")
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)
' ──────────────────────────────────
' 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
' ──────────────────────────────────
' Preparations for Players
' ──────────────────────────────────
mChar1.CollectedItemsMap.Initialize
mChar2.CollectedItemsMap.Initialize
' ──────────────────────────────────
' Start the Main loop
' ──────────────────────────────────
X2.Start
End Sub
private 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
private Sub MoveCharByMotorTo (CharIndex As Int, vec As B2Vec2)
' Log("#-Sub MoveCharByMotorTo, CharIndex=" & CharIndex & ", vec.X=" & vec.X & ", vec.y=" & vec.y)
CharIsMoving = True
vec.SubtractFromThis(Border.Body.Position)
Select Case CharIndex
Case 1
MotorChar1.LinearOffset = vec
Case 2
MotorChar2.LinearOffset = vec
End Select
End Sub
private 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
Private Sub World_BeginContact (Contact As B2Contact)
'must handle this event if we want to handle the PreSolve event.
' 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, World_BeginContact, bodies.OtherBody.Name = " & bodies.OtherBody.Name)
'If bodies.OtherBody.Name.ToLowerCase.StartsWith("p") And bodies.OtherBody.GraphicName = "" Then
If bodies.OtherBody.Name.ToLowerCase.StartsWith("p") Then
X2.SoundPool.PlaySound("stepstone_1")
bodies.OtherBody.GraphicName = "steppad_collision"
bodies.OtherBody.SwitchFrameIntervalMs = 100
X2.AddFutureTask2(Me, "FuTask_StopPoint_Highlight", 1000, bodies.OtherBody, True)
else if bodies.OtherBody.Name.ToLowerCase.StartsWith("textval") Then
Dim HitValue As Int = bodies.OtherBody.Name.SubString(7)
'CreateScore(bodies.OtherBody.Body.Position, HitValue)
X2.SoundPool.PlaySound("Pickup__008")
If ActiveCharIndex = 1 Then
mChar1.ItemAddValue("collectedvalues", HitValue)
mChar2.ItemAddValue("collectedvalues", "-" & (HitValue/2))
X2.AddFutureTask2(mChar1, "Collision_WithCoin", 0, bodies.OtherBody, True)
else If ActiveCharIndex = 2 Then
mChar2.ItemAddValue("collectedvalues", HitValue)
mChar1.ItemAddValue("collectedvalues", "-" & (HitValue/2))
X2.AddFutureTask2(mChar2, "Collision_WithCoin", 0, bodies.OtherBody, True)
End If
X2.AddFutureTask2(Me, "FuTask_TextVal_Hit", 1000, bodies.OtherBody, True)
End If
End If
End Sub
private Sub FuTask_TextVal_Hit (ft As X2FutureTask)
' Dim bwhit As X2BodyWrapper = ft.Value
' Dim HitValue As Int = bwhit.Name.SubString(7)
' Log("#-Sub gm.FuTask_TextVal_Hit, ActiveCharIndex=" & ActiveCharIndex & ", bwhit.Name=" & bwhit.Name)
UI_RefreshPlayerStates
End Sub
private Sub FuTask_StopPoint_Highlight (ft As X2FutureTask)
Dim point As X2BodyWrapper = ft.Value
point.GraphicName = "steppad_normal"
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
private Sub ActiveCharacterSelect_SelectedChange(Selected As Boolean) ' ####testingonly
LastDiceRollVal = 0
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
private Sub SwapPlayer
Log("#-Sub gm.SwapPlayer")
If CharIsMoving Then Return
If ActiveCharIndex =1 Then
RadioButton2.Selected = True
Else
RadioButton1.Selected = True
End If
' ' ####testingonly
' mChar1.bw.Body.FirstFixture.SetFilterBits(TextArea5.Text, TextArea6.Text)
' mChar1.bw.Body.FirstFixture.Density = TextArea4.Text
' mChar1.bw.Body.FirstFixture.Friction = TextArea3.Text
' mChar1.bw.Body.FirstFixture.Restitution = TextArea1.Text
' mChar2.bw.Body.FirstFixture.SetFilterBits(TextArea5.Text, TextArea6.Text)
' mChar2.bw.Body.FirstFixture.Density = TextArea4.Text
' mChar2.bw.Body.FirstFixture.Friction = TextArea3.Text
' mChar2.bw.Body.FirstFixture.Restitution = TextArea1.Text
' '/####testingonly
End Sub
private Sub Button1_Click ' ####testingonly
Log("#-")
Log("#- x708, ROLL DICE ~~~~~ # ~~~~~ # ~~~~~ # ~~~~~ # ~~~~~ # ~~~~~ O")
If CharIsMoving Then Return
X2.SoundPool.PlaySound("rolldice")
Sleep(200)
LastDiceRollVal = Rnd(3, 7)
Label2.Text = LastDiceRollVal
ActiveCharAdvance(LastDiceRollVal)
End Sub
Private Sub UI_RefreshPlayerStates
Log("#-Sub gm.UI_RefreshPlayerStates")
Label4.Text = mChar1.ItemGet("collectedvalues", "0")
Label12.Text = mChar2.ItemGet("collectedvalues", "0")
' Log("#- x747, " & fcn.logm(mChar1.CollectedItemsMap))
' Log("#- x748, " & fcn.logm(mChar2.CollectedItemsMap))
End Sub
private Sub ActiveCharAdvance(NumberOfSteps As Int)
Log("#-Sub ActiveCharAdvance")
' Fill the CharPoints list that is used in Tick()
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
'private 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
'End Sub
------------
figure.bas
------------
Sub Class_Globals
Public FigureNameAndId As String = ""
Public bw As X2BodyWrapper
Public InAir As Boolean
Public IsSmall As Boolean = True
Public LastPositionIndex As Int = 0
Public CollectedItemsMap As Map
Public DeletesCollidedCoins As Boolean = False
Private x2 As X2Utils 'ignore
Private LastTickTime As Int
Private SpecialState As Boolean
Private FaceRight As Boolean = True
Private MaxVelocity As Float = 10
Private ImpulseVector As B2Vec2
Private ProtectedTime As Int
End Sub
Public Sub Initialize (wrapper As X2BodyWrapper, ParameterMap As Map)
' Log("#-Sub figure.Initialize")
CollectedItemsMap.Initialize
LastPositionIndex = 0
bw = wrapper
x2 = bw.X2
bw.DelegateTo = Me
UpdateImpulseVector
CreateChar1Legs
DeletesCollidedCoins = ParameterMap.GetDefault("DeletesCollidedCoins", False)
End Sub
Private Sub CreateChar1Legs
' see --> https://www.b4x.com/android/forum/threads/xui2d-super-mario-example-2.96236/
' Dim rect As B2PolygonShape
' rect.Initialize
' 'rect.SetAsBox2(0.5, 0.5, x2.CreateVec2(0, -x2.GetShapeWidthAndHeight(bw.Body.FirstFixture.Shape).y / 2 + 0.05), 0)
' rect.SetAsBox2(0.5, 0.5, x2.CreateVec2(0, -x2.GetShapeWidthAndHeight(bw.Body.FirstFixture.Shape).y / 2 + 0.5), 0)
' Dim f As B2Fixture = bw.Body.CreateFixture2(rect, 0.1)
' 'f.Friction = 1
' f.Friction = 0
' f.Tag = "legs"
End Sub
Private Sub UpdateImpulseVector
'Log("#-Sub figure.UpdateImpulseVector, bw.Name=" & bw.Name)
ImpulseVector = x2.CreateVec2(0.5 * bw.Body.Mass * x2.TimeStepMs / 16, 0)
End Sub
Public Sub Hit_Start (ft As X2FutureTask)
If SpecialState Then Return
If x2.gs.GameTimeMs < ProtectedTime Then Return
End Sub
Private Sub StartGameOver
SpecialState = True
' bw.GraphicName = "Char1 small strike"
' bw.Body.FirstFixture.SetFilterBits(0, 0)
' bw.Body.FirstFixture.NextFixture.SetFilterBits(0, 0)
' bw.Body.LinearVelocity = x2.CreateVec2(0, 15)
bw.mGame.GameOver
End Sub
Public Sub Tick (GS As X2GameStep)
If LastTickTime = GS.GameTimeMs Then Return
LastTickTime = GS.GameTimeMs
' Log("#-Sub figure.Tick --> " & bw.Name)
If GS.ShouldDraw Then
bw.UpdateGraphic(GS, True)
End If
End Sub
Public Sub IsLegsFixture (Fixture As B2Fixture) As Boolean
Return Fixture.Tag <> Null And Fixture.Tag = "legs"
End Sub
public Sub ItemSet(Key As String, value As String)
If value = "" Then
CollectedItemsMap.Remove(Key)
Else
CollectedItemsMap.Put(Key, value)
End If
End Sub
public Sub ItemGet(Key As String, default As String) As String
Return CollectedItemsMap.GetDefault(Key, default)
End Sub
public Sub ItemAddValue(Key As String, Summand As String)
Dim IntValue As Int = CollectedItemsMap.GetDefault(Key, 0)
ItemSet(Key, IntValue +Summand)
End Sub
Public Sub Collision_WithCoin (ft As X2FutureTask)
Log("Sub figure.Collision_WithCoin")
Dim coin As X2BodyWrapper = ft.Value
If coin.IsDeleted Then Return
' The moving scores are not physical bodies.
' Their movement is managed in the MovingScore class.
' They don't have a shape.
' bw.X2.SoundPool.PlaySound("coin")
Dim bwhit As X2BodyWrapper = ft.Value
Dim score As Int = bwhit.Name.SubString(7)
Dim TimeToLive As Int = 2000
bw.X2.AddFutureTask(Me, "Add_Score",TimeToLive, score) 'add the score when the moving score reaches the corner
Dim bd As B2BodyDef
bd.BodyType = bd.TYPE_STATIC
bd.Position = coin.Body.Position
If DeletesCollidedCoins Then
coin.Delete(bw.X2.gs)
End If
Dim mscore As MovingScore
Dim wrapper As X2BodyWrapper = bw.X2.CreateBodyAndWrapper(bd, mscore, "score")
mscore.Initialize(wrapper, score)
wrapper.TimeToLiveMs = TimeToLive
'uncomment to add a slow down effect
' bw.X2.SlowDownPhysicsScale = 2
' bw.X2.UpdateTimeParameters
' bw.X2.AddFutureTask(Me, "Reset_PhysicsScore", 500, Null)
End Sub
Private Sub Add_Score (ft As X2FutureTask)
Log("#-Sub figure.Add_Score, ft.value=" & ft.Value)
'bw.mGame.mScore.IncreaseScore(ft.Value)
End Sub
-------
movingscore.bas
--------------
' From the "Walking character" example from Erel's Example Pack --> https://www.b4x.com/android/forum/threads/xui2d-example-pack.96454/#content
Sub Class_Globals
Private xui As XUI
Private bw As X2BodyWrapper
Private StartBCPosition, TargetBCPosition As B2Vec2
Private degrees As Int
End Sub
Public Sub Initialize (wrapper As X2BodyWrapper, score As Int)
bw = wrapper
'This body doesn't have any fixture so it is always considered to be invisible.
'We must set TickIfInvisible to True or it will never tick. A better option would have to create a fixture...
bw.TickIfInvisible = True
bw.GraphicName = "ScoreValue" & score ' Bitmap was created in Game.CreateScoreGraphics()
bw.SwitchFrameIntervalMs = 200
'StartBCPosition = bw.X2.WorldPointToMainBC(bw.Body.Position.X, bw.Body.Position.Y)
StartBCPosition = bw.X2.WorldPointToMainBC(bw.Body.Position.X, bw.Body.Position.Y)
Dim target As B2Vec2
'target.Set(bw.X2.ScreenAABB.BottomLeft.X + 0.5, bw.X2.ScreenAABB.TopRight.Y - 0.2)
target.Set(bw.Body.Position.X + 5, bw.Body.Position.Y + 5)
TargetBCPosition = bw.X2.WorldPointToMainBC(target.X, target.Y)
End Sub
Public Sub Tick (GS As X2GameStep)
bw.SwitchFrameIfNeeded(GS)
Dim CurrentTime As Int = bw.GetCurrentTime(GS)
'(target - start) * CurrentTime / TimeToLive + start
Dim position As B2Vec2 = TargetBCPosition.CreateCopy
position.SubtractFromThis(StartBCPosition)
position.MultiplyThis(CurrentTime / bw.TimeToLiveMs)
position.AddToThis(StartBCPosition)
degrees = degrees + 2 'making the score rotate will work, however rotating "temporary" graphics can have an impact on the performance.
If GS.ShouldDraw Then
GS.DrawingTasks.Add(bw.X2.GraphicCache.GetDrawTask(bw.GraphicName, bw.CurrentFrame, degrees, False, False, position.X, position.Y))
End If
If CurrentTime > bw.TimeToLiveMs Then
bw.Delete(GS)
End If
End SubWhat is to be done to keep the arrangement of the objects on top of each other under control?
