Olen käyttänyt ohjelmassani muunnosta Bresenham's line algorithm:sta, mutta en ole onnistunut siinä ihan täysin.
Alkuperäisessä koodissa vaihdettiin aloitus ja loppu x,y arvoja sen mukaan,
kummat arvot on koodille sopivammat. mutta kortin siirtoon ei alku ja loppupisteitä ole mahdollista vaihtaa, vaan koodin pitäisi pystyä laskemaan
aina oikeat lisäys x,y arvot.
http://www.experts-exchange.com/Programming/Languages/CPP/
Millaisia liikuttamis-algoritmeja olette kehittäneet?
Jos sun on tarkoitus liikuttaa sitä korttia pisteestä x1,y1 pisteeseen x2,y2 vakionopeudella tai vakioajassa, niin laskisin vaan erotuksesta liukuluvut ja lisäilisin niitä loopissa kortin koordinaatteihin, sitten mahdollisesti pyöristäen piirtofunktiolle.
En oikein keksi mitään järkevää syytä käyttää Bresenhamin algoritmia, kun kuitenkin käsittääkseni joudut piirtämään koko kortin uudestaan uudessa paikassa. Eli algoritmin tehokkuudesta saatava hyöty on täysin mitätön verrattuna kokonaisuuden käyttämään tehoon. Muutenkin tuo tehokkuus tulee vain jos siirrät korttia vain yhden pikselin verran per piirtokerta, joka vaikuttaa aika hitaalta, eli 60 px / sekunti olisi suurin järkevä nopeus nykynäytöillä.
Kokeilin tämmöstä koodia =)
Public Sub CountMove(II%, StartXY As t_Pos, EndXY As t_Pos, Speed%) ' X1%, Y1%, X2%, Y2%, Speed%)
Dim X1%, Y1%, X2%, Y2%, I%
X1 = StartXY.X
Y1 = StartXY.Y
X2 = EndXY.X
Y2 = EndXY.Y
If X1 < X2 Then Mo(II).EroX = (X1 / X2) Else Mo(II).EroX = -(X1 / X2)
If Y1 < Y2 Then Mo(II).EroY = (Y1 / Y2) Else Mo(II).EroY = -(Y1 / Y2)
Mo(II).StartX = X1
Mo(II).StartY = Y1
Mo(II).EndX = X2
Mo(II).EndY = Y2
Mo(II).X = X1
Mo(II).Y = Y1
Mo(II).Speed = Speed
Ca(II).Moving = True
End Sub
Function CardMove(ByVal II As Integer) As Boolean
Dim P As t_Pos
Dim M As Boolean
M = True
With Mo(II)
If ((.X + .EroX * .Speed > .EndX And .EroX > 0) Or (.X + .EroX * .Speed < .EndX And .EroX < 0)) And _
((.Y + .EroY * .Speed > .EndY And .EroY > 0) Or (.Y + .EroY * .Speed < .EndY And .EroY < 0)) Then
.Speed = .Speed / 2: If .Speed < 1 Then .Speed = 1
End If
If (((.X >= .EndX And .EroX > 0) Or (.X <= .EndX And .EroX < 0)) And _
((.Y >= .EndY And .EroY > 0) Or (.Y <= .EndY And .EroY < 0))) Then ' Loppu saavutettu!!
Ca(II).pos.X = .EndX
Ca(II).pos.Y = .EndY
.X = .EndX
.Y = .EndY
'M_Draw.mDrawCard II
M = MoveEndProcess(II)
Else
Ca(II).pos.X = .X
Ca(II).pos.Y = .Y
.X = .X + .EroX * .Speed
.Y = .Y + .EroY * .Speed
End If
End With
Ca(II).Moving = M
CardMove = M
End FunctionEi tuolla erotuksella saanut kovin tarkasti laskettua haluttua kohtaa..
If ((.X < .EndX And .EroX > 0) Or (.X > .EndX And .EroX < 0)) Then .X = .X + .EroX * .Speed
If ((.Y < .EndY And .EroY > 0) Or (.Y > .EndY And .EroY < 0)) Then .Y = .Y + .EroY * .SpeedTämä koodi estäisi korttia ajautumasta loppukohdan yli., mutta jompikumpi akseli pysähtyy ensin.
Tämän koodin tarkoituksena on sallia vaikka kaikkien korttien liikkuminen yhtäaikaa, josta tuleekin kivan näköinen korttien jako =)
Vaikkei koodi välttämättä olekaan täysin validia (en käytä VB:tä), siitä selvinnee, miten lasku olisi järkevää tehdä. Mainittuun algoritmiin en ota kantaa, koska se on Grezin mainitsemista syistä huono tähän tilanteeseen.
Sub LaskeKohta( _
ByVal Aika As Single, ByVal Kesto As Single, _
ByVal Alku As t_Pos, ByVal Loppu As t_Pos, _
ByRef Kohta As t_Pos)
' Ei liikuteta lopun yli eikä alun ali:
If Aika > Kesto Then Aika = Kesto
If Aika < 0 Then Aika = 0
' Suhteutetaan aika niin, että alku ja loppu ovat 0 ja 1
Aika = Aika / Kesto
' Itse laskut ovatkin helpot, tavallaan siis otetaan painotettu keskiarvo:
Kohta.X = Aika * Loppu.X + (1 - Aika) * Alku.X
Kohta.Y = Aika * Loppu.Y + (1 - Aika) * Alku.Y
End SubTämä funktio kuvastaakin sitä, miten itse tekisin siirron, jos alku- ja loppupisteet olisivat olennaiset. Toinen vaihtoehto olisi laskea nopeus ja liikkua sillä. Joka tapauksessa on järkevää erottaa koordinaattien käsittely ja ajan käsittely toisistaan niin, että ensin pidetään kirjaa siitä, onko liike vielä kesken ja mikä ajanhetki on menossa, ja sen jälkeen vasta lasketaan koordinaatit kuten esimerkissäni.
Ratkaisu ongelmaan olikin muokata tuota Bresenham's line algorithm:n koodia.
Riitti, kun lasketaan slopeX yms myös X:lle.
Siirtää tarkasti kohteeseen ja "Speed" pitää huolen nopeudesta.
''//Bresenham's line algorithm
''// laskee spriten suunnan aloituksen, kun tiedetään alku, ja loppupisteet.
Public Sub CountMove(II%, StartXY As t_Pos, EndXY As t_Pos, Speed%) ' X1%, Y1%, X2%, Y2%, Speed%)
Dim Dy As Long, DX As Long
If GS.Fast Then 'Jos nopeasti perille, niin ohitetaan koko aliohjelma
Ca(II).pos.X = EndXY.X
Ca(II).pos.Y = EndXY.Y
Table.Fresh = True 'Päivitetään kortit
DS.Fresh = True 'Päivitetään korttipakka
Exit Sub
End If
With Mo(II)
.EndX = EndXY.X
.EndY = EndXY.Y
.X = StartXY.X
.Y = StartXY.Y
.Speed = Speed
'Varmistetaan että annetaan oikea nopeus
If (Speed = 0) Then .Speed = 10
If (Speed <> -1) Then .Speed = Speed
If (.Speed <= 0) Then .Speed = 10
DX = .EndX - .X
Dy = .EndY - .Y
'// Adjust y-increment for negatively sloped lines
If (Dy < 0) Then
.SlopeY = -1: Dy = -Dy
Else
.SlopeY = 1
End If
'// Same X:lle
If (DX < 0) Then
.SlopeX = -1: DX = -DX
Else
.SlopeX = 1
End If
'// Bresenham constants
Mo(II).incE = 2 * Dy
.incNE = 2 * Dy - 2 * DX
.D = 2 * Dy - DX
'Sama X:lle
.incE2 = 2 * DX
.incNE2 = 2 * DX - 2 * Dy
.D2 = 2 * DX - Dy
End With
Ca(II).Moving = True
End Sub
Function CardMove(ByVal II As Integer) As Boolean
Dim P As t_Pos
Dim M As Boolean
Dim X2 As Single, Y2 As Single
M = True
With Mo(II)
'Jarrutetaan vauhtia
If ((.X + .SlopeX * .Speed > .EndX And .SlopeX > 0) Or (.X + .SlopeX * .Speed < .EndX And .SlopeX < 0)) And _
((.Y + .SlopeY * .Speed > .EndY And .SlopeY > 0) Or (.Y + .SlopeY * .Speed < .EndY And .SlopeY < 0)) Then
.Speed = .Speed / 2: If .Speed < 1 Then .Speed = 1
End If
' Loppu saavutettu ?
If (((.X >= .EndX And .SlopeX > 0) Or (.X <= .EndX And .SlopeX < 0)) And _
((.Y >= .EndY And .SlopeY > 0) Or (.Y <= .EndY And .SlopeY < 0))) Then
Ca(II).pos.X = .EndX
Ca(II).pos.Y = .EndY
.X = .EndX
.Y = .EndY
M = MoveEndProcess(II)
If M And .ToPlace = pTrash Then
'Jatko siirto, roskis pakkaan ylhäältä
P = Tra.CountCardPositions 'Lasketaan paikka
CountMove II, Ca(II).pos, P, 5
Exit Function
End If
Else
'Jatketaan liikkumista
Ca(II).pos.X = .X
Ca(II).pos.Y = .Y
If (.D <= 0) Then
Inc .D, .incE
Else
Inc .D, .incNE
If ((.Y < .EndY And .SlopeY > 0) Or (.Y > .EndY And .SlopeY < 0)) Then
Inc .Y, .SlopeY * .Speed
Else
.Y = .EndY
End If
End If
If (.D2 <= 0) Then
Inc .D2, .incE2
Else
Inc .D2, .incNE2
If ((.X < .EndX And .SlopeX > 0) Or (.X > .EndX And .SlopeX < 0)) Then
Inc .X, .SlopeX * .Speed
Else
.X = .EndX
End If
End If
End If
End With
Ca(II).Moving = M
CardMove = M
End FunctionAihe on jo aika vanha, joten et voi enää vastata siihen.