nD-Ristinolla
Posted: Tue Mar 22, 2011 6: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.
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.
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