CoolBasic Forums

Posted: **Thu Dec 18, 2008 7:56 pm**

Ja DrawToImage:han se sieltä puuttui ^^

EDIT:

Ja edellisen ongelmaan Killed Whalen funktio:

    Function PyöriväMonikulmio(x, y, r, a, c)
       For i = 1 To c
          Line x + Cos(i * 360 / c + a) * r, y - Sin(i * 360 / c + a) * r, x + Cos((i + 1) * 360 / c + a) * r, y - Sin((i + 1) * 360 / c + a) * r
       Next i
    EndFunction

[/edit]

Posted: **Thu Dec 18, 2008 8:02 pm**

DatsuniG wrote:Osaakos joku sanoa, miksei tämä toimi? Enpä huomannu tässä koodissa mitään häikkää. ^^

Code: Select all

    img = LoadImage("media/soldier.bmp")

    aika=Timer()
    img1 = WrapImage(img,1)
    väliaika1=Timer()-aika : aika=Timer()

    img2 = Wrapimage(img,2)
    väliaika2=Timer()-aika
    Color cbwhite

    DrawImage img,20,20
    Text 72,22,"Alkuperäinen"

    DrawImage img1,20,80
    Text 72,82,"Mode 1 - Aikaa kului: "+väliaika1+"ms"

    DrawImage img2,20,140
    Text 72,142,"Mode 2 - Aikaa kului: "+väliaika2+"ms"

    DrawScreen
    WaitKey


    Function WrapImage(img,mode)
    img1 = MakeImage(ImageWidth(img),ImageHeight(img))
        Select mode
            Case 1
                For i=ImageWidth(img) To 0 Step -1
                    For a=ImageHeight(img) To 0 Step -1
                        PutPixel Abs(i),Abs(a),GetPixel(ImageWidth(img)-i,ImageHeight(img)-a,Image(img)),Image(img1)
                    Next a
                Next i
            Case 2
                For i=0 To ImageWidth(img)
                    For a=ImageHeight(img) To 0 Step -1
                        PutPixel i,Abs(a),GetPixel(i,ImageHeight(img)-a,Image(img)),Image(img1)
                    Next a
                Next i
           Default
                MakeError "Invalid mode!"
        EndSelect
    Return img1
    EndFunction

EDIT:

Ja edellisen ongelmaan Killed Whalen funktio:

Code: Select all

    Function PyöriväMonikulmio(x, y, r, a, c)
       For i = 1 To c
          Line x + Cos(i * 360 / c + a) * r, y - Sin(i * 360 / c + a) * r, x + Cos((i + 1) * 360 / c + a) * r, y - Sin((i + 1) * 360 / c + a) * r
       Next i
    EndFunction

[/edit]

En valitettavasti osaa sanoa ongelmaasi mitään, mutta kiitos tuosta funktiosta

Posted: **Thu Dec 18, 2008 8:19 pm**

sillie wrote:Voiskos joku ystävällinen sielu tehdä mulle esimerkkiä miten saan kolmion kääntymään (rotation?) ? Ilmeisesti siihen siniä ja kosiniä tarvitaan mutta mulle ei uppoo kaaliin., vaikka oon pari tuntia ollu koneella ja matikankirjanki aihetta käsittelevät sivut lukenu. Alkaa hermostua tässä pikkuhiljaa

Tuossa olis tuota pohjaa.

Tein nopeasti tasasivuisen kolmion pyörityksen

Tänään tullut paljon laskettu sininiä ja cosinia

Matikassakin on aiheena geometria.
Esimerkit eivät ole täällä kopsattaviksi vaan opittaviksi!
Jos tarvitset tuota kääntämistä johonkin ohjelmaan/peliin, suosittelen imageen piirtämistä (katso komento Drawtoimage), jonka jälkeen voit käyttää imagen komentoja.

Tasasivuinen kolmion pyöritys tuossa (väsään ehkä vielä normaalille kolmiolle..)
EDIT: korkeuden laskussa pieni virhe.. Nyt korjattuna: h#=( ( size# * Sqrt(3) ) / 2 ) / 3 * 2

Code: Select all

SCREEN 1024,768

Color 255,0,0

Repeat

    DrawTriangle(200,200,a,100)
    a+1
    Text 10,10,"FPS: "+FPS()
    DrawScreen
Forever


Function DrawTriangle(x#,y#,ang#,size#) ' size=sivun pituus
   h#=( ( size# * Sqrt(3) ) / 2 ) / 3 * 2  
    
    x1#=x# + Sin(ang#)*h#
    y1#=y# - Cos(ang#)*h#
    x2#=x# + Sin(ang#+120)*h#
    y2#=y# - Cos(ang#+120)*h#
    x3#=x# + Sin(ang#-120)*h#
    y3#=y# - Cos(ang#-120)*h#
    
    Line x1#,y1#,x2#,y2#
    Line x1#,y1#,x3#,y3#
    Line x3#,y3#,x2#,y2#

EndFunction

Tasasivuinen kolmion pyöritys tuossa taulukoilla

Code: Select all

SCREEN 1024,768

Dim pisteX(2) ' kolme paikkaa
Dim pisteY(2) 

Repeat
    a+1
    DrawTringle(200,200,a,100)
    Text 10,10,"FPS: "+FPS()
    DrawScreen
Forever


Function DrawTringle(x#,y#,ang#,size#) ' size=sivun pituus
   h#=( ( size# * Sqrt(3) ) / 2 ) / 3 * 2  
    For a=0 To 2
        PisteX(a) = x# + Sin(ang#+a*120)*h#
        PisteY(a) = y# - Cos(ang#+a*120)*h#
    Next a
    For a=0 To 2
        If a=2 Then n=0 Else n=a+1
        Line pisteX(a),pisteY(a),pisteX(n),pisteY(n)
    Next a
EndFunction

Posted: **Thu Dec 18, 2008 9:44 pm**

Hejsan! Tulin tänne kysymään, ettei Hello World! menisi aivan ongelmanratkaisun puolelle, mutta tuskin tämä sentään omaa topickiaan tarvitsee...

Ongelmana on se, että kun ohjelma käännetään, ja se ajetaan, niin se suoriutuu mainiosti, ja menee "alkuruutuun". Tämän jälkeen, alkuruudusta painaessani näppäimistön näppäintä, jolloin ohjelman pitäisi siirtyä peliruutuun, ilmestyykin virheilmoitus: "Error! Memory access violation". Ok:ta painamalla ohjelma sulkeutuu. Mistä tämä johtuu? Täysin käsittämätöntä, sillä otin koodin hiukan muuntelemalla ensin learning centerin Ammukset 2:sta, ja sitten suoraan copypastella pelini koodiin. Laitan pelin tuohon aiheeseen kuuluvan koodin tuohon pastettuna, niin voitte tutkia sitä, ja kokeilla, ilmeneekö sama ongelma teidän tietokoneillanne. Koodi on kommentoitua minua itseäni varten, tuskin varmaan haittaa teitäkään

Code: Select all

'Alkuvalmistelut

SCREEN 400, 300
FrameLimit 30

'Ns. menu
Text 100,120, "Paina ENTER aloittaaksesi"
Text 10,10, "Avaruuslentelypeli alpha"
Text 10,280, "(c) Veikko 'Wee' Vauhkonen 2008"
DrawScreen
WaitKey
     
ClearText
'Objecktien & kentän valmistelut
Type AMMUS 'luo kokoelma, jonka nimi on AMMUS
    Field obj 'yksi kenttä nimeltään 'obj'
End Type 

ShowObject pati,OFF
ClsColor CbGreen
pikkukivi = LoadImage("pikkukivi.png")
puska = LoadImage("puska.png")
alus = LoadObject("ship.png", 36)
pati = LoadObject("pati.png", 36)
TurnObject alus, 90
PositionObject alus, -160, 30

'Itse pelisilmukka
Repeat
    'Kentän taustakuvat & muu tilpehööri
    DrawImage puska,100,95
    DrawImage pikkukivi,110,97
    DrawImage pikkukivi,230,169
    DrawImage puska,140,300
    'Tekstinsyötötökokeilut ylös, ja alaspäin vas. ylänurkka
    If UpKey() Then
                     ClearText 
                     Text 2,2, "Painat nuolta ylöspäin" 
    EndIf
    If DownKey() Then 
                     ClearText 
                     Text 2,2, "Painat nuolta alaspäin"
    EndIf
    'Päiväys alareunaan
    Text 1,280, "Tänään on"
    Text 80,280,Date()  
    Text 177,280,Time()
    'Piirretään ylä-ja alaviivat kentälle
    Line 0,26,400,26
    Line 0,260,400,260
    'Aluksen liikkuminen
    If UpKey() Then MoveObject alus, 2
    If DownKey() Then MoveObject alus, -2
    'Aluksen pelikentän rajaaminen
    If ObjectX(alus)>200 Then PositionObject alus, 200,ObjectY(alus) 
    If ObjectX(alus)<-200 Then PositionObject alus, -200,ObjectY(alus)
    If ObjectY(alus)>115 Then PositionObject alus, ObjectX(alus),115
    If ObjectY(alus)<-100 Then PositionObject alus, ObjectX(alus),-100
    'Ampuminen oikealle
    If KeyDown(cbkeyspace) And aselataus=0 Then 
                luoti.AMMUS = New(AMMUS)
                luoti\obj=CloneObject(pati)
                CloneObjectPosition luoti\obj,alus
                aselataus=5
     EndIf
     If aselataus>0 Then aselataus=aselataus-1
     
      For luoti.AMMUS = Each AMMUS
        MoveObject luoti\obj,6
        If ObjectX(luoti\obj)<-180 Or ObjectX(luoti\obj)>180 Or ObjectY(luoti\obj)<-130 Or ObjectY(luoti\obj)>130 Then                
            DeleteObject luoti\obj
            Delete luoti
        EndIf        
      Next luoti 
    
    'Se unohtumaton
    DrawScreen

Forever

Btw, tietenkin jos koodissa on muuten jotain huomautettavaa, nokankoputtamista, yms. niin kaikki otetaan vapaasti vastaan =)

Posted: **Thu Dec 18, 2008 9:54 pm**

Pistit sinne ShowObject pati,Off ennen kuin edes koko pati muuttujaa oli luotu.
Eli tee näin:

Code: Select all

pati=LoadObject("media\pati.bmp")
ShowObject pati,Off

Posted: **Thu Dec 18, 2008 10:48 pm**

Mulla olis ongelma johon olis kiva saada ratkaisu.
Miten koodaan semmosen toiminnon, että jos muuttujax = 0, ei voi mennä johonkin caseen? Eli siis jos näppäintä 1 painetaan jolloin mentäisiin case 2:teen,
mutta kun ammukset-muuttuja on 0 niin estetään tuo toiminto ettei mennä case 2:teen.
Toivottavasti ymmärsitte

Posted: **Thu Dec 18, 2008 11:33 pm**

KankiKalle wrote:Mulla olis ongelma johon olis kiva saada ratkaisu.
Miten koodaan semmosen toiminnon, että jos muuttujax = 0, ei voi mennä johonkin caseen? Eli siis jos näppäintä 1 painetaan jolloin mentäisiin case 2:teen,
mutta kun ammukset-muuttuja on 0 niin estetään tuo toiminto ettei mennä case 2:teen.
Toivottavasti ymmärsitte

Laita sen casen sisältö if:in sisälle, jossa tarkastat ettei ammukset ole 0.

Posted: **Fri Dec 19, 2008 4:10 pm**

Miks tää ei toimi?

Code: Select all

If  KeyDown(CBKEYl)Then PlaySound("media\sound1.mp3")

Posted: **Fri Dec 19, 2008 4:14 pm**

Lataa ääni ensin muistiin:

Code: Select all

sound = loadSound("media\sound1.mp3")

If KeyDown(CBKEYl)Then PlaySound sound

Posted: **Fri Dec 19, 2008 4:14 pm**

Okei! Kiitti

Posted: **Fri Dec 19, 2008 4:30 pm**

Eikä sitä aina ole pakko ladata muistiin. Kyllä sen näinkin pitäisi toimia:

Code: Select all


If SoundPlaying(snd)=0 Then
    snd=PlaySound("media\sound1.mp3")
EndIf

Edit: jaa ei olekkaan...

Posted: **Fri Dec 19, 2008 4:47 pm**

Miten saan objektin muuttumaan toiseksi?
Eli jos on ukko jonka ampuu siitä tulee ruumis.

Teen kalastuspeliä ihan harjoitusmielessä ja haluan saada vedessä uivan kalan vaihtumaan siiman päässä olevaan kalaan. Miten?

Posted: **Fri Dec 19, 2008 4:48 pm**

Vieras wrote:Miten saan objektin muuttumaan toiseksi?
Eli jos on ukko jonka ampuu siitä tulee ruumis.

Teen kalastuspeliä ihan harjoitusmielessä ja haluan saada vedessä uivan kalan vaihtumaan siiman päässä olevaan kalaan. Miten?

Hitto en kirjautunu sisään.

Ylempi on mun viesti.

Posted: **Fri Dec 19, 2008 4:51 pm**

Katso komento paintobject.

Posted: **Fri Dec 19, 2008 5:05 pm**

Character wrote:Katso komento paintobject.

Jos käytät komentoa ruumiiden tekoon älä käytä paintobject komentoa.. Paintobject vie hirveästi konetehoja.
Sen tilalle sijoita samaan paikkaan ruumiin kuvasi ja poista/piilota aikaisempi kuva.

Tässä vähän alkeellinen esimerkki.. Sijoita Cloonattavan veren paikalle tilalle joku muu kuva..

Code: Select all

SCREEN 800,600   
FrameLimit 40 'rajoita nopeutta

    Type VIHU
        Field obj%
        Field spd#
        Field reload
        Field ID%
    End Type
    
    Type AMMUS
        Field obj%
    End Type
    
Const MoveSpeed=7
Const TurnSpeed=5
Const vihuja = 50

kartta = LoadMap("Media\cdm2.til","Media\tileset.bmp")
car = LoadObject("Media\car2.bmp", 72)
pati = LoadObject("media\bullet.bmp")
cloonattava_veri=LoadObject("media\blood+bones23.png") ' tähän veripläikän sijainti..
cloonattava_vihu=LoadObject("media\guy.bmp",72)

ShowObject cloonattava_vihu,OFF
ShowObject cloonattava_veri,OFF
ShowObject pati,OFF
    
SetupCollision car, kartta, 1, 4, 2
     
For i=1 To vihuja
    Nev.VIHU=New(VIHU)
    nev\obj=CloneObject(cloonattava_vihu)
    SetupCollision nev\obj, kartta, 1, 4, 2
    ScreenPositionObject nev\obj,Rand(-400,400),Rand(-400,400)
    nev\spd=Rnd(1,4)
    nev\ID=1
Next i

// Toisiinsa collisiot
For kk.VIHU=Each VIHU
    For nn.VIHU=Each VIHU
        If nn<>kk Then SetupCollision nn\obj, kk\obj, 2, 2, 2
    Next nn
Next kk


    Repeat
            //////////////////////////
            ////// LIIKKUMINEN ///////
            //////////////////////////
        MoveObject car,(KeyDown(cbkeyW)+UpKey())*MoveSpeed-(KeyDown(cbkeyS)+DownKey())*MoveSpeed
        TurnObject car,(KeyDown(cbkeyA)-RightKey())*TurnSpeed-(KeyDown(cbkeyD)-LeftKey())*TurnSpeed
        
        
            //////////////////////////
            ///////// TEKOÄLY ////////
            //////////////////////////
            
        For maara.VIHU=Each VIHU
        
            If ObjectSight(maara\obj,car) And Distance2(maara\obj,car)<=200 And maara\ID>0
                maara\ID=2 
            ElseIf maara\ID>0
                maara\ID=1
            EndIf
            
            If maara\ID=1
                MoveObject maara\obj,maara\spd  
                If CountCollisions(maara\obj) Then TurnObject maara\obj, Rand (0,360)
            ElseIf maara\ID=2
                PointObject maara\obj,car
                If maara\reload=<0
                    aa.AMMUS=New(AMMUS)
                    aa\obj=CloneObject(pati)
                    CloneObjectPosition aa\obj,maara\obj
                    CloneObjectOrientation aa\obj,maara\obj
                    maara\reload=8
                EndIf
            EndIf
            
            If maara\reload>0 Then maara\reload-1
            
            If ObjectsOverlap(maara\obj,car) And maara\ID>0 Then
                //tietojen talteenotto
                posX#=ObjectX(maara\obj)
                posY#=ObjectY(maara\obj)
                angle#=-ObjectAngle(maara\obj)
                ShowObject maara\obj,OFF 'piilotetaan vihu
                
                //veripläikän luonti
                maara\obj=CloneObject(cloonattava_veri) ' ladataan veri
                PositionObject maara\obj,posX#,posY# ' samaan sijaintiin kuin vihu
                RotateObject maara\obj,angle# ' samaan kulmaan kuin vihu
                ObjectOrder maara\obj,-1 'asettaa vihun alimmaksi
                ObjectOrder kartta,-1 ' asettaa kartan alimmaksi
                maara\ID=0 ' estää vihun toiminnot
            EndIf
            
        Next maara 

        For aa.AMMUS=Each AMMUS
                MoveObject aa\obj,6
                If ObjectsOverlap(aa\obj,car) Then damage=damage+1 : delet=ON
                If GetMap(2, ObjectX(aa\obj), ObjectY(aa\obj)) <> 0 Then delet=ON    
                If delet=ON Then
                    DeleteObject aa\obj
                    Delete aa
                    delet=OFF
                EndIf
        Next aa

        UpdateGame
        
        CloneCameraPosition car
        
        DrawGame 
        
        Text 10,10,"FPS: "+FPS()+" /40"
        Text 10,30,"DAMAGE: "+damage
        
        DrawScreen
 Forever

Posted: **Fri Dec 19, 2008 6:29 pm**

siis miten saan viivan pyörimään. Siis siten että viivan alku pysyy koko ajan paikallaan, ei siten että sekin pyörii koska osaan tehdä sen itse.

Posted: **Fri Dec 19, 2008 6:35 pm**

Jani wrote:siis miten saan viivan pyörimään. Siis siten että viivan alku pysyy koko ajan paikallaan, ei siten että sekin pyörii koska osaan tehdä sen itse.

Tein nopeasti tälläisen

Code: Select all

Repeat
    a+1
    Line2(200,200,a,100)
    DrawScreen
Forever


Function Line2(x#,y#,ang#,pituus#)
    x2# = x# + Sin(ang#)*pituus#
    y2# = y# - Cos(ang#)*pituus#
    Line x#,y#,x2#,y2#
EndFunction

Posted: **Fri Dec 19, 2008 6:45 pm**

yritin soveltaa tuota kelloon mutta en onnistu (olen parsinut tunnit, minuutit ja sekunnit erilleen)

Posted: **Fri Dec 19, 2008 6:50 pm**

Jani wrote:yritin soveltaa tuota kelloon mutta en onnistu (olen parsinut tunnit, minuutit ja sekunnit erilleen)

Kello... Toivottavasti intosi ei jäädy, vaikka postaankin tämän

Tämä koodi pätkä ei ole minun tekemäni, vaan jostain täältä foorumilta löytämäni (olen tosin saattanut muokata sitä hieman). Tämä on ajalta, jolloin olin käyttänyt Coolbasiciä vasta viikon, joten en osannut hyödyntää paljoakaan sininiä ja cosinia ohjelmissani..

Alkuperäinen on KilledWhalen hieno kello

viewtopic.php?f=12&t=510&p=6028&hilit=kello#p6028

Code: Select all

SCREEN 450,500
Repeat
        SetWindow "Kello: "+Time()
        Text 100,10,"Date " + Date()
        Text 300,10,"Time " + Time()
        clock()
        DrawScreen
Forever

Function clock()
    kulma=0
    hour=Int(GetWord(Time(),1,":"))
    Minn=Int(GetWord(Time(),2,":"))
    secc=Int(GetWord(Time(),3,":"))
    For i=0 To 360 Step 30 'silmukoi kokonainen ympyrä
        Circle  225+Sin(kulma+i)*150, 250-Cos(kulma+i)*150,5
        If i>0 Then  
            Text 220+Sin(kulma+i)*175, 245-Cos(kulma+i)*175, i/30
        EndIf
    Next i
    
    For i=0 To 360 Step 6   
        Dot 225+Sin(kulma+i)*150, 250-Cos(kulma+i)*150
    Next i

    Line2(225,250,225+Cos(90-minn*6)*145,250-Sin(90-minn*6)*145,2) 
    Line2(225,250,225+Cos(90-(hour*30)-(minn/2))*125,250-Sin(90-(hour*30)-(minn/2))*125,4)
    Color cbred
    Line2 (225,250,225+Cos((90-(secc+lisäys#)*6))*150,250-Sin((90-(secc+lisäys#)*6))*150,1)
    Color 50,50,50
    Smooth2D ON
    Circle 220,245,10
    Color cbwhite
    Smooth2D OFF
EndFunction

Function line2(x#,y#,x2#,y2#,w=1)
    xx#=x#
    yy#=y#
    ang#=GetAngle(xx#,yy#,x2#,y2#)
    While Distance(xx#,yy#,x2#,y2#)>1
        Circle xx#-w/2,yy#-w/2,w
        xx#=xx#+Cos(ang#)
        yy#=yy#-Sin(ang#)
    Wend
EndFunction

Posted: **Fri Dec 19, 2008 8:50 pm**

Miten saan fysiikan peliin? Haluan pallon kimpoavan toisesta objektista. Ja paino voima myös.

CoolBasic Forums

Tyhmät kysymykset (I/2009)

Re: Tyhmät kysymykset

Re: Tyhmät kysymykset

Re: Tyhmät kysymykset

Re: Tyhmät kysymykset

Re: Tyhmät kysymykset

Re: Tyhmät kysymykset

Re: Tyhmät kysymykset

Taas tyhmä kysymys...

Re: Tyhmät kysymykset

Re: Tyhmät kysymykset

Re: Tyhmät kysymykset

Re: Tyhmät kysymykset

Re: Tyhmät kysymykset

Re: Tyhmät kysymykset

Re: Tyhmät kysymykset

Re: Tyhmät kysymykset

Re: Tyhmät kysymykset

Re: Tyhmät kysymykset

Re: Tyhmät kysymykset

Re: Tyhmät kysymykset