&ANALYZE-SUSPEND _VERSION-NUMBER UIB_v9r12 GUI &ANALYZE-RESUME &Scoped-define WINDOW-NAME Sudoku &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS Sudoku /*------------------------------------------------------------------------ File : Sudoku.w Author : Richard Elvin Created : January 2006 Usage : Create a Shortcut with the following properties Target: <%DLC%>/bin/prowin32.exe -rand 2 -p sudoku.w Start in: The -rand 2 is important or you get the same one every time! Also works with webclient, Target: "\bin\prowc.exe" -rand 2 -p sudoku.w So you don't need a full progress installation. ------------------------------------------------------------------------*/ CREATE WIDGET-POOL. /* *************************** Definitions ************************** */ /* Set Rankings to zero to stop the saving of best times, or set it to the * number of best times to store --- */ &SCOPED-DEFINE BestTimesFile sudoku.besttimes.txt &SCOPED-DEFINE Rankings 10 /* This writes every game to the history file as it is generated, you can * then export them all to Excel, 6 per page --- */ &SCOPED-DEFINE HistoryFile sudoku.history.txt &SCOPED-DEFINE HistoryOn YES &SCOPED-DEFINE csvRows fiRow1, fiRow2, fiRow3, fiRow4, fiRow5,~ fiRow6, fiRow7, fiRow8, fiRow9 /* -----=====<<<<< "TWEEKS" >>>>>=====----- * * These constants are used to "tweek" the generation of the grid. * Research has been conducted to find optimum values for fastest * grid generation. They have the following meaning * * NumCellsToTry * - The number of cells to try placing a random number in before giving * up and assuming the grid cannot be filled. The grid is then wiped * and filling starts again. * * NumBlanksToTry * - Number of different cells to try blanking before assuming that * blanking anymore will make the puzzle insolvable. * There's a trade-off here. Increasing this parameter causes the * generation of the grid to take longer, but decreasing it makes * the grid too easy to solve. * If the difficulty of a grid is measured by the number of blanks * (more blanks = harder puzzle) then presumably there's a value * for the parameter beyond which we don't get more blanks. * The puzzle is as hard as we can make it. * Trying various values and plotting on a graph versus NumBlanks * shows the optimum to be about 50, beyong that it's taking more * time for little benifit in terms of puzzle quality. */ &SCOPED-DEFINE NumCellsToTry 46 &SCOPED-DEFINE NumBlanksToTry 50 /* ---==< Variables Scoped at Procedure Level >==--- */ /* Used in many procedures... */ DEFINE VARIABLE iRow AS INTEGER NO-UNDO. DEFINE VARIABLE iCol AS INTEGER NO-UNDO. DEFINE VARIABLE iLoop1 AS INTEGER NO-UNDO. DEFINE VARIABLE iLoop2 AS INTEGER NO-UNDO. DEFINE VARIABLE iTempVal AS INTEGER NO-UNDO. /* For completion message... */ DEFINE VARIABLE iStartTime AS INTEGER NO-UNDO. DEFINE VARIABLE iMinimizedTime AS INTEGER NO-UNDO. DEFINE VARIABLE iGameTime AS INTEGER NO-UNDO. DEFINE VARIABLE iHints AS INTEGER NO-UNDO. DEFINE VARIABLE iErrors AS INTEGER NO-UNDO. /* For Best times... */ DEFINE VARIABLE iRank AS INTEGER NO-UNDO. DEFINE VARIABLE cRankTitle AS CHARACTER NO-UNDO. DEFINE VARIABLE cName AS CHARACTER FORMAT "x(12)" LABEL "Name" VIEW-AS FILL-IN SIZE 15.6 BY 1 NO-UNDO. /* ------====<< Temp-Tables >>====------ */ DEFINE TEMP-TABLE ttCell NO-UNDO FIELD RowNum AS INTEGER FIELD ColNum AS INTEGER FIELD SqrNum AS INTEGER FIELD CelVal AS INTEGER FIELD whCell AS WIDGET-HANDLE INDEX PriKey IS PRIMARY UNIQUE RowNum ColNum INDEX RowKey RowNum CelVal INDEX ColKey ColNum CelVal INDEX SqrKey SqrNum CelVal INDEX ValKey CelVal. DEFINE TEMP-TABLE BkUpCell NO-UNDO FIELD RowNum AS INTEGER FIELD ColNum AS INTEGER FIELD CelVal AS INTEGER INDEX BackKey IS PRIMARY UNIQUE RowNum ColNum. DEFINE TEMP-TABLE ttRanking NO-UNDO FIELD Rank AS INTEGER FIELD Player AS CHARACTER FIELD GameTime AS INTEGER INDEX TimeKey IS PRIMARY GameTime INDEX RankKey IS UNIQUE Rank. DEFINE TEMP-TABLE BkUpRanking NO-UNDO LIKE ttRanking. /* ------====<< Buttons >>====------ */ DEFINE BUTTON btnOK AUTO-GO LABEL "OK" SIZE 15 BY 1.14 BGCOLOR 8. /* ------====<< Frames >>====------ */ DEFINE FRAME fRanking cName AT ROW 1.8 COL 10 COLON-ALIGNED btnOK AT ROW 3.52 COL 12 SPACE(10) SKIP(0.1) WITH VIEW-AS DIALOG-BOX KEEP-TAB-ORDER SIDE-LABELS NO-UNDERLINE THREE-D SCROLLABLE TITLE cRankTitle DEFAULT-BUTTON BtnOK. /* fRanking triggers... */ ON 'CHOOSE' OF btnOK IN FRAME fRanking OR 'RETURN' OF cName IN FRAME fRanking DO: APPLY 'GO' TO FRAME fRanking. RETURN. END. ON 'WINDOW-CLOSE':U OF FRAME fRanking DO: APPLY 'CHOOSE':U TO btnOK IN FRAME fRanking. RETURN NO-APPLY. END. ON 'GO':U OF FRAME fRanking DO: ASSIGN FRAME fRanking cName. DISABLE ALL WITH FRAME fRanking. HIDE FRAME fRanking. FIND FIRST ttRanking WHERE ttRanking.Rank = iRank. ASSIGN ttRanking.Player = cName. END. /* To flash taskbar icon when generation complete */ PROCEDURE GetParent EXTERNAL "user32.dll" : DEFINE INPUT PARAMETER ipWindow AS LONG. DEFINE RETURN PARAMETER ipParent AS LONG. END PROCEDURE. PROCEDURE FlashWindowEx EXTERNAL "user32.dll": DEFINE INPUT PARAMETER ipWindow AS MEMPTR. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK /* ******************** Preprocessor Definitions ******************** */ &Scoped-define PROCEDURE-TYPE Window &Scoped-define DB-AWARE no /* Name of designated FRAME-NAME and/or first browse and/or first query */ &Scoped-define FRAME-NAME DEFAULT-FRAME /* Standard List Definitions */ &Scoped-Define ENABLED-OBJECTS RECT-134 RECT-135 RECT-136 RECT-137 RECT-138 ~ RECT-139 RECT-140 RECT-141 RECT-142 fiRow1[1] fiRow1[2] fiRow1[3] fiRow1[4] ~ fiRow1[5] fiRow1[6] fiRow1[7] fiRow1[8] fiRow1[9] fiRow2[1] fiRow2[2] ~ fiRow2[3] fiRow2[4] fiRow2[5] fiRow2[6] fiRow2[7] fiRow2[8] fiRow2[9] ~ fiRow3[1] fiRow3[2] fiRow3[3] fiRow3[4] fiRow3[5] fiRow3[6] fiRow3[7] ~ fiRow3[8] fiRow3[9] fiRow4[1] fiRow4[2] fiRow4[3] fiRow4[4] fiRow4[5] ~ fiRow4[6] fiRow4[7] fiRow4[8] fiRow4[9] fiRow5[1] fiRow5[2] fiRow5[3] ~ fiRow5[4] fiRow5[5] fiRow5[6] fiRow5[7] fiRow5[8] fiRow5[9] fiRow6[1] ~ fiRow6[2] fiRow6[3] fiRow6[4] fiRow6[5] fiRow6[6] fiRow6[7] fiRow6[8] ~ fiRow6[9] fiRow7[1] fiRow7[2] fiRow7[3] fiRow7[4] fiRow7[5] fiRow7[6] ~ fiRow7[7] fiRow7[8] fiRow7[9] fiRow8[1] fiRow8[2] fiRow8[3] fiRow8[4] ~ fiRow8[5] fiRow8[6] fiRow8[7] fiRow8[8] fiRow8[9] fiRow9[1] fiRow9[2] ~ fiRow9[3] fiRow9[4] fiRow9[5] fiRow9[6] fiRow9[7] fiRow9[8] fiRow9[9] &Scoped-Define DISPLAYED-OBJECTS fiRow1[1] fiRow1[2] fiRow1[3] fiRow1[4] ~ fiRow1[5] fiRow1[6] fiRow1[7] fiRow1[8] fiRow1[9] fiRow2[1] fiRow2[2] ~ fiRow2[3] fiRow2[4] fiRow2[5] fiRow2[6] fiRow2[7] fiRow2[8] fiRow2[9] ~ fiRow3[1] fiRow3[2] fiRow3[3] fiRow3[4] fiRow3[5] fiRow3[6] fiRow3[7] ~ fiRow3[8] fiRow3[9] fiRow4[1] fiRow4[2] fiRow4[3] fiRow4[4] fiRow4[5] ~ fiRow4[6] fiRow4[7] fiRow4[8] fiRow4[9] fiRow5[1] fiRow5[2] fiRow5[3] ~ fiRow5[4] fiRow5[5] fiRow5[6] fiRow5[7] fiRow5[8] fiRow5[9] fiRow6[1] ~ fiRow6[2] fiRow6[3] fiRow6[4] fiRow6[5] fiRow6[6] fiRow6[7] fiRow6[8] ~ fiRow6[9] fiRow7[1] fiRow7[2] fiRow7[3] fiRow7[4] fiRow7[5] fiRow7[6] ~ fiRow7[7] fiRow7[8] fiRow7[9] fiRow8[1] fiRow8[2] fiRow8[3] fiRow8[4] ~ fiRow8[5] fiRow8[6] fiRow8[7] fiRow8[8] fiRow8[9] fiRow9[1] fiRow9[2] ~ fiRow9[3] fiRow9[4] fiRow9[5] fiRow9[6] fiRow9[7] fiRow9[8] fiRow9[9] /* Custom List Definitions */ /* List-1,List-2,List-3,List-4,List-5,List-6 */ /* _UIB-PREPROCESSOR-BLOCK-END */ &ANALYZE-RESUME /* ************************ Function Prototypes ********************** */ &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD Allowed Sudoku FUNCTION Allowed RETURNS LOGICAL ( INPUT ipiRow AS INTEGER, INPUT ipiCol AS INTEGER, INPUT ipiSqr AS INTEGER, INPUT ipiVal AS INTEGER ) FORWARD. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD Indent Sudoku FUNCTION Indent RETURNS CHARACTER ( INPUT ipcString AS CHARACTER, INPUT ipiTotTab AS INTEGER ) FORWARD. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD NumBlanks Sudoku FUNCTION NumBlanks RETURNS INTEGER() FORWARD. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME /* *********************** Control Definitions ********************** */ /* Define the widget handle for the window */ DEFINE VAR Sudoku AS WIDGET-HANDLE NO-UNDO. /* Menu Definitions */ DEFINE SUB-MENU m_Excel MENU-ITEM m_This_Grid_Only LABEL "This Grid Only" MENU-ITEM m_Entire_History LABEL "Entire History". DEFINE SUB-MENU m_Game MENU-ITEM m_New LABEL "New" MENU-ITEM m_Restart LABEL "Restart" MENU-ITEM m_Open LABEL "Open" MENU-ITEM m_Save LABEL "Save" MENU-ITEM m_Hint LABEL "Hint (alt-h)" MENU-ITEM m_Clear LABEL "Clear" SUB-MENU m_Excel LABEL "Export to Excel" MENU-ITEM m_Times LABEL "Best Times" MENU-ITEM m_Exit LABEL "Exit" . DEFINE MENU MENU-BAR-Sudoku MENUBAR SUB-MENU m_Game LABEL "Game" MENU-ITEM m_Help LABEL "Help" . /* Definitions of the field level widgets */ DEFINE VARIABLE fiRow1 AS CHARACTER FORMAT "X":U EXTENT 9 VIEW-AS FILL-IN SIZE 3.4 BY 1 FONT 6 NO-UNDO. DEFINE VARIABLE fiRow2 AS CHARACTER FORMAT "X":U EXTENT 9 VIEW-AS FILL-IN SIZE 3.4 BY 1 FONT 6 NO-UNDO. DEFINE VARIABLE fiRow3 AS CHARACTER FORMAT "X":U EXTENT 9 VIEW-AS FILL-IN SIZE 3.4 BY 1 FONT 6 NO-UNDO. DEFINE VARIABLE fiRow4 AS CHARACTER FORMAT "X":U EXTENT 9 VIEW-AS FILL-IN SIZE 3.4 BY 1 FONT 6 NO-UNDO. DEFINE VARIABLE fiRow5 AS CHARACTER FORMAT "X":U EXTENT 9 VIEW-AS FILL-IN SIZE 3.4 BY 1 FONT 6 NO-UNDO. DEFINE VARIABLE fiRow6 AS CHARACTER FORMAT "X":U EXTENT 9 VIEW-AS FILL-IN SIZE 3.4 BY 1 FONT 6 NO-UNDO. DEFINE VARIABLE fiRow7 AS CHARACTER FORMAT "X":U EXTENT 9 VIEW-AS FILL-IN SIZE 3.4 BY 1 FONT 6 NO-UNDO. DEFINE VARIABLE fiRow8 AS CHARACTER FORMAT "X":U EXTENT 9 VIEW-AS FILL-IN SIZE 3.4 BY 1 FONT 6 NO-UNDO. DEFINE VARIABLE fiRow9 AS CHARACTER FORMAT "X":U EXTENT 9 VIEW-AS FILL-IN SIZE 3.4 BY 1 FONT 6 NO-UNDO. DEFINE RECTANGLE RECT-134 EDGE-PIXELS 2 GRAPHIC-EDGE NO-FILL SIZE 13.4 BY 3.48. DEFINE RECTANGLE RECT-135 EDGE-PIXELS 2 GRAPHIC-EDGE NO-FILL SIZE 13.4 BY 3.48. DEFINE RECTANGLE RECT-136 EDGE-PIXELS 2 GRAPHIC-EDGE NO-FILL SIZE 13.4 BY 3.48. DEFINE RECTANGLE RECT-137 EDGE-PIXELS 2 GRAPHIC-EDGE NO-FILL SIZE 13.4 BY 3.48. DEFINE RECTANGLE RECT-138 EDGE-PIXELS 2 GRAPHIC-EDGE NO-FILL SIZE 13.4 BY 3.48. DEFINE RECTANGLE RECT-139 EDGE-PIXELS 2 GRAPHIC-EDGE NO-FILL SIZE 13.4 BY 3.48. DEFINE RECTANGLE RECT-140 EDGE-PIXELS 2 GRAPHIC-EDGE NO-FILL SIZE 13.4 BY 3.48. DEFINE RECTANGLE RECT-141 EDGE-PIXELS 2 GRAPHIC-EDGE NO-FILL SIZE 13.4 BY 3.48. DEFINE RECTANGLE RECT-142 EDGE-PIXELS 2 GRAPHIC-EDGE NO-FILL SIZE 13.4 BY 3.48. /* ************************ Frame Definitions *********************** */ DEFINE FRAME DEFAULT-FRAME fiRow1[1] AT ROW 1.48 COL 3 NO-LABEL fiRow1[2] AT ROW 1.48 COL 7 NO-LABEL fiRow1[3] AT ROW 1.48 COL 11 NO-LABEL fiRow1[4] AT ROW 1.48 COL 16 NO-LABEL fiRow1[5] AT ROW 1.48 COL 20 NO-LABEL fiRow1[6] AT ROW 1.48 COL 24 NO-LABEL fiRow1[7] AT ROW 1.48 COL 29 NO-LABEL fiRow1[8] AT ROW 1.48 COL 33 NO-LABEL fiRow1[9] AT ROW 1.48 COL 37 NO-LABEL fiRow2[1] AT ROW 2.48 COL 3 NO-LABEL fiRow2[2] AT ROW 2.48 COL 5 COLON-ALIGNED NO-LABEL fiRow2[3] AT ROW 2.48 COL 9 COLON-ALIGNED NO-LABEL fiRow2[4] AT ROW 2.48 COL 14 COLON-ALIGNED NO-LABEL fiRow2[5] AT ROW 2.48 COL 18 COLON-ALIGNED NO-LABEL fiRow2[6] AT ROW 2.48 COL 22 COLON-ALIGNED NO-LABEL fiRow2[7] AT ROW 2.48 COL 27 COLON-ALIGNED NO-LABEL fiRow2[8] AT ROW 2.48 COL 31 COLON-ALIGNED NO-LABEL fiRow2[9] AT ROW 2.48 COL 35 COLON-ALIGNED NO-LABEL fiRow3[1] AT ROW 3.48 COL 3 NO-LABEL fiRow3[2] AT ROW 3.48 COL 5 COLON-ALIGNED NO-LABEL fiRow3[3] AT ROW 3.48 COL 9 COLON-ALIGNED NO-LABEL fiRow3[4] AT ROW 3.48 COL 14 COLON-ALIGNED NO-LABEL fiRow3[5] AT ROW 3.48 COL 18 COLON-ALIGNED NO-LABEL fiRow3[6] AT ROW 3.48 COL 22 COLON-ALIGNED NO-LABEL fiRow3[7] AT ROW 3.48 COL 27 COLON-ALIGNED NO-LABEL fiRow3[8] AT ROW 3.48 COL 31 COLON-ALIGNED NO-LABEL fiRow3[9] AT ROW 3.48 COL 35 COLON-ALIGNED NO-LABEL fiRow4[1] AT ROW 4.86 COL 3 NO-LABEL fiRow4[2] AT ROW 4.86 COL 5 COLON-ALIGNED NO-LABEL fiRow4[3] AT ROW 4.86 COL 9 COLON-ALIGNED NO-LABEL fiRow4[4] AT ROW 4.86 COL 14 COLON-ALIGNED NO-LABEL fiRow4[5] AT ROW 4.86 COL 18 COLON-ALIGNED NO-LABEL fiRow4[6] AT ROW 4.86 COL 22 COLON-ALIGNED NO-LABEL fiRow4[7] AT ROW 4.86 COL 27 COLON-ALIGNED NO-LABEL fiRow4[8] AT ROW 4.86 COL 31 COLON-ALIGNED NO-LABEL fiRow4[9] AT ROW 4.86 COL 35 COLON-ALIGNED NO-LABEL fiRow5[1] AT ROW 5.86 COL 3 NO-LABEL fiRow5[2] AT ROW 5.86 COL 5 COLON-ALIGNED NO-LABEL fiRow5[3] AT ROW 5.86 COL 9 COLON-ALIGNED NO-LABEL fiRow5[4] AT ROW 5.86 COL 14 COLON-ALIGNED NO-LABEL fiRow5[5] AT ROW 5.86 COL 18 COLON-ALIGNED NO-LABEL fiRow5[6] AT ROW 5.86 COL 22 COLON-ALIGNED NO-LABEL fiRow5[7] AT ROW 5.86 COL 27 COLON-ALIGNED NO-LABEL fiRow5[8] AT ROW 5.86 COL 31 COLON-ALIGNED NO-LABEL fiRow5[9] AT ROW 5.86 COL 35 COLON-ALIGNED NO-LABEL fiRow6[1] AT ROW 6.86 COL 3 NO-LABEL fiRow6[2] AT ROW 6.86 COL 5 COLON-ALIGNED NO-LABEL fiRow6[3] AT ROW 6.86 COL 9 COLON-ALIGNED NO-LABEL fiRow6[4] AT ROW 6.86 COL 14 COLON-ALIGNED NO-LABEL fiRow6[5] AT ROW 6.86 COL 18 COLON-ALIGNED NO-LABEL fiRow6[6] AT ROW 6.86 COL 22 COLON-ALIGNED NO-LABEL fiRow6[7] AT ROW 6.86 COL 27 COLON-ALIGNED NO-LABEL fiRow6[8] AT ROW 6.86 COL 31 COLON-ALIGNED NO-LABEL fiRow6[9] AT ROW 6.86 COL 35 COLON-ALIGNED NO-LABEL fiRow7[1] AT ROW 8.24 COL 3 NO-LABEL fiRow7[2] AT ROW 8.24 COL 5 COLON-ALIGNED NO-LABEL fiRow7[3] AT ROW 8.24 COL 9 COLON-ALIGNED NO-LABEL fiRow7[4] AT ROW 8.24 COL 14 COLON-ALIGNED NO-LABEL fiRow7[5] AT ROW 8.24 COL 18 COLON-ALIGNED NO-LABEL fiRow7[6] AT ROW 8.24 COL 22 COLON-ALIGNED NO-LABEL fiRow7[7] AT ROW 8.24 COL 27 COLON-ALIGNED NO-LABEL WITH 1 DOWN NO-BOX KEEP-TAB-ORDER OVERLAY SIDE-LABELS NO-UNDERLINE THREE-D AT COL 1 ROW 1 SIZE 41.4 BY 10.71 BGCOLOR 8 FGCOLOR 0 . /* DEFINE FRAME statement is approaching 4K Bytes. Breaking it up */ DEFINE FRAME DEFAULT-FRAME fiRow7[8] AT ROW 8.24 COL 31 COLON-ALIGNED NO-LABEL fiRow7[9] AT ROW 8.24 COL 35 COLON-ALIGNED NO-LABEL fiRow8[1] AT ROW 9.24 COL 3 NO-LABEL fiRow8[2] AT ROW 9.24 COL 5 COLON-ALIGNED NO-LABEL fiRow8[3] AT ROW 9.24 COL 9 COLON-ALIGNED NO-LABEL fiRow8[4] AT ROW 9.24 COL 14 COLON-ALIGNED NO-LABEL fiRow8[5] AT ROW 9.24 COL 18 COLON-ALIGNED NO-LABEL fiRow8[6] AT ROW 9.24 COL 22 COLON-ALIGNED NO-LABEL fiRow8[7] AT ROW 9.24 COL 27 COLON-ALIGNED NO-LABEL fiRow8[8] AT ROW 9.24 COL 31 COLON-ALIGNED NO-LABEL fiRow8[9] AT ROW 9.24 COL 35 COLON-ALIGNED NO-LABEL fiRow9[1] AT ROW 10.24 COL 3 NO-LABEL fiRow9[2] AT ROW 10.24 COL 5 COLON-ALIGNED NO-LABEL fiRow9[3] AT ROW 10.24 COL 9 COLON-ALIGNED NO-LABEL fiRow9[4] AT ROW 10.24 COL 14 COLON-ALIGNED NO-LABEL fiRow9[5] AT ROW 10.24 COL 18 COLON-ALIGNED NO-LABEL fiRow9[6] AT ROW 10.24 COL 22 COLON-ALIGNED NO-LABEL fiRow9[7] AT ROW 10.24 COL 27 COLON-ALIGNED NO-LABEL fiRow9[8] AT ROW 10.24 COL 31 COLON-ALIGNED NO-LABEL fiRow9[9] AT ROW 10.24 COL 35 COLON-ALIGNED NO-LABEL RECT-134 AT ROW 1.24 COL 2 RECT-135 AT ROW 1.24 COL 15 RECT-136 AT ROW 1.24 COL 28 RECT-137 AT ROW 4.62 COL 2 RECT-138 AT ROW 4.62 COL 15 RECT-139 AT ROW 4.62 COL 28 RECT-140 AT ROW 8 COL 2 RECT-141 AT ROW 8 COL 15 RECT-142 AT ROW 8 COL 28 WITH 1 DOWN NO-BOX KEEP-TAB-ORDER OVERLAY SIDE-LABELS NO-UNDERLINE THREE-D AT COL 1 ROW 1 SIZE 41.4 BY 10.71 BGCOLOR 8 FGCOLOR 0 . /* *********************** Procedure Settings ************************ */ &ANALYZE-SUSPEND _PROCEDURE-SETTINGS /* Settings for THIS-PROCEDURE Type: Window Allow: Basic,Browse,DB-Fields,Window,Query Other Settings: COMPILE */ &ANALYZE-RESUME _END-PROCEDURE-SETTINGS /* ************************* Create Window ************************** */ &ANALYZE-SUSPEND _CREATE-WINDOW IF SESSION:DISPLAY-TYPE = "GUI":U THEN CREATE WINDOW Sudoku ASSIGN HIDDEN = YES TITLE = "Sudoku" HEIGHT = 10.71 WIDTH = 41.4 MAX-HEIGHT = 46.52 MAX-WIDTH = 256 VIRTUAL-HEIGHT = 46.52 VIRTUAL-WIDTH = 256 RESIZE = no SCROLL-BARS = no STATUS-AREA = no BGCOLOR = 16 FGCOLOR = 0 KEEP-FRAME-Z-ORDER = yes THREE-D = yes MESSAGE-AREA = no SENSITIVE = yes. ELSE {&WINDOW-NAME} = CURRENT-WINDOW. ASSIGN {&WINDOW-NAME}:MENUBAR = MENU MENU-BAR-Sudoku:HANDLE. /* END WINDOW DEFINITION */ &ANALYZE-RESUME /* *********** Runtime Attributes and AppBuilder Settings *********** */ &ANALYZE-SUSPEND _RUN-TIME-ATTRIBUTES /* SETTINGS FOR WINDOW Sudoku VISIBLE,,RUN-PERSISTENT */ /* SETTINGS FOR FRAME DEFAULT-FRAME FRAME-NAME */ /* SETTINGS FOR FILL-IN fiRow1[1] IN FRAME DEFAULT-FRAME ALIGN-L */ /* SETTINGS FOR FILL-IN fiRow1[2] IN FRAME DEFAULT-FRAME ALIGN-L */ /* SETTINGS FOR FILL-IN fiRow1[3] IN FRAME DEFAULT-FRAME ALIGN-L */ /* SETTINGS FOR FILL-IN fiRow1[4] IN FRAME DEFAULT-FRAME ALIGN-L */ /* SETTINGS FOR FILL-IN fiRow1[5] IN FRAME DEFAULT-FRAME ALIGN-L */ /* SETTINGS FOR FILL-IN fiRow1[6] IN FRAME DEFAULT-FRAME ALIGN-L */ /* SETTINGS FOR FILL-IN fiRow1[7] IN FRAME DEFAULT-FRAME ALIGN-L */ /* SETTINGS FOR FILL-IN fiRow1[8] IN FRAME DEFAULT-FRAME ALIGN-L */ /* SETTINGS FOR FILL-IN fiRow1[9] IN FRAME DEFAULT-FRAME ALIGN-L */ /* SETTINGS FOR FILL-IN fiRow2[1] IN FRAME DEFAULT-FRAME ALIGN-L */ /* SETTINGS FOR FILL-IN fiRow3[1] IN FRAME DEFAULT-FRAME ALIGN-L */ /* SETTINGS FOR FILL-IN fiRow4[1] IN FRAME DEFAULT-FRAME ALIGN-L */ /* SETTINGS FOR FILL-IN fiRow5[1] IN FRAME DEFAULT-FRAME ALIGN-L */ /* SETTINGS FOR FILL-IN fiRow6[1] IN FRAME DEFAULT-FRAME ALIGN-L */ /* SETTINGS FOR FILL-IN fiRow7[1] IN FRAME DEFAULT-FRAME ALIGN-L */ /* SETTINGS FOR FILL-IN fiRow8[1] IN FRAME DEFAULT-FRAME ALIGN-L */ /* SETTINGS FOR FILL-IN fiRow9[1] IN FRAME DEFAULT-FRAME ALIGN-L */ IF SESSION:DISPLAY-TYPE = "GUI":U AND VALID-HANDLE(Sudoku) THEN Sudoku:HIDDEN = no. /* _RUN-TIME-ATTRIBUTES-END */ &ANALYZE-RESUME /* ************************ Control Triggers ************************ */ &Scoped-define SELF-NAME Sudoku &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Sudoku Sudoku ON WINDOW-CLOSE OF Sudoku /* Sudoku */ OR END-ERROR OF {&WINDOW-NAME} OR ENDKEY OF {&WINDOW-NAME} ANYWHERE DO: /* This event will close the window and terminate the procedure. */ APPLY "CLOSE":U TO THIS-PROCEDURE. RETURN NO-APPLY. END. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Sudoku Sudoku ON WINDOW-MINIMIZED OF Sudoku /* Sudoku */ DO: ASSIGN iMinimizedTime = TIME. END. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Sudoku Sudoku ON WINDOW-RESTORED OF Sudoku /* Sudoku */ DO: ASSIGN iStartTime = iStartTime + ( TIME - iMinimizedTime ). /* Add Minimized Duration to Start Time */ END. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &Scoped-define SELF-NAME m_Clear &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_Clear Sudoku ON CHOOSE OF MENU-ITEM m_Clear /* Clear */ DO: FOR EACH ttCell: ASSIGN ttCell.CelVal = 0. END. RUN DisplayCellValues. END. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &Scoped-define SELF-NAME m_Entire_History &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_Entire_History Sudoku ON CHOOSE OF MENU-ITEM m_Entire_History /* Entire History */ DO: RUN ExportHistory. END. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &Scoped-define SELF-NAME m_Exit &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_Exit Sudoku ON CHOOSE OF MENU-ITEM m_Exit /* Exit */ DO: APPLY "CLOSE":U TO THIS-PROCEDURE. END. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &Scoped-define SELF-NAME m_Help &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_Help Sudoku ON CHOOSE OF MENU-ITEM m_Help /* Help */ DO: MESSAGE "Fill all the squares with numbers" SKIP "such that each row, column and" SKIP "3x3 square contains each of the" SKIP "numbers one through to nine," SKIP "ONCE AND ONLY ONCE." SKIP(1) "-Minimizing pauses the clock." SKIP "-CTRL-T shows elapsed time." SKIP "-Export to Excel for a nice print." SKIP "-A Red Value indicates an Error." SKIP "-No hints or errors for a best time." VIEW-AS ALERT-BOX INFO BUTTONS OK TITLE "Sudoku Instructions". END. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &Scoped-define SELF-NAME m_Hint &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_Hint Sudoku ON CHOOSE OF MENU-ITEM m_Hint /* Hint (alt-h) */ DO: DEFINE VARIABLE iBlanks AS INTEGER NO-UNDO. DEFINE VARIABLE cHint AS CHARACTER NO-UNDO. ASSIGN iBlanks = numBlanks() iHints = iHints + 1. /* Try Rule2 first as it gives a friendlier message... */ RUN Rule2 ( INPUT TRUE, OUTPUT cHint ). IF numBlanks() = iBlanks THEN RUN Rule1 ( INPUT TRUE, OUTPUT cHint ). IF cHint <> "" THEN MESSAGE cHint VIEW-AS ALERT-BOX INFO BUTTONS OK TITLE "Hint...". RUN DisplayCellValues. END. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &Scoped-define SELF-NAME m_New &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_New Sudoku ON CHOOSE OF MENU-ITEM m_New /* New */ DO: RUN Generate. END. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &Scoped-define SELF-NAME m_Open &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_Open Sudoku ON CHOOSE OF MENU-ITEM m_Open /* Open */ DO: DEFINE VARIABLE cFileName AS CHARACTER NO-UNDO. DEFINE VARIABLE lOK AS LOGICAL NO-UNDO. ASSIGN cFileName = "Sudoku01.sdk". SYSTEM-DIALOG GET-FILE cFileName FILTERS "Sudoki" "*.sdk" INITIAL-DIR SESSION:TEMP-DIR MUST-EXIST RETURN-TO-START-DIR TITLE "Load Saved Game... " USE-FILENAME UPDATE lOK IN WINDOW Sudoku. IF lOK THEN RUN LoadGame ( cFileName ). END. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &Scoped-define SELF-NAME m_Restart &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_Restart Sudoku ON CHOOSE OF MENU-ITEM m_Restart /* Restart */ DO: SESSION:SET-WAIT-STATE( 'GENERAL':U ). RUN RestoreCells. RUN DisplayCellValues. ASSIGN iStartTime = TIME iHints = 0 iErrors = 0. SESSION:SET-WAIT-STATE( '':U ). END. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &Scoped-define SELF-NAME m_Save &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_Save Sudoku ON CHOOSE OF MENU-ITEM m_Save /* Save */ DO: DEFINE VARIABLE cFileName AS CHARACTER NO-UNDO. DEFINE VARIABLE lOK AS LOGICAL NO-UNDO. ASSIGN cFileName = "Sudoku01.sdk". SYSTEM-DIALOG GET-FILE cFileName FILTERS "Sudoki" "*.sdk" ASK-OVERWRITE DEFAULT-EXTENSION ".sdk" INITIAL-DIR SESSION:TEMP-DIR RETURN-TO-START-DIR SAVE-AS TITLE "Save Current Game As... " USE-FILENAME UPDATE lOK IN WINDOW Sudoku. IF lOK THEN RUN SaveGame ( cFileName ). END. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &Scoped-define SELF-NAME m_This_Grid_Only &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_This_Grid_Only Sudoku ON CHOOSE OF MENU-ITEM m_This_Grid_Only /* This Grid Only */ DO: SESSION:SET-WAIT-STATE( "GENERAL":U ). RUN ExcelExport. SESSION:SET-WAIT-STATE( "":U ). END. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &Scoped-define SELF-NAME m_Times &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL m_Times Sudoku ON CHOOSE OF MENU-ITEM m_Times /* Best Times */ DO: DEFINE VARIABLE cText AS CHARACTER NO-UNDO INITIAL "~nRank~tPlayer~t~tTime". FOR EACH ttRanking: ASSIGN cText = cText + "~n" + STRING( ttRanking.Rank ) + "~t" + Indent( ttRanking.Player, 2 ) + STRING( ttRanking.GameTime, "HH:MM:SS" ). END. MESSAGE cText VIEW-AS ALERT-BOX INFO BUTTONS OK TITLE " Sudoku Best Times ---". END. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &UNDEFINE SELF-NAME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Sudoku /* *************************** Main Block *************************** */ &SCOPED-DEFINE WhereAmI ASSIGN iCol = SELF:INDEX. ~ CASE SELF:NAME: ~ WHEN 'fiRow1' THEN ASSIGN iRow = 1. ~ WHEN 'fiRow2' THEN ASSIGN iRow = 2. ~ WHEN 'fiRow3' THEN ASSIGN iRow = 3. ~ WHEN 'fiRow4' THEN ASSIGN iRow = 4. ~ WHEN 'fiRow5' THEN ASSIGN iRow = 5. ~ WHEN 'fiRow6' THEN ASSIGN iRow = 6. ~ WHEN 'fiRow7' THEN ASSIGN iRow = 7. ~ WHEN 'fiRow8' THEN ASSIGN iRow = 8. ~ WHEN 'fiRow9' THEN ASSIGN iRow = 9. ~ END CASE. /* Force Numeric Values... */ ON 'ANY-PRINTABLE' OF {&csvRows} IN FRAME {&FRAME-NAME} DO: IF INDEX( '123456789':U, KEYFUNCTION( LASTKEY ) ) = 0 THEN RETURN NO-APPLY. ELSE RETURN. END. ON 'LEFT-ARROW', 'RIGHT-ARROW', 'UP-ARROW', 'DOWN-ARROW' OF {&csvRows} IN FRAME {&FRAME-NAME} DO: {&WhereAmI} CASE KEYFUNCTION( LASTKEY ): WHEN 'CURSOR-LEFT' THEN ASSIGN iCol = iCol - 1. WHEN 'CURSOR-RIGHT' THEN ASSIGN iCol = iCol + 1. WHEN 'CURSOR-UP' THEN ASSIGN iRow = iRow - 1. WHEN 'CURSOR-DOWN' THEN ASSIGN iRow = iRow + 1. END CASE. IF iCol = 0 THEN ASSIGN iCol = 9. IF iCol = 10 THEN ASSIGN iCol = 1. IF iRow = 0 THEN ASSIGN iRow = 9. IF iRow = 10 THEN ASSIGN iRow = 1. FIND FIRST ttCell WHERE ttCell.RowNum = iRow AND ttCell.ColNum = iCol. APPLY 'ENTRY' TO ttCell.whCell. RETURN NO-APPLY. END. /* Store change, check for error, check for completion... */ ON 'VALUE-CHANGED':U OF {&csvRows} IN FRAME {&FRAME-NAME} DO: {&WhereAmI} FIND FIRST ttCell WHERE ttCell.RowNum = iRow AND ttCell.ColNum = iCol. IF SELF:SCREEN-VALUE = "":U THEN ASSIGN iTempVal = 0. ELSE ASSIGN iTempVal = INTEGER( SELF:SCREEN-VALUE ). IF Allowed( ttCell.RowNum, ttCell.ColNum, ttCell.SqrNum, iTempVal ) THEN ASSIGN SELF:FGCOLOR = 0. ELSE ASSIGN SELF:FGCOLOR = 12 iErrors = iErrors + 1. ASSIGN ttCell.CelVal = iTempVal. IF numBlanks() = 0 THEN DO: ASSIGN iGameTime = TIME - iStartTime. MESSAGE "Sudoku completed in " STRING( iGameTime, 'HH:MM:SS':U ) " with " iHints " hints and " iErrors " errors." VIEW-AS ALERT-BOX INFO BUTTONS OK TITLE "Sudoku Completed". IF iHints = 0 AND iErrors = 0 THEN RUN Rankings. IF {&Rankings} > 0 AND {&Rankings} >= iRank AND iHints = 0 AND iErrors = 0 THEN DO: ASSIGN cName = OS-GETENV( "USERNAME" ) cRankTitle = "Time " + STRING( iGameTime, 'HH:MM:SS':U ) + " Rank " + STRING( iRank ). DISPLAY cName WITH FRAME fRanking. ENABLE ALL WITH FRAME fRanking. cName:SET-SELECTION( 1, LENGTH( cName ) + 1 ) IN FRAME fRanking. APPLY 'ENTRY' TO cName IN FRAME fRanking. END. END. RETURN. END. /* Display Elapsed Time... */ ON 'CTRL-T':U OF {&csvRows} IN FRAME {&FRAME-NAME} DO: MESSAGE STRING( TIME - iStartTime, 'HH:MM:SS':U ) " (HH:MM:SS)" SKIP "(" iHints " Hints & " iErrors " errors)" VIEW-AS ALERT-BOX INFO BUTTONS OK TITLE "Elapsed Time". RETURN. END. ON 'ALT-H':U OF {&csvRows} IN FRAME {&FRAME-NAME} APPLY 'CHOOSE':U TO MENU-ITEM m_Hint IN MENU m_Game. /* Set CURRENT-WINDOW: this will parent dialog-boxes and frames. */ ASSIGN CURRENT-WINDOW = {&WINDOW-NAME} THIS-PROCEDURE:CURRENT-WINDOW = {&WINDOW-NAME}. IF SEARCH( "Sudoku.ico" ) <> ? THEN DO: {&WINDOW-NAME}:LOAD-ICON( SEARCH( "Sudoku.ico" ) ). END. /* The CLOSE event can be used from inside or outside the procedure to */ /* terminate it. */ ON CLOSE OF THIS-PROCEDURE DO: RUN SaveBestTimes. RUN disable_UI. END. /* Best default for GUI applications is... */ PAUSE 0 BEFORE-HIDE. RUN LoadBestTimes. /* Now enable the interface and wait for the exit condition. */ /* (NOTE: handle ERROR and END-KEY so cleanup code will always fire. */ MAIN-BLOCK: DO ON ERROR UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK ON END-KEY UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK: RUN enable_UI. RUN PopttCell. WAIT-FOR CLOSE OF THIS-PROCEDURE. END. QUIT. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME /* ********************** Internal Procedures *********************** */ &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE BackUpCells Sudoku PROCEDURE BackUpCells : /* Back Up current cell values by copying * them to the BkUpCell TEMP-TABLE... */ DEFINE BUFFER aaCell FOR ttCell. FOR EACH aaCell, FIRST BkUpCell WHERE BkUpCell.RowNum = aaCell.RowNum AND BkUpCell.ColNum = aaCell.ColNum: ASSIGN BkUpCell.CelVal = aaCell.CelVal. END. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE disable_UI Sudoku _DEFAULT-DISABLE PROCEDURE disable_UI : /*------------------------------------------------------------------------------ Purpose: DISABLE the User Interface Parameters: Notes: Here we clean-up the user-interface by deleting dynamic widgets we have created and/or hide frames. This procedure is usually called when we are ready to "clean-up" after running. ------------------------------------------------------------------------------*/ /* Delete the WINDOW we created */ IF SESSION:DISPLAY-TYPE = "GUI":U AND VALID-HANDLE(Sudoku) THEN DELETE WIDGET Sudoku. IF THIS-PROCEDURE:PERSISTENT THEN DELETE PROCEDURE THIS-PROCEDURE. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE DisplayCellValues Sudoku PROCEDURE DisplayCellValues : /* Display the cells' values... */ DEFINE BUFFER aaCell FOR ttCell. FOR EACH aaCell: CASE aaCell.RowNum: WHEN 1 THEN ASSIGN fiRow1[ aaCell.ColNum ] = IF aaCell.CelVal = 0 THEN "":U ELSE STRING( aaCell.CelVal, "9" ). WHEN 2 THEN ASSIGN fiRow2[ aaCell.ColNum ] = IF aaCell.CelVal = 0 THEN "":U ELSE STRING( aaCell.CelVal, "9" ). WHEN 3 THEN ASSIGN fiRow3[ aaCell.ColNum ] = IF aaCell.CelVal = 0 THEN "":U ELSE STRING( aaCell.CelVal, "9" ). WHEN 4 THEN ASSIGN fiRow4[ aaCell.ColNum ] = IF aaCell.CelVal = 0 THEN "":U ELSE STRING( aaCell.CelVal, "9" ). WHEN 5 THEN ASSIGN fiRow5[ aaCell.ColNum ] = IF aaCell.CelVal = 0 THEN "":U ELSE STRING( aaCell.CelVal, "9" ). WHEN 6 THEN ASSIGN fiRow6[ aaCell.ColNum ] = IF aaCell.CelVal = 0 THEN "":U ELSE STRING( aaCell.CelVal, "9" ). WHEN 7 THEN ASSIGN fiRow7[ aaCell.ColNum ] = IF aaCell.CelVal = 0 THEN "":U ELSE STRING( aaCell.CelVal, "9" ). WHEN 8 THEN ASSIGN fiRow8[ aaCell.ColNum ] = IF aaCell.CelVal = 0 THEN "":U ELSE STRING( aaCell.CelVal, "9" ). WHEN 9 THEN ASSIGN fiRow9[ aaCell.ColNum ] = IF aaCell.CelVal = 0 THEN "":U ELSE STRING( aaCell.CelVal, "9" ). END CASE. END. DISPLAY fiRow1 fiRow2 fiRow3 fiRow4 fiRow5 fiRow6 fiRow7 fiRow8 fiRow9 WITH FRAME {&FRAME-NAME}. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE DumpGame Sudoku PROCEDURE DumpGame : /* Build up a history of generated games, so I can see if they're unique */ DEFINE BUFFER aaCell FOR ttCell. OUTPUT TO {&HistoryFile} APPEND. FOR EACH aaCell BREAK BY aaCell.RowNum BY aaCell.ColNum: PUT aaCell.CelVal FORMAT "9". END. PUT SKIP. OUTPUT CLOSE. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE enable_UI Sudoku _DEFAULT-ENABLE PROCEDURE enable_UI : /*------------------------------------------------------------------------------ Purpose: ENABLE the User Interface Parameters: Notes: Here we display/view/enable the widgets in the user-interface. In addition, OPEN all queries associated with each FRAME and BROWSE. These statements here are based on the "Other Settings" section of the widget Property Sheets. ------------------------------------------------------------------------------*/ DISPLAY fiRow1[1] fiRow1[2] fiRow1[3] fiRow1[4] fiRow1[5] fiRow1[6] fiRow1[7] fiRow1[8] fiRow1[9] fiRow2[1] fiRow2[2] fiRow2[3] fiRow2[4] fiRow2[5] fiRow2[6] fiRow2[7] fiRow2[8] fiRow2[9] fiRow3[1] fiRow3[2] fiRow3[3] fiRow3[4] fiRow3[5] fiRow3[6] fiRow3[7] fiRow3[8] fiRow3[9] fiRow4[1] fiRow4[2] fiRow4[3] fiRow4[4] fiRow4[5] fiRow4[6] fiRow4[7] fiRow4[8] fiRow4[9] fiRow5[1] fiRow5[2] fiRow5[3] fiRow5[4] fiRow5[5] fiRow5[6] fiRow5[7] fiRow5[8] fiRow5[9] fiRow6[1] fiRow6[2] fiRow6[3] fiRow6[4] fiRow6[5] fiRow6[6] fiRow6[7] fiRow6[8] fiRow6[9] fiRow7[1] fiRow7[2] fiRow7[3] fiRow7[4] fiRow7[5] fiRow7[6] fiRow7[7] fiRow7[8] fiRow7[9] fiRow8[1] fiRow8[2] fiRow8[3] fiRow8[4] fiRow8[5] fiRow8[6] fiRow8[7] fiRow8[8] fiRow8[9] fiRow9[1] fiRow9[2] fiRow9[3] fiRow9[4] fiRow9[5] fiRow9[6] fiRow9[7] fiRow9[8] fiRow9[9] WITH FRAME DEFAULT-FRAME IN WINDOW Sudoku. ENABLE RECT-134 RECT-135 RECT-136 RECT-137 RECT-138 RECT-139 RECT-140 RECT-141 RECT-142 fiRow1[1] fiRow1[2] fiRow1[3] fiRow1[4] fiRow1[5] fiRow1[6] fiRow1[7] fiRow1[8] fiRow1[9] fiRow2[1] fiRow2[2] fiRow2[3] fiRow2[4] fiRow2[5] fiRow2[6] fiRow2[7] fiRow2[8] fiRow2[9] fiRow3[1] fiRow3[2] fiRow3[3] fiRow3[4] fiRow3[5] fiRow3[6] fiRow3[7] fiRow3[8] fiRow3[9] fiRow4[1] fiRow4[2] fiRow4[3] fiRow4[4] fiRow4[5] fiRow4[6] fiRow4[7] fiRow4[8] fiRow4[9] fiRow5[1] fiRow5[2] fiRow5[3] fiRow5[4] fiRow5[5] fiRow5[6] fiRow5[7] fiRow5[8] fiRow5[9] fiRow6[1] fiRow6[2] fiRow6[3] fiRow6[4] fiRow6[5] fiRow6[6] fiRow6[7] fiRow6[8] fiRow6[9] fiRow7[1] fiRow7[2] fiRow7[3] fiRow7[4] fiRow7[5] fiRow7[6] fiRow7[7] fiRow7[8] fiRow7[9] fiRow8[1] fiRow8[2] fiRow8[3] fiRow8[4] fiRow8[5] fiRow8[6] fiRow8[7] fiRow8[8] fiRow8[9] fiRow9[1] fiRow9[2] fiRow9[3] fiRow9[4] fiRow9[5] fiRow9[6] fiRow9[7] fiRow9[8] fiRow9[9] WITH FRAME DEFAULT-FRAME IN WINDOW Sudoku. {&OPEN-BROWSERS-IN-QUERY-DEFAULT-FRAME} VIEW Sudoku. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE ExcelExport Sudoku PROCEDURE ExcelExport : /* Export the current grid to Excel & format for a nice print */ DEFINE VARIABLE chExcel AS COM-HANDLE NO-UNDO. DEFINE VARIABLE chWorkbook AS COM-HANDLE NO-UNDO. DEFINE VARIABLE chWorksheet AS COM-HANDLE NO-UNDO. DEFINE VARIABLE iSquare AS INTEGER NO-UNDO. DEFINE VARIABLE iEdge AS INTEGER NO-UNDO. DEFINE VARIABLE cSquareRange AS CHARACTER NO-UNDO EXTENT 9 INITIAL [ "A1:C3","A4:C6","A7:C9","D1:F3","D4:F6","D7:F9","G1:I3","G4:I6","G7:I9" ]. DEFINE VARIABLE iExcelEdge AS INTEGER NO-UNDO EXTENT 4 INITIAL [ 7, 8, 9, 10 ]. /* Left, Right, Top, Bottom */ DEFINE BUFFER aaCell FOR ttCell. CREATE "Excel.Application" chExcel. ASSIGN chExcel:Visible = FALSE chWorkbook = chExcel:Workbooks:Add() chWorksheet = chWorkbook:Worksheets:Item(1). /* Populate Cells... */ DO iRow = 1 TO 9: DO iCol = 1 TO 9: FIND FIRST aaCell WHERE aaCell.RowNum = iRow AND aaCell.ColNum = iCol. IF aaCell.CelVal <> 0 THEN ASSIGN chWorksheet:Cells:Item( iRow, iCol ):Value = aaCell.CelVal. END. END. /* Format Cells... */ /* Set the height and width of more cells than required for 1 grid */ /* As a bit of copying and pasting will let you get 2 by 3 grids nicely on a page */ ASSIGN chWorksheet:Columns("A:S"):ColumnWidth = 4 chWorksheet:Rows("1:29"):RowHeight = 27 chWorksheet:Range("A1:I9"):HorizontalAlignment = -4108 /* Centre */ chWorksheet:Range("A1:I9"):VerticalAlignment = -4108 /* Centre */ chWorksheet:Range("A1:I9"):Font:Bold = TRUE chWorksheet:Range("A1:I9"):Font:SIZE = 16 chWorksheet:Range("A1:I9"):Borders(11):Weight = 2 /* Internal Lines Horizontal, Thin */ chWorksheet:Range("A1:I9"):Borders(12):Weight = 2. /* Internal Lines Vertical, Thin */ /* Thick outline on Squares... */ DO iSquare = 1 TO 9: DO iEdge = 7 TO 10: ASSIGN chWorksheet:Range(cSquareRange[iSquare]):Borders(iEdge):Weight = 4. /* Thick */ END. END. ASSIGN chExcel:Visible = TRUE. RELEASE OBJECT chWorksheet. RELEASE OBJECT chWorkbook. RELEASE OBJECT chExcel. ASSIGN chExcel = ? chWorkbook = ? chWorksheet = ?. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE ExportHistory Sudoku PROCEDURE ExportHistory : /* Export Entire History File to Excel, 6 Grids per page --- */ DEFINE VARIABLE chExcel AS COM-HANDLE NO-UNDO. DEFINE VARIABLE chWorkbook AS COM-HANDLE NO-UNDO. DEFINE VARIABLE chWorksheet AS COM-HANDLE NO-UNDO. DEFINE VARIABLE cLine AS CHARACTER NO-UNDO. DEFINE VARIABLE iWorkSheet AS INTEGER NO-UNDO. DEFINE VARIABLE iGrid AS INTEGER NO-UNDO. DEFINE VARIABLE iCell AS INTEGER NO-UNDO. DEFINE VARIABLE iExcelRow AS INTEGER NO-UNDO. DEFINE VARIABLE iExcelCol AS INTEGER NO-UNDO. DEFINE VARIABLE iSquare AS INTEGER NO-UNDO. DEFINE VARIABLE iEdge AS INTEGER NO-UNDO. DEFINE VARIABLE iRowAdd AS INTEGER NO-UNDO EXTENT 6 INITIAL [ 0, 0, 10, 10, 20, 20 ]. DEFINE VARIABLE iExcelEdge AS INTEGER NO-UNDO EXTENT 4 INITIAL [ 7, 8, 9, 10 ]. /* Left, Right, Top, Bottom */ DEFINE VARIABLE cSquareRange AS CHARACTER NO-UNDO EXTENT 54 INITIAL [ "A1:C3","A4:C6","A7:C9","D1:F3","D4:F6","D7:F9","G1:I3","G4:I6","G7:I9", "K1:M3","K4:M6","K7:M9","N1:P3","N4:P6","N7:P9","Q1:S3","Q4:S6","Q7:S9", "A11:C13","A14:C16","A17:C19","D11:F13","D14:F16","D17:F19", "G11:I13","G14:I16","G17:I19","K11:M13","K14:M16","K17:M19", "N11:P13","N14:P16","N17:P19","Q11:S13","Q14:S16","Q17:S19", "A21:C23","A24:C26","A27:C29","D21:F23","D24:F26","D27:F29", "G21:I23","G24:I26","G27:I29","K21:M23","K24:M26","K27:M29", "N21:P23","N24:P26","N27:P29","Q21:S23","Q24:S26","Q27:S29" ]. IF SEARCH( "{&HistoryFile}" ) = ? THEN DO: MESSAGE "History File {&HistoryFile} Was Not Found!" VIEW-AS ALERT-BOX ERROR BUTTONS OK. RETURN. END. SESSION:SET-WAIT-STATE( "GENERAL":U ). INPUT FROM VALUE( SEARCH( "{&HistoryFile}" ) ). CREATE "Excel.Application" chExcel. ASSIGN chExcel:Visible = FALSE chWorkbook = chExcel:Workbooks:Add(). B-WORKSHEET: REPEAT: ASSIGN iWorkSheet = iWorkSheet + 1. /* A new workbook already has 3 sheets... */ IF iWorkSheet > 3 THEN DO: /* Add AFTER Last (Default is before) */ chWorksheet = chWorkbook:Worksheets:Item( iWorkSheet - 1 ). chWorkbook:Sheets:Add( ?, chWorksheet, ?, ? ). RELEASE OBJECT chWorksheet. END. ASSIGN chWorksheet = chWorkbook:Worksheets:Item( iWorkSheet ) chWorksheet:Columns("A:S"):ColumnWidth = 4 chWorksheet:Rows("1:29"):RowHeight = 27 chWorksheet:Range("A1:S29"):HorizontalAlignment = -4108 /* Centre */ chWorksheet:Range("A1:S29"):VerticalAlignment = -4108 /* Centre */ chWorksheet:Range("A1:S29"):Font:Bold = TRUE chWorksheet:Range("A1:S29"):Font:SIZE = 16 /* Thin internal lines --- */ chWorksheet:Range("A1:I9"):Borders(11):Weight = 2 /* Internal Lines Horizontal, Thin */ chWorksheet:Range("A1:I9"):Borders(12):Weight = 2 /* Internal Lines Vertical, Thin */ chWorksheet:Range("K1:S9"):Borders(11):Weight = 2 chWorksheet:Range("K1:S9"):Borders(12):Weight = 2 chWorksheet:Range("A11:I19"):Borders(11):Weight = 2 chWorksheet:Range("A11:I19"):Borders(12):Weight = 2 chWorksheet:Range("K11:S19"):Borders(11):Weight = 2 chWorksheet:Range("K11:S19"):Borders(12):Weight = 2 chWorksheet:Range("A21:I29"):Borders(11):Weight = 2 chWorksheet:Range("A21:I29"):Borders(12):Weight = 2 chWorksheet:Range("K21:S29"):Borders(11):Weight = 2 chWorksheet:Range("K21:S29"):Borders(12):Weight = 2 /* Page Setup --- */ chWorksheet:PageSetup:Zoom = 95 chWorksheet:PageSetup:LeftMargin = chExcel:InchesToPoints( 0.3 ) chWorksheet:PageSetup:RightMargin = chExcel:InchesToPoints( 0.3 ) chWorksheet:PageSetup:TopMargin = chExcel:InchesToPoints( 0.3 ) chWorksheet:PageSetup:BottomMargin = chExcel:InchesToPoints( 0.3 ) chWorksheet:PageSetup:HeaderMargin = chExcel:InchesToPoints( 0.3 ) chWorksheet:PageSetup:FooterMargin = chExcel:InchesToPoints( 0.3 ) chWorksheet:PageSetup:CenterHorizontally = TRUE chWorksheet:PageSetup:CenterVertically = TRUE chWorksheet:PageSetup:CenterFooter = "Sudoku Sheet " + STRING( iWorkSheet ). /* Thick outline on Squares... */ DO iSquare = 1 TO 54: DO iEdge = 7 TO 10: ASSIGN chWorksheet:Range(cSquareRange[iSquare]):Borders(iEdge):Weight = 4. /* Thick */ END. END. B-GRID: DO iGrid = 1 TO 6: IMPORT UNFORMATTED cLine. IF cLine = "" THEN LEAVE B-WORKSHEET. B-CELL: DO iCell = 1 TO 81: IF SUBSTRING( cLine, iCell, 1 ) = "0" THEN NEXT B-CELL. ASSIGN iRow = TRUNCATE( ( iCell - 1 ) / 9, 0 ) + 1 iCol = iCell MODULO 9 iCol = ( IF iCol = 0 THEN 9 ELSE iCol ) iExcelRow = iRow + iRowAdd[ iGrid ] iExcelCol = iCol + ( ( ( iGrid + 1 ) MODULO 2 ) * 10 ) chWorksheet:Cells:Item( iExcelRow, iExcelCol ):Value = INTEGER( SUBSTRING( cLine, iCell, 1 ) ). END. END. RELEASE OBJECT chWorksheet. END. INPUT CLOSE. ASSIGN chExcel:Visible = TRUE. RELEASE OBJECT chWorksheet. RELEASE OBJECT chWorkbook. RELEASE OBJECT chExcel. ASSIGN chExcel = ? chWorkbook = ? chWorksheet = ?. SESSION:SET-WAIT-STATE( "":U ). END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE FillGrid Sudoku PROCEDURE FillGrid : /* This procedure will fill the grid with random values, if * it gets stuck, it wipes all values and starts again. */ DEFINE VARIABLE iBlanksPreSolve AS INTEGER NO-UNDO. DEFINE VARIABLE iBlanksPostSolve AS INTEGER NO-UNDO. DEFINE VARIABLE iCellsTried AS INTEGER NO-UNDO. DEFINE VARIABLE cDummy AS CHARACTER NO-UNDO. DEFINE VARIABLE cValues AS CHARACTER NO-UNDO. DEFINE BUFFER aaCell FOR ttCell. B-OUTER: REPEAT ON STOP UNDO, LEAVE: /* Blank all squares */ FOR EACH aaCell: ASSIGN aaCell.CelVal = 0. END. ASSIGN iCellsTried = 0. B-INNER: REPEAT: /* Any Empty Cells Left? */ IF NOT CAN-FIND( FIRST aaCell WHERE aaCell.CelVal = 0 ) OR iCellsTried > {&NumCellsToTry} THEN LEAVE B-INNER. /* Pick A Random Cell */ ASSIGN iRow = RANDOM( 1, 9 ) iCol = RANDOM( 1, 9 ). FIND FIRST aaCell WHERE aaCell.RowNum = iRow AND aaCell.ColNum = iCol. /* Is it Blank ? */ /* If not try another */ IF aaCell.CelVal <> 0 THEN NEXT B-INNER. /* Try Random Values */ ASSIGN cValues = '123456789'. B-TRY: DO WHILE LENGTH( cValues ) > 0: ASSIGN iTempVal = IF LENGTH( cValues ) = 1 THEN INTEGER( cValues ) ELSE INTEGER( SUBSTRING( cValues, RANDOM( 1, LENGTH( cValues ) ), 1 ) ) cValues = REPLACE( cValues, STRING( iTempVal ), '' ). IF Allowed( aaCell.RowNum, aaCell.ColNum, aaCell.SqrNum, iTempVal ) THEN LEAVE B-TRY. ELSE NEXT B-TRY. END. /* Stuck, we can't find a value for this cell */ IF NOT Allowed( aaCell.RowNum, aaCell.ColNum, aaCell.SqrNum, iTempVal ) THEN DO: ASSIGN iCellsTried = iCellsTried + 1. IF iCellsTried >= {&NumCellsToTry} THEN NEXT B-OUTER. /* Stuck, Start Again */ ELSE NEXT B-INNER. /* Try another cell */ END. ELSE ASSIGN aaCell.CelVal = iTempVal. /* To get this far we've managed to add a valid * possible value. Now add any whose value is * constrained by our addition. */ B-Solve: REPEAT: ASSIGN iBlanksPreSolve = NumBlanks(). RUN Rule1 ( INPUT FALSE, OUTPUT cDummy ). RUN Rule2 ( INPUT FALSE, OUTPUT cDummy ). ASSIGN iBlanksPostSolve = NumBlanks(). IF iBlanksPostSolve = iBlanksPreSolve THEN LEAVE B-Solve. /* No improvement */ END. ASSIGN iCellsTried = iCellsTried + 1. END. /* B-INNER */ /* Any Empty Cells Left? */ /* If so, we're stuck, try again */ /* Else we're finished */ IF NOT CAN-FIND( FIRST aaCell WHERE aaCell.CelVal = 0 ) THEN LEAVE B-OUTER. END. /* B-OUTER */ END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE FlashTray Sudoku PROCEDURE FlashTray : /* To flash taskbar icon when generation complete */ /* From OEHive: http://www.oehive.org/node/395 */ DEFINE VARIABLE pfwi AS MEMPTR NO-UNDO. DEFINE VARIABLE hwndParent AS INTEGER NO-UNDO. RUN GetParent (CURRENT-WINDOW:HWND, OUTPUT hwndParent). SET-SIZE (pfwi) = 20. PUT-LONG (pfwi, 1) = GET-SIZE(pfwi). PUT-LONG (pfwi, 5) = hwndParent. PUT-LONG (pfwi, 9) = 2. /* = FLASW_TRAY */ PUT-LONG (pfwi,13) = 3. /* number of times to blink */ PUT-LONG (pfwi,17) = 0. /* blink rate in msec, 0=use system default */ RUN FlashWindowEx ( pfwi ). SET-SIZE(pfwi) = 0. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE Generate Sudoku PROCEDURE Generate : /* Generate a new game --- */ DEFINE VARIABLE iRemove AS INTEGER NO-UNDO. SESSION:SET-WAIT-STATE( "GENERAL":U ). RUN FillGrid. /* Randomly fill grid */ RUN Remove. /* Blank cells without making insoluble */ RUN BackUpCells. /* Save in case of restart */ RUN DisplayCellValues. /* Display Cell Values */ &IF {&HistoryOn} &THEN RUN DumpGame. &ENDIF ASSIGN iStartTime = TIME /* Start the clock... */ iHints = 0 iErrors = 0. SESSION:SET-WAIT-STATE( "":U ). RUN FlashTray. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE LoadBestTimes Sudoku PROCEDURE LoadBestTimes : /* Load ttRanking from the best times file */ IF SEARCH( "{&BestTimesFile}" ) = ? THEN RETURN. EMPTY TEMP-TABLE ttRanking. INPUT FROM VALUE( SEARCH( "{&BestTimesFile}" ) ). REPEAT: CREATE ttRanking. IMPORT ttRanking. END. INPUT CLOSE. FIND FIRST ttRanking WHERE ttRanking.Rank = 0 NO-ERROR. IF AVAILABLE ttRanking THEN DELETE ttRanking. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE LoadGame Sudoku PROCEDURE LoadGame : /* Load a saved game */ DEFINE INPUT PARAMETER cFileName AS CHARACTER NO-UNDO. DEFINE BUFFER aaCell FOR ttCell. DEFINE VARIABLE cRow AS CHARACTER NO-UNDO. DEFINE VARIABLE iTime AS INTEGER NO-UNDO. INPUT FROM VALUE( cFileName ). DO iLoop1 = 1 TO 9: IMPORT UNFORMATTED cRow. DO iLoop2 = 1 TO 9: FIND FIRST aaCell WHERE aaCell.RowNum = iLoop1 AND aaCell.ColNum = iLoop2. ASSIGN aaCell.CelVal = INTEGER( SUBSTRING( cRow, iLoop2, 1 ) ). END. END. IMPORT iTime. IMPORT iHints. IMPORT iErrors. INPUT CLOSE. RUN BackUpCells. RUN DisplayCellValues. ASSIGN iStartTime = TIME - iTime. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE PopttCell Sudoku PROCEDURE PopttCell : /* Initialise ttCell, Populate Row, Column and Square Numbers * Rows and Columns are numbered from top left. * Squares are numbered as follows: * 1 2 3 * 4 5 6 * 7 8 9 */ DEFINE VARIABLE hFieldGroup AS HANDLE NO-UNDO. DEFINE VARIABLE hWidget AS HANDLE NO-UNDO. DEFINE BUFFER aaCell FOR ttCell. /* Only needs done once... */ IF CAN-FIND( FIRST aaCell ) THEN RETURN. DO iRow = 1 TO 9: DO iCol = 1 TO 9: CREATE aaCell. ASSIGN aaCell.RowNum = iRow aaCell.ColNum = iCol. IF iRow >= 1 AND iRow <= 3 AND iCol >= 1 AND iCol <= 3 THEN aaCell.SqrNum = 1. IF iRow >= 1 AND iRow <= 3 AND iCol >= 4 AND iCol <= 6 THEN aaCell.SqrNum = 2. IF iRow >= 1 AND iRow <= 3 AND iCol >= 7 AND iCol <= 9 THEN aaCell.SqrNum = 3. IF iRow >= 4 AND iRow <= 6 AND iCol >= 1 AND iCol <= 3 THEN aaCell.SqrNum = 4. IF iRow >= 4 AND iRow <= 6 AND iCol >= 4 AND iCol <= 6 THEN aaCell.SqrNum = 5. IF iRow >= 4 AND iRow <= 6 AND iCol >= 7 AND iCol <= 9 THEN aaCell.SqrNum = 6. IF iRow >= 7 AND iRow <= 9 AND iCol >= 1 AND iCol <= 3 THEN aaCell.SqrNum = 7. IF iRow >= 7 AND iRow <= 9 AND iCol >= 4 AND iCol <= 6 THEN aaCell.SqrNum = 8. IF iRow >= 7 AND iRow <= 9 AND iCol >= 7 AND iCol <= 9 THEN aaCell.SqrNum = 9. END. END. /* Create Cell BackUp table... */ FOR EACH aaCell: CREATE BkUpCell. ASSIGN BkUpCell.RowNum = aaCell.RowNum BkUpCell.ColNum = aaCell.ColNum. END. ASSIGN hFieldGroup = FRAME {&FRAME-NAME}:FIRST-CHILD hWidget = hFieldGroup:FIRST-CHILD. DO WHILE VALID-HANDLE( hWidget ): IF hWidget:TYPE = "FILL-IN" THEN DO: ASSIGN iCol = hWidget:INDEX. CASE hWidget:NAME: WHEN "fiRow1":U THEN ASSIGN iRow = 1. WHEN "fiRow2":U THEN ASSIGN iRow = 2. WHEN "fiRow3":U THEN ASSIGN iRow = 3. WHEN "fiRow4":U THEN ASSIGN iRow = 4. WHEN "fiRow5":U THEN ASSIGN iRow = 5. WHEN "fiRow6":U THEN ASSIGN iRow = 6. WHEN "fiRow7":U THEN ASSIGN iRow = 7. WHEN "fiRow8":U THEN ASSIGN iRow = 8. WHEN "fiRow9":U THEN ASSIGN iRow = 9. END CASE. FIND FIRST aaCell WHERE aaCell.RowNum = iRow AND aaCell.ColNum = iCol. ASSIGN aaCell.whCell = hWidget. END. ASSIGN hWidget = hWidget:NEXT-SIBLING. END. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE Rankings Sudoku PROCEDURE Rankings : /* Re-Evaluate Rankings */ /* Rankings = 0 means do not save rankings */ IF {&Rankings} = 0 THEN RETURN. /* Work Out Ranking --- */ IF CAN-FIND( FIRST ttRanking ) THEN B-RANK1: FOR EACH ttRanking BY ttRanking.GameTime: IF iGameTime < ttRanking.GameTime THEN DO: ASSIGN iRank = ttRanking.Rank. LEAVE B-RANK1. END. ELSE ASSIGN iRank = ttRanking.Rank + 1. END. ELSE ASSIGN iRank = 1. /* Not made the Hall of Fame --- */ IF iRank > {&Rankings} THEN RETURN. /* To get to here you're in the Hall of Fame --- */ EMPTY TEMP-TABLE BkUpRanking. FOR EACH ttRanking: CREATE BkUpRanking. BUFFER-COPY ttRanking TO BkUpRanking. END. EMPTY TEMP-TABLE ttRanking. B-RANK2: DO iLoop1 = 1 TO {&Rankings}: IF iLoop1 = iRank THEN DO: CREATE ttRanking. ASSIGN ttRanking.Rank = iLoop1 ttRanking.GameTime = iGameTime ttRanking.Player = cName. END. ELSE IF iLoop1 < iRank THEN DO: FIND FIRST BkUpRanking WHERE BkUpRanking.Rank = iLoop1 NO-ERROR. IF NOT AVAILABLE BkUpRanking THEN LEAVE B-RANK2. CREATE ttRanking. BUFFER-COPY BkUpRanking TO ttRanking. END. ELSE IF iLoop1 > iRank THEN DO: FIND FIRST BkUpRanking WHERE BkUpRanking.Rank = iLoop1 - 1 NO-ERROR. IF NOT AVAILABLE BkUpRanking THEN LEAVE B-RANK2. CREATE ttRanking. BUFFER-COPY BkUpRanking TO ttRanking ASSIGN ttRanking.Rank = iLoop1. END. END. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE Remove Sudoku PROCEDURE Remove : /* Remove Cell Values without making it insoluble */ DEFINE VARIABLE iBlankAttempts AS INTEGER NO-UNDO. DEFINE VARIABLE iCurrentBlanks AS INTEGER NO-UNDO. DEFINE VARIABLE iLastTimeBlanks AS INTEGER NO-UNDO. DEFINE VARIABLE cDummy AS CHARACTER NO-UNDO. DEFINE BUFFER aaCell FOR ttCell. B-Blank: REPEAT FOR aaCell ON STOP UNDO, LEAVE: /* First do BackUp */ RUN BackUpCells. /* Pick a non-blank cell */ B-Pick: REPEAT: ASSIGN iRow = RANDOM( 1, 9 ) iCol = RANDOM( 1, 9 ). FIND FIRST aaCell WHERE aaCell.RowNum = iRow AND aaCell.ColNum = iCol. IF aaCell.CelVal = 0 /* Is it Blank ? */ THEN NEXT B-Pick. /* If so try another */ ELSE LEAVE B-Pick. END. /* Blank It */ ASSIGN aaCell.CelVal = 0. /* Count Blanks */ ASSIGN iLastTimeBlanks = numBlanks(). B-SOLVE: REPEAT: /* Run a solve */ RUN Rule1 ( INPUT FALSE, OUTPUT cDummy ). RUN Rule2 ( INPUT FALSE, OUTPUT cDummy ). /* Count Blanks Again */ ASSIGN iCurrentBlanks = NumBlanks(). IF iCurrentBlanks = 0 /* <---Solved */ OR iCurrentBlanks = iLastTimeBlanks /* <---Stuck */ THEN LEAVE B-SOLVE. ASSIGN iLastTimeBlanks = iCurrentBlanks. END. /* Restore in case we're stuck */ RUN RestoreCells. IF iCurrentBlanks = 0 THEN DO: /* Still solvable, 'Re-Blank' * ( RUN RestoreCells. will have 'Un-Blanked' it ) * and carry on blanking... */ ASSIGN aaCell.CelVal = 0. NEXT B-Blank. /* Still Solvable, Re-Blank carry on blanking */ END. ELSE DO: /* Now unsolvable, DON'T 'Re-Blank' try blanking * another until the attempts limit is reached... */ ASSIGN iBlankAttempts = iBlankAttempts + 1. IF iBlankAttempts >= {&NumBlanksToTry} THEN LEAVE B-Blank. /* Now Insoluble */ END. END. /* B-Blank */ END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE RestoreCells Sudoku PROCEDURE RestoreCells : /* Restore Previously saved backup of cell values... */ DEFINE BUFFER aaCell FOR ttCell. FOR EACH BkUpCell, FIRST aaCell WHERE aaCell.RowNum = BkUpCell.RowNum AND aaCell.ColNum = BkUpCell.ColNum: ASSIGN aaCell.CelVal = BkUpCell.CelVal. END. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE Rule1 Sudoku PROCEDURE Rule1 : /* Solve by the following logic - * If a particular cell can only have one value, * then that cell must indeed have that value. */ DEFINE INPUT PARAMETER plOneOnly AS LOGICAL NO-UNDO. DEFINE OUTPUT PARAMETER pcHint AS CHARACTER NO-UNDO. DEFINE VARIABLE iPossibilities AS INTEGER NO-UNDO. DEFINE VARIABLE iPossible AS INTEGER NO-UNDO. DEFINE BUFFER aaCell FOR ttCell. FOR EACH aaCell WHERE aaCell.CelVal = 0: ASSIGN iPossibilities = 0. DO iTempVal = 1 TO 9: IF Allowed( aaCell.RowNum, aaCell.ColNum, aaCell.SqrNum, iTempVal ) THEN ASSIGN iPossibilities = iPossibilities + 1 iPossible = iTempVal. END. IF iPossibilities = 1 THEN DO: ASSIGN aaCell.CelVal = iPossible. IF plOneOnly THEN DO: ASSIGN pcHint = "The cell at row " + STRING( aaCell.RowNum, "9" ) + " column " + STRING( aaCell.ColNum, "9" ) + " can only be a " + STRING( aaCell.CelVal, "9" ) + " (Rule 1).". RETURN. END. END. END. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE Rule2 Sudoku PROCEDURE Rule2 : /* Solve by the following logic - * If a particular square (or row or column) still requires a particular * value, and that value, can only be placed in one cell in that square * (or row or column) then place that value in that cell. * NB. The same code is repeated 3 times, for rows columns and squares * making it an ideal candidate for an include file, but then we'd need * to think about PROPATH... */ DEFINE INPUT PARAMETER plOneOnly AS LOGICAL NO-UNDO. DEFINE OUTPUT PARAMETER pcHint AS CHARACTER NO-UNDO. DEFINE VARIABLE iPossibilities AS INTEGER NO-UNDO. DEFINE VARIABLE iRowColSqr AS INTEGER NO-UNDO. DEFINE BUFFER aaCell FOR ttCell. DO iRowColSqr = 1 TO 9: /* Value to place --- */ DO iTempVal = 1 TO 9: /* -----=====<<<<< SQUARES >>>>>=====----- */ /* Only looking to place values not already got --- */ IF NOT CAN-FIND( FIRST aaCell WHERE aaCell.SqrNum = iRowColSqr AND aaCell.CelVal = iTempVal ) THEN DO: ASSIGN iPossibilities = 0. FOR EACH aaCell WHERE aaCell.SqrNum = iRowColSqr AND aaCell.CelVal = 0: IF Allowed( aaCell.RowNum, aaCell.ColNum, aaCell.SqrNum, iTempVal ) THEN ASSIGN iPossibilities = iPossibilities + 1 iRow = aaCell.RowNum iCol = aaCell.ColNum. END. IF iPossibilities = 1 THEN DO: FIND FIRST aaCell WHERE aaCell.RowNum = iRow AND aaCell.ColNum = iCol. ASSIGN aaCell.CelVal = iTempVal. IF plOneOnly THEN DO: ASSIGN pcHint = "Square " + STRING( iRowColSqr, "9" ) + " needs a " + STRING( iTempVal, "9" ) + " (Rule 2).". RETURN. END. END. END. /* Square Check */ /* -----=====<<<<< ROWS >>>>>=====----- */ /* Only looking to place values not already got --- */ IF NOT CAN-FIND( FIRST aaCell WHERE aaCell.RowNum = iRowColSqr AND aaCell.CelVal = iTempVal ) THEN DO: ASSIGN iPossibilities = 0. FOR EACH aaCell WHERE aaCell.RowNum = iRowColSqr AND aaCell.CelVal = 0: IF Allowed( aaCell.RowNum, aaCell.ColNum, aaCell.SqrNum, iTempVal ) THEN ASSIGN iPossibilities = iPossibilities + 1 iRow = aaCell.RowNum iCol = aaCell.ColNum. END. IF iPossibilities = 1 THEN DO: FIND FIRST aaCell WHERE aaCell.RowNum = iRow AND aaCell.ColNum = iCol. ASSIGN aaCell.CelVal = iTempVal. IF plOneOnly THEN DO: ASSIGN pcHint = "Row " + STRING( iRowColSqr, "9" ) + " needs a " + STRING( iTempVal, "9" ) + " (Rule 2).". RETURN. END. END. END. /* Row Check */ /* -----=====<<<<< COLUMNS >>>>>=====----- */ /* Only looking to place values not already got --- */ IF NOT CAN-FIND( FIRST aaCell WHERE aaCell.ColNum = iRowColSqr AND aaCell.CelVal = iTempVal ) THEN DO: ASSIGN iPossibilities = 0. FOR EACH aaCell WHERE aaCell.ColNum = iRowColSqr AND aaCell.CelVal = 0: IF Allowed( aaCell.RowNum, aaCell.ColNum, aaCell.SqrNum, iTempVal ) THEN ASSIGN iPossibilities = iPossibilities + 1 iRow = aaCell.RowNum iCol = aaCell.ColNum. END. IF iPossibilities = 1 THEN DO: FIND FIRST aaCell WHERE aaCell.RowNum = iRow AND aaCell.ColNum = iCol. ASSIGN aaCell.CelVal = iTempVal. IF plOneOnly THEN DO: ASSIGN pcHint = "Column " + STRING( iRowColSqr, "9" ) + " needs a " + STRING( iTempVal, "9" ) + " (Rule 2).". RETURN. END. END. END. /* Column Check */ END. /* iTempVal = 1 TO 9 (Values to Place) */ END. /* iLoop = 1 TO 9 (Squares, Rows and Columns )*/ END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE SaveBestTimes Sudoku PROCEDURE SaveBestTimes : /* Write ttRanking to the best times file */ OUTPUT TO VALUE( "{&BestTimesFile}" ). FOR EACH ttRanking WHERE ttRanking.Rank <= {&Rankings}: EXPORT ttRanking. END. OUTPUT CLOSE. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE SaveGame Sudoku PROCEDURE SaveGame : /* Save the current game */ DEFINE INPUT PARAMETER cFileName AS CHARACTER NO-UNDO. DEFINE BUFFER aaCell FOR ttCell. OUTPUT TO VALUE( cFileName ). FOR EACH aaCell BREAK BY aaCell.RowNum BY aaCell.ColNum: PUT aaCell.CelVal FORMAT "9". IF LAST-OF( aaCell.RowNum ) THEN PUT SKIP. END. EXPORT ( TIME - iStartTime ). EXPORT iHints. EXPORT iErrors. OUTPUT CLOSE. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME /* ************************ Function Implementations ***************** */ &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION Allowed Sudoku FUNCTION Allowed RETURNS LOGICAL ( INPUT ipiRow AS INTEGER, INPUT ipiCol AS INTEGER, INPUT ipiSqr AS INTEGER, INPUT ipiVal AS INTEGER ) : DEFINE BUFFER aaCell FOR ttCell. DEFINE BUFFER bbCell FOR ttCell. /* May be correcting an error by deleting a value... */ IF ipiVal = 0 THEN RETURN TRUE. /* First get the cell we're checking... */ FIND FIRST aaCell WHERE aaCell.RowNum = ipiRow AND aaCell.ColNum = ipiCol. /* Now make sure there are no OTHER cells in the * same row, column or square with the same value... */ RETURN NOT CAN-FIND( FIRST bbCell WHERE bbCell.RowNum = ipiRow AND bbCell.CelVal = ipiVal AND ROWID( bbCell ) <> ROWID( aaCell ) ) AND NOT CAN-FIND( FIRST bbCell WHERE bbCell.ColNum = ipiCol AND bbCell.CelVal = ipiVal AND ROWID( bbCell ) <> ROWID( aaCell ) ) AND NOT CAN-FIND( FIRST bbCell WHERE bbCell.SqrNum = ipiSqr AND bbCell.CelVal = ipiVal AND ROWID( bbCell ) <> ROWID( aaCell ) ). END FUNCTION. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION Indent Sudoku FUNCTION Indent RETURNS CHARACTER ( INPUT ipcString AS CHARACTER, INPUT ipiTotTab AS INTEGER ): &SCOPED-DEFINE TabWidth 9.6001 RETURN ipcString + FILL( "~t", ipiTotTab - INTEGER( TRUNCATE( FONT-TABLE:GET-TEXT-WIDTH-CHARS( ipcString ) / {&TabWidth}, 0 ) ) ). END FUNCTION. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION NumBlanks Sudoku FUNCTION NumBlanks RETURNS INTEGER(): DEFINE VARIABLE iBlanks AS INTEGER NO-UNDO. DEFINE BUFFER aaCell FOR ttCell. FOR EACH aaCell WHERE aaCell.CelVal = 0: ASSIGN iBlanks = iBlanks + 1. END. RETURN iBlanks. END FUNCTION. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME