ROGLITE2.1 for QB64

ROGLITE2.BAS

' M(,) CONTAINS THE MAP DATA
' V(,) ARRAY CONTAINS THE VISIBILITY DATA
' MAP DATA: 1=FLOOR, 2=WALL

'''
' Feature toggles.
'''

' Set this to 1 to cause the entire playfield to be visible.
Const SHOW_PLAYFIELD = 0

'''
' Misc. constants.
'''

Const X_OFFSET = 1
Const Y_OFFSET = 2
Const SX = 40
Const SY = 24

' Map characters.
Const TILE$ = ".#>"
Const TILE_FLOOR = 1
Const TILE_WALL = 2
Const TILE_STAIRS = 3

Const MAX_ENEMIES = 100

Const SLIME_TILE_1 = 219
Const SLIME_TILE_2 = 220
Const SLIME_COLOR = 2

'''
' Declare all the things!
'''

Type EnemyInfo
    type As Integer
    x As Integer
    y As Integer
    hp As Integer
End Type

Dim Shared M(SX, SY)
Dim Shared V(SX, SY)

' The number of enemies on the current level.
Dim Shared numEnemies As Integer

Dim Shared PX As Integer
Dim Shared PY As Integer

Dim Shared HP As Integer

' Damages and healing effects are stored up until the HUD is displayed, then added to player HP.
Dim Shared hpDelta As Integer

' Attack Power
Dim Shared AP As Integer

' Defense Power
Dim Shared DP As Integer

' Level
Dim Shared LV As Integer

Dim Shared perception As Integer

' Experience
Dim Shared XP As Integer

' Turn Count
Dim Shared CT As Integer
Dim Shared enemies(MAX_ENEMIES) As EnemyInfo

''
' Initialize all the things!
''

PlayGameOver
Randomize Timer

Width SX

Let HP = 10
Let LV = 1
Let perception = 1

Do
    BuildMap ' BUILD THE MAP
    DrawStatusScreen 'START ON STATUS, THEN DRAW MAP

    Do
        UpdateHUD
        DrawEntities
        UpdatePlayer
        UpdateMonsters
        Let CT = CT + 1
    Loop Until M(PX, PY) = TILE_STAIRS
    Let LV = LV + 1
    PlayGoingDown
Loop

Sub DrawEntities
    Color 7, 0

    ' Update playfield visibility.
    Let rangeOfVision = perception ' I might change this formula later.
    For y = PY - rangeOfVision To PY + rangeOfVision
        If y >= 0 And y < SY Then
            For X = PX - rangeOfVision To PX + rangeOfVision
                If X >= 0 And X < SX Then
                    Let V(X, y) = 1
                    If Not ((X = PX) And (y = PY)) Then
                        Locate y + Y_OFFSET, X + X_OFFSET
                        Print Mid$(TILE$, M(X, y), 1);
                    End If
                End If
            Next X
        End If
    Next y

    Color 15, 1
    Locate PY + Y_OFFSET, PX + X_OFFSET
    Print "@";
    Color 7, 0 ' Reset the color attributes.

    If CT / 2 = Int(CT / 2) Then C0 = SLIME_TILE_1 Else C0 = SLIME_TILE_2
    For N = 0 To numEnemies - 1
        If enemies(N).hp > 0 Then
            If V(enemies(N).x, enemies(N).y) = 1 Then
                If enemies(N).type = 1 Then
                    Color SLIME_COLOR
                Else
                    Color 7
                End If
                Locate enemies(N).y + Y_OFFSET, enemies(N).x + X_OFFSET
                Print Chr$(C0);
            End If
        End If
    Next N
    Color 7, 0 ' Reset the color attributes.
End Sub

Sub UpdatePlayer
    If HP = 0 Then GameOver

    Do
        A$ = InKey$
    Loop Until Len(A$) > 0

    Let dx = 0
    Let dy = 0

    Select Case UCase$(A$)
        Case "W"
            Let dy = dy - 1
        Case "S"
            Let dy = dy + 1
        Case "A"
            Let dx = dx - 1
        Case "D"
            Let dx = dx + 1
        Case " "
            DrawStatusScreen
    End Select

    If Asc(A$) = 27 Then GameOver

    If dx <> 0 Or dy <> 0 Then
        Let t = M(PX + dx, PY + dy)
        If t = TILE_FLOOR Or t = TILE_STAIRS Then
            ' Erase the player.
            Locate PY + Y_OFFSET, PX + X_OFFSET
            Print Mid$(TILE$, M(PX, PY), 1);

            PlayClick

            ' Move player to the new position.
            Let PX = PX + dx
            Let PY = PY + dy
        End If
    End If

End Sub

Sub UpdateMonsters
    For n = 0 To numEnemies - 1
        If enemies(n).hp > 0 Then ' Make sure the monster is alive.
            If enemies(n).x = PX And enemies(n).y = PY Then
                ' If the player touched the slime.
                enemies(n).hp = enemies(n).hp - 1:
                hpDelta = hpDelta - 1
            End If
            Let x0 = Int(Rnd * 3) - 1
            If y0 = 0 Then y0 = Int(Rnd * 3) - 1 Else y0 = 0

            Let t = M(enemies(n).x + x0, enemies(n).y + y0)
            If t = TILE_FLOOR Or t = TILE_STAIRS Then ' Is the tile walkable?
                Locate enemies(n).y + Y_OFFSET, enemies(n).x + X_OFFSET
                If V(enemies(n).x, enemies(n).y) = 0 Then Print "*"; Else Print Mid$(TILE$, M(enemies(n).x, enemies(n).y), 1); ' Erase the monster.
                Let enemies(n).x = enemies(n).x + x0
                Let enemies(n).y = enemies(n).y + y0
                If enemies(n).x = PX And enemies(n).y = PY Then
                    ' If the slime touched the player.
                    enemies(n).hp = enemies(n).hp - 1
                    hpDelta = hpDelta - 1
                End If
            End If
        End If
    Next n
End Sub

Sub BuildMap
    ' Phase 1: Completely random noise.
    For y = 0 To SY - 1
        For X = 0 To SX - 1
            If Rnd > 0.25 Then
                Let M(X, y) = TILE_WALL
            Else
                Let M(X, y) = TILE_FLOOR
            End If
        Next X
    Next y

    ' Phase 2: Smooth it out.
    For y = 1 To SY - 2
        For X = 1 To SX - 2
            Let neighborCount = 0
            For Y0 = -1 To 1
                For X0 = -1 To 1
                    If M(X + X0, y + Y0) = TILE_WALL Then
                        Let neighborCount = neighborCount + 1
                    End If
                Next X0
            Next Y0
            If neighborCount >= 3 And neighborCount <= 4 Then
                Let M(X, y) = TILE_WALL
            Else
                Let M(X, y) = TILE_FLOOR
            End If
        Next X
    Next y

    ' Phase 3: Establish the border.
    For X = 0 To SX - 1
        Let M(X, 0) = TILE_WALL
        Let M(X, SY - 1) = TILE_WALL
    Next X
    For y = 0 To SY - 1
        Let M(0, y) = 2
        Let M(SX - 1, y) = TILE_WALL
    Next y

    ' Find a valid player spawn point.
    Do
        Let PX = Int(Rnd * SX)
        Let PY = Int(Rnd * SY)
    Loop Until M(PX, PY) = TILE_FLOOR

    ' Spawn some monsters.
    Let numEnemies = LV
    For n = 0 To numEnemies - 1
        Let enemies(n).type = 1
        Let enemies(n).hp = 1
        Do
            ' Monsters can only spawn on floor tiles that don't contain the player.
            Let enemies(n).x = Int(Rnd * SX)
            Let enemies(n).y = Int(Rnd * SY)
        Loop While M(enemies(n).x, enemies(n).y) <> TILE_FLOOR Or (enemies(n).x = PX And enemies(n).y = PY)
    Next n

    ' Find a place to place the stairs.
    Do
        Let DX = Int(Rnd * SX)
        Let DY = Int(Rnd * SY)
    Loop While M(DX, DY) <> TILE_FLOOR
    Let M(DX, DY) = TILE_STAIRS

    ' Clear the visibility map.
    For y = 0 To SY - 1
        For X = 0 To SX - 1
            Let V(X, y) = SHOW_PLAYFIELD
        Next X
    Next y
End Sub

Sub DrawMap
    Color 7, 0
    For y = 0 To SY - 1
        For x = 0 To SX - 1
            Locate y + Y_OFFSET, x + X_OFFSET
            Select Case V(x, y)
                Case 0
                    Print "*";
                Case 1
                    Print Mid$(TILE$, M(x, y), 1);
            End Select
        Next x
    Next y
End Sub

Sub DrawStatusScreen
    Cls
    Print "PLAYER STATUS"
    Print "===================="
    Print "EXPERIENCE:"; XP
    Print "LEVEL:"; LV
    Print "HEALTH:"; HP
    Print "ATTACK:"; AP
    Print "DEFENSE:"; DP
    Print "PERCEPTION:"; perception
    Print
    Print "INSTRUCTIONS"
    Print "=================="
    Print "WASD TO MOVE"
    Print "SPACE FOR STATUS SCREEN"
    Print
    Print "PRESS ANY KEY TO CONTINUE"
    Do While Len(InKey$) = 0
    Loop
    DrawMap
End Sub

Sub UpdateHUD
    Locate 1, 1
    Color , 1
    If hpDelta <> 0 Then
        PlayOuch
        HP = HP + hpDelta
        hpDelta = 0
        Color 4
    Else
        Color 15
    End If
    Print "HP:"; HP;
    Color 15
    Print "AP:"; AP; "DP:"; DP; "LV:"; LV; "XP:"; EX;

    Color , 0
End Sub

Sub GameOver
    Cls
    If HP = 0 Then
        Print "YOU ARE DEAD."
        PlayGameOver
    End If
    Print "GOODBYE!"
    End
End Sub

'''
' SFX Routines
'''

Sub PlayClick
    Const VOLUME = 1
    Const AMPLITUDE = VOLUME / 2
    Const PI = 3.1415926
    Const TAU = 2 * PI

    Let sampleLengthSeconds = 0.1
    Let samplesToGenerate = sampleLengthSeconds * _SndRate

    Let frequencyStart = 100
    Let sampleCount = 0

    i = 0
    di = 1 / 200.0
    Do Until sampleCount >= samplesToGenerate
        Let decay = (samplesToGenerate - sampleCount) / (samplesToGenerate * 8)
        Let frequency = frequencyStart * decay
        Let theta = frequency * TAU / _SndRate

        ' Triangle Wave
        _SndRaw 1 * AMPLITUDE * decay * i
        Let i = i + di
        If i > 1 Then
            Let i = 0
        End If

        Let sampleCount = sampleCount + 1
    Loop
End Sub

Sub PlayGameOver
    Const VOLUME = 1
    Const AMPLITUDE = VOLUME / 2
    Const PI = 3.1415926
    Const TAU = 2 * PI
    Let sampleLengthSeconds = 1.5
    Let samplesToGenerate = sampleLengthSeconds * _SndRate
    Let frequencyStart = 400
    Let sampleCount = 0

    i = 0
    di = 1 / 200.0
    Do Until sampleCount >= samplesToGenerate
        Let decay = (samplesToGenerate - sampleCount) / samplesToGenerate
        Let frequency = frequencyStart * decay
        Let theta = frequency * TAU / _SndRate

        ' Square Wave
        Let left = AMPLITUDE * decay * Sgn(Sin(theta * sampleCount))

        ' Sign Wave
        Let right = AMPLITUDE * decay * Sin(theta * 2 * sampleCount)

        _SndRaw left, right

        Let sampleCount = sampleCount + 1
    Loop
End Sub

Sub PlayOuch
    Const VOLUME = 1
    Const AMPLITUDE = VOLUME / 2

    Let sampleLengthSeconds = 0.1
    Let samplesToGenerate = sampleLengthSeconds * _SndRate

    For n = 1 To 2
        Let sampleCount = 0
        Do Until sampleCount >= samplesToGenerate
            Let decay = (samplesToGenerate - sampleCount) / samplesToGenerate

            ' Noise
            _SndRaw AMPLITUDE * decay * (Rnd * 2 - 1)

            Let sampleCount = sampleCount + 1
        Loop
    Next n
End Sub

Sub PlayGoingDown
    Const VOLUME = 1
    Const AMPLITUDE = VOLUME / 2

    Let sampleLengthSeconds = 1.5
    Let samplesToGenerate = sampleLengthSeconds * _SndRate
    Let sampleCount = 0

    i = 0
    di = 1 / 100.0 ' The 100 roughly corresponds to the frequency.
    Do Until sampleCount >= samplesToGenerate
        Let decay = (samplesToGenerate - sampleCount) / samplesToGenerate

        ' Triangle Wave
        _SndRaw AMPLITUDE * decay * i
        Let i = i + di
        If i > 1 Then
            Let i = 0
            Let di = di * 0.995
        End If

        Let sampleCount = sampleCount + 1
    Loop
End Sub

• I've added a couple of different sound effects using the _SndRaw statement.
• Screen size has been updated 40x25.
• Added a bit of color.
• There's a perception attribute that affects range of vision. Planning to add a random potion to each level to increase player stats.
• Somewhat more complex playfield generator.
• I've dropped the line numbers. QBASIC Subroutines all the way here.