`Slideways
`Coding Challenge Entry
`By Patrick Lewis
`3/13/2005
`Update 3/15/2005
Sync On:Sync Rate 60:Autocam Off:Hide Mouse
Type Coordinates
   x as Float:y as Float:z as Float
Endtype
Global Object as Coordinates
 
Type Players
   Score as Integer:Color as String
Endtype
Dim O_Color(36) as String:Dim Blast(36):Dim ObjectSeq(6,6):Dim Player(2) as Players:Global Phase as Byte
Create Bitmap 1,512,512:Set Current bitmap 1:Box 0,0,511,511,RGB(192,192,192),RGB(221,221,221),RGB(192,192,192),RGB(255,255,255):Get Image 2,0,0,511,511:Set Current Bitmap 0:Delete Bitmap 1
b=1:For i =1 to 6:For j = 1 to 6:Make_Crystal(b):Position Object b,j*11-39,i*11-33,100:b=b+1:Next j:Next i
Make Object Cone 40,7.5:Make Object Cylinder 41,3:Make Mesh From Object 41,41:Add Limb 40,1,41:Delete Object 41:Delete Mesh 41:Offset Limb 40,0,0,4.5,0:Disable Object ZDepth 40
Make Camera 1:Color Backdrop 1,RGB(182,183,206):Set Camera to Image 1,1,512,512:Position Camera 1,0,0,200:Point Camera 1,0,0,0
Make Object Plain 42,200,150:Position Object 42,0,0,150:Texture Object 42,1:Set Object Cull 42,1:Turn Object Left 42,180:Set Object Emissive 42,RGB(110,110,110)
`Set Bump Mapping On 42,2
 
Do
`Select mode: Player vs Player or Player vs AI
 Mode = 1 ` 1=Player vs Player. 2=Player vs AI
 
 
 Phase = 1 ` 1=Player 1 choose color. 2=Player 2 choose color. 3=Player 1 turn. 4=Player 2 turn
 
 csx=Screen Width()/2:csy=Screen Height()/2
 Do
    `Controls
    Offx=Mousex()-csx
    Offy=Mousey()-csy
    Select Phase
       Case 1
          Set Cursor 0,0:Print "Player 1 Select Color"
          ypos=Int(Offy/11)*-11
          xpos=Int(Offx/11)*11-7
          ypos=Min_Max(ypos,-22,33)
          xpos=Min_Max(xpos,-29,26)
          Rotate Object 40,0,0,45
          Position Object 40,xpos+5,ypos-5,100
          If Mouseclick()=1
             O=Pick Object(Object Screen X(40)-10,Object Screen Y(40)-10,1,36)
             Player(1).Color=O_Color(O)
             Phase = 2
          Endif
       Endcase
       Case 2
          Set Cursor 0,0:Print "Player 2 Select Color"
          ypos=Int(Offy/11)*-11
          xpos=Int(Offx/11)*11-7
          ypos=Min_Max(ypos,-22,33)
          xpos=Min_Max(xpos,-29,26)
          Rotate Object 40,0,0,45
          Position Object 40,xpos+5,ypos-5,100
          If Mouseclick()=1
             O=Pick Object(Object Screen X(40)-10,Object Screen Y(40)-10,1,36)
             Player(2).Color=O_Color(O)
             If Player(2).Color<>Player(1).Color
                Phase = 4:Delay=9
             Else
                Player(2).Color=""
             Endif
          Endif
       Endcase
       Case Default
          Set Cursor 0,0:Print "Turn: Player "; Phase-2
          If abs(Offx)>Abs(Offy)
             ypos=Int(Offy/11)*-11
             ypos=Min_Max(ypos,-22,33)
             Position Object 40,40*((Offx>0)-(Offx<0)),ypos,100
             Rotate Object 40,0,0,90*((Offx<0)-(Offx>0))
          Else
             xpos=Int(Offx/11)*11-7
             xpos=Min_Max(xpos,-29,26)
             Position Object 40,xpos,40*((Offy<0)-(Offy>0))+5,100
             Rotate Object 40,0,0,180*(Offy>0)
          Endif
          If mouseclick()=1 And Click=0 And Delay=0
             Row=(Object Position Y(40)+33)/10
             Col=(Object Position X(40)+39)/10
             If Row=0 or Col=0 Then Click=-11 Else Click=11
             Delay=50
          Endif
       Endcase
    Endselect
 
    `Move crystals
    For i = 1 to 36
       Turn Object Right i,1
       OCol=(Object Position X(i)+39)/10
       ORow=(Object Position Y(i)+33)/10
       If Click<>0
          If Row=0 or Row=7
             If OCol=Col
                Rotate Object i,0,0,0
                Move Object Up i,((Click>0)-(Click<0))
             Endif
          Else
             If ORow=Row
                Rotate Object i,0,0,0
                Move Object Right i,((Click>0)-(Click<0))
             Endif
          Endif
       Else
          If Delay=49
             If OCol=0 Then Position Object i,6*11-39,Object Position Y(i),100:OCol=6
             If OCol=7 Then Position Object i,1*11-39,Object Position Y(i),100:OCol=1
             If ORow=0 Then Position Object i,Object Position X(i),6*11-33,100:ORow=6
             If ORow=7 Then Position Object i,Object Position X(i),1*11-33,100:ORow=1
             ObjectSeq(OCol,ORow)=i
          Endif
       Endif
    Next i
    L=0
    Select Delay
       Case 1
          L=Check_Elim()
       EndCase
       Case 2:If Phase=3 Then Phase=4 Else Phase=3
       Endcase
       Case 40:Check_Diag_Down():EndCase
       Case 42:Check_Diag_Up():EndCase
       Case 44:Check_Vertical():EndCase
       Case 46:Check_Horizontal():EndCase
       Case Default
          If Delay>10 And Delay<40
             BlastEm()
          Endif
       Endcase
    Endselect
    If Click<>0 Then Click=Click-(Click>0)+(Click<0) Else IF Delay>0 Then Delay=Delay-1
    Set Cursor 0,50
    Print "Player 1 Color: "; Player(1).Color;""
    Print "Player 2 Color: "; Player(2).Color;""
    Print ""
    Print "Player 1 Score: "; Player(1).Score
    Print "Player 2 Score: "; Player(2).Score
    Sync
    If L<>0 Then Exit
 Loop
 W=3-L
 Player(W).Score=Player(W).Score+100
 Win=((Player(2).Score>Player(1).Score)+1)*(Player(2).Score<>Player(1).Score)
 If Win
    Center Text Screen Width()/2,0,"Player "+str$(W)+" has Won!"
 Else
    Center Text Screen Width()/2,0,"It's a TIE!"
 EndIf
 Set Cursor 0,50
 Print "Player 1 Color: "; Player(1).Color;""
 Print "Player 2 Color: "; Player(2).Color;""
 Print ""
 Print "Player 1 Score: "; Player(1).Score
 Print "Player 2 Score: "; Player(2).Score
 Center Text Screen Width()/2,24,"Press 'N' to quit, or any key to Play Again!"
 Sync
 Wait key
 If Lower$(Inkey$())="n" Then End
Loop
 
Function Make_Crystal(ObjectID)
   Make Object Sphere ObjectID,10,3,4
   Color=Rnd(5)
   Restore Colors
   For c = 0 to Color
      Read O_Color(ObjectID),cr,cg,cb,er,eg,eb
   Next c
   Color Object ObjectID,rgb(cr,cg,cb)
   Set Object Emissive ObjectID,rgb(er,eg,eb)
   Set Alpha Mapping On ObjectID,80
   Set Object Cull ObjectID,0
   Blast(ObjectID)=0
Endfunction
 
Function Check_Horizontal()
Dim clrs(2) as String
For i = 1 to 6
   For j =1 to 4
      For test = 0 to 2
         clrs(test)=O_Color(ObjectSeq(i,j+test))
      Next test
      If clrs(0)=clrs(1) and clrs(1)=clrs(2)
         Plyr=Phase-2
         Oplyr=-Plyr+3
         If clrs(0)<>Player(Oplyr).Color
            For test=0 to 2
               Blast(ObjectSeq(i,j+test))=1
            Next test
         Endif
      Endif
   Next j
Next i
Endfunction
 
Function Check_Vertical()
Dim clrs(2) as String
For i = 1 to 6
   For j =1 to 4
      For test = 0 to 2
         clrs(test)=O_Color(ObjectSeq(j+test,i))
      Next test
      If clrs(0)=clrs(1) and clrs(1)=clrs(2)
         Plyr=Phase-2
         Oplyr=-Plyr+3
         If clrs(0)<>Player(Oplyr).Color
            For test=0 to 2
               Blast(ObjectSeq(j+test,i))=1
            Next test
         Endif
      Endif
   Next j
Next i
Endfunction
 
Function Check_Diag_Up()
Dim clrs(2) as String
For i = 1 to 4
   For j =1 to 4
      For test = 0 to 2
         clrs(test)=O_Color(ObjectSeq(i+test,j+test))
      Next test
      If clrs(0)=clrs(1) and clrs(1)=clrs(2)
         Plyr=Phase-2
         Oplyr=-Plyr+3
         If clrs(0)<>Player(Oplyr).Color
            For test=0 to 2
               Blast(ObjectSeq(i+test,j+test))=1
            Next test
         Endif
      Endif
   Next j
Next i
Endfunction
 
Function Check_Diag_Down()
Dim clrs(2) as String
For i = 3 to 6
   For j =1 to 4
      For test = 0 to 2
         clrs(test)=O_Color(ObjectSeq(i-test,j+test))
      Next test
      If clrs(0)=clrs(1) and clrs(1)=clrs(2)
         Plyr=Phase-2
         Oplyr=-Plyr+3
         If clrs(0)<>Player(Oplyr).Color
            For test=0 to 2
               Blast(ObjectSeq(i-test,j+test))=1
            Next test
         Endif
      Endif
   Next j
Next i
Endfunction
 
Function BlastEm()
   For i = 1 to 36
      If Blast(i)=1
         OS#=Object Size(i)-.3
         Scale Object i,OS#/20.0*100.0,OS#/20.0*100.0,OS#/20.0*100.0
         If Object Size(i)<2.0
            If O_Color(i)=Player(Phase-2).Color Then Player(Phase-2).Score=Player(Phase-2).Score+10
            Return_Object(i)
            Delete Object i
            Make_Crystal(i)
            Position Object i,Object.x,Object.y,Object.z
         Endif
      Endif
   Next i
EndFunction
 
Function Check_Elim()
   c1=0:c2=0
   For i = 1 to 36
      If O_Color(i)=Player(1).Color then c1=c1+1
      If O_Color(i)=Player(2).Color then c2=c2+1
   Next i
Lose=0
If c1<3 Then Lose=1
If c2<3 Then Lose=2
EndFunction Lose
 
Function Min_Max(Var1,Min,Max)
If Var1<Min then Var1=Min Else If Var1>Max Then Var1=Max
Endfunction Var1
 
Function Return_Object(ObjectID)
Object.x=Object Position X(ObjectID):Object.y=Object Position Y(ObjectID):Object.z=Object Position Z(ObjectID)
EndFunction
 
Colors:
Data "White",255,255,255,100,100,100,"Red",255,0,0,100,0,0,"Blue",0,0,255,0,0,06,"Green",0,255,0,0,100,0,"Yellow",255,255,0,100,100,0,"Pink",248,86,248,88,0,88