Share My Creation Block Drop

Here's my second offering to share, source code included; the only additional library is Animation.
Try and stack as many blocks on top of each other.

B4X:
#Region  Project Attributes 
    #ApplicationLabel: DITL Block Drop
    #VersionCode: 1
    #VersionName: 1.1
    'SupportedOrientations possible values: unspecified, landscape or portrait.
    #SupportedOrientations: portrait
    #CanInstallToExternalStorage: False
#End Region

#Region  Activity Attributes 
    #FullScreen: False
    #IncludeTitle: True
    #BridgeLogger: True
#End Region

Sub Process_Globals
    Private Timer1 As Timer
    Private BlockHeight As Int = 30dip
    Private BlockWidth As Int = 200dip
    Private speedX As Int = 5dip
    Private goingRight As Boolean = True
    Private currentX As Int
    Private score As Int = 0
    Private gameRunning As Boolean = False
    Private particleList As List
    Private highScore As Int = 0
End Sub

Sub Globals
    Private currentBlock As Panel
    Private previousBlockTop As Int = 90%y
    Private pnlGame As Panel
    Dim lastBlockTop As Int
    Private lblScore As Label
    Private canvas As Canvas
    Private previousBlockLeft As Int
    Private previousBlockTop As Int
    Private previousBlockWidth As Int
    Private btnRestart As Button
    Private lblGameOver As Label
    Private lblHighScore As Label
    Private FixedBlockY As Int = 50%y 
End Sub

Sub Activity_Create(FirstTime As Boolean)
    Activity.LoadLayout("blocks")
    lastBlockTop = pnlGame.Height 
    canvas.Initialize(pnlGame)
     currentBlock.Initialize("")
    lblScore.TextColor = Colors.Black
    lblScore.TextSize = 20
    Timer1.Initialize("Timer1", 16)
    StartGame
End Sub

Sub AddBlock(top As Int, left As Int, width As Int)
    Dim block As Panel
    block.Initialize("")
    block.Color = Colors.White
    pnlGame.AddView(block, left, top, width, BlockHeight)
End Sub

Sub AddNewMovingBlock
    currentX = 0
    goingRight = True
    currentBlock.Initialize("")
    currentBlock.Color = Colors.Red
    pnlGame.AddView(currentBlock, currentX, previousBlockTop - BlockHeight, BlockWidth, BlockHeight)
End Sub

Sub StartGame
    pnlGame.RemoveAllViews
    BlockWidth = 200dip
    previousBlockTop = FixedBlockY + (5 * BlockHeight) 
    previousBlockWidth = BlockWidth
    previousBlockLeft = (pnlGame.Width - BlockWidth) / 2
    LoadHighScore
    For i = 0 To 4
        Dim block As Panel
        block.Initialize("")
        Dim top As Int = previousBlockTop - (i * BlockHeight)
        pnlGame.AddView(block, previousBlockLeft, top, BlockWidth, BlockHeight)
        Dim baseColor As Int = Colors.RGB(50 + Rnd(0, 80), 100 + Rnd(0, 100), 200)
        Dim cd As ColorDrawable
        cd.Initialize2(baseColor, 0dip, 1dip, Colors.Black)
        block.Background = cd
        Add3DEffectToBlock(block)
    Next
    previousBlockTop = previousBlockTop - (4 * BlockHeight)
    score = 0
    lblScore.Text = "Score: 0"
    Dim baseBlock As Panel
    baseBlock.Initialize("")
    pnlGame.AddView(baseBlock, previousBlockLeft, previousBlockTop, BlockWidth, BlockHeight)
    baseBlock.Color = Colors.Gray
    Dim cd As ColorDrawable
    cd.Initialize2(baseColor,0dip,1dip,Colors.Black)
    baseBlock.Background = cd
    Dim bbColor As Int = Colors.Gray
    Apply3DEffect(baseBlock, bbColor) 
    gameRunning = True
    CreateNewBlock
    Timer1.Enabled = True
End Sub

Sub PlaceBlock
    Timer1.Enabled = False
    currentBlock.Top = previousBlockTop - BlockHeight
    ' Calculate overlap
    Dim left1 As Int = currentBlock.Left
    Dim right1 As Int = currentBlock.Left + currentBlock.Width
    Dim left2 As Int = previousBlockLeft
    Dim right2 As Int = previousBlockLeft + previousBlockWidth
    Dim overlapLeft As Int = Max(left1, left2)
    Dim overlapRight As Int = Min(right1, right2)
    Dim overlapWidth As Int = overlapRight - overlapLeft
    If overlapWidth <= 0 Then
        GameOver
        Return
    End If
    ' Create trimmed block
    Dim blockColor As Int = Colors.RGB(Rnd(100,255), Rnd(100,255), Rnd(100,255))
    currentBlock.Color = blockColor
    Dim placedBlock As Panel
    placedBlock.Initialize("")
    placedBlock.Color = blockColor
    pnlGame.AddView(placedBlock, overlapLeft, currentBlock.Top, overlapWidth, BlockHeight)
    ' Move all blocks down
    For i = 0 To pnlGame.NumberOfViews - 1
        Dim v As View = pnlGame.GetView(i)
        v.Top = v.Top + BlockHeight
    Next
    Apply3DEffect(placedBlock, blockColor)'
    ' Store placed block info in the Tag
    Dim placedInfo As Map
    placedInfo.Initialize
    placedInfo.Put("left", overlapLeft)
    placedInfo.Put("top", currentBlock.Top)
    placedInfo.Put("width", overlapWidth)
    placedBlock.Tag = placedInfo
    ' Update previous block tracking
    previousBlockTop = placedBlock.Top
    previousBlockLeft = overlapLeft
    previousBlockWidth = overlapWidth
    ' Create falling overhang if any
    If left1 < overlapLeft Then
        ' Left overhang
        Dim overhangLeft As Panel
        overhangLeft.Initialize("")
        overhangLeft.Color = blockColor
        Dim widthLeft As Int = overlapLeft - left1
        pnlGame.AddView(overhangLeft, left1, currentBlock.Top, widthLeft, BlockHeight)
        AnimateFall(overhangLeft)
    End If

    If right1 > overlapRight Then
        ' Right overhang
        Dim overhangRight As Panel
        overhangRight.Initialize("")
        overhangRight.Color = blockColor
        Dim widthRight As Int = right1 - overlapRight
        pnlGame.AddView(overhangRight, overlapRight, currentBlock.Top, widthRight, BlockHeight)
        AnimateFall(overhangRight)
    End If
    ' Remove old block
    currentBlock.RemoveView
    ' Update score
    score = score + 1
    UpdateScore
    ' Create next block with updated width
    currentBlock.Initialize("")
    currentBlock.Color = Colors.RGB(Rnd(100,255), Rnd(100,255), Rnd(100,255))
    Dim cbColor As Int = Colors.RGB(Rnd(100,255), Rnd(100,255), Rnd(100,255))
    currentBlock.Width = previousBlockWidth
    currentBlock.Height = BlockHeight
    currentBlock.Top = previousBlockTop - BlockHeight
    currentBlock.Left = 0
    Dim cd As ColorDrawable
    cd.Initialize2(cbColor, 0dip, 1dip, Colors.Black)
    currentBlock.Background = cd
    pnlGame.AddView(currentBlock, currentBlock.Left, currentBlock.Top, currentBlock.Width, BlockHeight)
    ' Randomize starting side
    goingRight = Rnd(0, 2) = 0
    If goingRight Then
        currentBlock.Left = 0
    Else
        currentBlock.Left = pnlGame.Width - currentBlock.Width
    End If

    Timer1.Enabled = True
End Sub

Sub AnimateFall(p As Panel)
    Dim anim As Animation
    anim.InitializeTranslate("fall", 0, 0, 0, 100%y - p.Top)
    anim.Duration = 700
    anim.Start(p)
    Dim fade As Animation
    fade.InitializeAlpha("", 1, 0)
    fade.Duration = 700
    fade.Start(p)
    ' Schedule removal after animation
    Sleep(700)
    p.RemoveView
End Sub

Sub Activity_Touch (Action As Int, X As Float, Y As Float)
    If gameRunning And Action = Activity.ACTION_DOWN Then
        PlaceBlock
    End If
End Sub

Sub Add3DEffectToBlock(block As Panel)
    ' Bottom shadow
    Dim shadow As Label
    shadow.Initialize("")
    shadow.Color = Colors.ARGB(100, 0, 0, 0) ' semi-transparent black
    block.AddView(shadow, 0, block.Height - 2dip, block.Width, 2dip)
    ' Top highlight
    Dim highlight As Label
    highlight.Initialize("")
    highlight.Color = Colors.ARGB(100, 255, 255, 255) ' semi-transparent white
    block.AddView(highlight, 0, 0, block.Width, 2dip)
End Sub


Sub Apply3DEffect(block As Panel, baseColor As Int)
    Dim highlight As Panel
    Dim shadow As Panel
    Dim cd As ColorDrawable
    cd.Initialize2(baseColor, 0dip, 1dip, Colors.Black)
    block.Background = cd
    ' Top highlight
    highlight.Initialize("")
    highlight.Color = Colors.ARGB(100, 255, 255, 255) ' semi-transparent white
    block.AddView(highlight, 0, 0, block.Width, 2dip)
    ' Bottom shadow
    shadow.Initialize("")
    shadow.Color = Colors.ARGB(100, 0, 0, 0) ' semi-transparent black
    block.AddView(shadow, 0, block.Height - 2dip, block.Width, 2dip)
End Sub

Sub GameOver
    gameRunning = False
    Timer1.Enabled = False
    SaveHighScore
    Log("Game Over ")
    Activity.LoadLayout("gameover")
    lblGameOver.Text = "Game Over! Score: " & score
End Sub

Sub btnRestart_Click
    Activity.RemoveAllViews
    Activity.LoadLayout("blocks")
    StartGame
End Sub

Sub Timer1_Tick
    If Not(gameRunning) Or currentBlock.IsInitialized = False Then Return
    ' Move the current block left/right
    If goingRight Then
        currentBlock.Left = currentBlock.Left + speedX
        If currentBlock.Left + currentBlock.Width >= pnlGame.Width Then
            goingRight = False
        End If
    Else
        currentBlock.Left = currentBlock.Left - speedX
        If currentBlock.Left <= 0 Then
            goingRight = True
        End If
    End If
End Sub

Sub CreateNewBlock
    currentBlock.Initialize("")
    currentX = 0
    If goingRight = False Then currentX = pnlGame.Width - previousBlockWidth
    
    pnlGame.AddView(currentBlock, currentX, FixedBlockY, previousBlockWidth, BlockHeight)
    Dim clr As Int = Colors.RGB(Rnd(100, 255), Rnd(100, 255), Rnd(100, 255))
    currentBlock.Color = clr
    Dim cd As ColorDrawable
    cd.Initialize2(clr, 0dip, 1dip, Colors.Black)
    currentBlock.Background = cd
    currentBlock.Tag = clr
    goingRight = True
End Sub

Sub UpdateScore
    lblScore.Text = "Score: " & score 
    If score > highScore Then
        lblHighScore.Text = "High Score " & highScore
    End If
End Sub

Sub SaveHighScore
    If score > highScore Then
        highScore = score
        File.WriteString(File.DirInternal, "hiscore.txt", highScore)
    End If
End Sub

Sub LoadHighScore
    If File.Exists(File.DirInternal, "hiscore.txt") Then
        highScore = File.ReadString(File.DirInternal, "hiscore.txt")
        lblHighScore.Text = highScore
    Else
        highScore = 0
    End If
End Sub
 

Attachments

  • Screenshot_20250818-154610.png
    Screenshot_20250818-154610.png
    37.1 KB · Views: 229
  • Screenshot_20250818-154639.png
    Screenshot_20250818-154639.png
    38.2 KB · Views: 178
  • Screenshot_20250818-154646.png
    Screenshot_20250818-154646.png
    53.3 KB · Views: 62
Top