nD-Ristinolla

Jaa meneillään olevat projektisi tai valmiit pelit muun yhteisön kanssa täällä.
Post Reply
User avatar
buke44
Active Member
Posts: 169
Joined: Sat May 23, 2009 8:10 pm
Location: Tampere

nD-Ristinolla

Post by buke44 » Tue Mar 22, 2011 7:45 am

Koodailimpa n-ulotteisen ristinollan. Tässä pitää normaalin ristinollan tapaan saada kolmen suoraa omaa kuviotaan. Tässä ei ole vielä tekoälyä tai nettipeliä, joten pelaaminen tapahtuu itseä tai saman ruudun takana olevaa kaveria vastaan.

Code: Select all

SCREEN 300,400
FrameLimit 20

Type rasti
    Field sijainti //koordinaatit
    Field rn //1 = 0 2 = X
EndType 

kuvio=1

Global dimensions,win

AddText "Valitse ulottuvuudet välillä 2-15"
Repeat
    s$=Input(":") 
    DrawScreen 
Until KeyHit (cbkeyenter)Or KeyHit (cbkeyreturn)

ClearText 
CloseInput 

dimensions=Int (s)

If dimensions>15 Or dimensions<2 Then MakeError "ulottuvuudet välillä 2-15"

Dim tempkoord (dimensions-1) As Byte

Dim tempkoord2 (dimensions-1)As Byte 

Dim tempkoord3 (dimensions-1)As Byte

Dim nytkoord (dimensions-1)

Dim koordtunnus (14) As String 
koordtunnus (0)="X"
koordtunnus (1)="Y"
koordtunnus (2)="Z"
For i=3 To 14
    koordtunnus (i)=Chr (i+62)
Next i

Dim koordohj (14) As String 
koordohj (0)="Mouse X"
koordohj (1)="Mouse Y"
koordohj (2)="Mouse Z"
koordohj (3)="Q/W"
koordohj (4)="A/S"
koordohj (5)="Z/X"
koordohj (6)="E/R"
koordohj (7)="D/F"
koordohj (8)="C/V"
koordohj (9)="T/Y"
koordohj (10)="G/H"
koordohj (11)="B/N"
koordohj (12)="U/I"
koordohj (13)="J/K"
koordohj (14)="M/,"

Dim ohj1 (11)
ohj1 (0)=16
ohj1 (1)=30
ohj1 (2)=44
ohj1 (3)=18
ohj1 (4)=32
ohj1 (5)=46
ohj1 (6)=20
ohj1 (7)=34
ohj1 (8)=48
ohj1 (9)=22
ohj1 (10)=36
ohj1 (11)=50

Repeat 
    nytkoord (0)=MouseX ()/100
    nytkoord (1)=MouseY ()/100
    If nytkoord (1)>2 Then nytkoord (1)=2
    
    If dimensions>2 Then 
        wheel=MouseMoveZ ()
        nytkoord (2)=nytkoord(2)+wheel
        If nytkoord (2)>2 Then nytkoord (2)=2
        If nytkoord (2)<0 Then nytkoord (2)=0
    EndIf
    
    If dimensions>3 Then 
        For i=3 To dimensions-1
            If KeyHit (ohj1(i-3)) Then nytkoord (i)=nytkoord (i)-1
            If KeyHit (ohj1(i-3)+1) Then nytkoord (i)=nytkoord (i)+1
            If nytkoord (i)>2 Then nytkoord (i)=2
            If nytkoord (i)<0 Then nytkoord (i)=0
        Next i
    EndIf 
    
    If MouseHit (1) Then 
        If uusrasti (kuvio)=0 Then 
            kuvio=kuvio+1
            If kuvio=3 Then kuvio=1
        EndIf 
    EndIf 
    
    If kuvio=1 Then Text 1,1,"risti" Else Text 1,1,"nolla"
    
    Color cbWhite
    Line 100,0,100,300
    Line 200,0,200,300
    Line 0,100,300,100
    Line 0,200,300,200
    Color cbRed
    Line 0,300,300,300
    Color cbWhite
    
    For i=0 To dimensions-1
        Text 0+RoundDown (i/5)*100,300+(i Mod 5)*20,koordtunnus (i)+":"+nytkoord (i)+","+koordohj (i)
    Next i

    For rasti1.rasti=Each rasti 
        getkoord (ConvertToInteger (rasti1),1)
        If dimensions>2 Then 
            nayta=1
            For i=2 To dimensions-1
                If Not tempkoord (i)=nytkoord (i) Then 
                    nayta=0
                EndIf
            Next i
             If nayta=1 Then    
                If rasti1\rn=2 Then Circle tempkoord (0)*100,tempkoord(1)*100,100,0
                If rasti1\rn=1 Then 
                    Line tempkoord (0)*100,tempkoord(1)*100,tempkoord (0)*100+100,tempkoord(1)*100+100
                    Line tempkoord (0)*100+100,tempkoord(1)*100,tempkoord (0)*100,tempkoord(1)*100+100
                EndIf 
            EndIf 
        Else 
            If rasti1\rn=2 Then Circle tempkoord (0)*100,tempkoord(1)*100,100,0
            If rasti1\rn=1 Then 
                Line tempkoord (0)*100,tempkoord(1)*100,tempkoord (0)*100+100,tempkoord(1)*100+100
                Line tempkoord (0)*100+100,tempkoord(1)*100,tempkoord (0)*100,tempkoord(1)*100+100
            EndIf 
        EndIf 
    Next rasti1
    If win=1 Then MakeError "Risti voitti"
    If win=2 Then MakeError "Nolla voitti"
    DrawScreen 
Forever 


Function getkoord (r,asd)   
    rasti1.rasti=ConvertToType (r)
    For i=0 To dimensions-1
        Select asd
            Case 1
                tempkoord (i)=PeekByte (rasti1\sijainti,i)
            Case 2
                tempkoord2 (i)=PeekByte (rasti1\sijainti,i)
            Case 3
                tempkoord3 (i)=PeekByte (rasti1\sijainti,i)
        EndSelect 
    Next i
EndFunction 


Function uusrasti (rn) 
    For rasti1.rasti=Each rasti
        getkoord (ConvertToInteger (rasti1),1)
        eiok=0
        For i=0 To dimensions-1
            If tempkoord (i)<>nytkoord(i) Then 
                eiok=1
            EndIf 
        Next i
        If eiok=0 Then Return 1
    Next rasti1
    rasti1.rasti=New (rasti)
    rasti1\rn=rn
    rasti1\sijainti=MakeMEMBlock (dimensions-1)
    For i=0 To dimensions-1
        PokeByte rasti1\sijainti,i,nytkoord (i)
    Next i
    For rasti1.rasti=Each rasti
        getkoord (ConvertToInteger (rasti1),1)
        For rasti2.rasti=Each rasti
            If rasti2<>rasti1 Then 
                If rasti1\rn=rasti2\rn Then 
                    getkoord (ConvertToInteger (rasti2),2)
                    For rasti3.rasti=Each rasti
                        If rasti3<>rasti1 Then 
                            If rasti3<>rasti2 Then 
                                If rasti3\rn=rasti2\rn Then 
                                    getkoord (ConvertToInteger (rasti3),3)
                                    sallit=1
                                    For i=0 To dimensions-1
                                        v1=tempkoord(i)-tempkoord2(i)
                                        v2=tempkoord2(i)-tempkoord3(i)
                                        If Not (v1=v2) Then sallit=0
                                    Next i
                                    If sallit=1 Then win=rn
                                EndIf 
                            EndIf 
                        EndIf 
                    Next rasti3
                EndIf 
            EndIf 
        Next rasti2
    Next rasti1
EndFunction 

Ruudun alaosassa näkyy nykyiset koordinaatit, ja kontrollit miten jokaisessa ulottuvuudessa liikutaan. Kuvion asettaminen tapahtuu hiren klikkauksella. Ulottuvuuksia otin kontrollien ja yms. takia mukaan vain 15. Luulen kuitenkin että vähän yli 14 miljoonaa ruutua riittää jokaiselle.
Last edited by buke44 on Tue Mar 22, 2011 4:39 pm, edited 1 time in total.

User avatar
Jonez
Devoted Member
Posts: 575
Joined: Mon Aug 27, 2007 8:37 pm

Re: nD-Ristinolla

Post by Jonez » Tue Mar 22, 2011 12:23 pm

Ei nyt aivot taivu tajuamaan että onko tuo "oikeasti" n-ulotteinen ristinolla vai ei. Kolmanteen ulottuvuuteen asti kaikki toimii, ja oikestaan kaikki ulottuvuudet siitä eteenpäin ovatkin turhia. Aloittaja nimittäin voittaa täydellisessä pelissä aina käyttämällä vain kolmea ekaa ulottuvuutta.

Mutta ihan hauskahan tuo oli. Itse sain siitä sen irti, että joutui vähän miettimään siinä 3d-versiossa mihin niitä rasteja pitää laitella jos haluaa voittaa. :)

Edit. tuli mieleen, että olisiko käyttäjäystävällisempää jos ulottuvuuksia voisi valita esim. plus-miinus-napeilla, ja hiiren rullalla sitten liikkua tässä ulottuvuudessa (lukuun ottamatta kahta ensimmäistä).
-Vuoden 2008 aloittelijan ystävä -palkinnon voittaja-
Image <- protestipelikilpailun voittaja.
Space War

User avatar
Mickey
Newcomer
Posts: 33
Joined: Sat Feb 09, 2008 11:32 am
Location: Liminka

Re: nD-Ristinolla

Post by Mickey » Tue Mar 22, 2011 5:58 pm

Jo ennen testaamista voin neliulotteisen ristinollan keksijänä (vaikkenkaan ensimmäisenä :D ) sanoa, että Jonez on oikeassa siinä, että kahdestaan pelatessa aloittajalle on varma voitto tiedossa, jos sen osaa hankkia. suosittelen, että vaihdat 3^n -kokoisesta kentästä 4^n -kokoiseen kenttään. Testannen peliä kohta Ikuisen aloittelijan kanssa, editoin sitten viestiini kommenttia.
EDIT:

Peli on hyvin toteutettu, mutta käyttöliittymä on hivenen epämiellyttävä, koska kaikkea ei näe kerralla. Tämän toteuttamiseen on varsin kätevä keino, jota en nyt osaa tässä selittää, mutta jonka näet sitten, kun 4-Dimensional Gamesin neliulotteinen ristinolla ilmestyy.

4-Dimensional Games:
Kotisivu (Täältä löydät tietoja sekä peliemme latauslinkit.)
Facebook-sivu (Täältä löydät esimerkiksi uutisia peliemme ja sivumme päivityksistä.)

User avatar
Jonez
Devoted Member
Posts: 575
Joined: Mon Aug 27, 2007 8:37 pm

Re: nD-Ristinolla

Post by Jonez » Tue Mar 22, 2011 11:45 pm

Ehkä tämä on täysin väärin ajateltu, mutta tässä on ensimmäinen asia joka tuli mieleen kun rupesin ajattelemaan helposti hahmotettavaa 4-ulotteista ristinollaa. Tässä kuvassa siis punainen (aloittaja) on juuri saavuttanut voiton.
Image
Ja tämähän on selvä parannusehdotus tähän kolmen tai neljän suoran 4-ulotteiseen ristinollaan, eikä näin ollen ole offtopikkia nähnytkään.
-Vuoden 2008 aloittelijan ystävä -palkinnon voittaja-
Image <- protestipelikilpailun voittaja.
Space War

User avatar
buke44
Active Member
Posts: 169
Joined: Sat May 23, 2009 8:10 pm
Location: Tampere

Re: nD-Ristinolla

Post by buke44 » Wed Mar 23, 2011 12:21 am

Noni tein 4-ruutuisen nD-ristinollan. Tavoitteena siis saada neljän suora

Code: Select all

SCREEN 400,500
FrameLimit 20

Type rasti
    Field sijainti //koordinaatit
    Field rn //1 = 0 2 = X
EndType 

kuvio=1

Global dimensions,win
Global asdd As String 

AddText "Valitse ulottuvuudet välillä 2-15"
Repeat
    s$=Input(":") 
    DrawScreen 
Until KeyHit (cbkeyenter)Or KeyHit (cbkeyreturn)

ClearText 
CloseInput 

dimensions=Int (s)

If dimensions>15 Or dimensions<2 Then MakeError "ulottuvuudet välillä 2-15"

Dim tempkoord (dimensions-1) As Byte

Dim tempkoord2 (dimensions-1)As Byte 

Dim tempkoord3 (dimensions-1)As Byte

Dim tempkoord4 (dimensions-1) As Byte 

Dim nytkoord (dimensions-1)

Dim koordtunnus (14) As String 
koordtunnus (0)="X"
koordtunnus (1)="Y"
koordtunnus (2)="Z"
For i=3 To 14
    koordtunnus (i)=Chr (i+62)
Next i

Dim koordohj (14) As String 
koordohj (0)="Mouse X"
koordohj (1)="Mouse Y"
koordohj (2)="Mouse Z"
koordohj (3)="Q/W"
koordohj (4)="A/S"
koordohj (5)="Z/X"
koordohj (6)="E/R"
koordohj (7)="D/F"
koordohj (8)="C/V"
koordohj (9)="T/Y"
koordohj (10)="G/H"
koordohj (11)="B/N"
koordohj (12)="U/I"
koordohj (13)="J/K"
koordohj (14)="M/,"

Dim ohj1 (11)
ohj1 (0)=16
ohj1 (1)=30
ohj1 (2)=44
ohj1 (3)=18
ohj1 (4)=32
ohj1 (5)=46
ohj1 (6)=20
ohj1 (7)=34
ohj1 (8)=48
ohj1 (9)=22
ohj1 (10)=36
ohj1 (11)=50

Repeat 
    nytkoord (0)=MouseX ()/100
    nytkoord (1)=MouseY ()/100
    If nytkoord (1)>3 Then nytkoord (1)=3
    
    If dimensions>2 Then 
        wheel=MouseMoveZ ()
        nytkoord (2)=nytkoord(2)+wheel
        If nytkoord (2)>3 Then nytkoord (2)=3
        If nytkoord (2)<0 Then nytkoord (2)=0
    EndIf
    
    If dimensions>3 Then 
        For i=3 To dimensions-1
            If KeyHit (ohj1(i-3)) Then nytkoord (i)=nytkoord (i)-1
            If KeyHit (ohj1(i-3)+1) Then nytkoord (i)=nytkoord (i)+1
            If nytkoord (i)>3 Then nytkoord (i)=3
            If nytkoord (i)<0 Then nytkoord (i)=0
        Next i
    EndIf 
    
    If MouseHit (1) Then 
        If uusrasti (kuvio)=0 Then 
            kuvio=kuvio+1
            If kuvio=3 Then kuvio=1
        EndIf 
    EndIf 
    
    If kuvio=1 Then Text 1,1,"risti" Else Text 1,1,"nolla"
    
    Color cbWhite
    Line 100,0,100,400
    Line 200,0,200,400
    Line 300,0,300,400
    Line 0,100,400,100
    Line 0,200,400,200
    Line 0,300,400,300
    Color cbRed
    Line 0,400,400,400
    Color cbWhite
    
    For i=0 To dimensions-1
        Text 0+RoundDown (i/5)*100,400+(i Mod 5)*20,koordtunnus (i)+":"+nytkoord (i)+","+koordohj (i)
    Next i

    For rasti1.rasti=Each rasti 
        getkoord (ConvertToInteger (rasti1),1)
        If dimensions>2 Then 
            nayta=1
            For i=2 To dimensions-1
                If Not tempkoord (i)=nytkoord (i) Then 
                    nayta=0
                EndIf
            Next i
             If nayta=1 Then    
                If rasti1\rn=2 Then Circle tempkoord (0)*100,tempkoord(1)*100,100,0
                If rasti1\rn=1 Then 
                    Line tempkoord (0)*100,tempkoord(1)*100,tempkoord (0)*100+100,tempkoord(1)*100+100
                    Line tempkoord (0)*100+100,tempkoord(1)*100,tempkoord (0)*100,tempkoord(1)*100+100
                EndIf 
            EndIf 
        Else 
            If rasti1\rn=2 Then Circle tempkoord (0)*100,tempkoord(1)*100,100,0
            If rasti1\rn=1 Then 
                Line tempkoord (0)*100,tempkoord(1)*100,tempkoord (0)*100+100,tempkoord(1)*100+100
                Line tempkoord (0)*100+100,tempkoord(1)*100,tempkoord (0)*100,tempkoord(1)*100+100
            EndIf 
        EndIf 
    Next rasti1
    If win=1 Then MakeError "Risti voitti"
    If win=2 Then MakeError "Nolla voitti"
    DrawScreen 
Forever 


Function getkoord (r,asd)   
    rasti1.rasti=ConvertToType (r)
    For i=0 To dimensions-1
        Select asd
            Case 1
                tempkoord (i)=PeekByte (rasti1\sijainti,i)
            Case 2
                tempkoord2 (i)=PeekByte (rasti1\sijainti,i)
            Case 3
                tempkoord3 (i)=PeekByte (rasti1\sijainti,i)
            Case 4
                tempkoord4 (i)=PeekByte (rasti1\sijainti,i)
        EndSelect 
    Next i
EndFunction 


Function uusrasti (rn) 
    For rasti1.rasti=Each rasti
        getkoord (ConvertToInteger (rasti1),1)
        eiok=0
        For i=0 To dimensions-1
            If tempkoord (i)<>nytkoord(i) Then 
                eiok=1
            EndIf 
        Next i
        If eiok=0 Then Return 1
    Next rasti1
    rasti1.rasti=New (rasti)
    rasti1\rn=rn
    rasti1\sijainti=MakeMEMBlock (dimensions-1)
    For i=0 To dimensions-1
        PokeByte rasti1\sijainti,i,nytkoord (i)
    Next i
    For rasti1.rasti=Each rasti
        getkoord (ConvertToInteger (rasti1),1)
        For rasti2.rasti=Each rasti
            If rasti2<>rasti1 Then 
                If rasti1\rn=rasti2\rn Then 
                    getkoord (ConvertToInteger (rasti2),2)
                    For rasti3.rasti=Each rasti
                        If rasti3<>rasti1 Then 
                            If rasti3<>rasti2 Then 
                                If rasti3\rn=rasti2\rn Then 
                                    getkoord (ConvertToInteger (rasti3),3)
                                    For rasti4.rasti=Each rasti
                                        If (rasti4<>rasti1 And rasti4<>rasti2)And rasti4<>rasti3 Then 
                                            If rasti4\rn=rasti3\rn Then 
                                                getkoord (ConvertToInteger (rasti4),4)
                                                sallit=1
                                                For i=0 To dimensions-1
                                                    v1=tempkoord(i)-tempkoord2(i)
                                                    v2=tempkoord2(i)-tempkoord3(i)
                                                    v3=tempkoord3(i)-tempkoord4(i)
                                                    If Not (v1=v2 And v2=v3) Then sallit=0
                                                Next i
                                                If sallit=1 Then win=rn
                                            EndIf 
                                        EndIf 
                                    Next rasti4
                                EndIf 
                            EndIf 
                        EndIf 
                    Next rasti3
                EndIf 
            EndIf 
        Next rasti2
    Next rasti1
EndFunction 

User avatar
Mickey
Newcomer
Posts: 33
Joined: Sat Feb 09, 2008 11:32 am
Location: Liminka

Re: nD-Ristinolla

Post by Mickey » Wed Mar 23, 2011 9:19 pm

Hienoa, että vaihdoit neljäksi. Mutta nyt, eilistä virkeämmällä mielellä voisin selittää, miten nD-ristinolla on yksinkertaisesti paras projisoida (toimii myös ruutupaperilla):
Otetaan aluksi 4*4-ruudukko. Se halutaan muuttaa kolmiulotteiseksi, jolloin siihen tulee neljä edellisen vaiheen näköistä kerrosta. Siispä 4*4-ruudukon alle piirretään vielä kolme samanlaista. Nyt halutaan kasvattaa pelilauta neliulotteiseksi. Tulee neljä edellisen vaiheen näköistä asiaa, joita voimme sanoa vaikkapa neliulotteisiksi hyperkerroksiksi (lähes hauskinta neliulotteisessa geometriassa on tunkea hyper-etuliitettä kaikkialle :D ). Niitä siis piirretään kolme äskeisen oikealle puolelle. Meillä on siis 16*16-ruudukko, joka jakaantuu kuuteentoista 4*4-ruudukkoon, ja joka esittää 4^4-ruudukkoa. Jos halutaan 5D-hyperkerroksia, lisätään ne taas edellisen alle, 6D-hyperkerrokset taas oikealle ja niin edelleen. Itse olen muistaakseni pelannut enimmillään 6-ulotteisena ja hyvin on toiminut.
4-Dimensional Games:
Kotisivu (Täältä löydät tietoja sekä peliemme latauslinkit.)
Facebook-sivu (Täältä löydät esimerkiksi uutisia peliemme ja sivumme päivityksistä.)

Post Reply

Who is online

Users browsing this forum: No registered users and 5 guests