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