Page 1 of 2 12 LastLast
Results 1 to 10 of 17

Thread: Sudoku [game]

  1. #1
    thinBasic MVPs
    Join Date
    Oct 2012
    Location
    Germany
    Age
    54
    Posts
    1,526
    Rep Power
    170

    Sudoku [game]

    You like to solve sudoku-puzzles?

    24 kB of thinBasic-code to get busy:

    ' #Filename "Sudoku.tBasic"
    #MINVERSION 1.9.16.16
    
    Uses "TBGL"
    
    '[] Const
    Begin Const
      ' window-size:
      %Width       = 640
      %Height      = 640
      ' window-handle:
      %hWnd        = TBGL_CreateWindowEx(                 _
                     "thinBasic-Sudoku    [esc to exit]", _
                     %Width, %Height, 32,                 _
                     %TBGL_WS_WINDOWED | %TBGL_WS_CLOSEBOX | %TBGL_WS_DONTSIZE )  
      
      ' font-ids              
      %Font_Text   = TBGL_BuildFont(TBGL_FontHandle("Courier New", 16, %TBGL_BOLD), 1)
      %Font_Large  = TBGL_BuildFont(TBGL_FontHandle("Courier New", 36, %TBGL_BOLD), 2)
      %Font_Small  = TBGL_BuildFont(TBGL_FontHandle("Courier New", 11),             3)
      %Font_Digits = TBGL_BuildFont(TBGL_FontHandle("Wingdings",   24),             4)
      
      ' button-ids
      %btnEasy = 1
      %btnMedium
      %btnHard   
      %btnHelp
      %btnRestart   
      %btnNew  
      
    End Const
    
    ' dimensioning of globals follows type-definitions!
    ' find them at the end of the script
      
    ' --------------------------------------------------------------------------------------------------
    Function TBMain()
    ' --------------------------------------------------------------------------------------------------
      
      Local lMB           As Long   ' check left mouse-button
                                    ' -1 : up, release
                                    '  0 : not
                                    '  1 : down, push
                                    '  2 : hold
      
      Local lBtn         As Long    ' UI-button-index-counter
      
      ' --- clear keyboard-buffer 
      TBGL_ResetKeyState()
      ' --- display the window
      TBGL_ShowWindow
     
      ' --- TBGL setup:
      TBGL_ShowCursor(TRUE)
      TBGL_UseLighting FALSE
      TBGL_UseDepth FALSE
      TBGL_DepthFunc(%TBGL_ALWAYS)
      TBGL_UseTexturing(FALSE)
      TBGL_RenderMatrix2D(0, %Height, %Width, 0)
      TBGL_BackColor( 0, 60, 220 )
      
      ' --- setup global btn-buttons:
      btn(%btnEasy).sText    = "Easy"
      btn(%btnEasy).X1       = 60  : btn(%btnEasy).Y1    = 568
      btn(%btnEasy).X2       = 220 : btn(%btnEasy).Y2    = 596
      btn(%btnMedium).sText  = "Medium"
      btn(%btnMedium).X1     = 240 : btn(%btnMedium).Y1  = btn(%btnEasy).Y1 
      btn(%btnMedium).X2     = 400 : btn(%btnMedium).Y2  = btn(%btnEasy).Y2 
      btn(%btnMedium).Is     = TRUE
      btn(%btnHard).sText    = "Hard"
      btn(%btnHard).X1       = 420 : btn(%btnHard).Y1    = btn(%btnEasy).Y1 
      btn(%btnHard).X2       = 580 : btn(%btnHard).Y2    = btn(%btnEasy).Y2 
      btn(%btnHelp).sText    = "Help"
      btn(%btnHelp).X1       = 60  : btn(%btnHelp).Y1    = 600
      btn(%btnHelp).X2       = 220 : btn(%btnHelp).Y2    = 628
      btn(%btnRestart).sText = "Restart"
      btn(%btnRestart).X1    = 240 : btn(%btnRestart).Y1 = btn(%btnHelp).Y1 
      btn(%btnRestart).X2    = 400 : btn(%btnRestart).Y2 = btn(%btnHelp).Y2 
      btn(%btnNew).sText     = "New"
      btn(%btnNew).X1        = 420 : btn(%btnNew).Y1     = btn(%btnHelp).Y1 
      btn(%btnNew).X2        = 580 : btn(%btnNew).Y2     = btn(%btnHelp).Y2 
      
      ' --- Main-Loop
      
      While TBGL_IsWindow(%hWnd)
        
        
        TBGL_ClearFrame  
          ' --- draw the buttons:
          For lBtn = %BtnEasy To %BtnNew
            btn(lBtn).Render
          Next 
          ' --- draw the game-board:
          Sudoku.Render()
            
        TBGL_DrawFrame
        
        ' --- check input:
        If TBGL_GetWindowKeyState(%hWnd, %VK_ESCAPE) Then Exit While
        
        lMB = IIf(TBGL_GetWindowKeyState(%hWnd, %VK_LBUTTON), IIf(lMB < 1, 1, 2), IIf(lMB > 0, -1, 0))
        
        If lMB = 1 Then 
        ' = when left button went down
          
          If Not sudoku.Input Then
          ' = no input on the board
            Sudoku.ShowDigits = FALSE
            
            ' --- check if a button was clicked
            For lBtn = 1 To %BtnNew
              If Between(TBGL_MouseGetPosX, btn(lBtn).X1, btn(lBtn).X2 ) Then
                If Between(TBGL_MouseGetPosY, btn(lBtn).Y1, btn(lBtn).Y2 ) Then
                  ' = mouse points this button
                  Call "Click_" & btn(lBtn).sText    
                EndIf
              EndIf
            Next
          EndIf  
        EndIf
      Wend
      
    End Function
    
    ' --------------------------------------------------------------------------------------------------
    Sub Click_Easy()
    ' --------------------------------------------------------------------------------------------------
      ' set Sudoku.Mode to Easy
      If Sudoku.Mode <> 1 Then
        btn(%BtnEasy).Is   = TRUE
        btn(%BtnMedium).Is = FALSE
        btn(%BtnHard).Is   = FALSE
        Sudoku.Mode = 1
        Sudoku.NewBoard
      EndIf
      
    End Sub
    
    ' --------------------------------------------------------------------------------------------------
    Sub Click_Medium()
    ' --------------------------------------------------------------------------------------------------
      ' set Sudoku.Mode to Medium
      If Sudoku.Mode <> 2 Then
        btn(%BtnEasy).Is   = FALSE
        btn(%BtnMedium).Is = TRUE
        btn(%BtnHard).Is   = FALSE
        Sudoku.Mode = 2
        Sudoku.NewBoard
      EndIf
      
    End Sub
    
    ' --------------------------------------------------------------------------------------------------
    Sub Click_Hard()   
    ' --------------------------------------------------------------------------------------------------
      ' set Sudoku.Mode to Hard
      If Sudoku.Mode <> 3 Then
        btn(%BtnEasy).Is   = FALSE
        btn(%BtnMedium).Is = FALSE
        btn(%BtnHard).Is   = TRUE
        Sudoku.Mode = 3
        Sudoku.NewBoard
      EndIf
      
    End Sub
    
    ' --------------------------------------------------------------------------------------------------
    Sub Click_New()
    ' --------------------------------------------------------------------------------------------------
      ' call to start a new game
      Sudoku.NewBoard()
    
    End Sub
    
    ' --------------------------------------------------------------------------------------------------
    Sub Click_Help()
    ' --------------------------------------------------------------------------------------------------
      ' toggle visibility of possible numbers
      Btn(%BtnHelp).Is = Btn(%BtnHelp).Is XOR TRUE 
      Sudoku.Help = Btn(%BtnHelp).Is
    
    End Sub
    
    ' --------------------------------------------------------------------------------------------------
    Sub Click_Restart()
    ' --------------------------------------------------------------------------------------------------
      ' restart the current game
      Local x, y As Long
       
      Memory_Set(VarPtr(Sudoku.Visible(1,1)), Repeat$(81, MKL$(0)))
        
      For x = 1 To 9
        For y = 1 To 9
          If Sudoku.Fixed(x,y) Then
            sudoku.Visible(x,y) = sudoku.content(x,y)
          EndIf
        Next
      Next
    
    End Sub
    
    ' --------------------------------------------------------------------------------------------------
    Sub Click_Sudoku()
    ' --------------------------------------------------------------------------------------------------
      ' if a digit was clicked to place into selected field
      
      If Sudoku.SelX = 0 Or Sudoku.SelY = 0 Then Exit Sub
      
      Select Case Sudoku.SelDigit
        Case 10
          Sudoku.Visible(Sudoku.SelX, Sudoku.SelY) = 0    
        Case Else
          Sudoku.Visible(Sudoku.SelX, Sudoku.SelY) = Sudoku.SelDigit
      End Select
    
    End Sub
    
    
    
    ' ##################################################################################################
    Type tButton
    ' ##################################################################################################
    
      sText  As String 
      FontID As Long 
      
      X1     As Long
      Y1     As Long
      X2     As Long
      Y2     As Long
      Is     As Boolean  ' state-switch   
      
    ' --------------------------------------------------------------------------------------------------
      Function Render()
    ' --------------------------------------------------------------------------------------------------
        
        If Not Between(Me.FontID, 1, 4) Then 
          ' ensure valid font:
          Me.FontID = %Font_Text
        EndIf
        
        TBGL_SetActiveFont Me.FontID
        
        If Between(TBGL_MouseGetPosX, Me.X1, Me.X2) Then
          If Between(TBGL_MouseGetPosY, Me.Y1, Me.Y2) Then
            ' mouse points on Me:
            TBGL_Color 255, 0, 255
            TBGL_Rect Me.X1 - 2, Me.Y1 - 2, Me.X2 + 2, Me.Y2 + 2
          EndIf
        EndIf
       
        If Me.Is Then  
          ' "checked"
          TBGL_Color 80, 200, 40
        Else 
          ' "not checked"
          TBGL_Color 40, 80, 200
        EndIf 
        
        ' draw the button:
        TBGL_Rect Me.X1, Me.Y1, Me.X2, Me.Y2
        
        ' draw the caption:
        TBGL_Color 255, 255, 255
        TBGL_PrintFont2D Me.sText, 0.5 * (Me.X2 - Me.X1) + Me.X1, Me.Y2 - IIf(Me.FontID = %font_Digits, 1, 8), %TBGL_ALIGN_NONE, %TBGL_ALIGN_CENTER_DOWN
          
      End Function
    ' ..................................................................................................
    End Type
    ' ..................................................................................................
    
    ' ##################################################################################################
    Type tSudoku
    ' ##################################################################################################
      
      Content(9,9) As Long     ' real number that belongs here
      Visible(9,9) As Long     ' displayed number
      
      Fixed(9,9)   As Boolean  ' are these fields given visible by tSudoku.NewBoard()
      
      Group(9,9)   As Long     ' block-group of the tile(x,y)
      
      ' positions of the fields
      X1(9,9)      As Long
      Y1(9,9)      As Long
      X2(9,9)      As Long
      Y2(9,9)      As Long
      
      Help         As Boolean  ' display possible numbers
      
      Mode         As Long     ' 1 easy, 2 medium, 3 hard
      
      Digit(10)    As tButton
      
      ShowDigits   As Boolean  ' show digit-buttons to input numbers
      
      SelX         As Long     ' selected field
      SelY         As Long
      
      PointX       As Long     ' pointed field
      PointY       As Long
      
      SelDigit     As Long     ' clicked digit-button
      
      missing      As Long     ' = empty fields
      
       
    ' --------------------------------------------------------------------------------------------------
      Function _Create()
    ' --------------------------------------------------------------------------------------------------
        ' assign initial variables:
        
        Local x, y   As Long
        Local x1, y1 As Long     ' positions
        
        x1 = 64
        For x = 1 To 9
          y1 = 36
          
          For y = 1 To 9
           ' assign group-numbers:
            Me.Group(x, y) = (X-1)\3 + 1 + (Y-1)\3 * 3  
           ' positions:
            Me.X1(x,y) = x1
            Me.Y1(x,y) = y1
            Me.X2(x,y) = x1 + 48
            Me.Y2(x,y) = y1 + 48
            y1 += 56
            If Mod(y, 3) = 0 Then 
              y1 += 8
            EndIf
         
          Next
          x1 += 56
          If Mod(x, 3) = 0 Then 
            x1 += 8
          EndIf
         
        Next          
    
       ' setup digit-input-buttons caption: 
        For x = 1 To 9
          Me.Digit(x).sText = Chr$(x + 139)
          Me.Digit(x).FontID = %Font_Digits
        Next
        Me.Digit(10).sText = Chr$(161)
        Me.Digit(10).FontID = %Font_Digits
        
        Me.Mode = 2  ' medium difficulty at start
        
      End Function  
    
    
    ' --------------------------------------------------------------------------------------------------
      Function Render()
    ' --------------------------------------------------------------------------------------------------
        ' draw sudoku-fields including digit-buttons
        
        
        Static x, y, i, lTop        As Long
        Static sRow                 As String   ' possible numbers
        Static Sinus, Cosinus, lRot As Long     ' to move "Solved !!!"-text
        
        Me.PointX = 0
        Me.PointY = 0
        
         
        For x = 1 To 9
          If Between(TBGL_MouseGetPosX, Me.X1(x, 1), Me.X2(x, 1)) Then
            For y = 1 To 9
              If Between(TBGL_MouseGetPosY, Me.Y1(x, y), Me.Y2(x, y)) Then
                Me.PointX = X
                Me.PointY = Y
                Exit Exit For
              EndIf
            Next
          EndIf
        Next
        
        ' count down filled fields:
        Me.Missing = 81
        
        ' draw 9 * 9 fields:
          
        For x = 1 To 9
          For y = 1 To 9   
            If All( X = Me.SelX, _
                    Y = Me.SelY, _
                    Me.Fixed(x, y) = FALSE _
              ) Then 
                TBGL_Color 255, 0, 255
              TBGL_Rect Me.X1(x,y)-4, Me.Y1(x,y)-4, Me.X2(x,y)+4, Me.Y2(x,y)+4  
            EndIf
                   
            TBGL_Color 220, 220, 240
            TBGL_Rect Me.X1(x,y), Me.Y1(x,y), Me.X2(x,y), Me.Y2(x,y)  
          
            If Me.Visible(x,y) Then
              If Me.Fixed(x,y) Then
                TBGL_Color 0, 0, 0  
                Me.Missing -= 1
              Else
                If Me.IsCorrect( x, y) Then
                  TBGL_Color 0, 40, 190
                  Me.Missing -= 1
                Else 
                  TBGL_Color 240, 40, 0
                EndIf
              EndIf
              
              TBGL_SetActiveFont %Font_Large
              TBGL_PrintFont2D TStr$(Me.Visible(x,y)), Me.X1(x,y) + 8, Me.Y2(x,y) - 8
            ElseIf Me.Help Then
              
              TBGL_SetActiveFont %Font_Small
              TBGL_Color 220, 100, 60
              sRow = ""
              lTop = Me.Y1(x,y) + 13
              For i = 1 To 9
                sRow &= IIf$(Me.IsPossible(i, x, y), TStr$(i) & " ", "  ")
                If Mod(i, 3) = 0 Then
                  TBGL_PrintFont2D sRow, Me.X1(x,y) + 4, lTop
                  lTop += 15
                  sRow = ""
                EndIf
              Next
            EndIf
          Next
        Next
       
        If Me.Missing = 0 Then 
          ' = all fields filled in
          lRot += 1
          If lRot > 360 Then lRot -= 360
          
          Sinus   = %width/2  + Sin(lRot * M_PI/180) * 140
          Cosinus = %height/2 + Cos(lRot * M_PI/180) * 140
          
          TBGL_SetActiveFont %Font_Large
          TBGL_Color 0, 0, 0
          TBGL_PrintFont2D "Solved !!!", Sinus + 2, Cosinus + 2, %TBGL_ALIGN_NONE, %TBGL_ALIGN_CENTER_CENTER  
          TBGL_Color 230, 50, 0
          TBGL_PrintFont2D "Solved !!!", Sinus,     Cosinus,     %TBGL_ALIGN_NONE, %TBGL_ALIGN_CENTER_CENTER  
          
          Me.ShowDigits = FALSE
          Me.SelX = 0
          Me.SelY = 0
          
        EndIf
         
        If Me.ShowDigits Then 
          ' = await possible click onto a number to fill in on selected field
          ' draw the digit-buttons:
          For i = 1 To 10
            Me.Digit(i).Render()
          Next
        EndIf
        
      End Function  
    
    
    
    ' --------------------------------------------------------------------------------------------------
      Function Input() As Boolean
    ' --------------------------------------------------------------------------------------------------
        Static x, y As Long
        
        If Me.ShowDigits Then
          ' checck for click onto digit-buttons:
          For x = 1 To 10
            If Between(TBGL_MouseGetPosX, Me.Digit(x).X1, Me.Digit(x).X2) Then
              If Between(TBGL_MouseGetPosY, Me.Digit(x).Y1, Me.Digit(x).Y2) Then
                Me.SelDigit   = x
                Me.ShowDigits = FALSE
                click_Sudoku()
                ' --- click done
                Return TRUE  
              EndIf
            EndIf    
          Next
        Else
          Me.SelX = 0
          Me.SelY = 0
        EndIf
        
        
        If All(Me.PointX, Me.PointY) Then
          If Not Me.Fixed(Me.PointX, Me.PointY) Then
            
            ' remember pointed field 
            Me.SelX = Me.PointX
            Me.SelY = Me.PointY
            
            ' position digit-buttons around selected field
               
            Me.Digit(1).X1 = Me.X1(Me.PointX, Me.PointY) - 16 
            Me.Digit(1).Y1 = Me.Y1(Me.PointX, Me.PointY) - 26
            Me.Digit(1).X2 = Me.Digit(1).X1 + 25
            Me.Digit(1).Y2 = Me.Digit(1).Y1 + 25
            
            Me.Digit(2).X1 = Me.Digit(1).X1 - 16
            Me.Digit(2).Y1 = Me.Digit(1).Y2 
            Me.Digit(2).X2 = Me.Digit(2).X1 + 25
            Me.Digit(2).Y2 = Me.Digit(2).Y1 + 25
            
            Me.Digit(3).X1 = Me.Digit(2).X1 
            Me.Digit(3).Y1 = Me.Digit(2).Y2 + 2
            Me.Digit(3).X2 = Me.Digit(3).X1 + 25
            Me.Digit(3).Y2 = Me.Digit(3).Y1 + 25
            
            Me.Digit(4).X1 = Me.Digit(1).X1 
            Me.Digit(4).Y1 = Me.Digit(3).Y2 
            Me.Digit(4).X2 = Me.Digit(1).X2
            Me.Digit(4).Y2 = Me.Digit(4).Y1 + 25
            
            Me.Digit(5).X1 = Me.X1(Me.PointX, Me.PointY) + 12 
            Me.Digit(5).Y1 = Me.Y2(Me.PointX, Me.PointY) + 8
            Me.Digit(5).X2 = Me.Digit(5).X1 + 25
            Me.Digit(5).Y2 = Me.Digit(5).Y1 + 25
            
            Me.Digit(6).X1 = Me.X2(Me.PointX, Me.PointY) - 8
            Me.Digit(6).Y1 = Me.Digit(4).Y1
            Me.Digit(6).X2 = Me.Digit(6).X1 + 25
            Me.Digit(6).Y2 = Me.Digit(4).Y2
            
            Me.Digit(7).X1 = Me.Digit(6).X1 + 16 
            Me.Digit(7).Y1 = Me.Digit(3).Y1
            Me.Digit(7).X2 = Me.Digit(7).X1 + 25
            Me.Digit(7).Y2 = Me.Digit(3).Y2
            
            Me.Digit(8).X1 = Me.Digit(7).X1 
            Me.Digit(8).Y1 = Me.Digit(2).Y1
            Me.Digit(8).X2 = Me.Digit(7).X2
            Me.Digit(8).Y2 = Me.Digit(2).Y2
            
            Me.Digit(9).X1 = Me.Digit(6).X1 
            Me.Digit(9).Y1 = Me.Digit(1).Y1
            Me.Digit(9).X2 = Me.Digit(6).X2
            Me.Digit(9).Y2 = Me.Digit(1).Y2
            
            Me.Digit(10).X1 = Me.Digit(5).X1 
            Me.Digit(10).Y1 = Me.Y1(Me.PointX, Me.PointY) - 32
            Me.Digit(10).X2 = Me.Digit(5).X2
            Me.Digit(10).Y2 = Me.Digit(10).Y1 + 25
            
          
     
            Me.ShowDigits = TRUE
            
          EndIf 
          ' yes we had a click:
          Function = TRUE
        EndIf
        
        
      End Function  
    
    ' --------------------------------------------------------------------------------------------------
      Function GetPossible(ByRef n() As Long, _
                           ByVal X   As Long, _
                           ByVal Y   As Long  _
                           ) As Long
    ' --------------------------------------------------------------------------------------------------
        
        ' n() will receive all possible numbers for x,y
        ' returns count of possibilities
        
        Local i, lResult As Long
        
        
        For i = 1 To 9
          If Not Me.IsInGroup( i, Me.Group(x,y) ) Then
            If Not Me.IsInX(i, x) Then
              If Not Me.IsInY(i, y) Then
                lResult += 1
                n(lResult) = i
              EndIf
            EndIf
          EndIf
        Next   
        
        Function = lResult
           
      End Function  
    
    ' --------------------------------------------------------------------------------------------------
      Function IsPossible(ByVal n As Long, _
                          ByVal X As Long, _
                          ByVal Y As Long  _
                           ) As Boolean
    ' --------------------------------------------------------------------------------------------------
        
        ' returns if number n were possible at x,y
        
        If Not Me.IsInGroup( n, Me.Group(x,y) ) Then
          If Not Me.IsInX(n, x) Then
            If Not Me.IsInY(n, y) Then
              Function = TRUE
            EndIf
          EndIf
        EndIf
           
      End Function  
    
    ' --------------------------------------------------------------------------------------------------
      Function IsInX(ByVal n As Long, _ 
                     ByVal x As Long  _
                     ) As Boolean
    ' --------------------------------------------------------------------------------------------------
      ' check if number n is already in column x   
        
        Local y As Long
        
        For y = 1 To 9
          If Me.Visible(x, y) = n Then
            Return TRUE
          EndIf
        Next
           
      End Function  
                       
    ' --------------------------------------------------------------------------------------------------
      Function IsInY(ByVal n As Long, _ 
                     ByVal y As Long  _
                     ) As Boolean
    ' --------------------------------------------------------------------------------------------------
      ' check if number n is already in row y  
        Local x As Long
        
        For x = 1 To 9
          If Me.Visible(x, y) = n Then
            Return TRUE
          EndIf
        Next 
           
      End Function  
    
    ' --------------------------------------------------------------------------------------------------
      Function IsInGroup(ByVal n     As Long, 
                         ByVal group As Long _
                         ) As Boolean
    ' --------------------------------------------------------------------------------------------------
      ' check if number n is already in the given group  
       
        
        Local x, y As Long
        
        For x = 1 To 9
          For y = 1 To 9
            If Me.Group(x,y) = group Then
              If Me.Visible(x, y) = n Then
                Return TRUE
              EndIf
            EndIf
          Next
        Next
           
      End Function  
    
    ' --------------------------------------------------------------------------------------------------
      Function IsCorrect(ByVal X As Long, _
                         ByVal Y As Long  _
                         ) As Boolean
    ' --------------------------------------------------------------------------------------------------
        
        ' returns if placed number is correct at x, y
        Static lX, lY As Long
         
        
        
        For lX = 1 To 9
          If lX <> x Then
            If Me.Visible(lX, y) = Me.Visible(x,y) Then Return FALSE
          EndIf
        Next
               
        For lY = 1 To 9
          If lY <> y Then
            If Me.Visible(x, lY) = Me.Visible(x,y) Then Return FALSE
          EndIf
        Next
        
        For lX = 1 To 9
          For lY = 1 To 9
            If All( lX            <> x,             _
                    lY            <> y,             _
                    Me.Group(x,y) = Me.Group(lX,lY) _
                   ) Then
              If Me.Visible(lX, lY) = Me.Visible(x,y) Then Return FALSE
            EndIf
          Next
        Next
        
        Function = TRUE
           
      End Function  
                       
    ' --------------------------------------------------------------------------------------------------
      Function NewBoard() 
    ' --------------------------------------------------------------------------------------------------
        
        ' starts a new game
        
        Local i, x, y, num(9)      As Long
        Local finish               As Boolean
        
        If TBGL_IsWindow(%hWnd) Then
          TBGL_ClearFrame
            TBGL_SetActiveFont %Font_Large
            TBGL_Color 0, 20, 60
            TBGL_PrintFont2D "Please wait", 161, 381
            TBGL_Color 200, 240, 200
            TBGL_PrintFont2D "Please wait", 160, 380
          TBGL_DrawFrame
        EndIf
        
        
        Randomize
         
        While Not finish  
          ' clear visible numbers:
          Memory_Set(VarPtr(Me.Visible(1,1)), Repeat$(81, MKL$(0)))
          
          For y = 1 To 9
            For x = 1 To 9
              i = Me.GetPossible(num, x, y)  
              If Not i Then Exit Exit For
              ' pick random a number of what's possible
              Me.Visible(x, y) = num(Rnd(1, i))
              finish = All( x = 9, y = 9)
            Next
          Next
        Wend
        ' all numbers placed now
        
        ' set calculated content, hide visible, erase fixed
        Memory_Set(VarPtr(Me.Content(1,1)), Memory_Get(VarPtr(Me.Visible(1,1)), 324))
        Memory_Set(VarPtr(Me.Visible(1,1)), Repeat$(81, MKL$(0)))
        Memory_Set(VarPtr(Me.Fixed(1,1)),   Repeat$(81, MKI$(0)))
         
       
         ' total count of visible fields depending on mode:
        i = 29 + (3 - Me.Mode) * 5 + Rnd(1, 4 - Me.Mode)
        x = 0
        y = 0
    
        While i > 0
          x += Rnd(1, 2)
          If x > 4 Then x = 0
          y += Rnd(1, 2)
          If y > 4 Then y = 0
    
          If x Or y Then
            If Rnd(1, 2) = 1 Then
              If Not Me.Fixed(5+x, 5+y) Then
                Me.Fixed(5+x,5+y) = TRUE
                Me.Visible(5+x,5+y) = Me.Content(5+x,5+y)
                i -= 1
              EndIf 
              If Not Me.Fixed(5-x, 5-y) Then
                Me.Fixed(5-x,5-y) = TRUE
                Me.Visible(5-x,5-y) = Me.Content(5-x,5-y)
                i -= 1
              EndIf 
            EndIf
    
            If i < 1 Then Exit While
    
            If Rnd(1, 2) = 1 Then
              If Not Me.Fixed(5+x, 5-y) Then
                Me.Fixed(5+x,5-y) = TRUE
                Me.Visible(5+x,5-y) = Me.Content(5+x,5-y)
                i -= 1
              EndIf 
              If Not Me.Fixed(5-x, 5+y) Then
                Me.Fixed(5-x,5+y) = TRUE
                Me.Visible(5-x,5+y) = Me.Content(5-x,5+y)
                i -= 1
              EndIf 
            EndIf
          EndIf  
        Wend
        
        Me.SelX = 0
        Me.SelY = 0
        
      End Function  
       
    ' ..................................................................................................
    End Type  
    ' ..................................................................................................
    
    '[] Global 
    
    Global Sudoku       As tSudoku
    Global Btn(%BtnNew) As tButton
                                                                                                         
    ' :::::::::::::::::::::::::::::::::::::>> The End <<::::::::::::::::::::::::::::::::::::::::::::::::
    
    It took me almost 6 hours to write this
    Attached Images Attached Images
    Last edited by ReneMiner; 03-03-2016 at 12:05.
    I think there are missing some Forum-sections as beta-testing and support

  2. #2
    Member
    Join Date
    Nov 2012
    Location
    Missouri, USA
    Posts
    113
    Rep Power
    29
    Rene,

    Pardon, my language, but, "Damn, you're good!!" It is a great program. Six(60) hours to write; it would have taken me 6 months.

    My thinBasic I was running would not run or bundle it. I was prompted that 1.9.16.16 was required. I was still running 1.9.16.0. But I must have missed something about that version. I could exit it, but when I tried to install 1.9.16.16 it indicated it was still running. But I could not find it running; not even with Task Manager. I had to restart my laptop before I could install 1.9.16.16.

    BTW How do I select all your code at one time?

    Bill
    Last edited by Billbo; 25-02-2016 at 22:53.

  3. #3
    thinBasic MVPs
    Join Date
    Oct 2012
    Location
    Germany
    Age
    54
    Posts
    1,526
    Rep Power
    170
    double-click to select all..
    guess it will run with all 1.9.16-versioons. Just edit the first line
    I think there are missing some Forum-sections as beta-testing and support

  4. #4
    Member
    Join Date
    Nov 2012
    Location
    Missouri, USA
    Posts
    113
    Rep Power
    29
    Rene,

    Do not remove the line. If you read my reply close enough, you will notice that it would not run or bundle in 1.9.16.0.

    Thanks for the info about coping the code.

    Bill

  5. #5
    ReneMiner: It took me almost 6 hours to write this
    it will take me one century to write this
    certainly i will use some of the code parts someday
    thanks

  6. #6
    Member
    Join Date
    Nov 2012
    Location
    Missouri, USA
    Posts
    113
    Rep Power
    29
    Rene,

    I am playing a game, but I want to save it and come back later. How do I do that?

    Bill

  7. #7
    thinBasic MVPs
    Join Date
    Oct 2012
    Location
    Germany
    Age
    54
    Posts
    1,526
    Rep Power
    170
    sorry Bill, not possible yet. I will add save and load tommorow. Promise!
    I think there are missing some Forum-sections as beta-testing and support

  8. #8
    thinBasic MVPs
    Join Date
    Oct 2012
    Location
    Germany
    Age
    54
    Posts
    1,526
    Rep Power
    170
    Good morning!

    Attached the promised upgrade: now you may load & save your games.

    EDIT: attachement replaced
    Attached Files Attached Files
    Last edited by ReneMiner; 03-03-2016 at 12:03.
    I think there are missing some Forum-sections as beta-testing and support

  9. #9
    Member
    Join Date
    Nov 2012
    Location
    Missouri, USA
    Posts
    113
    Rep Power
    29
    Rene,

    Thanks a lot. Works great!!

    Bill

  10. #10
    thinBasic author ErosOlmi's Avatar
    Join Date
    Sep 2004
    Location
    Milan - Italy
    Age
    57
    Posts
    8,777
    Rep Power
    10
    Hi René,

    can I include this script in standard thinBasic distribution under \SampleScripts\OOP\?
    It is a great example of TBGL and OOP.

    Thanks
    Eros
    www.thinbasic.com | www.thinbasic.com/community/ | help.thinbasic.com
    Windows 10 Pro for Workstations 64bit - 32 GB - Intel(R) Xeon(R) W-10855M CPU @ 2.80GHz - NVIDIA Quadro RTX 3000

Page 1 of 2 12 LastLast

Similar Threads

  1. first puzzle : sudoku
    By TomLebowski in forum UI (User Interface)
    Replies: 1
    Last Post: 10-01-2010, 11:59
  2. Game: UFO on the run
    By peter in forum Sources, Templates, Code Snippets, Tips and Tricks, Do you know ...
    Replies: 19
    Last Post: 27-10-2008, 21:59
  3. Game: Game modes
    By Michael Hartlef in forum CM contest 2009
    Replies: 16
    Last Post: 05-10-2008, 04:58
  4. Fun game
    By Michael Clease in forum Gaming
    Replies: 4
    Last Post: 02-06-2008, 07:21
  5. A little but very serious game in 96k
    By ErosOlmi in forum Gaming
    Replies: 3
    Last Post: 12-05-2007, 20:24

Members who have read this thread: 0

There are no members to list at the moment.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •