CB raycast collision

raycast_testi.CB

ChDir "C:\Program Files (x86)\CoolBasic"

// CBRAYCASTER
// -----------
// Esimerkin näppäimet:
//  - Enter:              Vaihtaa debug-tilaa
//  - Välilyönti:         Generoi kartan uudelleen
//  - Hiiren rulla:       Muuttaa kartan satunnaisuuden astetta
//  - WASD:               Liikuttaa objektia
//  - Nuolet vasen-oikea: Kääntää objektia
//  - Nuolet ylös-alas:   Lisää/vähentää tarkistusmatkan pituutta


Const MAPW = 30
Const MAPH = 20

// Yhden tilen leveys ja korkeus
Const TILEW = 32
Const TILEH = 20

// Näihin globaaleihin tallennetaan osumakohdan koordinaatit
Global gCastX#, gCastY#

// Piirrelläänkö debug-tavaraa?
Global gDebug
gDebug = True

SCREEN MAPW*TILEW, MAPH*TILEH

Dim TILEMAP(MAPW, MAPH)

// Jännästi täällä jo funktio joka resetoi TILEMAP-taulun valitulla randomisuudella
Function resetTileMap(randomness = 4)
    If randomness < 1 Then randomness = 1
    For x = 0 To MAPW-1
        For y = 0 To MAPH-1
            If Rand(randomness)=1 Then TILEMAP(x, y) = 1 Else TILEMAP(x, y) = 0
        Next y
    Next x
EndFunction
randyrandom = 4
resetTileMap(randyrandom)

// Testaillaan objektilla
obj = LoadObject("Media\guy.bmp", 72)
speed = 2
angle = Rand(0,360)

// Kuinka pitkältä katsotaan, alustetaan se neljän laatan pituudelle
length = TILEW*4


// Luodaan kuva tilekartasta
tilemapImg = InitTileMap()


ClsColor cbBlack
Color 255, 0, 0
Repeat

    // Debug-tilaa voi vaihtaa Enterillä
    If KeyHit(cbKeyReturn) Or KeyHit(cbKeyEnter) Then gDebug = Not gDebug

    // Välilyönnillä voi randomisoida kartan uudelleen
    If KeyHit(cbKeySpace) Then
        resetTileMap(randyrandom)
        tilemapImg = InitTileMap()
    EndIf

    // Hiiren rullalla voi vaihtaa kartan randomisuutta
    randyrandom = randyrandom + MouseMoveZ()

    DrawImage tilemapImg, 0, 0

    // WASD liikuttaa objektia
    TranslateObject obj, (KeyDown(cbKeyD)-KeyDown(cbKeyA))*speed, (KeyDown(cbKeyW)-KeyDown(cbKeyS))*speed
    // Oikea ja vasen nuolinäppäin kääntää objektia
    angle = angle + (RightKey()-LeftKey())*2
    RotateObject obj, -angle

    startX = WorldToScreenX(ObjectX(obj))
    startY = WorldToScreenY(ObjectY(obj))

    // Ylös ja alas nuolinäppäimet muuttavat tarkistusmatkan pituutta
    length = length + (UpKey()-DownKey())*2

    endX = startX + Cos(angle)*length
    endY = startY + Sin(angle)*length

    If gDebug Then
        If hit Then Color 255, 255, 255
        Circle2(startX, startY, length)
        Line startX, startY, endX, endY
    EndIf

    Color 0,255,0
    hit = CastRay(startX, startY, endX, endY)
    If hit Or gDebug Then
        // Jos osui seinään tai debug-tilassa, niin piirretään osumapiste
        Color 0, 0, 255
        DrawToWorld ON
        Circle2World(ScreenToWorldX(gCastX), ScreenToWorldY(gCastY), 5)
        DrawToWorld OFF
    EndIf

    // Näytetään FPS
    Color cbWhite
    Text 0, 0, "FPS: " + FPS()

    DrawScreen
Forever


// PORTED FROM http://dev.mothteeth.com/2011/11/2d-ray-casting-on-a-grid-in-as3/
Function CastRay(origX1#, origY1#, origX2#, origY2#)
    // Pisteiden normalisaatio
    x1# = origX1 / TILEW
    y1# = origY1 / TILEH
    x2# = origX2 / TILEW
    y2# = origY2 / TILEH

    If RoundDown(x1) = RoundDown(x2) And RoundDown(y1) = RoundDown(y2) Then
        // Ei ylitä minkään laatan rajoja, joten ei voi olla törmäystä.
        // Asetetaan loppupiste muuttujiin gCastX ja gCastY
        gCastX = origX2
        gCastY = origY2
        Return False
    EndIf

    // Kumpaan suuntaan mennään x- ja y-suunnassa
    If x2 >= x1 Then stepX = 1 Else stepX = -1
    If y2 >= y1 Then stepY = 1 Else stepY = -1

    // Säteen suunta
    rayDirX# = x2 - x1
    rayDirY# = y2 - y1

    // Kuinka pitkälle liikutaan kummallakin akselilla kun toisella akselilla hypätään seuraavaan
    // kokonaiseen tileen
    ratioX# = rayDirX / rayDirY
    ratioY# = rayDirY / rayDirX

    deltaY# = x2 - x1
    deltaX# = y2 - y1

    deltaX = Abs(deltaX)
    deltaY = Abs(deltaY)

    // Alustetaan testiä varten käytettävät kokonaislukumuuttujat alkutilekoordinaatteihin
    // Huom: Käytetään normalisoituja versioita parametreista origX1 ja origY1
    testX = RoundDown(x1)
    testY = RoundDown(y1)

    // Alustetaan ei-kokonaislukuhyppäys liikkumalla seuraavan tilen reunalle ja jakamalla saatu
    // arvo vastakkaisen akselin kokonaisluvulla.
    // Jos liikutaan positiiviseen suuntaan, siirrytään nykyisen tilen päähän, muulloin alkuun.
    If stepX > 0 Then
        maxX# = deltaX * (1.0 - (x1 Mod 1))
    Else
        maxX# = deltaX * (x1 Mod 1)
    EndIf
    If stepY > 0 Then
        maxY# = deltaY * (1.0 - (y1 Mod 1))
    Else
        maxY# = deltaY * (y1 Mod 1)
    EndIf

    endTileX = RoundDown(x2)
    endTileY = RoundDown(y2)

    // Nyt liikutaan!
    hit = False
    colX# = 0.0
    colY# = 0.0

    While (testX <> endTileX Or testY <> endTileY)
        // Piirretään debuggailua varten boksi sen tilen ympärille, jossa tällä hetkellä ollaan.
        If gDebug Then Box testX*TILEW, testY*TILEH, TILEW, TILEH, OFF
        If maxX < maxY Then
            maxX = maxX + deltaX
            testX = testX + stepX

            If testX >= 0 And testX <= MAPW-1 Then
                // Jos ollaan tilekartan rajojen sisällä, tarkistetaan onko tässä tilessä törmäystä.
                hit = TILEMAP(testX, testY)
            Else
                // Jos taas ollaan tilekartan rajojen ulkopuolella niin asetetaan törmäys heti.
                hit = 1
            EndIf
            If hit Then
                colX = testX
                If stepX < 0 Then colX = colX + 1.0 // Jos mennään vasemmalle päin, lisätään yksi.
                colY = y1 + ratioY * (colX - x1)
                colX = colX * TILEW // Skaalataan törmäyspiste ylöspäin
                colY = colY * TILEH
                // Asetetaan "paluuarvot"
                gCastX = colX
                gCastY = colY
                'SetWindow "Hit in tile (" + testX + ", " + testY + ")"
                Return True
            EndIf
        Else
            maxY = maxY + deltaY
            testY = testY + stepY

            If testY >= 0 And testY <= MAPH-1 Then
                hit = TILEMAP(testX, testY)
            Else
                hit = 1
            EndIf
            If hit Then
                colY = testY
                If stepY < 0 Then colY = colY + 1.0 // Add one if going up
                colX = x1 + ratioX * (colY - y1)
                colX = colX * TILEW // Skaalataan törmäyspiste ylöspäin
                colY = colY * TILEH
                gCastX = colX
                gCastY = colY
                'SetWindow "Hit in tile (" + testX + ", " + testY + ")"
                Return True
            EndIf
        EndIf
    Wend

    // Ei löydetty törmäystä, palautetaan loppupiste
    gCastX = origX2
    gCastY = origY2
    'SetWindow "No hit in tile (" + testX + ", " + testY + ")"
    Return False
EndFunction

// Piirtää ympyrän keskikoordinaattien mukaan
Function Circle2(x, y, r, fill=0)
    Circle x-r,y-r,r*2,fill
EndFunction

// Piirtää ympyrän keskikoordinaattien mukaan maailmankoordinaatistossa
Function Circle2World(x, y, r, fill=0)
    Circle x-r,y+r,r*2,fill
EndFunction

// Muuttaa maailmankoordinaatit näytönkoordinaateiksi, kun kameraa ei olla liikuteltu
Function WorldToScreenX#(x#)
    Return x + MAPW * TILEW / 2
EndFunction

Function WorldToScreenY#(y#)
    Return -y + MAPH * TILEH / 2
EndFunction

// Muuttaa näyttökoordinaatit maailmankoordinaateiksi, kun kameraa ei olla liikuteltu
Function ScreenToWorldX#(x#)
    Return x - MAPW * TILEW / 2
EndFunction

Function ScreenToWorldY#(y#)
    Return MAPH * TILEH / 2 - y
EndFunction 

// Alustaa TILEMAP-taulukon
Function InitTileMap()
    img = MakeImage(MAPW*TILEW, MAPH*TILEH)
    DrawToImage img
    Color 255, 0, 0
    For x=0 To MAPW-1
        For y=0 To MAPH-1
            If TILEMAP(x, y) Then
                Box x*TILEW, y*TILEH, TILEW, TILEH
            EndIf
        Next y
    Next x

    DrawToScreen
    Return img
EndFunction

Voisit heittää cb-foorumeille Esimerkit & tutoriaalit -alueelle. :)