CoolBasic Forums

Posted: **Sat May 10, 2008 11:55 pm**

!!! WARNING !!! teipäs tämmösen, käyttäkää omalla vastuulla:
Hakkeroi (köh) siis lue koneesi muistia:

Aika jännä systeemi. Tolla on kiva leikkiä

. Yhdessä vaiheessa löyty jopa merkki joka muuttui jatkuvasti, näytti käyvän ASCII-merkistön läpi. Outoa...

Posted: **Sat May 10, 2008 11:59 pm**

Joo tolla on tosiaan kiva leikkiä. Itelläni tuolla löyty jotain koodia tyyliin p_stream$string, p_fcurrentdate#float jne.

E: Olin tekemässä tällaista peliä viikkokisaan, mutta mielenkiinto ei vain säilynyt. Koodi on melko kommentoitua, joten en ajattelin laittaa tämän avoimeksi lähdekoodiksi, jotta voisin sanoa itseäni open source kehittäjäksi.

Code: Select all

    
    //
    ' Feel free to modify :)
    //
    
    SCREEN 800,620
    SetWindow "Blox Blox"
    
    //
    //  GAME DATA
    //
    
    ' Variables for the blocks. They
    ' declares the position
    Dim blockx(2)
    Dim blocky(2)
    
    ' This is the blink timer for
    ' falling block
    
    Global blinktimer
    Global blinking
    
    Global falltimer
    blinktimer = Timer() 
    falltimer = Timer()
    
    ' This is data for undoing moves
    ' Note that 999 moves is the max!
    Dim historyx(999)
    Dim historyy(999)
    Global datanow
    
    ' Type for all the blocks to
    ' the map. x, y declare position,
    ' d - declare the map data given
    Type mdata
        Field x
        Field y
        Field d
    EndType 
    
    Global author$
    Global lvlname$
    Global resource$
    Global level
    level = 1
    
    ' Special data
    Global activate
    Global completed
    Global needed
    
    ' Flash intro globals
    Global Int_Dir
    Global Int_Amount
    
    Global font
    font = LoadFont("arial",20)
    SetFont font
    
    //
    //  CALL MAIN FUNCTION
    //
    
    Main()
    
    //
    //  FUNCTIONS
    // 
    
    ' This function gets the data
    ' of block. Eq. dat = GetData(10,4)
    Function GetData(x,y)
        Dim b.mdata
        For b.mdata = Each mdata
            If b\x = x And b\y = y Then Return b\d
        Next b
    EndFunction 
    
    ' Neary same but this function sets
    ' the block data
    Function SetData(x,y,d)
        Dim b.mdata
        For b.mdata = Each mdata
            If b\x = x And b\y = y Then b\d = d
        Next b
    EndFunction 
    
    ' Very close of the previous,
    ' but this creates a new block
    Function PutData(x,y,d)
        Dim b.mdata
        b.mdata = New(mdata)
        b\x = x
        b\y = y
        b\d = d
    EndFunction 
    
    ' Boolean. Are the blocks in
    ' a pile? Return true if is so,
    ' false as its not.
    Function InPile()
        Return ((blockx(1) = blockx(2)) And (blocky(1) = blocky(2)))
    EndFunction 
    
    ' Boolean. Is there block falling? True if so
    Function Falling()
        If GetData(Blockx(1),Blocky(1))=0 Or GetData(Blockx(2),Blocky(2))=0 Then 
            Return 1 
        Else 
            If GetData(Blockx(1),Blocky(1))=3 And Activate = 0 Then Return 1 Else Return 0
        EndIf 
    EndFunction 
    
    ' Draws player blocks. If they are in
    ' pile, show it to player with color
    Function DrawPlayerBlocks()
        If InPile() Then Color 255,255,0 Else Color 0,255,0
        Box blockx(1)*20,blocky(1)*20,20,20
        Box blockx(2)*20,blocky(2)*20,20,20
    EndFunction 
    
    ' Draws the game blocks
    Function DrawGameBlocks()
        Dim b.mdata
        For b.mdata = Each mdata
            Color cbsilver
            'If b\d Then Box b\x*10,b\y*10,10,10
            Select b\d
            Case 1: WiseBlock(b\x,b\y,1)
            Case 2: WiseBlock(b\x,b\y,2)
            Case 3
                If Activate Then WiseBlock(b\x,b\y,1) Else WiseBlock(b\x,b\y,4)
            Case 4: WiseBlock(b\x,b\y,3)
            Case 9
                If completed = needed Then
                    If blinking Then WiseBlock(b\x,b\y,9)
                Else
                    WiseBlock(b\x,b\y,9)
                EndIf 
            EndSelect 
        Next b
    EndFunction
    
    ' Level complete - portal
    Function CompletePortal()
        If both(4) Then 
            completed = completed + 1
            SetData(blockx(1),blocky(1),1)
            activate = Not activate
        EndIf 
    EndFunction 
    
    ' Loads the blocks from a
    ' file.
    Function LoadBlocks$(res$)
        Dim resf
        Dim strl$
        resf = OpenToRead(res) 
            Dim a
            While Not EOF(resf)
                strl = Left(ReadLine(resf),40)
                Dim i
                For i = 0 To Len(strl)
                    PutData(i,a,Int(Mid(strl,i+1,1)))
                    If Mid(strl,i+1,1) = 9 Then
                        blockx(1) = i
                        blockx(2) = i
                        blocky(1) = a
                        blocky(2) = a
                    EndIf 
                    If Mid(strl,i+1,1) = 4 Then needed = needed + 1
                Next i
                a = a + 1
            Wend 
        CloseFile(resf)
        Return strl
    EndFunction 
    
    ' Moves the blocks
    Function Move(dirx,diry)
        If dirx <> 0 Or diry <> 0 Then
            If InPile() Then
                Blockx(1) = Blockx(1) + dirx*2
                Blocky(1) = blocky(1) + diry*2
                Blockx(2) = Blockx(2) + dirx
                Blocky(2) = Blocky(2) + diry
            Else
                If blockx(1) = blockx(2) And dirx <> 0 Then 
                    blockx(1) = blockx(1) + dirx
                    blockx(2) = blockx(2) + dirx
                Else
                    If dirx = 1 Then
                        If blockx(1)<blockx(2) Then 
                            blockx(1) = blockx(1) + 1
                        Else
                            blockx(2) = blockx(2) + 1
                        EndIf 
                    ElseIf dirx = -1
                        If blockx(1)<blockx(2) Then 
                            blockx(2) = blockx(2) - 1
                        Else
                            blockx(1) = blockx(1) - 1
                        EndIf 
                    EndIf
                EndIf
                
                If blocky(1) = blocky(2) And diry <> 0 Then
                    blocky(1) = blocky(1) + diry
                    blocky(2) = blocky(2) + diry
                Else
                    If diry = 1 Then  
                        If blocky(1)<blocky(2) Then 
                            blocky(1) = blocky(1) + 1
                        Else
                            blocky(2) = blocky(2) + 1
                        EndIf 
                    ElseIf diry = -1
                        If blocky(1)<blocky(2) Then 
                            blocky(2) = blocky(2) - 1
                        Else
                            blocky(1) = blocky(1) - 1
                        EndIf 
                    EndIf
                EndIf 
            EndIf 
            datanow = datanow + 1
            historyx(datanow) = dirx
            historyy(datanow) = diry
            ActivateBridge()
        EndIf 
    EndFunction 
    
    ' This function shows a red box in
    ' the point where might be a falling
    ' block controlled by player
    Function DropBlock()
        Color Blinking*255,0,0
        If Falling() Then 
            Box Blockx(1)*20,Blocky(1)*20,20,20
            Box Blockx(2)*20,Blocky(2)*20,20,20
        EndIf 
    EndFunction 
    
    ' This allows player control the
    ' blocks
    Function PlayerControl()
        If Falling() = False Then Move(KeyHit(cbkeyright)-KeyHit(cbkeyleft),(KeyHit(cbkeydown)-KeyHit(cbkeyup)))
    EndFunction 
    
    ' Updates the blinking timer for
    ' drop block function
    Function UpdateBlinkTimer()
        If Timer()>Blinktimer+500 Then
            Blinking = Not Blinking
            Blinktimer = Timer()
        EndIf 
    EndFunction 
    
    ' Undo the move
    ' Return 0 if failed
    Function Undo()
        If datanow > 0 Then
            datanow = datanow - 1
            Move(historyx(datanow),historyy(datanow))
        Else
            Return 0
        EndIf 
    EndFunction 
    
    ' Redo the move
    ' Return 0 if failed
    Function Redo()
        If falling() = False And historyx(datanow+1)<>0 And historyy(datanow+1)<>0 Then
            datanow = datanow + 1
            Move(historyx(datanow),historyy(datanow))
        Else
            Return 0
        EndIf 
    EndFunction 
    
    ' This function checks is the
    ' block touching that type of
    ' gameblock
    Function One(t)
        Return (GetData(Blockx(1),Blocky(1))=t Or GetData(Blockx(2),Blocky(2))=t)
    EndFunction 
    
    ' Is both touching a block
    Function Both(t)
        Return (GetData(Blockx(1),Blocky(1))=t And GetData(Blockx(2),Blocky(2))=t)
    EndFunction 
    
    ' Activates the bridge
    Function ActivateBridge()
        If One(2) Then activate = Not activate
    EndFunction 
    
    ' This function handles the
    ' history given to the array
    Function HandleHistory()
        If KeyHit(cbkeyr) Then Redo()
        If KeyHit(cbkeyu) Then Undo()
    EndFunction 
    
    Function WiseBlock(x,y,t)
        Select t
        Case 1
            Color 160,160,160
            Box x*20,y*20,20,20
            Color 130,130,130
            Box x*20,y*20,20,20,0
            Color 160,160,160
            Box x*20+1,y*20+1,19,19
        Case 2
            Color 0,0,160
            Box x*20,y*20,20,20
            Color 0,0,130
            Box x*20,y*20,20,20,0
            Color 0,0,160
            Box x*20+1,y*20+1,19,19
        Case 3
            Color 0,160,0
            Box x*20,y*20,20,20
            Color 0,130,0
            Box x*20,y*20,20,20,0
            Color 0,160,0
            Box x*20+1,y*20+1,19,19
        Case 9
            Color 160,160,0
            Box x*20,y*20,20,20
            Color 130,130,0
            Box x*20,y*20,20,20,0
            Color 160,160,0
            Box x*20+1,y*20+1,19,19
        EndSelect 
    EndFunction 
    
    Function ClearBlocks()
        Dim b.mdata
        For b.mdata = Each mdata
            Delete b
        Next b
    EndFunction 
    
    ' This is not part of the game,
    ' but this let the splash look better :D
    Function FlashIntro(Con$)
        Int_Amount = 1
        Int_Dir = 1
        While True
            If Int_Amount < 200 Then
                Int_Amount = Int_Amount + (Int_Dir*10)
            Else
                Int_Amount = Int_Amount + (Int_Dir*2)
            EndIf
            If Int_Amount > 254 Then Int_Dir = -Int_Dir
            If Int_Amount < 1 Then Exit
            Color Int_Amount,Int_Amount,Int_Amount
            CenterText ScreenWidth()/2,ScreenHeight()/2,Con$
            DrawScreen 
        Wend 
    EndFunction 
    
    ' Show bottom bar
    Function BottomBar()
        Color cbsilver
        Text 5,ScreenHeight()-25,completed+"/"+needed+"                 "+datanow
    EndFunction 
    
    ' This function starts the current
    ' level over and clears the data
    Function StartOver()
        ClearBlocks()
        datanow = 0
        needed = 0
        completed = 0
        activate = 0
        main()
    EndFunction
    
    ' This goes to the next level
    ' and clears the data
    Function NextLevel()
        level = level + 1
        ClearBlocks()
        datanow = 0
        needed = 0
        completed = 0
        activate = 0
        main()
    EndFunction
    
    //
    //  TEH MAIN PROGRAM
    //
    
    Function Main()
        resource = LoadBlocks("maps/"+level+".txt")
        FlashIntro("Level "+Level)
        While True
            If falling() Then StartOver()
            If Both(9) And completed = needed And needed > 0 Then NextLevel()
            HandleHistory()
            DrawGameBlocks()
            DrawPlayerBlocks()
            PlayerControl()
            UpdateBlinkTimer()
            BottomBar()
            CompletePortal()
            DrawScreen 
        Wend 
    EndFunction

Peli tarvitsee toimiakseen oma tekemiä karttoja Maps/ kansiossa tyyliin 1.txt, 2.txt, 3.txt jne. Joiden sisältö on esim. tällainen (Tätä voi käyttää testaamiseen)

Code: Select all

0000000000000000000000000000000000000000
0000000000000000000000000000000000000000
0000000000000000000000000000000000000000
0000000000000000000000000000000000000000
0000000000000000000000000000000000000000
0000000000000000000331110000000000000000
0000000000000000000331410000000000000000
0000000000000000000331110000000000000000
0000000000000000000330010000000000000000
0000000000000000000330010000000000000000
0000000000000000000330010000000000000000
0000000000000000000111110000000000000000
0000000000000000000111000000000000000000
0000000000000000000111000000000000000000
0000000000000000000111000000000000000000
0000000000000000000191000000000000000000
0000000000000000000111000000000000000000
0000000000000000000000000000000000000000
0000000000000000000000000000000000000000
0000000000000000000000000000000000000000
0000000000000000000000000000000000000000
0000000000000000000000000000000000000000
0000000000000000000000000000000000000000
0000000000000000000000000000000000000000
0000000000000000000000000000000000000000
0000000000000000000000000000000000000000
0000000000000000000000000000000000000000
0000000000000000000000000000000000000000
0000000000000000000000000000000000000000
0000000000000000000000000000000000000000

0 tarkoittaa samaa kuin ei mitään, 1 tarkoittaa lattiaa, 9 on aloituspaikka, 3 on lattiaa joka ilmestyy kun kytkin on aktivoitu, joka merkitään 2. 4 taas on portaali, jotka täytyy painaa pohjaan, jotta palaamalla alkupaikkaan (9) pääsisi seuraavalle tasolle.

Kun on yksi keltainen palikka, ne ovat pinossa, ja silloin täytetään liikkuessa 2 paikkaa vihreillä palikoilla 4 eri suunnassa. Kun ei olla pinossa, täytetään 1 keltainen palikka, joka on liikesuunasta laskettuna uloimman vihreän palikan koordinaateissa. Sininen 2 kytkin tarvitsee vain vihreän palikan kosketuksen, kun taas 4 portaali ja 9 seuraavataso - portaali tarvitsevat keltaisen palikan.

E2: Ainiin, portaalit laittavat päälle / pois päältä ilmestyviä lattioita.
E3: Peli on tehty toimivaksi FVD:n kanssa.

Posted: **Sun May 11, 2008 2:52 pm**

Tietääkö kukaan, mistä saisi PAL-version Dodonpachi Dai-ou-jousta? Vai onko sitä edes olemassa.
Miten voisi sitten saada sen toimimaan PAL-playstation kakkoselle?

Posted: **Sun May 11, 2008 7:16 pm**

En usko että löydät sen PAL versiota, sillä itse en ainakaan pikaisella googletuksella löytänyt mitään viittausta sellaiseen. ( :D )
Ja vaikka saisitkin NTSC konsolin, ei peli silti toimisi ilman yhteensopivaa telkkaria.

Helpoin tapa olisi varmaan viritellä PS2 ohjain kiinni koneeseen, ja pelailla sitten emulaattorilla.

Posted: **Mon May 12, 2008 7:58 am**

Tai olla virittämättä ohjainta, mutta silti pelata emulaattorilla. (Vai onko mahdotonta? Mutta ainakin jotkut emulaattorit sallivat pelin tallentamisen milloin vain jne, ja tämä ehken vaikeutuisi jos olis käytössä ohjain.)

Posted: **Mon May 12, 2008 8:08 pm**

Kyllähän ne pelit ilman ohjaintakin toimivat, mutta siinähän on aivan eri fiilis kuin verrattuna näppikseen.
Tykkään pelailla useimpia pc-pelejäkin padilla, paljon ergonomisempaa :D

Posted: **Mon May 12, 2008 8:27 pm**

Toimintapeleissä menee padillakin pelailu, mutta räiskinnässä ei näppis+hiiri -komboa voita mikään. Vaan mielipide- ja tottumuskysymyshän se on.

Posted: **Mon May 12, 2008 10:31 pm**

Sain toimimaan Dodonpachin (Ei dai-ou-jou) koneella. Todella vaikea peli. Kunhan sitten saisin vielä sen vaikeamman dai-ou-joun :D

Posted: **Thu May 15, 2008 7:44 pm**

Voisiko itkuhälyttimestä tehdä yksikanavaisen radio-ohjattavan? Siis jos mikrofonin tilalle laittaisi virtalähteen ja painikkeen, ja vastaanottimessa kaiuttimen tilalle moottorin?

Posted: **Thu May 15, 2008 8:04 pm**

Periaatteessa ainakin, samahan se toimintatapa on - mutta oikeiden (tehtävään tarkoitettujen) osien käyttäminen voisi olla parempi idea : D

Posted: **Thu May 15, 2008 8:08 pm**

koodaaja wrote:Periaatteessa ainakin, samahan se toimintatapa on - mutta oikeiden (tehtävään tarkoitettujen) osien käyttäminen voisi olla parempi idea : D

Saahan sitä aina kokeilla.

Posted: **Thu May 15, 2008 8:12 pm**

Kertokaas mulle, että onko Cutenews hyvä uutisten hallinta ohjelma

?

Posted: **Thu May 15, 2008 8:20 pm**

jannepelaa wrote:Voisiko itkuhälyttimestä tehdä yksikanavaisen radio-ohjattavan? Siis jos mikrofonin tilalle laittaisi virtalähteen ja painikkeen, ja vastaanottimessa kaiuttimen tilalle moottorin?

Yleensä kaiuttimen ja moottorin resistanssi on eri, mutta saattaisi toimiakkin. Tosin tuo painikkeen mikrofonin tilalle laittaminen tuskin tulee toimimaan, koska käsittääkseni mikrofoni indusoi piiriin pienen virran... riippuu tietysti mikrofonin tyypistä. Kun laitat siihen oskillaattorin, saat oskillaattorista riippuen sinikäyrää toisesta päästä ja oikeanlainen ac -moottorihan toimii oikealla frekvenssillä, jos häiriöitä ei ole liikaa. Oikean frekvenssin löytämiseen ei varmaan edes tarvitse oskilloskooppia, koska kokeilemalla oskillaattorilla varmaan löytyy.

Mutta ei tuossa viritelmässä oikein mitään järkeä ole. Paitsi se, ettei tarvitse ruveta langatonta siirtoa miettimään... mutta aika moni asia voi kyllä mennä pieleenkin.

Posted: **Thu May 15, 2008 9:01 pm**

vilQuri wrote:Kertokaas mulle, että onko Cutenews hyvä uutisten hallinta ohjelma ?

On. Itse tosin käytän omatekoista, mutta CuteNews on mainio jos ei jaksa tehdä omaa (hyvää) uutisten hallinta -sovellusta.

Tuli muuten mieleen, että kun CuteNewsissä lukee, että sitä mainosta ei saa poistaa siitä koodista jos haluaa käyttää ilmaiseksi. Noh saivarrellen kannattaa kirjoittaa uutisten alkuun

Code: Select all

</span>

ja loppuun

Code: Select all

<span style="display:none;">

jolloin käyttäjä ei näe sitä mainosta. En muista toimiiko uusissa versioissa kun niissä saattaa olla uusia härpäkkeitä, mutta aikoinaan kun kokeilin niin toimi mainiosti. Idea on se, että voi aina väittää, että tuo koodi oli siinä ihan vaan sivun ulkoasun muuttamiseksi, sillä eihän mainosta ole poistettu.

EDIT: Tietenkin CuteNewsin sisällyttävän koodirivin jälkeen pitää sulkea tuo span tagi.

Posted: **Thu May 15, 2008 9:50 pm**

Grandi wrote:
vilQuri wrote: Tuli muuten mieleen, että kun CuteNewsissä lukee, että sitä mainosta ei saa poistaa siitä koodista jos haluaa käyttää ilmaiseksi. Noh saivarrellen kannattaa kirjoittaa uutisten alkuun
Code: Select all
</span>
ja loppuun
Code: Select all
<span style="display:none;">
jolloin käyttäjä ei näe sitä mainosta. En muista toimiiko uusissa versioissa kun niissä saattaa olla uusia härpäkkeitä, mutta aikoinaan kun kokeilin niin toimi mainiosti. Idea on se, että voi aina väittää, että tuo koodi oli siinä ihan vaan sivun ulkoasun muuttamiseksi, sillä eihän mainosta ole poistettu.

Tuo toiminee niin kauan, että CuteNewsin tekijä huomaa tempun ja muuttaa lisenssin muotoon "mainoksen tulee näkyä sivulla, jos tuotetta haluaa käyttää ilmaiseksi" CuteNews:n seuraavassa versiossa. Vanhoihin versioihinhan lisenssimuutos ei voi vaikuttaa.

P.S. Minullakin on hyviä kokemuksia CuteNewsistä.

Posted: **Fri May 16, 2008 2:41 pm**

Onkos kukaan CB:läisistä pelannut WoWia? Itse en ole, mutta aion pelata jos löydän hyvän C64 emulaattorin sille.

Posted: **Fri May 16, 2008 2:45 pm**

Ei oo vähään aikaan kiinnostanu koodata, mutta tänään iski himot, mutta sitten tajusin että CBhän ei toimi linuxissa. No menin xp:n puolelle mutta kesti muutama minuutti kun vaihdoin takasin ubuntuu. No ei ne himot kahessa minuutissa mihinkään kadonnu, joten kertokaapas cbn kaltaisia kieliä joilla voisin koodailla linuxin puolella?

Java ja c++ näytti aivan liian vaikealta.

Posted: **Fri May 16, 2008 2:52 pm**

Kävisikö esim. FreeBasic? Mukana on muunmuassa 3D ominaisuudet ja läpinäkyvyys.

Posted: **Fri May 16, 2008 3:24 pm**

Minne ilmaiseen palveluun kannattaa tehdä HTML-sivut? Ajattelin ettämielummin rumat* itsetehdyt sivut kuin rumat** freewebs-sivut.
*Nyt haukun itseäni. **Nyt haukun Freewebsiä.

Posted: **Fri May 16, 2008 3:33 pm**

Chaosworm wrote:Minne ilmaiseen palveluun kannattaa tehdä HTML-sivut? Ajattelin ettämielummin rumat* itsetehdyt sivut kuin rumat** freewebs-sivut.

Jouluserver.com, Arkku.net, Servut.us?

CoolBasic Forums

Offtopic

Re: Offtopic

Re: Offtopic

Re: Offtopic

Re: Offtopic

Re: Offtopic

Re: Offtopic

Re: Offtopic

Re: Offtopic

Re: Offtopic

Re: Offtopic

Re: Offtopic

Re: Offtopic

Re: Offtopic

Re: Offtopic

Re: Offtopic

Re: Offtopic

Re: Offtopic

Re: Offtopic

Re: Offtopic

Re: Offtopic