Vanhoja hukkuneita hyödyllisiä koodien pätkiä
Vanhoja hukkuneita hyödyllisiä koodien pätkiä
Kuten otsikko kertoo, niin tänne saisi postata vanhoja, mutta hyviä/käytännöllisiä koodien pätkiä. Minulta on mennyt hukkaan marcoderin(oliko ne marcoderin?) auton fysiikat, koska ne olivat vain vanhoilla foorumeilla (niihin ei ole enää pääsyä), ja enkä ole niitä tallentanut sen kummemmin mihinkään.(En ole löytänyt uudelta foorumilta muuta, kuin linkin vanhoille foorumeille.)
PS. Nämä, "kategoria" tyyliset viestit ovat mielestäni käteviä, en sitten tiedä muista, mutta senpähän takia ainakin itse teen tällaisia.
PS. Nämä, "kategoria" tyyliset viestit ovat mielestäni käteviä, en sitten tiedä muista, mutta senpähän takia ainakin itse teen tällaisia.
Solar Eclipse
We're in a simulation, and God is trying to debug us.
Re: Vanhoja hukkuneita hyödyllisiä koodien pätkiä
Minulla on sattumoisin marcoderin autofysiikkakoodi tallennettuna koneelle. Voinkin tässä sen uppiakkin:
Code: Select all
Const WWIDTH = 5 // Renkaan leveys
Const WLENGTH = 15 // Renkaan pituus
Const WHEELBASE = 58 // Akseliväli
Const RAILGAUGE = 35 // Raideleveys
Const MAXSPEED = 7
Const MAXBSPEED = 3 // Auton maksimi peruutusnopeus
Const STEERSPEED# = 2.5 // Ohjauksen nopeus
Const STEERSPEED2# = 0.2 // Ohjauksen nopeus kun auto kulkee huippunopeutta
Const MAXSTEER = 35 // Maksimi ohjauskulma
Const ACCELERATION# = 0.02 // Kiihtyvyys
Const BACCELERATION# = 0.2 // Peruutuskiihtyvyys
Const SLOWDOWN# = 0.1 // Hidastuvuus
Const WHEELHOLD = 0.5//Renkaiden pito0
// Asetetaan vakiot joilla viitataan taulukon elementteihin
Const CAR_X = 1 // Auton position X
Const CAR_Y = 2 // Auton positio Y
Const CAR_ANGLE = 3 // Auton kulma
Const CAR_STEER = 4 // Ohjauskulma
Const CAR_SPEED = 5 // Nopeus
Const CAR_FIELDS = 5 // Taulukon kenttien lukumäärä
Dim CarTable#(0, CAR_FIELDS)
gNumCars = 0
Global gx1#, gy1#, gx2#, gy2#, gx3#, gy3#, gx4#, gy4#
// Luodaan auto
car1 = AddCar(0, 0, 0)
objCar = LoadObject("..\media\car.bmp", 180)
// Luodaan toinen auto
car2 = AddCar(0, 100, 0)
// Nurtsia taustalle
grass=MakeObjectFloor()
lawn=LoadImage("..\Media\grass.bmp")
PaintObject grass,lawn
DrawToWorld ON
Color 0, 0, 0
Repeat
CarPhysic(car1, UpKey(), DownKey(), LeftKey(), RightKey())
CarPhysic(car2, KeyDown(cbKeyW), KeyDown(cbKeyS), KeyDown(cbKeyA), KeyDown(cbKeyD))
PositionObject objCar, CarTable(car1, CAR_X), CarTable(car1, CAR_Y)
RotateObject objCar, -CarTable(car1, CAR_ANGLE)
CloneCameraPosition objCar
DrawGame
DrawCars()
Text 0, 60, "Speed: " + CarTable(1, CAR_SPEED)
DrawScreen
Forever
Function AddCar(x, y, angle)
gNumCars + 1
ClearArray OFF
ReDim CarTable(gNumCars, CAR_FIELDS)
CarTable(gNumCars, CAR_X) = x
CarTable(gNumCars, CAR_Y) = y
CarTable(gNumCars, CAR_ANGLE) = angle
CarTable(gNumCars, CAR_STEER) = 0
CarTable(gNumCars, CAR_SPEED) = 0
Return gNumCars
End Function
Function CarPhysic(carID, bAccelerate, bBackup, bLeft, bRight)
// Ohjauksen nopeus muuttuu nopeuden mukaan
p# = 100 / MAXSPEED * CarTable(carID, CAR_SPEED)
s# = STEERSPEED - (STEERSPEED - STEERSPEED2) / 100 * p
// Vasemmalle
If bLeft = True And bRight = False Then
If CarTable(carID, CAR_STEER) > 0 Then s = STEERSPEED * 2
CarTable(carID, CAR_STEER) = CarTable(carID, CAR_STEER) - s
CarTable(carID, CAR_STEER) = Max(CarTable(carID, CAR_STEER), -MAXSTEER)
EndIf
// Oikealle
If bLeft = False And bRight = True Then
If CarTable(carID, CAR_STEER) < 0 Then s = STEERSPEED * 2
CarTable(carID, CAR_STEER) = CarTable(carID, CAR_STEER) + s
CarTable(carID, CAR_STEER) = Min(CarTable(carID, CAR_STEER), MAXSTEER)
EndIf
// Oikaisu eli ei ohjata
If bLeft = False And bRight = False Then
If CarTable(carID, CAR_STEER) > 0 Then
CarTable(carID, CAR_STEER) = CarTable(carID, CAR_STEER) - STEERSPEED * 2
CarTable(carID, CAR_STEER) = Max(CarTable(carID, CAR_STEER), 0)
EndIf
If CarTable(carID, CAR_STEER) < 0 Then
CarTable(carID, CAR_STEER) = CarTable(carID, CAR_STEER) + STEERSPEED * 2
CarTable(carID, CAR_STEER) = Min(CarTable(carID, CAR_STEER), 0)
EndIf
EndIf
// Kiihdytys
If bAccelerate = True And bBackup = False Then
CarTable(carID, CAR_SPEED) = CarTable(carID, CAR_SPEED) + ACCELERATION
CarTable(carID, CAR_SPEED) = Min(CarTable(carID, CAR_SPEED), MAXSPEED)
EndIf
// Peruutus
If bAccelerate = False And bBackup = True Then
CarTable(carID, CAR_SPEED) = CarTable(carID, CAR_SPEED) - BACCELERATION
CarTable(carID, CAR_SPEED) = Max(CarTable(carID, CAR_SPEED), -MAXBSPEED)
EndIf
// Hidastus
If bAccelerate = False And bBackup = False Then
If CarTable(carID, CAR_SPEED) > 0 Then
CarTable(carID, CAR_SPEED) = CarTable(carID, CAR_SPEED) - SLOWDOWN
CarTable(carID, CAR_SPEED) = Max(CarTable(carID, CAR_SPEED), 0)
EndIf
If CarTable(carID, CAR_SPEED) < 0 Then
CarTable(carID, CAR_SPEED) = CarTable(carID, CAR_SPEED) + SLOWDOWN
CarTable(carID, CAR_SPEED) = Min(CarTable(carID, CAR_SPEED), 0)
EndIf
EndIf
a# = CarTable(carID, CAR_ANGLE) - 90
// Lasketaan etuakselin keskipiste
fax# = CarTable(carID, CAR_X) - (Sin(a) * WHEELBASE / 2)
fay# = CarTable(carID, CAR_Y) - (Cos(a) * WHEELBASE / 2)
// Lasketaan taka-akselin keskipiste
rax# = CarTable(carID, CAR_X) - (Sin(a - 180) * WHEELBASE / 2)
ray# = CarTable(carID, CAR_Y) - (Cos(a - 180) * WHEELBASE / 2)
// Siirretään etuakselia renkaiden osoittamaan suuntaan nopeuden verran
a# = a + CarTable(carID, CAR_STEER)
fax# = fax - (Sin(a) * CarTable(carID, CAR_SPEED))
fay# = fay - (Cos(a) * CarTable(carID, CAR_SPEED))
// Lasketaan auton uusi kulma
CarTable(carID, CAR_ANGLE) = GetAngle(rax, ray, fax, fay)
// Lasketaan auton uusi paikka
CarTable(carID, CAR_X) = fax + Sin(CarTable(carID, CAR_ANGLE)-90) * WHEELBASE / 2
CarTable(carID, CAR_Y) = fay + Cos(CarTable(carID, CAR_ANGLE)-90) * WHEELBASE / 2
End Function
Function DrawCars()
For i = 1 To gNumCars
DrawCar(i)
Next i
End Function
Function DrawCar(carID)
// Auton runko
DrawBox(CarTable(carID, CAR_X), CarTable(carID, CAR_Y), CWIDTH, CLENGTH, CarTable(carID, CAR_ANGLE))
// Laskenaan renkaiden paikat
CalcBoxPoints(CarTable(carID, CAR_X), CarTable(carID, CAR_Y), RAILGAUGE, WHEELBASE, CarTable(carID, CAR_ANGLE))
wx1# = gx1: wy1# = gy1
wx2# = gx2: wy2# = gy2
wx3# = gx3: wy3# = gy3
wx4# = gx4: wy4# = gy4
// Vasen eturengas
DrawBox(wx1, wy1, WWIDTH, WLENGTH, CarTable(carID, CAR_ANGLE) + CarTable(carID, CAR_STEER))
// Oikea eturengas
DrawBox(wx2, wy2, WWIDTH, WLENGTH, CarTable(carID, CAR_ANGLE) + CarTable(carID, CAR_STEER))
// Vasen takarengas
DrawBox(wx4, wy4, WWIDTH, WLENGTH, CarTable(carID, CAR_ANGLE))
// Oikea takarengas
DrawBox(wx3, wy3, WWIDTH, WLENGTH, CarTable(carID, CAR_ANGLE))
End Function
Function DrawBox(x#, y#, width#, length#, angle#)
CalcBoxPoints(x, y, width, length, angle)
Line gx1, gy1, gx2, gy2
Line gx2, gy2, gx3, gy3
Line gx3, gy3, gx4, gy4
Line gx4, gy4, gx1, gy1
End Function
Function CalcBoxPoints(x#, y#, width#, length#, angle#)
a# = angle - 90
lx# = x - (Sin(a + 90) * width / 2)
ly# = y - (Cos(a + 90) * width / 2)
gx1 = lx - (Sin(a) * length / 2)
gy1 = ly - (Cos(a) * length / 2)
gx2 = gx1 - (Sin(a - 90) * width)
gy2 = gy1 - (Cos(a - 90) * width)
gx3 = gx2 - (Sin(a - 180) * length)
gy3 = gy2 - (Cos(a - 180) * length)
gx4 = gx3 - (Sin(a - 270) * width)
gy4 = gy3 - (Cos(a - 270) * width)
End Function
Kiinnostuin pelien tekemisestä ennen 1. luokkaa.
Sitten 3. luokalla tuli CB. Ja siitä se alkoi.
Blender! TF2! CB! Game Maker! Nokia-mollaus! Kitaransoitto! Breakdance! MadTracker! Minecraft!
Sitten 3. luokalla tuli CB. Ja siitä se alkoi.
Blender! TF2! CB! Game Maker! Nokia-mollaus! Kitaransoitto! Breakdance! MadTracker! Minecraft!
Re: Vanhoja hukkuneita hyödyllisiä koodien pätkiä
elmo123:n version koodia on näköjään hieman modattu.. se ei toimi aivan kuten alkuperäinen. No, tässä on vieläkin enemmän modattu versio, se käyttää kokoelmia. Olkaas hyvä.
Code: Select all
// Tämä Marcoderin esimerkki on muunnettu käyttämään kokoelmia taulukon sijaan.
// Tämän seurauksena jouduin tekemään koodiin muutoksia, mutta itse "fysiikan" laskenta on ennallaan.
// Koodi on siis puhdas remake alkuperäisen pohjalta. (find/replace ... ah.)
// Lisäyksenä jokaisella autolla voi olla eri asetukset.
// -Todo:
// Käsijarru, Vaihteet, Sivuluisu, Moottorin RPM lukemat,
// Car kokoelman instansseille GetXXX() ja SetXXX() funktiot.
// (C) JATothrim. Koodi on täysin vapaasti käytettävissä.
//Kokoelma Auton asetuksille
Type CarSettings
Field WWIDTH As Float // Renkaan leveys
Field WLENGTH As Float // Renkaan pituus
Field WHEELBASE As Float // Akseliväli
Field RAILGAUGE As Float // Raideleveys
Field MAXSPEED As Float // Auton maksimi nopeus
Field MAXBSPEED As Float // Auton maksimi peruutusnopeus
Field STEERSPEED As Float // Ohjauksen nopeus
Field STEERSPEED2 As Float // Ohjauksen nopeus kun auto kulkee huippunopeutta
Field MAXSTEER As Float // Maksimi ohjauskulma
Field ACCELERATION As Float // Kiihtyvyys
Field BACCELERATION As Float // Peruutuskiihtyvyys
Field SLOWDOWN As Float // Hidastuvuus
EndType
//Kokoelma Autoille.
Type Car
Field pCarSettings As Integer // Osoitin CarSettings Kokoelman instansiin
Field x As Float // Auton x-koordinaatti
Field y As Float // Auton y-koordinaatti
Field angle As Float // Auton kulma
Field speed As Float // Auton nopeus
Field steer As Float // Ohjaus kulma
EndType
//Erillaisten autojen asetukset on kätevä piilottaa funktioiden alle:
Function GetDefaultCarSettings()
car_set.CarSettings = New(CarSettings)
car_set\WWIDTH = 10
car_set\WLENGTH = 15
car_set\WHEELBASE = 58
car_set\RAILGAUGE = 35
car_set\MAXSPEED = 7
car_set\MAXBSPEED = 3
car_set\STEERSPEED = 2.5
car_set\STEERSPEED2 = 0.2
car_set\MAXSTEER = 35
car_set\ACCELERATION = 0.02
car_set\BACCELERATION = 0.2
car_set\SLOWDOWN = 0.1
Return ConvertToInteger(car_set)
EndFunction
Function GetSuperCarSettings()
car_set.CarSettings = New(CarSettings)
car_set\WWIDTH = 12
car_set\WLENGTH = 20
car_set\WHEELBASE = 58
car_set\RAILGAUGE = 30
car_set\MAXSPEED = 12
car_set\MAXBSPEED = 4
car_set\STEERSPEED = 4.5
car_set\STEERSPEED2 = 0.9
car_set\MAXSTEER = 40
car_set\ACCELERATION = 0.12
car_set\BACCELERATION = 0.25
car_set\SLOWDOWN = 0.05
Return ConvertToInteger(car_set)
EndFunction
//"laatikko renkaiden" piirtämisen globaalit:
Global gx1#, gy1#, gx2#, gy2#, gx3#, gy3#, gx4#, gy4#
//Vaihda tämä polku oikeaksi!
'ChDir "C:\Ohjelmat\Coolbasic"
grass=MakeObjectFloor()
lawn=LoadImage("Media\grass.bmp")
PaintObject grass,lawn
//Haetaan auton asetukset:
defsettings = GetSuperCarSettings()
// Luodaan auto:
pCar1 = CreateCar(defsettings, 0, 0, 0)
//muutetaan osoitin tyyppiksi, jotta voimme lukea sen tiedot helposti.
//voit tehdä itse GetCarX() jne. funktiot tyyppiosoittimelle.
Car1.Car = ConvertToType(pCar1)
objCar = LoadObject("media\car.bmp", 180)
DrawToWorld ON
Color cbwhite
Repeat
CarPhysic(pCar1, UpKey(), DownKey(), LeftKey(), RightKey())
PositionObject objCar, Car1\x, Car1\y
RotateObject objCar, -Car1\angle
CloneCameraPosition objCar
DrawGame
DrawCar(pCar1)
Text 0, 60, "Speed: " + Car1\speed
DrawScreen
Forever
//Luo uuden auton, palauttaa osoittimen Car kokoelman instansiin.
Function CreateCar(pSettings%, x# = 0, y# = 0, angle# = 0)
new_car.Car = New(Car)
settings.CarSettings = ConvertToType(pSettings)
If settings = NULL Then MakeError "Invalid settings pointer!"
new_car\pCarSettings = pSettings
new_car\x = x
new_car\y = y
new_car\angle = angle
Return ConvertToInteger(new_car)
EndFunction
Function CarPhysic(pCar, bAccelerate, bBackup, bLeft, bRight)
iCar.Car = ConvertToType(pCar)
If iCar = NULL Then MakeError "Invalid car pointer!"
iSettings.CarSettings = ConvertToType(iCar\pCarSettings)
If iSettings = NULL Then MakeError "Invalid settings pointer!"
// Ohjauksen nopeus muuttuu nopeuden mukaan
p# = 100 / iSettings\MAXSPEED * iCar\speed
s# = iSettings\STEERSPEED - (iSettings\STEERSPEED - iSettings\STEERSPEED2) / 100 * p
// Vasemmalle
If bLeft = True And bRight = False Then
If iCar\steer > 0 Then s = iSettings\STEERSPEED * 2
iCar\steer = iCar\steer - s
iCar\steer = Max(iCar\steer, -iSettings\MAXSTEER)
EndIf
// Oikealle
If bLeft = False And bRight = True Then
If iCar\steer < 0 Then s = iSettings\STEERSPEED * 2
iCar\steer = iCar\steer + s
iCar\steer = Min(iCar\steer, iSettings\MAXSTEER)
EndIf
// Oikaisu eli ei ohjata
If bLeft = False And bRight = False Then
If iCar\steer > 0 Then
iCar\steer = iCar\steer - iSettings\STEERSPEED * 2
iCar\steer = Max(iCar\steer, 0)
EndIf
If iCar\steer < 0 Then
iCar\steer = iCar\steer + iSettings\STEERSPEED * 2
iCar\steer = Min(iCar\steer, 0)
EndIf
EndIf
// Kiihdytys
If bAccelerate = True And bBackup = False Then
iCar\speed = iCar\speed + iSettings\ACCELERATION
iCar\speed = Min(iCar\speed, iSettings\MAXSPEED)
EndIf
// Peruutus
If bAccelerate = False And bBackup = True Then
iCar\speed = iCar\speed - iSettings\BACCELERATION
iCar\speed = Max(iCar\speed, -iSettings\MAXBSPEED)
EndIf
// Hidastus
If bAccelerate = False And bBackup = False Then
If iCar\speed > 0 Then
iCar\speed = iCar\speed - iSettings\SLOWDOWN
iCar\speed = Max(iCar\speed, 0)
EndIf
If iCar\speed < 0 Then
iCar\speed = iCar\speed + iSettings\SLOWDOWN
iCar\speed = Min(iCar\speed, 0)
EndIf
EndIf
a# = iCar\angle - 90
// Lasketaan etuakselin keskipiste
fax# = iCar\x - (Sin(a) * iSettings\WHEELBASE / 2)
fay# = iCar\y - (Cos(a) * iSettings\WHEELBASE / 2)
// Lasketaan taka-akselin keskipiste
rax# = iCar\x - (Sin(a - 180) * iSettings\WHEELBASE / 2)
ray# = iCar\y - (Cos(a - 180) * iSettings\WHEELBASE / 2)
// Siirretään etuakselia renkaiden osoittamaan suuntaan nopeuden verran
a# = a + iCar\steer
fax# = fax - (Sin(a) * iCar\speed)
fay# = fay - (Cos(a) * iCar\speed)
//Sivuluisu: siirrä taka-akselia (ja etuakselia)!
// Lasketaan auton uusi kulma
iCar\angle = GetAngle(rax, ray, fax, fay)
// Lasketaan auton uusi paikka
iCar\x = fax + Sin(iCar\angle-90) * iSettings\WHEELBASE / 2
iCar\y = fay + Cos(iCar\angle-90) * iSettings\WHEELBASE / 2
EndFunction
Function DrawCar(pCar)
iCar.Car = ConvertToType(pCar)
If iCar = NULL Then MakeError "Invalid car pointer!"
iSettings.CarSettings = ConvertToType(iCar\pCarSettings)
If iSettings = NULL Then MakeError "Invalid settings pointer!"
// Auton runko
DrawBox(iCar\x, iCar\y, CWIDTH, CLENGTH, iCar\angle)
// Laskenaan renkaiden paikat
CalcBoxPoints(iCar\x, iCar\y, iSettings\RAILGAUGE, iSettings\WHEELBASE, iCar\angle)
wx1# = gx1: wy1# = gy1
wx2# = gx2: wy2# = gy2
wx3# = gx3: wy3# = gy3
wx4# = gx4: wy4# = gy4
// Vasen eturengas
DrawBox(wx1, wy1, iSettings\WWIDTH, iSettings\WLENGTH, iCar\angle + iCar\steer)
// Oikea eturengas
DrawBox(wx2, wy2, iSettings\WWIDTH, iSettings\WLENGTH, iCar\angle + iCar\steer)
// Vasen takarengas
DrawBox(wx4, wy4, iSettings\WWIDTH, iSettings\WLENGTH, iCar\angle)
// Oikea takarengas
DrawBox(wx3, wy3, iSettings\WWIDTH, iSettings\WLENGTH, iCar\angle)
EndFunction
Function DrawBox(x#, y#, width#, length#, angle#)
CalcBoxPoints(x, y, width, length, angle)
Line gx1, gy1, gx2, gy2
Line gx2, gy2, gx3, gy3
Line gx3, gy3, gx4, gy4
Line gx4, gy4, gx1, gy1
EndFunction
Function CalcBoxPoints(x#, y#, width#, length#, angle#)
a# = angle - 90
lx# = x - (Sin(a + 90) * width / 2)
ly# = y - (Cos(a + 90) * width / 2)
gx1 = lx - (Sin(a) * length / 2)
gy1 = ly - (Cos(a) * length / 2)
gx2 = gx1 - (Sin(a - 90) * width)
gy2 = gy1 - (Cos(a - 90) * width)
gx3 = gx2 - (Sin(a - 180) * length)
gy3 = gy2 - (Cos(a - 180) * length)
gx4 = gx3 - (Sin(a - 270) * width)
gy4 = gy3 - (Cos(a - 270) * width)
EndFunction
-On selkeästi impulsiivinen koodaaja joka...
Re: Vanhoja hukkuneita hyödyllisiä koodien pätkiä
Pienellä muutoksella niin että autoa ei huippunopeudessa ohjata liikaa..? Tätä voisi hyväksi käyttää myös siinä miten auto menee sladiin.. Tosin tuossa ei sitä ole koodattu.
Ohjeet:
Typeen CarSettingsField lisätään
Functionoon GetDefaultCarSettings() ja GetSuperCarSettings()
Functionoon CarPhysic lisätään seuraavaa vaikka ohjauksen nopeuden muuttamisen jälkeen
Lopuksi vielä muutetaan
// Vasemmalle: kohdasta
iCar\steer = Max(iCar\steer, -iSettings\MAXSTEER)
// Oikealle: kohdasta
iCar\steer = Min(iCar\steer, iSettings\MAXSTEER)
Ohjeet:
Typeen CarSettingsField lisätään
Code: Select all
MAXSTEER2 As Float // Maksimi ohjauskulma kun auto kulkee huippunopeutta
Code: Select all
car_set\MAXSTEER2 = xx
Code: Select all
// Maksimi ohjaus muuttuu nopeuden mukaan
m# = 100 / iSettings\MAXSPEED * iCar\speed
x# = iSettings\MAXSTEER - (iSettings\MAXSTEER - iSettings\MAXSTEER2) / 100 * m
// Vasemmalle: kohdasta
iCar\steer = Max(iCar\steer, -iSettings\MAXSTEER)
Code: Select all
iCar\steer = Max(iCar\steer, -x#)
iCar\steer = Min(iCar\steer, iSettings\MAXSTEER)
Code: Select all
iCar\steer = Min(iCar\steer, x#)
Re: Vanhoja hukkuneita hyödyllisiä koodien pätkiä
Lisäksi tuo tekee pelaamisesta sellaista että jarruttamisesta on hyötyä
Re: Vanhoja hukkuneita hyödyllisiä koodien pätkiä
Rekisteröidyppä foorumeille, viestisi oli hyviä, ja koodisi olivat käytännöllisiä. Mutta meni vähän offiksi. :S
Solar Eclipse
We're in a simulation, and God is trying to debug us.
Re: Vanhoja hukkuneita hyödyllisiä koodien pätkiä
Tuplaposti tulee, anteeksi. Niin olisiko kellään enää sitä MgZ:n Ragdollia?
Solar Eclipse
We're in a simulation, and God is trying to debug us.
Re: Vanhoja hukkuneita hyödyllisiä koodien pätkiä
Olen vähän parannellut ja kaikkea, mutta perusjutut ovat ihan samat. EDIT: olettaisin, että puhumme samasta systeemistäMaGetzUb wrote:Tuplaposti tulee, anteeksi. Niin olisiko kellään enää sitä MgZ:n Ragdollia?
Code: Select all
DrawToWorld ON
SetWindow "Ragdoll"
FrameLimit 100
SCREEN 610,610
'ClsColor cbwhite
// ihminen koostuu (tässä tapauksessa) yhdestätoista pisteestä, joilla jokaisella
// on nykyinen ja edellinen sijainti xy - tasolla.
// Ideana on pitää jokainen piste vakioetäisyydellä määritellyistä pisteistä, jolloin ne käyttäytyvät realisisen oloisesti
Dim xPosition(11) As Float
Dim yPosition(11) As Float
Dim previousXposition(11) As Float
Dim previousYposition(11) As Float
Const PAINOVOIMA = -0.1 // painovoima ( negatiivinen = alaspäin, positiivinen = ylöspäin)
Const ACCURACY = 10 // tarkkuus (mitä suurempi luku, sitä tarkempi, 1=minimi)
resetDoll()
Repeat
If MouseDown(1) Then
temp_dis=0
pienin_dis=100
For i=1 To 11
temp_dis=Distance(xposition(i),yposition(i),MouseWX(),MouseWY())
If temp_dis<pienin_dis Then pienin_dis=temp_dis : napattu_piste=i
Next i
Else
napattu_piste=0
EndIf
If napattu_piste>0 Then
xposition(napattu_piste)=MouseWX()
yposition(napattu_piste)=MouseWY()
EndIf
If KeyDown(cbKeyR) Then resetDoll()
If RightKey() Then
xposition(7)=xposition(7)+2
ElseIf LeftKey() Then
xposition(7)=xposition(7)-2
ElseIf KeyHit(cbKeySpace) Then
resetDoll()
EndIf
If UpKey() Then
yposition(7)=yposition(7)+2
ElseIf DownKey() Then
yposition(7)=yposition(7)-2
EndIf
Color cbDark
// lasketaan fysiikat
simulate()
// piirretään pää oikealle paikalle
kulma = GetAngle(xPosition(6),yPosition(6),xPosition(7),yPosition(7))
Circle (xPosition(7)+Cos(kulma)*5)-10,((yPosition(7)-Sin(kulma)*5))+10,20
DrawScreen
Forever
Function Simulate()
// lasketaan jokaiselle pisteelle uusi sijainti
For i=1 To 11
calculateNewXposition(i)
calculateNewYposition(i)
Next i
// pisteet siirretään ACCURACY:n mukaan joko kerran tai useita kertoja vakioetäisyydelle toisistaan
For i=1 To ACCURACY
// parametrit = ensimmäisen pisteen sijainti taulukossa, toisen pisteen sijainti taulukossa, pidettävä välimatka
sustainDistance(1,2,20)
sustainDistance(2,3,20)
sustainDistance(3,4,20)
sustainDistance(4,5,20)
sustainDistance(3,6,20)
sustainDistance(6,7,20)
sustainDistance(7,8,20)
sustainDistance(8,9,20)
sustainDistance(7,10,20)
sustainDistance(10,11,20)
// pisteet eivät saa ylittää pelikenttää
For j=1 To 11
If Abs(xPosition(j))>300 Then ChangeSpeed(j,2,0.5)
If Abs(yPosition(j))>300 Then ChangeSpeed(j,1,0.5)
xPosition(j) = Min(Max(-300,xPosition(j)),300)
yPosition(j) = Min(Max(-300,yPosition(j)),300)
Next j
Next i
//piirretään viivat
drawLine(1,2)
drawLine(2,3)
drawLine(3,4)
drawLine(4,5)
drawLine(3,6)
drawLine(6,7)
drawLine(7,8)
drawLine(8,9)
drawLine(7,10)
drawLine(10,11)
EndFunction
Function calculateNewXposition(pointNumber)
temp# = xPosition(pointNumber)
xPosition(pointNumber) = 2*xPosition(pointNumber) - previousXposition(pointNumber) // + kiihtyvyys X-suunnassa
previousXposition(pointNumber) = temp#
EndFunction
Function calculateNewYposition(pointNumber)
temp# = yPosition(pointNumber)
yPosition(pointNumber) = 2*yPosition(pointNumber) - previousYposition(pointNumber) + PAINOVOIMA // * PAINOVOIMAn tilalle voi sijoittaa minkä tahansa Y-suuntaisen kiihtyvyyden
previousYposition(pointNumber) = temp#
EndFunction
Function sustainDistance(firstPoint, secondPoint, distanceToSustain#)
xDistance# = (xPosition(firstPoint) - xPosition(secondPoint))
yDistance# = (yPosition(firstPoint) - yPosition(secondPoint))
currentDistance# = Sqrt(xDistance#^2+yDistance#^2)
multiplier# = (currentDistance#-distanceToSustain#)/currentDistance#
xPosition(firstPoint) = xPosition(firstPoint) - xDistance#*0.5*multiplier#
yPosition(firstPoint) = yPosition(firstPoint) - yDistance#*0.5*multiplier#
xPosition(secondPoint) = xPosition(secondPoint) + xDistance#*0.5*multiplier#
yPosition(secondPoint) = yPosition(secondPoint) + yDistance#*0.5*multiplier#
EndFunction
Function drawLine(firstPoint, secondPoint)
For x=0 To 2
For y=0 To 2
Line xPosition(firstPoint)+x,yPosition(firstPoint)+y,xPosition(secondPoint)+x,yPosition(secondPoint)+y
Next y
Next x
EndFunction
Function ChangeSpeed(pointNumber,xy,dir#)
Select xy
Case 0
previousXposition(pointNumber) = xposition(pointNumber)-((xposition(pointNumber)-previousXposition(pointNumber))*dir)
previousYposition(pointNumber) = yposition(pointNumber)-((yposition(pointNumber)-previousYposition(pointNumber))*dir)
Case 1
previousXposition(pointNumber) = xposition(pointNumber)-((xposition(pointNumber)-previousXposition(pointNumber))*dir)
Case 2
previousYposition(pointNumber) = yposition(pointNumber)-((yposition(pointNumber)-previousYposition(pointNumber))*dir)
EndSelect
EndFunction
Function resetDoll()
xPosition(1) = -50
yPosition(1) = -50
previousXposition(1) = -50
previousYposition(1) = -50
xPosition(2) = -25
yPosition(2) = -50
previousXposition(2) = -25
previousYposition(2) = -50
xPosition(3) = 0
yPosition(3) = -50
previousXposition(3) = 0
previousYposition(3) = -50
xPosition(4) = 25
yPosition(4) = -50
previousXposition(4) = 25
previousYposition(4) = -50
xPosition(5) = 50
yPosition(5) = -50
previousXposition(5) = 50
previousYposition(5) = -50
xPosition(6) = 0
yPosition(6) = -25
previousXposition(6) = 0
previousYposition(6) = -25
xPosition(7) = 0
yPosition(7) = 0
previousXposition(7) = 0
previousYposition(7) = 0
xPosition(8) = -25
yPosition(8) = 0
previousXposition(6) = -25
previousYposition(6) = 0
xPosition(9) = -50
yPosition(9) = 0
previousXposition(9) = -50
previousYposition(9) = 0
xPosition(10) = 25
yPosition(10) = 0
previousXposition(10) = 25
previousYposition(10) = 0
xPosition(11) = 50
yPosition(11) = 0
previousXposition(11) = 50
previousYposition(11) = 0
EndFunction
Re: Vanhoja hukkuneita hyödyllisiä koodien pätkiä
Oikea oli, olet vain näköjään muuttanut piirtokomentoja omiksi.
Solar Eclipse
We're in a simulation, and God is trying to debug us.