Keskustelu: Ohjelmointikysymykset: FreeBASIC: Hahmon liikkumisongelma (FreeBasic)

declare function nappaint () as string
declare function voiliikkua (y as integer, x as integer, oy as integer, ox as integer) as integer
declare sub kartanpiirto
declare sub kumitus (y as integer, x as integer)
declare sub liike (nappi as string, tyyppi as integer, uy as integer, ux as integer, y as integer, x as integer)

screenres 640, 400, 32  ' näytön asettelu

type olio  ' olio ryhmä, sisältää kaikki hirviöt, hahmo(t) jne...
    tyyppi as integer
    y as integer
    x as integer
    uy as integer
    ux as integer
end type

type tyyppi
    muoto as string * 1     ' merkki
    vari as integer         ' väri
end type

dim shared kartta(1 to 80,1 to 35) as integer
dim shared olio(1 to 10) as olio
dim shared oliom as integer
dim shared tyyppi(1 to 10) as tyyppi
dim i as integer
dim a as string

tyyppi(1).muoto = "O"       ' pelaaja
tyyppi(1).vari = rgb(255, 255, 000)
tyyppi(2).muoto = "O"       ' rosvo
tyyppi(2).vari = rgb(123, 123, 126)

oliom = 2

olio(1).tyyppi = 1
olio(1).y = 32
olio(1).x = 43
olio(1).uy = olio(1).y
olio(1).ux = olio(1).x

olio(2).tyyppi = 2      ' 2 on rosvo
olio(2).y = 2
olio(2).x = 3
olio(2).uy = olio(2).Y
olio(2).ux = olio(2).x

kartanpiirto

cls

do  ' pääsilmukka

    for i = 1 to oliom  ' olioiden piirto
        locate olio(i).y, olio(i).x
        color tyyppi(olio(i).tyyppi).vari   ' värin laitto
        print tyyppi(olio(i).tyyppi).muoto  ' olion väri

        if voiliikkua(olio(i).uy, olio(i).ux, olio(i).y, olio(i).x) then
            olio(i).y = olio(i).uy
            olio(i).x = olio(i).ux
        end if

        if olio(1).tyyppi = 1 then
            Select Case a          ' näppäimet ja niiden toiminnot
                Case "a"           ' Vasemmalle
                    olio(1).uy = olio(1).y
                    olio(1).ux = olio(1).x -1
                Case "d"          ' Oikealle
                    olio(1).ux = olio(1).x + 1
                    olio(1).uy = olio(1).y
                Case "w"           ' Ylös
                    olio(1).ux = olio(1).x
                    olio(1).uy = olio(1).y - 1
                Case "s"           ' Alas
                    olio(1).ux = olio(1).x
                    olio(1).uy = olio(1).y + 1
                Case Chr(27)       ' Sulje ohjelma
                    End
            End Select
        end if


    next i

    a = nappaint    ' näppäinten tunnistus

    for i = 1 to oliom  ' olioiden kumitus
        locate olio(i).y, olio(i).x
        kumitus(olio(i).y, olio(i).x)
    next i

loop    ' pääsilmukan lopetus

function nappaint () as string  ' näppäintunnistus
    dim a as string

    do
        a = inkey
    loop until a <> ""
    nappaint = a
end function

Function voiliikkua (y As Integer,  x As Integer, oy as integer, ox as integer) As Integer        ' törmäysfunctio

    dim i as integer

    voiliikkua = -1     ' Oletuksena voi liikkua, siis -1, ei liikkua on 0

    FOR i = 1 TO oliom                              ' Verrataan jokaisen hirviön koordinaatteja
        IF y = oy AND x = ox THEN         ' Jos ruudussa on hirviö
            voiliikkua = 0                                    ' ruutu on varattu
            EXIT FUNCTION
        END IF
    NEXT i

    If x < 1 Or x > 80 Or y < 1 Or y > 35 Then  ' ei voi liikkua seuraavilla alueilla ( reunatunnistus)
        voiliikkua = 0
        Exit Function
    End If

End Function

Sub kumitus (y As Integer,  x As Integer)   ' kumitus aliohjelma

    Dim piirto As Integer

    piirto = kartta(y, x)   ' piirto on x, y koordinaateissa sijaiteva luku
    kartta(y, x) = piirto   ' x, y koordinaateissa sijaitseva luku on piirto
    kartanpiirto            ' piiretään uudestaan

End Sub

Sub kartanpiirto    ' Kartanpiirto aliohjelma

    Dim i As Integer            ' Muuttujat määritetään
    Dim i2 As Integer
                                ' Kartan tarkistus
    For i2 = 1 To 35           ' y
        For i = 1 To 80        ' x
            Locate i2,  i
            If kartta(i, i2) = 0 Then Print " ";  ' maaksi piiretään .
            If kartta(i, i2) = 1 Then Print "#";  ' piirtää 1 kohtiin seinää
        Next i
    Next i2

End Sub