Tyhmät kysymykset (I/2009)

Koodiapina · Post by **Koodiapina** » Thu Oct 02, 2008 3:46 pm

Hieman optimoitu versio:

ClsColor 255,255,255
Color 0,0,0
Repeat
  Text 120,0, "Heitetään kolikkoa" 
  klaava = klaava + Rand(1)
  kaikki = kaikki + 1
  Text 10,30, "Kruuna:  "+(kaikki-klaava)
  Text 10,50, "Klaava:  "+klaava
  DrawScreen 
Forever

SuojelusPerkele · Post by **SuojelusPerkele** » Thu Oct 02, 2008 4:01 pm

Juu, näkyy tuo Grandin versio pelittävän hiukan paremmin..

Semmonen kymysys vielä että miten saisi laskemaan klaavojen ja kruunien todennäköisyyden (eli esim. klaavalle= klaavojen määrä/kaikkien heittojen määrä)
Kokeilin tuohon laittaa sitä mutta nollaa antaa siitä vastaukseksi..

Code: Select all

    ClsColor 255,255,255
    Color 0,0,0
    Repeat
      Text 120,0, "Heitetään kolikkoa"
      klaava = klaava + Rand(1)
      kaikki = kaikki + 1
      Text 10,30, "Kruuna:  "+(kaikki-klaava)
      Text 10,50, "Klaava:  "+klaava
      Text 10,100,"kaikki heitot: "+kaikki
      DrawScreen 
      If KeyHit (cbkeyreturn) Then
      WaitKey 
      EndIf 
    Forever

nevssons · Post by **nevssons** » Fri Oct 03, 2008 7:43 am

Rand komennossa täytyy antaa kaksi lukua. pienin ja suurin mahdollinen.

Code: Select all

 ClsColor 255,255,255
    Color 0,0,0
    Repeat
      Text 120,0, "Heitetään kolikkoa"
      klaava = klaava + Rand(0,1)
      kaikki = kaikki +1
      Text 10,30, "Kruuna:  "+(kaikki-klaava)
      Text 10,50, "Klaava:  "+klaava
      Text 10,100,"kaikki heitot: "+kaikki
      DrawScreen 
      If KeyHit (cbkeyreturn) Then
      WaitKey 
      EndIf 
    Forever

Koodiapina · Post by **Koodiapina** » Fri Oct 03, 2008 11:53 am

nevssons wrote:Rand komennossa täytyy antaa kaksi lukua. pienin ja suurin mahdollinen.

Ei CoolBasicissa; jos annetaan vain yksi parametri, toinen on automaattisesti nolla. Sekoitat varmaan johonkin muuhun kieleen, kuten PHP:hen.

Jonhu · Post by **Jonhu** » Sat Oct 04, 2008 3:21 pm

Itselle partikkelit on melko tuntemattomia, mutta päätin tutustua niiden maailmaan. Ongelmana tuossa on että se ei ole mitenkään uskottavan näköinen. Mitä minun pitäisi tehdätuolle että saisin siitä uskottavamman?

Code: Select all

SCREEN 1024, 768
FrameLimit 30

bullet_img= LoadImage( "media\bullet.bmp" )
maasto    = MakeImage(ScreenWidth(),100)
muta      = MakeImage(1,1)

DrawToImage muta
    Color 123,90,0:Box 0,0,1,1
DrawToImage maasto
    Color cbgreen: Box 0,0,ScreenWidth(),100
DrawToScreen

maastox=0 : maastoy=500
painovoima#=0.2

Repeat
    If ammuselossa=OFF Then
        Placex#=MouseX()
        Placey#=400
        If MouseUp(1)Then ammuselossa=ON
    EndIf
    If ammuselossa=ON Then 
          speed#=speed#+PAINOVOIMA# 
          placeY#=placeY#+speed#
          If ImagesCollide(bullet_img,placeX#,placeY#,0,maasto,maastox,maastoy,0)>0 Then 
                 DrawToImage maasto 
                 Color cbblack : koko=30 : Circle placeX#-koko/2,placeY#-maastoY-koko/2,koko,1
                 DrawToScreen

                // PARTIKKELIROSKA
                Particle_muta = MakeEmitter(muta,30)
               ScreenPositionObject Particle_muta,placeX#,placeY#
               RotateObject     Particle_muta,90
               ObjectLife       Particle_muta,20
               ParticleMovement Particle_muta,Rand(speed#+1,speed#),painovoima,Rnd(0.8,1)
               ParticleEmission Particle_muta,10,20,100
        
               ammuselossa=OFF: placeY#=0:speed#=0
         EndIf
    EndIf
    
    DrawImage maasto,maastox,maastoy
    DrawImage bullet_img,placeX#,placeY#
    
    DrawScreen
Until EscapeKey()

DumBasZ · Post by **DumBasZ** » Sat Oct 04, 2008 4:23 pm

Miten voi piirtää viivan ruutuun tietyn ajan välein? Niinku että tulisi aina tietyn ajan päästä uusi viiva kuvaan.

E: typo

Sly_Jack0 · Post by **Sly_Jack0** » Sat Oct 04, 2008 4:52 pm

Code: Select all

Repeat

    If Timer()>aika+1000 Then
    
        y=y+15
        Line 10,y,100,y
        aika=Timer()
        
    EndIf

    DrawScreen OFF

Forever

Tuoppi · Post by **Tuoppi** » Sat Oct 04, 2008 5:49 pm

Kuinka saan ohjelman tunnistamaan onko auto radalla vai ei? Siis kuvilla tai objekteilla ei tileillä.

Helper · Post by **Helper** » Sat Oct 04, 2008 7:58 pm

Tuoppi wrote:Kuinka saan ohjelman tunnistamaan onko auto radalla vai ei? Siis kuvilla tai objekteilla ei tileillä.

piirrät esim. Kuvan joka on tie ja kuvan joka on maasto. Jos imagecollisions tie <1 sitten auto ei ole radalla..

Helper2 · Post by **Helper2** » Sat Oct 04, 2008 8:25 pm

Tuoppi wrote:Kuinka saan ohjelman tunnistamaan onko auto radalla vai ei? Siis kuvilla tai objekteilla ei tileillä.

Tossa yksinkertanen esimerkki. En ehtinyt selostaa toimenpiteitä, mutta toivottavasti ymmärrät ilmankin.

Code: Select all

SCREEN 800,600

car=LoadImage("media\car2.bmp")
rata=MakeImage(ScreenWidth(),ScreenHeight())
kentta=MakeImage(ScreenWidth(),ScreenHeight())

DrawToImage rata
    Color cbsilver:Box 50,50,700,500
    Color cbblack:Box 300,300,300,200
DrawToImage kentta
    Color cbgreen:Box 0,0,ScreenWidth(),ScreenHeight()
DrawToScreen

kenttax=0 : kenttay=0
paikkax=200 : paikkay=150

Repeat

    If DownKey() And ImagesCollide(car,paikkax,paikkay+25,0,rata,kenttax,kenttay,0)=1 Then paikkay+3
    If RightKey()And ImagesCollide(car,paikkax+33,paikkay,0,rata,kenttax,kenttay,0)=1 Then paikkax+3
    If UpKey()   And ImagesCollide(car,paikkax,paikkay-25,0,rata,kenttax,kenttay,0)=1 Then paikkay-3
    If LeftKey() And ImagesCollide(car,paikkax-33,paikkay,0,rata,kenttax,kenttay,0)=1 Then paikkax-3
    
    DrawImage kentta,kenttax,kenttay
    DrawImage rata,kenttax,kenttay
    DrawImage car,paikkax,paikkay
    
    DrawScreen
    
Until EscapeKey()

nevssons · Post by **nevssons** » Sat Oct 04, 2008 9:51 pm

Miten saisi kameran seuraamaan tekstiä addtext:issä samalla tavalla kuin printissä?

MAVmaggot · Post by **MAVmaggot** » Sat Oct 04, 2008 10:17 pm

En ymmärrä kyllä mitä eroa printillä ja addtextillä on tässä tapauksessa on. Jos ei teksti pysy kameran mukana tarkista ettet ole kirjoittanut DrawToWorld On, On, On. Se piirtää tekstin(,piirtokomennot ja kuvat) maailman koordinaatteihin, eli teksti menee pelikenttään.

nevssons · Post by **nevssons** » Sat Oct 04, 2008 10:24 pm

MAVmaggot wrote:En ymmärrä kyllä mitä eroa printillä ja addtextillä on tässä tapauksessa on. Jos ei teksti pysy kameran mukana tarkista ettet ole kirjoittanut DrawToWorld On, On, On. Se piirtää tekstin(,piirtokomennot ja kuvat) maailman koordinaatteihin, eli teksti menee pelikenttään.

Printillä ja Addtextillä on se ero että Addtext säilyy Drawscreenissä.
DrawToWorld vaikuttaa vain text-komentoon (Siis se viimeinen kohta.), eikä addtextiin.

Joten:

nevssons wrote:Miten saisi kameran seuraamaan tekstiä addtext:issä samalla tavalla kuin printissä?

Koodiapina · Post by **Koodiapina** » Sat Oct 04, 2008 10:35 pm

nevssons wrote:Miten saisi kameran seuraamaan tekstiä addtext:issä samalla tavalla kuin printissä?

Joudut koodaamaan oman systeemin, ja tuo toimisi parhaiten Text komennolla. Tässä pieni esimerkki sitä käyttäen:

Code: Select all

  Type _Text
    Field Id
    Field Con$
  EndType 
  
  Global GlobalId

  While 1
    ListTexts()
    i = i + 1
    AddText2(i)
    DrawScreen 
  Wend 
  
  Function AddText2(Con$)
    _t._Text = New(_Text)
    _t\Con = Con
    _t\Id = GlobalId + 1
    GlobalId = GlobalID + 1
  EndFunction 
  
  Function ListTexts()
    las._Text = Last(_Text)
    For _t._Text = Each _Text
      If _t\Id > las\Id - (ScreenHeight()/TextHeight("|")) Then
        If Pla < (ScreenHeight()/TextHeight("|")) Then
          Text 0,Pla*TextHeight("|"),_t\Con
        EndIf
        Pla = Pla + 1
      EndIf 
    Next _t
  EndFunction

nevssons · Post by **nevssons** » Sat Oct 04, 2008 10:50 pm

Höh, pöh ja höpsispöh!

Ehdin jo koodata tälläisen komentokäyttiksen alun ja tähän se tyssäs.

Code: Select all

SCREEN 500,300
Font=LoadFont("Arial",16)
SetFont Font
ChDir "C:\"

Repeat
IP$=Input(CurrentDir())
If KeyUp(28) Then 
CloseInput
AddText CurrentDir()+IP$
Select Lower(GetWord(IP$,1))
Case "help"
AddText ""
AddText "  Quit                  Sulkee ohjelman"
AddText "  Dir                    Kertoo kansion sisallon"
AddText "  Time                 Nayttaa paivamaaran ja kellonajan"
AddText "  ChDir <polku>   Vaihtaa hakemistoa"
AddText ""
Case "chdir"
ChDir GetWord(IP$,2)
Case "quit"
End 
Case "time"
AddText ""
AddText "  Date: "+Date() 
AddText "  Time: "+Time() 
AddText ""
Case "dir"
AddText ""
StartSearch
    count=0
    Repeat
        file$=FindFile()
        If file$="" Then Exit         
            AddText "  "+file$ 
 
            count+1 
            
            DrawScreen 
    Forever
EndSearch
AddText ""
AddText "  "count+" Tiedostoa\kansiota"
AddText ""
Default
AddText ""
AddText "  Komentoa "+GetWord(IP$,1)+" ei ole olemassa" 
AddText ""
End Select 
EndIf 

DrawScreen
Forever

Sori taas kerran offitopic

Koodiapina · Post by **Koodiapina** » Sat Oct 04, 2008 11:04 pm

Saat käyttää vapaasti tätä, aikoinaan tekemääni komentokäyttistä:

Code: Select all

SCREEN 640,480,32,0

    Type sline
        Field scon$
        Field gtype
        Field sinp
    EndType
   
    ClsColor 0,0,208
    ClsColor 0,0,0
    fnt = LoadFont("lucida console",14,1)
    SetFont fnt

    NewMsg("")
    NewMsg("")
    NewMsg("")
    NewMsg("    Joku systeemi 4.9")
    NewMsg("    Pelaako? %sys.status")
    NewMsg("")
    NewMsg("")
    NewMsg("    KOMENNOT:")
    NewMsg("")
    NewMsg("    kirjoita <teksti>")
    NewMsg("    hakemisto -listaa           (Parametri on valinnainen)")
    NewMsg("    poista <tiedosto>")
    NewMsg("")
    NewMsg("")
   
    curdir$ = "kavijat/jotain"
   
    Global inputs$
   
    status$ = "vieras.SYSTEEMI"
    Dim cmark$
   
    While True
        If Timer()>markt+200 Then
            Select n
            Case 0:cmark="|"
            Case 1:cmark="/"
            Case 2:cmark="-"
            Case 3:cmark="\"
            EndSelect
            n = n + 1
            If n>3 Then n=0
            markt = Timer()
        EndIf
        Locate -100,-100
        inputs = Input("")
        For sl.sline = Each sline
            Color 255,255,255
            If InStr(sl\scon,status) Then Color 127,255,0
            If InStr(sl\scon,"VIRHE:") Then Color 255,0,0
            If InStr(sl\scon,"VAROITUS:") Then Color 255,255,0
            printings$ = Replace(sl\scon,"%sys.status",cmark)
            If sy>(readpoint-1) And sy<(readpoint+28) Then
                Text 10,10+(ny*16),printings
                ny = ny + 1
            EndIf
            lastwidth = TextWidth(printings)
            sy = sy + 1
        Next sl
        ny = ny + 1
        Color 255,255,255
        Text 10,10+(ny-1)*16,status+": "+inputs
        Color 127,255,0
        Box TextWidth(status+": "+inputs)+10,10+(ny-1)*16-1,8,14,1
        If sy > readpoint+28 Then readpoint = sy-28
        sy = 0
        ny = 0
        If KeyHit(cbkeyreturn) Then
            dont = 0
            NewMsg(status+": "+inputs)
            If GetCode("kirjoita") Then
                NewMsg(GetWord(inputs,2))
            ElseIf GetCode("hakemisto")
                NewMsg("")
                NewMsg(curdir)
                If GetCode("-listaa") Then
                    NewMsg("")
                    NewMsg("    Size      Name")
                    NewMsg("")
                    StartSearch
                        While True
                            msg$ = "    "
                            tfil$ = FindFile()
                            If tfil="" Then Exit
                            msg = msg + FileSize(tfil)
                            For a = 0 To (7-Len(Str(FileSize(tfil))))
                                msg = msg + " "
                            Next a
                            msg = msg + "  "
                            msg = msg + tfil
                            If IsDirectory(tfil) And tfil<>"." And tfil<>".." Then
                                msg = msg + "/"
                            EndIf
                            NewMsg(msg)
                        Wend
                    EndSearch
                EndIf
                NewMsg("")
            // Poistaa vain tiedostoja
            ElseIf GetCode("poista")
                If FileExists(GetWord(inputs,2)) Then
                    DeleteFile GetWord(inputs,2)
                Else
                    NewMsg("VIRHE: Tiedostoa"+" ei löytynyt!")
                EndIf
            EndIf
            CloseInput()
            ClearKeys()
        EndIf
        DrawScreen
    Wend   
   
    Function NewMsg(con$,gtyp=0)
        sl.sline = New(sline)
        sl\scon = con
        sl\gtype = gtyp
        lasts = sl\scon
    EndFunction
   
    Function GetCode(code$)
        Return InStr(Lower(inputs),Lower(code))
    EndFunction

Mukana on muutama esimerkki komento.

nevssons · Post by **nevssons** » Sun Oct 05, 2008 11:00 am

Kiitos grandi, mutta tuota ei tavitakkaan. Kehitin systeemin jonka edessä omasi näyttää purkalta

. Tein tälläisen hauskan funktion:

Code: Select all

Const rivimäärä = 18
Dim rivit(rivimäärä) As String 
Global käytetyt

//ohjelma tähän

Function Rivi(txt$)
   If käytetyt=rivimäärä Then 
    ClearText 
     For f=1 To rivimäärä-1
      rivit(f)=rivit(f+1)
      AddText rivit(f)
    Next f
    käytetyt-1
   EndIf 
  käytetyt+1
  rivit(käytetyt)=txt$
  AddText txt$
EndFunction

EDIT:

Ymmärsit varmaan perjaatteen? Tuo on vastaus alkuperäiseen kysymykseeni.

Koodiapina · Post by **Koodiapina** » Sun Oct 05, 2008 12:57 pm

Minun koodini oli pidempi koska käytin tyyppikokoelmia. Se ei ole purkkaa, vaan tosiasia, että tyyppien kanssa työskennellessä rivimäärät paisuvat pakostakin. Sitä en kiellä, etteikö koodistani löytyisi oikeastikkin purkkaa. Ja tein muuten tarkoituksellaankin vaikeammalla tavalla: Minun versiossani viestien määrä on dynaaminen, ja vanhat tallennetaan. Näin niitä voitaisiin jälkeenpäin selata, joka on tärkeä ominaisuus komentokäyttis simulaattoreissa.

Cérebro · Post by **Cérebro** » Sun Oct 05, 2008 2:56 pm

Onko CoolBasicciin tehty "pyöristetty suorakulmio"-funktiota? Jos on, voisiko joku näyttää sen?

MAVmaggot · Post by **MAVmaggot** » Sun Oct 05, 2008 3:33 pm

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

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

Re: Tyhmät kysymykset