;- Norm's Sodoku Math Lib


;- spot Structure
Structure Spot
  Value.l     ; value assigned to the spot
  Flag.l      ; non zero if this is original setting (readonly)
  Color.l     ; assigned player color (0 if original)
EndStructure
Structure Thought
  Value.l     ; current value tryied in this spot
  Start.l     ; initial value first tryied
  x.l
  y.l         ; location tryied
  Flag.l      ; 0,1,2 (thought,player,initial)
EndStructure

Global Dim Grid.Spot(8,8)
Global NewList Think.Thought()


Procedure.l CompileMode()
  FN$=UCase(GetFilePart(ProgramFilename() ))
  If Left(FN$,9)="PUREBASIC"
    ProcedureReturn 1
  EndIf
EndProcedure
Global RunPath.s=GetPathPart(ProgramFilename())

If CompileMode()
  RunPath=Left(RunPath,Len(RunPath)-1)
  RunPath=GetPathPart(RunPath)+"Sodoku\"
EndIf
;Debug Runpath
SetCurrentDirectory(RunPath)
Global MasterSave.s=Runpath+"Masters\"
Global GameSave.s=RunPath+"Saves\"

#Master="Master (*.sms)|*.sms|All Sodoku (*.sms,*.ssv)|*.sms;*.ssv|All files (*.*)|*.*"
#Saves="Save Files (*.ssv)|*.ssv|All Sodoku (*.sms,*.ssv)|*.sms;*.ssv|All files (*.*)|*.*"

Procedure DebugGrid()
  For y=0 To 8
    m$=""
    For x=0 To 8
      m$=M$+Str(Grid(x,y)\Value)
    Next x
    Debug m$
  Next y
EndProcedure

Procedure ClearGrid()
  For y=0 To 8
    For x=0 To 8
      Grid(x,y)\Value=0
      Grid(x,y)\Flag=0
      Grid(x,y)\Color=0
    Next x
  Next y
  ClearList(Think())
EndProcedure
Procedure CopyGrid2Thought()
  ClearList(Think())
  For y=0 To 8
    For x=0 To 8
      If Grid(x,y)\Value
        AddElement(Think())
        Think()\Value=Grid(x,y)\Value
        Think()\Start=Think()\Value
        Think()\x=x
        Think()\y=y
        If Grid(x,y)\Flag
          Think()\Flag=2
        Else
          Think()\Flag=1
        EndIf
      EndIf      
    Next x
  Next y
  ;and we need to sort the list, descending order
  ;this way we can change the user's guess before the original geusses
  SortStructuredList(Think(), 1, OffsetOf(Thought\Flag), #PB_Sort_Long)
 
EndProcedure
Procedure.l ValidSpot(x.l,y.l,v.l)
  If Grid(x,y)\Value
    ProcedureReturn #False
  EndIf
  ;is column/row free of this value
  For c2=0 To 8
    If Grid(x,c2)\Value=v
      ProcedureReturn #False
    EndIf
    If Grid(c2,y)\Value=v
      ProcedureReturn #False
    EndIf
  Next c2
  ;check if box is free of value
  gx=Int(x/3)
  gy=Int(y/3)
  bx=gx*3
  by=gy*3
  ex=bx+2
  ey=by+2
  ;Debug "Box Test X="+Str(bx)+Str(ex)+" Y="+Str(by)+Str(ey)
  For tx=bx To ex
    For ty=by To ey
      If Grid(tx,ty)\Value=v
        ProcedureReturn #False
      EndIf
    Next ty
  Next tx
  ProcedureReturn #True      
EndProcedure
Procedure.l SaveGame(mode.l)
  ;mode=1 to save game as a game starting point (master)
  If Mode
    ;Debug RunPath+"m001.sms"
    fn.s=SaveFileRequester("Save master sodoku file",MasterSave+"*.sms",#Master,0)
  Else
    fn.s=SaveFileRequester("Game save file",GameSave+"*.ssv",#Saves,0)
  EndIf
  If fn
    If GetExtensionPart(fn)=""
      If mode
        fn=fn+".sms"
      Else
        fn=fn+".ssv"
      EndIf
    EndIf
    If CreateFile(1,fn)
      ;Debug "Saving"
      For y=0 To 8
        ;m$=""
        For x=0 To 8
          WriteStringN(1,Str(Grid(x,y)\Value))
          If Grid(x,y)\Value
            If Grid(x,y)\Color=0
              Grid(x,y)\Flag=0-Grid(x,y)\Value
            EndIf
            WriteStringN(1,Str(Grid(x,y)\Flag))
            WriteStringN(1,Str(Grid(x,y)\Color))
          Else
            Grid(x,y)\Flag=0
            Grid(x,y)\Color=0
            WriteStringN(1,"0")
            WriteStringN(1,"0")
          EndIf
          ;m$=m$+Str(grid(x,y)\value)
        Next x
        ;Debug m$
      Next y
      CloseFile(1)
      ProcedureReturn #True
    Else
      ProcedureReturn #False
    EndIf
  Else
    ProcedureReturn #False
  EndIf
EndProcedure
Procedure LoadGame(mode.l)
  ;mode=1 to load a game from a master, 0 to load a saved game
  If Mode
    ;Debug RunPath+"m001.sms"
    fn.s=OpenFileRequester("Load master sodoku file",MasterSave+"*.sms",#Master,0)
  Else
    ;Debug RunPath+"m001.sms"
    fn.s=OpenFileRequester("Load game save file",GameSave+"*.ssv",#Saves,0)
  EndIf
  If fn    
    If OpenFile(1,fn)
      ;Debug "loading"
      For y=0 To 8
        ;m$=""
        For x=0 To 8
          Grid(x,y)\Value=Val(ReadString(1))
          If Grid(x,y)\Value
            Grid(x,y)\Flag=Abs(Val(ReadString(1)))
            Grid(x,y)\Color=Val(ReadString(1))
            If Grid(x,y)\Color=0
              Grid(x,y)\Flag=0-Grid(x,y)\Value
            EndIf
            If Grid(x,y)\Flag+mode
              Grid(x,y)\Color=0
              Grid(x,y)\Flag=0-Grid(x,y)\Value            
            EndIf
          Else
            Grid(x,y)\Flag=0
            Grid(x,y)\Color=0
            x$=ReadString(1)
            x$=ReadString(1)
          EndIf
          ;m$=m$+Str(grid(x,y)\Value)
        Next x
        ;Debug m$
      Next y
      CloseFile(1)
      ;check if grid is full
      ;Debug "Game loaded"
      For y=0 To 8
        For x=0 To 8
          If Grid(x,y)\Value=0
            ;Debug "Game not full"
            ProcedureReturn #True
          EndIf          
        Next x
      Next y
      ;grid is full, so prepare for play
      ;Debug "deleting some spots"
      SV=40+(15*Skill)
      For x=0 To 8
        For y=0 To 8
          If Random(80)>SV
            Grid(x,y)\Value=0
            Grid(x,y)\Flag=0
          EndIf
        Next y
      Next x
      
      ProcedureReturn #True
    Else
      ProcedureReturn #False
    EndIf
  Else
    ProcedureReturn #False
  EndIf
EndProcedure
Procedure.l PromptForSave(mode.l)
  Select MessageRequester("Waffle's Sodoku","Do you wish to save this game?",#MB_YESNOCANCEL)
    Case #IDYES
      ProcedureReturn SaveGame(mode)
    Case #IDNO
      ProcedureReturn #True
    Case #IDCANCEL
      ProcedureReturn #False
  EndSelect
EndProcedure
Procedure.l SolveGame()
  ;this attempts to solve the current game
  ;based on current settings.
  CopyGrid2Thought()
  ProgressWindow()
  Repeat
    ;locate a blank spot
    For x=0 To 8
      For y=0 To 8
        If Grid(x,y)\Value=0
          Break 2
        EndIf
      Next y
    Next x
    If x>8
      ;CallDebugger
      RestoreWindow()
      ProcedureReturn #True
    EndIf
    v.l=Random(8)+1
    For try=1 To 10
      If ValidSpot(x,y,v)
        Grid(x,y)\Value=v        
        Grid(x,y)\Flag=0-v
        AddElement(Think())
        Think()\Value=v
        Think()\Start=v
        Think()\x=x
        Think()\y=y
        Break 1
      EndIf
      v+1
      If v>9
        v=1
      EndIf
    Next try
    If try>10
      ;no valid move
      ;start changing previous moves and see the happs
      While LastElement(Think())
        v=Think()\Value
        Repeat
          v+1
          If v>9
            v=1
          EndIf
          If ValidSpot(Think()\x,Think()\y,v)
            think()\Value=v
            Grid(Think()\x,Think()\y)\Value=v
            If v<>Think()\start
              Break 2
            EndIf
          EndIf
        Until v=Think()\Start
        Grid(Think()\x,Think()\y)\Value=0
        Grid(Think()\x,Think()\y)\Flag=0
        DeleteElement(Think())
      Wend      
    EndIf
    If PackerProgress(x*10)=0
      ;CallDebugger
      RestoreWindow()
      ProcedureReturn #False
    EndIf
  Until x>8
  ;CallDebugger
  RestoreWindow()
  ProcedureReturn true
EndProcedure
Procedure NewGame()
  ;this attemps to create a "new master"
  ;and check to see if the master is solvable
  time.l=GetTickCount_()
  ClearGrid()
  If SolveGame()
    ;we auto save these as master
    OpenPreferences(RunPath+"WSodoku.ini")
    mfn.s=ReadPreferenceString("LastSave","001")
    Repeat
      If FileSize(MasterSave+mfn+".sms")=-1
        WritePreferenceString("LastSave",mfn)
        Break 1
      EndIf
      v=Val(mfn)+1
      mfn=Right("000"+Str(v),3)
    Until v>999
    ClosePreferences()
    If v<=999   
      fn.s=MasterSave+mfn+".sms"
      If CreateFile(1,fn)
        For y=0 To 8
          For x=0 To 8
            WriteStringN(1,Str(Grid(x,y)\Value))
            WriteStringN(1,Str(Grid(x,y)\Flag))
            WriteStringN(1,Str(Grid(x,y)\Color))  
          Next x
        Next y
        CloseFile(1)
      EndIf
    EndIf
    msg.s="Solution Found in "+Str(Int(GetTickCount_()-time)/1000)+Chr(10)
    msg=msg+"Do you wish to play this?"
    If MessageRequester("Deep Thought",msg,#MB_YESNO)=#IDYES
      ;grid is full, so prepare for play
      SV=40+(15*Skill)
      For x=0 To 8
        For y=0 To 8
          If Random(80)>SV
            Grid(x,y)\Value=0
            Grid(x,y)\Flag=0
          EndIf
        Next y
      Next x
    EndIf    
  Else
    MessageRequester("Deep Thought","No solution on new game??")
  EndIf
  
EndProcedure