Koodit: FreeBASIC: ASCII-tasoloikka

' ASCII-tasoloikka
' """"""""""""""""
' Ensimmäinen FreeBASIC-kokeilu. Saa lyödä.
' Sankari liikkuu nuolista, hyppää välilyönnillä, ESC:llä poistuu
'
' Koodilla saa tehdä mitä lystää
'
' TODO: AMPUMINEN

Option Explicit

' ******** FUNKTIOIDEN ESITTELYT ****************
Declare Function LataaTaso (ladattava As String) As Integer
Declare Sub piirraKehys
Declare Sub piirraTaso
Declare Sub piirraMerkki (nro As Integer)
Declare Sub asetaPiirtoReunat
Declare Sub lueNapit
Declare Sub liikutaOlioita
Declare Sub liikutaSankaria (x As Integer, y As Integer)
Declare Sub tulostaTilastot

' Numeroidaan mahdolliset karttaobjektit
Const TYHJA   = 0
Const PELAAJA = 1
Const ESTE    = 2
Const MORKO   = 3
Const KOLIKKO = 4
Const MAALI   = 5


' Alustetaan pelitaso maksimikokoonsa (200*100)
Dim Shared ptaso(199, 99) As Integer
Dim Shared leveys As Integer
Dim Shared korkeus As Integer

' Katsomissuunta (ampumissuunta)
enum Suunta
  VASEN = 1
  OIKEA
End enum

' Otustyyppi (vihollinen/pelaaja)
Type olio
  x As Integer
  y As Integer
  z As Suunta
End Type

' Vihollisista dynaaminen taulukko
Dim Shared viholliset() As olio
Dim Shared sankari As olio        ' pelaaja
Dim Shared kolikkoja As Integer   ' kolikkojen lkm
kolikkoja = 0                     ' aluksi 0

' Kenttätiedosto
Dim taso As String
taso = "1.lvl"

' Ladataan pelitaso
If LataaTaso(taso) = -1 Then
  Print "Tasoa ei saatu ladattua."
  Print "Paina jotakin nappia."
  While INKEY$ = "": WEND
End if

' Piirrettävän tasoalueen reunakoordinaatit ja muutakin
Dim Shared alkuX As Integer, alkuY As Integer
Dim Shared Kaynnissa As Integer
Dim Shared Ilmassa As Integer, hyppyvoima As Integer

Const HYPPYTEHO = 5  ' Tätä säätämällä vaihtuu hypyn korkeus

Ilmassa = 0
Kaynnissa = 1

' Näytön asetus
SCREEN 13

' *** Pääsilmukka ***
Do
  tulostaTilastot
  piirraKehys
  piirraTaso
  lueNapit
  liikutaOlioita
  Sleep 50
Loop until Kaynnissa = 0

CLS
Locate 13, 16
Color 15, 0
Print "Game Over"
While INKEY$ = "": Wend

SCREEN 0
CLS
END


' ********* FUNKTIOIDEN MÄÄRITTELYT *************

' *** Tasonlatausfunktio
Function LataaTaso(ladattava As String) As Integer

  ' Yritetään avata tiedosto
  If Open(ladattava For Input As #1) Then
    LataaTaso = -1   ' Virhepaluuarvo
    Exit Function
  End if

  Dim silmukkaX As Integer, silmukkaY As Integer
  Dim rivi As String, merkit As String

  ' merkit-muuttujaan mahdolliset karttamerkit samassa järjestyksessä, kun ne on numeroitu ylhäällä
  merkit = " X#@oG"

  ' Tyhjätään pelitaso
  For silmukkaX = 0 To 199
    For silmukkaY = 0 To 99
      ptaso(silmukkaX, silmukkaY) = TYHJA
    Next silmukkaY
  Next silmukkaX

  ' Luetaan tiedostosta tason koko
  Input #1, leveys, korkeus

  ' Käydään lopputiedosto läpi rivi kerrallaan
  For silmukkaY = 0 To (korkeus - 1)
    Line Input #1, rivi

    ' Tarkistetaan, että rivillä oikea määrä merkkejä
    If Len(rivi) <> leveys Then
      LataaTaso = -1
      Exit Function
    End If

    For silmukkaX = 0 To (leveys - 1)
      ptaso(silmukkaX, silmukkaY) = InStr(merkit, Mid(rivi, silmukkaX+1, 1)) - 1
      ' Onko vihollinen/pelaaja/kolikko
      If ptaso(silmukkaX, silmukkaY) = MORKO Then
        ' Kasvatetaan vihollistaulukkoa yhdellä ja asetetaan koordinaatit
        Redim Preserve viholliset(1 To (Ubound(viholliset, 1) + 1))
        viholliset(Ubound(viholliset, 1)).x = silmukkaX
        viholliset(Ubound(viholliset, 1)).y = silmukkaY
        viholliset(Ubound(viholliset, 1)).z = VASEN
      Elseif ptaso(silmukkaX, silmukkaY) = PELAAJA Then
        sankari.x = silmukkaX
        sankari.y = silmukkaY
        sankari.z = VASEN
        ' Tason piirtoreunat kuntoon
        asetaPiirtoreunat
      Elseif ptaso(silmukkaX, silmukkaY) = KOLIKKO Then
        kolikkoja = kolikkoja + 1
      End If
    Next silmukkaX
  Next silmukkaY

  ' Suljetaan tiedosto
  Close #1

  ' Kaikki sujui, palautetaan 0
  LataaTaso = 0

End Function


' *** Kentän reunojen piirto
Sub piirraKehys
  Dim i As Integer, j As Integer
  ' Värin vaihto
  Color 8, 0
  ' Ylä- ja alareunat
  For i = 3 To 24 Step 21
    For j = 2 To 39
      Locate i, j
      Print CHR$(219)
    Next j
  Next i
  ' Sivut
  For i = 2 To 39 Step 37
    For j = 3 To 24
      Locate j, i
      Print CHR$(219)
    Next j
  Next i
End Sub


' *** Tason piirto
Sub piirraTaso
  Dim i As Integer, j As Integer
  ' Ruutuun mahtuu tasosta 36x20 kokoinen pala
  ' joten pitää tehdä pieniä tarkasteluita
  If leveys > 36 Then
    For i = 0 To 35
      If korkeus > 20 Then
        For j = 0 To 19
          Locate 4+j, 3+i
          piirraMerkki( ptaso(alkuX+i, alkuY+j) )
        Next j
      Else
        For j = 0 To korkeus - 1
          Locate 4+j, 3+i
          piirraMerkki( ptaso(alkuX+i, j) )
        Next j
      End If
    Next i
  Else
    For i = 0 To leveys - 1
      If korkeus > 20 Then
        For j = 0 To 19
          Locate 4+j, 3+i
          piirraMerkki( ptaso(i, alkuY+j) )
        Next j
      Else
        For j = 0 To korkeus - 1
          Locate 4+j, 3+i
          piirraMerkki( ptaso(i, j) )
        Next j
      End If
    Next i
  End If
End Sub


' *** Apualiohjelma tason piirron selkeyttämiseksi
Sub piirraMerkki(nro As Integer)
  Select Case nro
    Case TYHJA
      Print " "
    Case PELAAJA
      Color 12, 0
      Print "X"
    Case ESTE
      Color 6, 0
      Print "#"
    Case MORKO
      Color 13, 0
      Print "@"
    Case KOLIKKO
      Color 14, 0
      Print "o"
    Case MAALI
      Color 11, 0
      Print "G"
  End Select
End Sub


' *** Piirtoalueen reunojen asetus
Sub asetaPiirtoReunat
  ' Ensin piirtoalueen vasen raja
  If leveys > 36 And sankari.x > 17 Then
    If (leveys - sankari.x) > 18 Then
      alkuX = sankari.x - 17
    Else
      alkuX = leveys - 36
    End If
  Else
    alkuX = 0
  End If
  ' Sitten yläraja
  If korkeus > 20 And sankari.y > 18 Then
    If (korkeus - sankari.y) > 3 Then
      alkuY = sankari.y - 17
    Else
      alkuY = korkeus - 20
    End If
  Else
    alkuY = 0
  End If
End Sub


' *** Näppiksen käsittely
Sub lueNapit
  Dim uusiX As Integer, uusiY As Integer
  uusiX = sankari.x: uusiY = sankari.y
  Select Case INKEY$
    Case CHR$(255) + "K"       ' Vasen
      uusiX = sankari.x - 1
    Case CHR$(255) + "M"       ' Oikea
      uusiX = sankari.x + 1
    Case CHR$(32)              ' Välilyönti
      If Ilmassa = 0 Then
        hyppyvoima = HYPPYTEHO
        Ilmassa = 1
      End If
    Case CHR$(27)              ' ESC
      Kaynnissa = 0
  End Select
  liikutaSankaria(uusiX, uusiY)
End Sub


' *** Hirviöiden liikuttelu
Sub liikutaOlioita
  ' Käydään hirviötaulukko läpi
  Dim i As Integer
  For i = LBound(viholliset,1) To UBound(viholliset,1)
    ' Mihin suuntaan menossa
    Select Case viholliset(i).z
      Case VASEN
        ' Voiko liikkua vasemmalle (eli onko edessä seinä tai joutuuko ilman päälle)
        If ptaso(viholliset(i).x-1, viholliset(i).y) = TYHJA And ptaso(viholliset(i).x-1, viholliset(i).y+1) = ESTE Then
          ptaso(viholliset(i).x, viholliset(i).y) = TYHJA
          viholliset(i).x = viholliset(i).x - 1
          ptaso(viholliset(i).x, viholliset(i).y) = MORKO
        Else  ' Jos ei voi, vaihdetaan suuntaa
          viholliset(i).z = OIKEA
        End If
      Case OIKEA
        ' Voiko liikkua oikealle (eli onko edessä seinä tai joutuuko ilman päälle)
        If ptaso(viholliset(i).x+1, viholliset(i).y) = TYHJA And ptaso(viholliset(i).x+1, viholliset(i).y+1) = ESTE Then
          ptaso(viholliset(i).x, viholliset(i).y) = TYHJA
          viholliset(i).x = viholliset(i).x + 1
          ptaso(viholliset(i).x, viholliset(i).y) = MORKO
        Else  ' Jos ei voi, vaihdetaan suuntaa
          viholliset(i).z = VASEN
        End If
    End Select
  Next i
End Sub


' *** Sankarin liikuttelu tiettyyn kohtaan
Sub liikutaSankaria(x As Integer, y As Integer)
  ' Jos ollaan ilmassa, tehdään temppuja
  If Ilmassa = 1 Then
    If hyppyvoima > 0 Then
      y = y - 1
      hyppyvoima = hyppyvoima - 1
    Else
      y = y + 1
    End If
  End If

  ' Katsotaan, onko tyhjä tai kolikollinen ruutu
  If ptaso(x, y) = TYHJA Or ptaso(x, y) = KOLIKKO Then
    ' Kolikko pois
    If ptaso(x, y) = KOLIKKO Then
      kolikkoja = kolikkoja - 1
    End If
    ' Vanhasta kohtaa sankari pois
    ptaso(sankari.x, sankari.y) = TYHJA
    ' Uudet koordinaatit ja sankari paikoilleen
    sankari.x = x
    sankari.y = y
    ptaso(x, y) = PELAAJA
    ' Uudet piirtoreunat
    asetaPiirtoReunat
    ' Tarkistetaan, ollaanko ilman päällä
    If ptaso(x, y+1) = TYHJA Then
      Ilmassa = 1
    Else
      Ilmassa = 0
    End If

  ' Katsotaan, onko ruudussa mörkö
  Elseif ptaso(x, y) = MORKO Then
    ' Peli loppuu :(
    Kaynnissa = 0
  ' Onko maali?
  Elseif ptaso(x, y) = MAALI Then
    ' Onko kolikot kerätty
    If kolikkoja = 0 Then
      Kaynnissa = 0
    End If
  End If
End Sub

' *** Tilastojen tulostusta
Sub tulostaTilastot
  Locate 1, 2: CLS
  Color 15, 0
  Print "Kolikkoja:";
  Print kolikkoja
End Sub

40 30
########################################
#         #                            #
#G        # o              o         o #
######    #########      ####       ####
#                 #                    #
#      @          #                    #
#############     ####            ## o #
#                    ##          ###   #
#                    ###        ####   #
# o   #   #          ####      #####   #
#######   #######    #####    ######   #
#                                      #
# o              @                     #
#######   ################    ##########
#            o                         #
#                      #       @    o  #
#                      #################
#     #############                    #
#     #         o #                    #
#  o  #        ###################     #
#######           #       #  o  #      #
#                             @        #
# o       ##############################
#####     #o                           #
#o        #                            #
#         #            @               #
#     #######     ##############       #
#                        #             #
#                      o #         X   #
########################################