"Fossies" - the Fresh Open Source Software Archive 
Member "seed7/prg/sudoku7.sd7" (29 Nov 2020, 86363 Bytes) of package /linux/misc/seed7_05_20210223.tgz:
As a special service "Fossies" has tried to format the requested text file into HTML format (style:
standard) with prefixed line numbers.
Alternatively you can here
view or
download the uninterpreted source code file.
See also the last
Fossies "Diffs" side-by-side code changes report for "sudoku7.sd7":
05_20200929_vs_05_20201208.
1
2 (********************************************************************)
3 (* *)
4 (* sudoku7.sd7 Sudoku program *)
5 (* Copyright (C) 2006 Thomas Mertes *)
6 (* *)
7 (* This program is free software; you can redistribute it and/or *)
8 (* modify it under the terms of the GNU General Public License as *)
9 (* published by the Free Software Foundation; either version 2 of *)
10 (* the License, or (at your option) any later version. *)
11 (* *)
12 (* This program is distributed in the hope that it will be useful, *)
13 (* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
14 (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *)
15 (* GNU General Public License for more details. *)
16 (* *)
17 (* You should have received a copy of the GNU General Public *)
18 (* License along with this program; if not, write to the *)
19 (* Free Software Foundation, Inc., 51 Franklin Street, *)
20 (* Fifth Floor, Boston, MA 02110-1301, USA. *)
21 (* *)
22 (********************************************************************)
23
24
25 $ include "seed7_05.s7i";
26 include "window.s7i";
27 include "keybd.s7i";
28 include "float.s7i";
29 include "draw.s7i";
30 include "stdfont9.s7i";
31 include "pixmap_file.s7i";
32 include "dialog.s7i";
33 include "pic16.s7i";
34
35 const integer: WINDOW_WIDTH is 896;
36 const integer: WINDOW_HEIGHT is 704;
37 const integer: STRETCH_FACTOR is 68;
38 const integer: PIXMAP_SIZE is 32;
39 const integer: SMALL_PIXMAP_SIZE is 16;
40 const integer: FIELD_XPOS is 8;
41 const integer: FIELD_YPOS is 64;
42 const integer: FIELD_BORDER is 3;
43
44 const integer: X_SHIFT is FIELD_XPOS + FIELD_BORDER - STRETCH_FACTOR * 2;
45 const integer: Y_SHIFT is FIELD_YPOS + FIELD_BORDER - STRETCH_FACTOR * 2;
46
47 const integer: CELL_SHIFT is 5;
48 const integer: CELL_SIZE is STRETCH_FACTOR - 2 * CELL_SHIFT + 1;
49 const integer: PIXMAP_SHIFT is CELL_SHIFT + (CELL_SIZE - PIXMAP_SIZE) div 2;
50 const integer: SMALL_PIXMAP_SHIFT is CELL_SHIFT + (CELL_SIZE - 3 * SMALL_PIXMAP_SIZE) div 2;
51
52 const integer: TOP_BUTTON_Y is 16;
53 const integer: TOP_BUTTON_MIN_X is 14;
54 const integer: RIGHT_BUTTON_X is X_SHIFT + STRETCH_FACTOR * 11 + 16;
55 const integer: RIGHT_BUTTON_MIN_Y is Y_SHIFT + STRETCH_FACTOR * 2 + CELL_SHIFT;
56
57 const integer: EXIT_BUTTON_X is 850;
58
59 const color: BACKGROUND is black;
60 const color: FOREGROUND is white;
61
62 var text: info is STD_NULL;
63 var array PRIMITIVE_WINDOW: blue_digits is 0 times PRIMITIVE_WINDOW.value;
64 var array PRIMITIVE_WINDOW: red_digits is 0 times PRIMITIVE_WINDOW.value;
65 var array PRIMITIVE_WINDOW: small_digits is 0 times PRIMITIVE_WINDOW.value;
66 var PRIMITIVE_WINDOW: single_pixmap is PRIMITIVE_WINDOW.value;
67 var PRIMITIVE_WINDOW: double_pixmap is PRIMITIVE_WINDOW.value;
68 var PRIMITIVE_WINDOW: triple_pixmap is PRIMITIVE_WINDOW.value;
69 var PRIMITIVE_WINDOW: exit_pixmap is PRIMITIVE_WINDOW.value;
70 var PRIMITIVE_WINDOW: checkmark_pixmap is PRIMITIVE_WINDOW.value;
71
72 var array array integer: field is 9 times 9 times 0;
73 var array array bitset: candidates is 9 times 9 times EMPTY_SET;
74 var array array boolean: user_input is 9 times 9 times FALSE;
75 var boolean: blue_changes is FALSE;
76 var boolean: show_candidates is FALSE;
77 var boolean: show_solution is FALSE;
78 var boolean: lookForSingles is FALSE;
79 var boolean: lookForHiddenSingles is FALSE;
80 var boolean: lookForLockedCandidates is FALSE;
81 var boolean: lookForNakedPairs is FALSE;
82 var boolean: lookForNakedTriples is FALSE;
83 var boolean: lookForNakedQuads is FALSE;
84 var boolean: lookForHiddenPairs is FALSE;
85 var boolean: lookForHiddenTriples is FALSE;
86 var boolean: lookForHiddenQuads is FALSE;
87 var boolean: lookForXWing is FALSE;
88 var boolean: lookForSwordfish is FALSE;
89
90 var boolean: quit is FALSE;
91
92
93 const array string: blue_zero is [](
94 " ",
95 " ",
96 " xBBBBBBBBBc ",
97 " xBBc xBBc ",
98 " xBc xBc ",
99 " xBc xBc ",
100 " xBc xBc ",
101 " xBc xBc ",
102 " xBc xBBBc ",
103 " xBc xBBBBc ",
104 " xBc xBBBBc ",
105 " xBc xBBBBc ",
106 " xBc xBBBBc ",
107 " xBBc xBBBBc ",
108 " xBBBBBBBBBc ",
109 " ");
110
111
112 const array string: blue_one is [](
113 " ",
114 " ",
115 " xBBBBc ",
116 " xBc ",
117 " xBc ",
118 " xBc ",
119 " xBc ",
120 " xBc ",
121 " xBBBc ",
122 " xBBBBc ",
123 " xBBBBc ",
124 " xBBBBc ",
125 " xBBBBc ",
126 " xBBBBc ",
127 " xBBBBBBBBBBc ",
128 " ");
129
130
131 const array string: blue_two is [](
132 " ",
133 " ",
134 " xBBBBBBBBBc ",
135 " xBBc xBBc ",
136 " xBc xBc ",
137 " xBc ",
138 " xBc ",
139 " xBc ",
140 " xBBBBBBBBBc ",
141 " xBBBBc ",
142 " xBBBBc ",
143 " xBBBBc ",
144 " xBBBBc ",
145 " xBBBBc ",
146 " xBBBBBBBBBBBc ",
147 " ");
148
149
150 const array string: blue_three is [](
151 " ",
152 " ",
153 " xBBBBBBBBBc ",
154 " xBBc xBBc ",
155 " xBc xBc ",
156 " xBc ",
157 " xBc ",
158 " xBc ",
159 " xBBBBBBBBBc ",
160 " xBBBBc ",
161 " xBBBBc ",
162 " xBBBBc ",
163 " xBc xBBBBc ",
164 " xBBc xBBBBc ",
165 " xBBBBBBBBBc ",
166 " ");
167
168
169 const array string: blue_four is [](
170 " ",
171 " ",
172 " xBc ",
173 " xBc ",
174 " xBc ",
175 " xBc ",
176 " xBc xBc ",
177 " xBc xBc ",
178 " xBBBBBBBBBBBc ",
179 " xBBBBc ",
180 " xBBBBc ",
181 " xBBBBc ",
182 " xBBBBc ",
183 " xBBBBc ",
184 " xBBBBc ",
185 " ");
186
187 const array string: blue_five is [](
188 " ",
189 " ",
190 " xBBBBBBBBBBBc ",
191 " xBc ",
192 " xBc ",
193 " xBc ",
194 " xBc ",
195 " xBc ",
196 " xBBBBBBBBBBc ",
197 " xBBBBc ",
198 " xBBBBc ",
199 " xBBBBc ",
200 " xBc xBBBBc ",
201 " xBBc xBBBBc ",
202 " xBBBBBBBBBc ",
203 " ");
204
205
206 const array string: blue_six is [](
207 " ",
208 " ",
209 " xBBBBBBBBBc ",
210 " xBBc xBBc ",
211 " xBc xBc ",
212 " xBc ",
213 " xBc ",
214 " xBc ",
215 " xBBBBBBBBBBc ",
216 " xBc xBBBBc ",
217 " xBc xBBBBc ",
218 " xBc xBBBBc ",
219 " xBc xBBBBc ",
220 " xBBc xBBBBc ",
221 " xBBBBBBBBBc ",
222 " ");
223
224
225 const array string: blue_seven is [](
226 " ",
227 " ",
228 " xBBBBBBBBBBBc ",
229 " xBc ",
230 " xBc ",
231 " xBc ",
232 " xBc ",
233 " xBBc ",
234 " xBBBBBBc ",
235 " xBBBBc ",
236 " xBBBBc ",
237 " xBBBBc ",
238 " xBBBBc ",
239 " xBBBBc ",
240 " xBBBBc ",
241 " ");
242
243
244 const array string: blue_eight is [](
245 " ",
246 " ",
247 " xBBBBBBBBBc ",
248 " xBBc xBBc ",
249 " xBc xBc ",
250 " xBc xBc ",
251 " xBc xBc ",
252 " xBc xBc ",
253 " xBBBBBBBBBc ",
254 " xBc xBBBBc ",
255 " xBc xBBBBc ",
256 " xBc xBBBBc ",
257 " xBc xBBBBc ",
258 " xBBc xBBBBc ",
259 " xBBBBBBBBBc ",
260 " ");
261
262
263 const array string: blue_nine is [](
264 " ",
265 " ",
266 " xBBBBBBBBBc ",
267 " xBBc xBBc ",
268 " xBc xBc ",
269 " xBc xBc ",
270 " xBc xBc ",
271 " xBc xBc ",
272 " xBBBBBBBBBBc ",
273 " xBBBBc ",
274 " xBBBBc ",
275 " xBBBBc ",
276 " xBc xBBBBc ",
277 " xBBc xBBBBc ",
278 " xBBBBBBBBBc ",
279 " ");
280
281
282 const array string: red_zero is [](
283 " ",
284 " ",
285 " xRRRRRRRRRO ",
286 " xRRO xRRO ",
287 " xRO xRO ",
288 " xRO xRO ",
289 " xRO xRO ",
290 " xRO xRO ",
291 " xRO xRRRO ",
292 " xRO xRRRRO ",
293 " xRO xRRRRO ",
294 " xRO xRRRRO ",
295 " xRO xRRRRO ",
296 " xRRO xRRRRO ",
297 " xRRRRRRRRRO ",
298 " ");
299
300
301 const array string: red_one is [](
302 " ",
303 " ",
304 " xRRRRO ",
305 " xRO ",
306 " xRO ",
307 " xRO ",
308 " xRO ",
309 " xRO ",
310 " xRRRO ",
311 " xRRRRO ",
312 " xRRRRO ",
313 " xRRRRO ",
314 " xRRRRO ",
315 " xRRRRO ",
316 " xRRRRRRRRRRO ",
317 " ");
318
319
320 const array string: red_two is [](
321 " ",
322 " ",
323 " xRRRRRRRRRO ",
324 " xRRO xRRO ",
325 " xRO xRO ",
326 " xRO ",
327 " xRO ",
328 " xRO ",
329 " xRRRRRRRRRO ",
330 " xRRRRO ",
331 " xRRRRO ",
332 " xRRRRO ",
333 " xRRRRO ",
334 " xRRRRO ",
335 " xRRRRRRRRRRRO ",
336 " ");
337
338
339 const array string: red_three is [](
340 " ",
341 " ",
342 " xRRRRRRRRRO ",
343 " xRRO xRRO ",
344 " xRO xRO ",
345 " xRO ",
346 " xRO ",
347 " xRO ",
348 " xRRRRRRRRRO ",
349 " xRRRRO ",
350 " xRRRRO ",
351 " xRRRRO ",
352 " xRO xRRRRO ",
353 " xRRO xRRRRO ",
354 " xRRRRRRRRRO ",
355 " ");
356
357
358 const array string: red_four is [](
359 " ",
360 " ",
361 " xRO ",
362 " xRO ",
363 " xRO ",
364 " xRO ",
365 " xRO xRO ",
366 " xRO xRO ",
367 " xRRRRRRRRRRRO ",
368 " xRRRRO ",
369 " xRRRRO ",
370 " xRRRRO ",
371 " xRRRRO ",
372 " xRRRRO ",
373 " xRRRRO ",
374 " ");
375
376 const array string: red_five is [](
377 " ",
378 " ",
379 " xRRRRRRRRRRRO ",
380 " xRO ",
381 " xRO ",
382 " xRO ",
383 " xRO ",
384 " xRO ",
385 " xRRRRRRRRRRO ",
386 " xRRRRO ",
387 " xRRRRO ",
388 " xRRRRO ",
389 " xRO xRRRRO ",
390 " xRRO xRRRRO ",
391 " xRRRRRRRRRO ",
392 " ");
393
394
395 const array string: red_six is [](
396 " ",
397 " ",
398 " xRRRRRRRRRO ",
399 " xRRO xRRO ",
400 " xRO xRO ",
401 " xRO ",
402 " xRO ",
403 " xRO ",
404 " xRRRRRRRRRRO ",
405 " xRO xRRRRO ",
406 " xRO xRRRRO ",
407 " xRO xRRRRO ",
408 " xRO xRRRRO ",
409 " xRRO xRRRRO ",
410 " xRRRRRRRRRO ",
411 " ");
412
413
414 const array string: red_seven is [](
415 " ",
416 " ",
417 " xRRRRRRRRRRRO ",
418 " xRO ",
419 " xRO ",
420 " xRO ",
421 " xRO ",
422 " xRRO ",
423 " xRRRRRRO ",
424 " xRRRRO ",
425 " xRRRRO ",
426 " xRRRRO ",
427 " xRRRRO ",
428 " xRRRRO ",
429 " xRRRRO ",
430 " ");
431
432
433 const array string: red_eight is [](
434 " ",
435 " ",
436 " xRRRRRRRRRO ",
437 " xRRO xRRO ",
438 " xRO xRO ",
439 " xRO xRO ",
440 " xRO xRO ",
441 " xRO xRO ",
442 " xRRRRRRRRRO ",
443 " xRO xRRRRO ",
444 " xRO xRRRRO ",
445 " xRO xRRRRO ",
446 " xRO xRRRRO ",
447 " xRRO xRRRRO ",
448 " xRRRRRRRRRO ",
449 " ");
450
451
452 const array string: red_nine is [](
453 " ",
454 " ",
455 " xRRRRRRRRRO ",
456 " xRRO xRRO ",
457 " xRO xRO ",
458 " xRO xRO ",
459 " xRO xRO ",
460 " xRO xRO ",
461 " xRRRRRRRRRRO ",
462 " xRRRRO ",
463 " xRRRRO ",
464 " xRRRRO ",
465 " xRO xRRRRO ",
466 " xRRO xRRRRO ",
467 " xRRRRRRRRRO ",
468 " ");
469
470
471 const array string: blue_single is [](
472 " ",
473 " ",
474 " ",
475 " ",
476 " xBBBc ",
477 " xBBBBBc ",
478 " xBBBBBBBc ",
479 " xBBBBBBBc ",
480 " xBBBBBBBc ",
481 " xBBBBBc ",
482 " xBBBc ",
483 " ",
484 " ",
485 " ",
486 " ");
487
488
489 const array string: blue_double is [](
490 " ",
491 " xBBBc ",
492 " xBBBBBc ",
493 " xBBBBBc ",
494 " xBBBBBc ",
495 " xBBBc ",
496 " ",
497 " ",
498 " ",
499 " ",
500 " ",
501 " xBBBc ",
502 " xBBBBBc",
503 " xBBBBBc",
504 " xBBBBBc",
505 " xBBBc ");
506
507
508 const array string: blue_triple is [](
509 " ",
510 " xBc ",
511 " xBBBc ",
512 " xBBBc ",
513 " xBc ",
514 " ",
515 " xBc ",
516 " xBBBc ",
517 " xBBBc ",
518 " xBc ",
519 " ",
520 " xBc ",
521 " xBBBc",
522 " xBBBc",
523 " xBc ");
524
525
526 const array string: candidates_pic is [](
527 " ",
528 " BB BBB BBB",
529 " B B B",
530 " B B BB",
531 " BBB BBB BBB",
532 " ",
533 " B BBB BB",
534 " B B B B ",
535 " BBB BBB BBB",
536 " B BB BBB",
537 " ",
538 " BBB BBB BBB",
539 " B BBB BBB",
540 " B BBB B",
541 " B BBB BB ");
542
543
544 const proc: initCandidates is func
545 local
546 var integer: row is 0;
547 var integer: column is 0;
548 begin
549 for row range 1 to 9 do
550 for column range 1 to 9 do
551 if user_input[row][column] then
552 candidates[row][column] := {field[row][column]};
553 else
554 field[row][column] := 0;
555 candidates[row][column] := {1 .. 9};
556 rect(X_SHIFT + STRETCH_FACTOR * succ(column) + CELL_SHIFT,
557 Y_SHIFT + STRETCH_FACTOR * succ(row) + CELL_SHIFT,
558 CELL_SIZE, CELL_SIZE, BACKGROUND);
559 end if;
560 end for;
561 end for;
562 end func;
563
564
565 const proc: initGrid is func
566 local
567 var integer: row is 0;
568 var integer: column is 0;
569 begin
570 for row range 1 to 10 do
571 if row rem 3 = 1 then
572 rect(X_SHIFT + STRETCH_FACTOR * 2 - 1, Y_SHIFT + STRETCH_FACTOR * succ(row) - 1,
573 STRETCH_FACTOR * 9 + 3, 3, FOREGROUND);
574 else
575 line(X_SHIFT + STRETCH_FACTOR * 2, Y_SHIFT + STRETCH_FACTOR * succ(row),
576 STRETCH_FACTOR * 9, 0, FOREGROUND);
577 end if;
578 end for;
579 for column range 1 to 10 do
580 if column rem 3 = 1 then
581 rect(X_SHIFT + STRETCH_FACTOR * succ(column) - 1, Y_SHIFT + STRETCH_FACTOR * 2 - 1,
582 3, STRETCH_FACTOR * 9 + 3, FOREGROUND);
583 else
584 line(X_SHIFT + STRETCH_FACTOR * succ(column), Y_SHIFT + STRETCH_FACTOR * 2,
585 0, STRETCH_FACTOR * 9, FOREGROUND);
586 end if;
587 end for;
588 end func;
589
590
591 const proc: clearField (in integer: row, in integer: column) is func
592 begin
593 rect(X_SHIFT + STRETCH_FACTOR * succ(column) + CELL_SHIFT + 1,
594 Y_SHIFT + STRETCH_FACTOR * succ(row) + CELL_SHIFT + 1,
595 CELL_SIZE - 2, CELL_SIZE - 2, BACKGROUND);
596 end func;
597
598
599 const proc: markField (in integer: row, in integer: column) is func
600 begin
601 rect(X_SHIFT + STRETCH_FACTOR * succ(column) + CELL_SHIFT + 1,
602 Y_SHIFT + STRETCH_FACTOR * succ(row) + CELL_SHIFT + 1,
603 CELL_SIZE - 2, CELL_SIZE - 2, light_gray);
604 end func;
605
606
607 const proc: clearDigit (in integer: row, in integer: column) is func
608 begin
609 field[row][column] := 0;
610 user_input[row][column] := FALSE;
611 initCandidates;
612 rect(X_SHIFT + STRETCH_FACTOR * succ(column) + PIXMAP_SHIFT,
613 Y_SHIFT + STRETCH_FACTOR * succ(row) + PIXMAP_SHIFT,
614 PIXMAP_SIZE, PIXMAP_SIZE, BACKGROUND);
615 end func;
616
617
618 const proc: setRedDigit (in integer: row, in integer: column,
619 in integer: digit) is func
620 begin
621 field[row][column] := digit;
622 user_input[row][column] := TRUE;
623 candidates[row][column] := {digit};
624 clearField(row, column);
625 put(X_SHIFT + STRETCH_FACTOR * succ(column) + PIXMAP_SHIFT,
626 Y_SHIFT + STRETCH_FACTOR * succ(row) + PIXMAP_SHIFT,
627 red_digits[digit], PSET);
628 end func;
629
630
631 const proc: setBlueDigit (in integer: row, in integer: column,
632 in integer: digit) is func
633 begin
634 field[row][column] := digit;
635 candidates[row][column] := {digit};
636 blue_changes := TRUE;
637 clearField(row, column);
638 put(X_SHIFT + STRETCH_FACTOR * succ(column) + PIXMAP_SHIFT,
639 Y_SHIFT + STRETCH_FACTOR * succ(row) + PIXMAP_SHIFT,
640 blue_digits[digit], PSET);
641 end func;
642
643
644 const proc: writeSmallDigit (in integer: row, in integer: column,
645 in integer: digit) is func
646 begin
647 put(X_SHIFT + STRETCH_FACTOR * succ(column) + SMALL_PIXMAP_SHIFT +
648 (pred(digit) mod 3) * 16,
649 Y_SHIFT + STRETCH_FACTOR * succ(row) + SMALL_PIXMAP_SHIFT +
650 (pred(digit) div 3) * 16,
651 small_digits[digit], PSET);
652 end func;
653
654
655 const proc: excludeInRow (in integer: row, in integer: digit) is func
656 local
657 var integer: column is 0;
658 begin
659 for column range 1 to 9 do
660 if field[row][column] = 0 then
661 excl(candidates[row][column], digit);
662 end if;
663 end for;
664 end func;
665
666
667 const proc: excludeInColumn (in integer: column, in integer: digit) is func
668 local
669 var integer: row is 0;
670 begin
671 for row range 1 to 9 do
672 if field[row][column] = 0 then
673 excl(candidates[row][column], digit);
674 end if;
675 end for;
676 end func;
677
678
679 const proc: excludeInBox (in integer: row, in integer: column, in integer: digit) is func
680 local
681 var integer: row1 is 0;
682 var integer: col1 is 0;
683 begin
684 for row1 range succ(pred(row) div 3 * 3) to succ(pred(row) div 3) * 3 do
685 for col1 range succ(pred(column) div 3 * 3) to succ(pred(column) div 3) * 3 do
686 if field[row1][col1] = 0 then
687 excl(candidates[row1][col1], digit);
688 end if;
689 end for;
690 end for;
691 end func;
692
693
694 const proc: excludeDigit (in integer: row, in integer: column) is func
695 begin
696 excludeInRow(row, field[row][column]);
697 excludeInColumn(column, field[row][column]);
698 excludeInBox(row, column, field[row][column]);
699 end func;
700
701
702 const proc: excludeFields is func
703 local
704 var integer: row is 0;
705 var integer: column is 0;
706 begin
707 for row range 1 to 9 do
708 for column range 1 to 9 do
709 if field[row][column] <> 0 then
710 excludeDigit(row, column);
711 end if;
712 end for;
713 end for;
714 end func;
715
716
717 const proc: showAllCandidates is func
718
719 local
720 var integer: row is 1;
721 var integer: column is 1;
722 var integer: digit is 0;
723
724 begin
725 for row range 1 to 9 do
726 for column range 1 to 9 do
727 if field[row][column] = 0 then
728 clearField(row, column);
729 box(X_SHIFT + STRETCH_FACTOR * succ(column) + CELL_SHIFT,
730 Y_SHIFT + STRETCH_FACTOR * succ(row) + CELL_SHIFT,
731 CELL_SIZE, CELL_SIZE, light_green);
732 for digit range 1 to 9 do
733 if digit in candidates[row][column] then
734 writeSmallDigit(row, column, digit);
735 end if;
736 end for;
737 elsif not user_input[row][column] then
738 setBlueDigit(row, column, field[row][column]);
739 end if;
740 end for;
741 end for;
742 DRAW_FLUSH;
743 end func;
744
745
746 const proc: checkSingles (inout boolean: changeDone) is func
747 local
748 var integer: row is 0;
749 var integer: column is 0;
750 var integer: digit is 0;
751 begin
752 for row range 1 to 9 do
753 for column range 1 to 9 do
754 if field[row][column] = 0 then
755 if card(candidates[row][column]) = 1 then
756 digit := min(candidates[row][column]);
757 field[row][column] := digit;
758 candidates[row][column] := {digit};
759 excludeDigit(row, column);
760 changeDone := TRUE;
761 end if;
762 end if;
763 end for;
764 end for;
765 end func;
766
767
768 const proc: checkHiddenSinglesInRow (in integer: row,
769 inout boolean: changeDone) is func
770 local
771 var integer: digit is 0;
772 var integer: column is 0;
773 var integer: foundColumn is 0;
774 var integer: foundCount is 0;
775 begin
776 for digit range 1 to 9 do
777 foundCount := 0;
778 for column range 1 to 9 do
779 if digit in candidates[row][column] then
780 foundColumn := column;
781 incr(foundCount);
782 end if;
783 end for;
784 if foundCount = 1 and field[row][foundColumn] = 0 then
785 field[row][foundColumn] := digit;
786 candidates[row][foundColumn] := {digit};
787 excludeDigit(row, foundColumn);
788 changeDone := TRUE;
789 end if;
790 end for;
791 end func;
792
793
794 const proc: checkHiddenSinglesInColumn (in integer: column,
795 inout boolean: changeDone) is func
796 local
797 var integer: digit is 0;
798 var integer: row is 0;
799 var integer: foundRow is 0;
800 var integer: foundCount is 0;
801 begin
802 for digit range 1 to 9 do
803 foundCount := 0;
804 for row range 1 to 9 do
805 if digit in candidates[row][column] then
806 foundRow := row;
807 incr(foundCount);
808 end if;
809 end for;
810 if foundCount = 1 and field[foundRow][column] = 0 then
811 field[foundRow][column] := digit;
812 candidates[foundRow][column] := {digit};
813 excludeDigit(foundRow, column);
814 changeDone := TRUE;
815 end if;
816 end for;
817 end func;
818
819
820 const proc: checkHiddenSinglesInBox (in integer: startRow, in integer: startColumn,
821 inout boolean: changeDone) is func
822 local
823 var integer: digit is 0;
824 var integer: row is 0;
825 var integer: column is 0;
826 var integer: foundRow is 0;
827 var integer: foundColumn is 0;
828 var integer: foundCount is 0;
829 begin
830 for digit range 1 to 9 do
831 foundCount := 0;
832 for row range startRow to startRow + 2 do
833 for column range startColumn to startColumn + 2 do
834 if digit in candidates[row][column] then
835 foundRow := row;
836 foundColumn := column;
837 incr(foundCount);
838 end if;
839 end for;
840 end for;
841 if foundCount = 1 and field[foundRow][foundColumn] = 0 then
842 field[foundRow][foundColumn] := digit;
843 candidates[foundRow][foundColumn] := {digit};
844 excludeDigit(foundRow, foundColumn);
845 changeDone := TRUE;
846 end if;
847 end for;
848 end func;
849
850
851 const proc: checkHiddenSingles (inout boolean: changeDone) is func
852 local
853 var integer: row is 0;
854 var integer: column is 0;
855 begin
856 for row range 1 to 9 do
857 checkHiddenSinglesInRow(row, changeDone);
858 end for;
859 for column range 1 to 9 do
860 checkHiddenSinglesInColumn(column, changeDone);
861 end for;
862 for row range 1 to 7 step 3 do
863 for column range 1 to 7 step 3 do
864 checkHiddenSinglesInBox(row, column, changeDone);
865 end for;
866 end for;
867 end func;
868
869
870 const proc: checkLockedCandidatesInRow (in integer: row,
871 inout boolean: changeDone) is func
872 local
873 var integer: digit is 0;
874 var integer: column is 0;
875 var integer: foundColumn is 0;
876 var integer: row1 is 0;
877 begin
878 for digit range 1 to 9 do
879 foundColumn := 0;
880 for column range 1 to 9 do
881 if digit in candidates[row][column] then
882 if foundColumn = 0 then
883 foundColumn := succ((pred(column) div 3) * 3);
884 elsif column < foundColumn or column > foundColumn + 2 then
885 foundColumn := 10;
886 end if;
887 end if;
888 end for;
889 if foundColumn in {1 .. 9} then
890 for row1 range succ(pred(row) div 3 * 3) to succ(pred(row) div 3) * 3 do
891 if row1 <> row then
892 for column range foundColumn to foundColumn + 2 do
893 if digit in candidates[row1][column] then
894 excl(candidates[row1][column], digit);
895 changeDone := TRUE;
896 end if;
897 end for;
898 end if;
899 end for;
900 end if;
901 end for;
902 end func;
903
904
905 const proc: checkLockedCandidatesInColumn (in integer: column,
906 inout boolean: changeDone) is func
907 local
908 var integer: digit is 0;
909 var integer: row is 0;
910 var integer: foundRow is 0;
911 var integer: col is 0;
912 begin
913 for digit range 1 to 9 do
914 foundRow := 0;
915 for row range 1 to 9 do
916 if digit in candidates[row][column] then
917 if foundRow = 0 then
918 foundRow := succ((pred(row) div 3) * 3);
919 elsif row < foundRow or row > foundRow + 2 then
920 foundRow := 10;
921 end if;
922 end if;
923 end for;
924 if foundRow in {1 .. 9} then
925 for col range succ(pred(column) div 3 * 3) to succ(pred(column) div 3) * 3 do
926 if col <> column then
927 for row range foundRow to foundRow + 2 do
928 if digit in candidates[row][col] then
929 excl(candidates[row][col], digit);
930 changeDone := TRUE;
931 end if;
932 end for;
933 end if;
934 end for;
935 end if;
936 end for;
937 end func;
938
939
940 const proc: checkLockedCandidatesInBox (in integer: startRow, in integer: startColumn,
941 inout boolean: changeDone) is func
942 local
943 var integer: digit is 0;
944 var integer: row is 0;
945 var integer: column is 0;
946 var integer: foundRow is 0;
947 var integer: foundColumn is 0;
948 begin
949 for digit range 1 to 9 do
950 foundRow := 0;
951 foundColumn := 0;
952 for row range startRow to startRow + 2 do
953 for column range startColumn to startColumn + 2 do
954 if digit in candidates[row][column] then
955 if foundRow = 0 then
956 foundRow := row;
957 elsif foundRow <> row then
958 foundRow := 10;
959 end if;
960 if foundColumn = 0 then
961 foundColumn := column;
962 elsif foundColumn <> column then
963 foundColumn := 10;
964 end if;
965 end if;
966 end for;
967 end for;
968 if foundRow in {1 .. 9} then
969 for column range 1 to 9 do
970 if column < startColumn or column > startColumn + 2 then
971 if digit in candidates[foundRow][column] then
972 excl(candidates[foundRow][column], digit);
973 changeDone := TRUE;
974 end if;
975 end if;
976 end for;
977 end if;
978 if foundColumn in {1 .. 9} then
979 for row range 1 to 9 do
980 if row < startRow or row > startRow + 2 then
981 if digit in candidates[row][foundColumn] then
982 excl(candidates[row][foundColumn], digit);
983 changeDone := TRUE;
984 end if;
985 end if;
986 end for;
987 end if;
988 end for;
989 end func;
990
991
992 const proc: checkLockedCandidates (inout boolean: changeDone) is func
993 local
994 var integer: row is 0;
995 var integer: column is 0;
996 begin
997 for row range 1 to 9 do
998 checkLockedCandidatesInRow(row, changeDone);
999 end for;
1000 for column range 1 to 9 do
1001 checkLockedCandidatesInColumn(column, changeDone);
1002 end for;
1003 for row range 1 to 7 step 3 do
1004 for column range 1 to 7 step 3 do
1005 checkLockedCandidatesInBox(row, column, changeDone);
1006 end for;
1007 end for;
1008 end func;
1009
1010
1011 const proc: checkNakedPairsInRow (in integer: row,
1012 inout boolean: changeDone) is func
1013 local
1014 var integer: col1 is 0;
1015 var integer: col2 is 0;
1016 var integer: column is 0;
1017 var set of integer: pairSet is EMPTY_SET;
1018 begin
1019 for col1 range 1 to 8 do
1020 if card(candidates[row][col1]) = 2 then
1021 pairSet := candidates[row][col1];
1022 for col2 range succ(col1) to 9 do
1023 if candidates[row][col2] = pairSet then
1024 for column range 1 to 9 do
1025 if column <> col1 and column <> col2 and
1026 card(candidates[row][column] & pairSet) <> 0 then
1027 candidates[row][column] := candidates[row][column] - pairSet;
1028 changeDone := TRUE;
1029 end if;
1030 end for;
1031 end if;
1032 end for;
1033 end if;
1034 end for;
1035 end func;
1036
1037
1038 const proc: checkNakedPairsInColumn (in integer: column,
1039 inout boolean: changeDone) is func
1040 local
1041 var integer: row1 is 0;
1042 var integer: row2 is 0;
1043 var integer: row is 0;
1044 var set of integer: pairSet is EMPTY_SET;
1045 begin
1046 for row1 range 1 to 8 do
1047 if card(candidates[row1][column]) = 2 then
1048 pairSet := candidates[row1][column];
1049 for row2 range succ(row1) to 9 do
1050 if candidates[row2][column] = pairSet then
1051 for row range 1 to 9 do
1052 if row <> row1 and row <> row2 and
1053 card(candidates[row][column] & pairSet) <> 0 then
1054 candidates[row][column] := candidates[row][column] - pairSet;
1055 changeDone := TRUE;
1056 end if;
1057 end for;
1058 end if;
1059 end for;
1060 end if;
1061 end for;
1062 end func;
1063
1064
1065 const proc: checkNakedPairsInBox (in integer: startRow, in integer: startColumn,
1066 inout boolean: changeDone) is func
1067 local
1068 var integer: row1 is 0;
1069 var integer: row2 is 0;
1070 var integer: col1 is 0;
1071 var integer: col2 is 0;
1072 var integer: row is 0;
1073 var integer: column is 0;
1074 var set of integer: pairSet is EMPTY_SET;
1075 begin
1076 for row1 range startRow to startRow + 2 do
1077 for col1 range startColumn to startColumn + 2 do
1078 if card(candidates[row1][col1]) = 2 then
1079 pairSet := candidates[row1][col1];
1080 for row2 range startRow to startRow + 2 do
1081 for col2 range startColumn to startColumn + 2 do
1082 if (row2 <> row1 or col2 <> col1) and
1083 candidates[row2][col2] = pairSet then
1084 for row range startRow to startRow + 2 do
1085 for column range startColumn to startColumn + 2 do
1086 if (row <> row1 or column <> col1) and
1087 (row <> row2 or column <> col2) and
1088 card(candidates[row][column] & pairSet) <> 0 then
1089 candidates[row][column] := candidates[row][column] - pairSet;
1090 changeDone := TRUE;
1091 end if;
1092 end for;
1093 end for;
1094 end if;
1095 end for;
1096 end for;
1097 end if;
1098 end for;
1099 end for;
1100 end func;
1101
1102
1103 const proc: checkNakedPairs (inout boolean: changeDone) is func
1104 local
1105 var integer: row is 0;
1106 var integer: column is 0;
1107 begin
1108 for row range 1 to 9 do
1109 checkNakedPairsInRow(row, changeDone);
1110 end for;
1111 for column range 1 to 9 do
1112 checkNakedPairsInColumn(column, changeDone);
1113 end for;
1114 for row range 1 to 7 step 3 do
1115 for column range 1 to 7 step 3 do
1116 checkNakedPairsInBox(row, column, changeDone);
1117 end for;
1118 end for;
1119 end func;
1120
1121
1122 const proc: checkNakedTriplesInRow (in integer: row,
1123 inout boolean: changeDone) is func
1124 local
1125 var integer: col1 is 0;
1126 var integer: col2 is 0;
1127 var integer: col3 is 0;
1128 var integer: column is 0;
1129 var set of integer: tripleSet is EMPTY_SET;
1130 begin
1131 for col1 range 1 to 7 do
1132 if card(candidates[row][col1]) in {2, 3} then
1133 for col2 range succ(col1) to 8 do
1134 if card(candidates[row][col2]) >= 2 and
1135 card(candidates[row][col1] | candidates[row][col2]) <= 3 then
1136 for col3 range succ(col2) to 9 do
1137 if card(candidates[row][col3]) >= 2 then
1138 tripleSet := candidates[row][col1] | candidates[row][col2] |
1139 candidates[row][col3];
1140 if card(tripleSet) = 3 then
1141 for column range 1 to 9 do
1142 if column <> col1 and column <> col2 and column <> col3 and
1143 card(candidates[row][column] & tripleSet) <> 0 then
1144 candidates[row][column] := candidates[row][column] - tripleSet;
1145 changeDone := TRUE;
1146 end if;
1147 end for;
1148 end if;
1149 end if;
1150 end for;
1151 end if;
1152 end for;
1153 end if;
1154 end for;
1155 end func;
1156
1157
1158 const proc: checkNakedTriplesInColumn (in integer: column,
1159 inout boolean: changeDone) is func
1160 local
1161 var integer: row1 is 0;
1162 var integer: row2 is 0;
1163 var integer: row3 is 0;
1164 var integer: row is 0;
1165 var set of integer: tripleSet is EMPTY_SET;
1166 begin
1167 for row1 range 1 to 7 do
1168 if card(candidates[row1][column]) in {2, 3} then
1169 for row2 range succ(row1) to 8 do
1170 if card(candidates[row2][column]) >= 2 and
1171 card(candidates[row1][column] | candidates[row2][column]) <= 3 then
1172 for row3 range succ(row2) to 9 do
1173 if card(candidates[row3][column]) >= 2 then
1174 tripleSet := candidates[row1][column] | candidates[row2][column] |
1175 candidates[row3][column];
1176 if card(tripleSet) = 3 then
1177 for row range 1 to 9 do
1178 if row <> row1 and row <> row2 and row <> row3 and
1179 card(candidates[row][column] & tripleSet) <> 0 then
1180 candidates[row][column] := candidates[row][column] - tripleSet;
1181 changeDone := TRUE;
1182 end if;
1183 end for;
1184 end if;
1185 end if;
1186 end for;
1187 end if;
1188 end for;
1189 end if;
1190 end for;
1191 end func;
1192
1193
1194 const proc: checkNakedTriplesInBox (in integer: startRow, in integer: startColumn,
1195 inout boolean: changeDone) is func
1196 local
1197 var integer: row1 is 0;
1198 var integer: row2 is 0;
1199 var integer: row3 is 0;
1200 var integer: col1 is 0;
1201 var integer: col2 is 0;
1202 var integer: col3 is 0;
1203 var integer: row is 0;
1204 var integer: column is 0;
1205 var set of integer: tripleSet is EMPTY_SET;
1206 begin
1207 for row1 range startRow to startRow + 2 do
1208 for col1 range startColumn to startColumn + 2 do
1209 if card(candidates[row1][col1]) in {2, 3} then
1210 for row2 range startRow to startRow + 2 do
1211 for col2 range startColumn to startColumn + 2 do
1212 if (row2 <> row1 or col2 <> col1) and
1213 card(candidates[row2][col2]) >= 2 and
1214 card(candidates[row1][col1] | candidates[row2][col2]) <= 3 then
1215 for row3 range startRow to startRow + 2 do
1216 for col3 range startColumn to startColumn + 2 do
1217 if (row3 <> row1 or col3 <> col1) and
1218 (row3 <> row2 or col3 <> col2) and
1219 card(candidates[row3][col3]) >= 2 then
1220 tripleSet := candidates[row1][col1] | candidates[row2][col2] |
1221 candidates[row3][col3];
1222 if card(tripleSet) = 3 then
1223 for row range startRow to startRow + 2 do
1224 for column range startColumn to startColumn + 2 do
1225 if (row <> row1 or column <> col1) and
1226 (row <> row2 or column <> col2) and
1227 (row <> row3 or column <> col3) and
1228 card(candidates[row][column] & tripleSet) <> 0 then
1229 candidates[row][column] := candidates[row][column] - tripleSet;
1230 changeDone := TRUE;
1231 end if;
1232 end for;
1233 end for;
1234 end if;
1235 end if;
1236 end for;
1237 end for;
1238 end if;
1239 end for;
1240 end for;
1241 end if;
1242 end for;
1243 end for;
1244 end func;
1245
1246
1247 const proc: checkNakedTriples (inout boolean: changeDone) is func
1248 local
1249 var integer: row is 0;
1250 var integer: column is 0;
1251 begin
1252 for row range 1 to 9 do
1253 checkNakedTriplesInRow(row, changeDone);
1254 end for;
1255 for column range 1 to 9 do
1256 checkNakedTriplesInColumn(column, changeDone);
1257 end for;
1258 for row range 1 to 7 step 3 do
1259 for column range 1 to 7 step 3 do
1260 checkNakedTriplesInBox(row, column, changeDone);
1261 end for;
1262 end for;
1263 end func;
1264
1265
1266 const proc: checkNakedQuadsInRow (in integer: row,
1267 inout boolean: changeDone) is func
1268 local
1269 var integer: col1 is 0;
1270 var integer: col2 is 0;
1271 var integer: col3 is 0;
1272 var integer: col4 is 0;
1273 var integer: column is 0;
1274 var set of integer: quadSet is EMPTY_SET;
1275 begin
1276 for col1 range 1 to 6 do
1277 if card(candidates[row][col1]) in {2, 3, 4} then
1278 for col2 range succ(col1) to 7 do
1279 if card(candidates[row][col2]) >= 2 and
1280 card(candidates[row][col1] | candidates[row][col2]) <= 4 then
1281 for col3 range succ(col2) to 8 do
1282 if card(candidates[row][col3]) >= 2 and
1283 card(candidates[row][col1] | candidates[row][col2] |
1284 candidates[row][col3]) <= 4 then
1285 for col4 range succ(col3) to 9 do
1286 if card(candidates[row][col4]) >= 2 then
1287 quadSet := candidates[row][col1] | candidates[row][col2] |
1288 candidates[row][col3] | candidates[row][col4];
1289 if card(quadSet) = 4 then
1290 for column range 1 to 9 do
1291 if column <> col1 and column <> col2 and column <> col3 and column <> col4 and
1292 card(candidates[row][column] & quadSet) <> 0 then
1293 candidates[row][column] := candidates[row][column] - quadSet;
1294 changeDone := TRUE;
1295 end if;
1296 end for;
1297 end if;
1298 end if;
1299 end for;
1300 end if;
1301 end for;
1302 end if;
1303 end for;
1304 end if;
1305 end for;
1306 end func;
1307
1308
1309 const proc: checkNakedQuadsInColumn (in integer: column,
1310 inout boolean: changeDone) is func
1311 local
1312 var integer: row1 is 0;
1313 var integer: row2 is 0;
1314 var integer: row3 is 0;
1315 var integer: row4 is 0;
1316 var integer: row is 0;
1317 var set of integer: quadSet is EMPTY_SET;
1318 begin
1319 for row1 range 1 to 6 do
1320 if card(candidates[row1][column]) in {2, 3, 4} then
1321 for row2 range succ(row1) to 7 do
1322 if card(candidates[row2][column]) >= 2 and
1323 card(candidates[row1][column] | candidates[row2][column]) <= 4 then
1324 for row3 range succ(row2) to 8 do
1325 if card(candidates[row3][column]) >= 2 and
1326 card(candidates[row1][column] | candidates[row2][column] |
1327 candidates[row3][column]) <= 4 then
1328 for row4 range succ(row3) to 9 do
1329 if card(candidates[row4][column]) >= 2 then
1330 quadSet := candidates[row1][column] | candidates[row2][column] |
1331 candidates[row3][column] | candidates[row4][column];
1332 if card(quadSet) = 4 then
1333 for row range 1 to 9 do
1334 if row <> row1 and row <> row2 and row <> row3 and row <> row4 and
1335 card(candidates[row][column] & quadSet) <> 0 then
1336 candidates[row][column] := candidates[row][column] - quadSet;
1337 changeDone := TRUE;
1338 end if;
1339 end for;
1340 end if;
1341 end if;
1342 end for;
1343 end if;
1344 end for;
1345 end if;
1346 end for;
1347 end if;
1348 end for;
1349 end func;
1350
1351
1352 const proc: checkNakedQuadsInBox (in integer: startRow, in integer: startColumn,
1353 inout boolean: changeDone) is func
1354 local
1355 var integer: row1 is 0;
1356 var integer: row2 is 0;
1357 var integer: row3 is 0;
1358 var integer: row4 is 0;
1359 var integer: col1 is 0;
1360 var integer: col2 is 0;
1361 var integer: col3 is 0;
1362 var integer: col4 is 0;
1363 var integer: row is 0;
1364 var integer: column is 0;
1365 var set of integer: quadSet is EMPTY_SET;
1366 begin
1367 for row1 range startRow to startRow + 2 do
1368 for col1 range startColumn to startColumn + 2 do
1369 if card(candidates[row1][col1]) in {2, 3, 4} then
1370 for row2 range startRow to startRow + 2 do
1371 for col2 range startColumn to startColumn + 2 do
1372 if (row2 <> row1 or col2 <> col1) and
1373 card(candidates[row2][col2]) >= 2 and
1374 card(candidates[row1][col1] | candidates[row2][col2]) <= 4 then
1375 for row3 range startRow to startRow + 2 do
1376 for col3 range startColumn to startColumn + 2 do
1377 if (row3 <> row1 or col3 <> col1) and
1378 (row3 <> row2 or col3 <> col2) and
1379 card(candidates[row3][col3]) >= 2 and
1380 card(candidates[row1][col1] | candidates[row2][col2] |
1381 candidates[row3][col3]) <= 4 then
1382 for row4 range startRow to startRow + 2 do
1383 for col4 range startColumn to startColumn + 2 do
1384 if (row4 <> row1 or col4 <> col1) and
1385 (row4 <> row2 or col4 <> col2) and
1386 (row4 <> row3 or col4 <> col3) and
1387 card(candidates[row4][col4]) >= 2 then
1388 quadSet := candidates[row1][col1] | candidates[row2][col2] |
1389 candidates[row3][col3] | candidates[row4][col4];
1390 if card(quadSet) = 4 then
1391 for row range startRow to startRow + 2 do
1392 for column range startColumn to startColumn + 2 do
1393 if (row <> row1 or column <> col1) and
1394 (row <> row2 or column <> col2) and
1395 (row <> row3 or column <> col3) and
1396 (row <> row4 or column <> col4) and
1397 card(candidates[row][column] & quadSet) <> 0 then
1398 candidates[row][column] := candidates[row][column] - quadSet;
1399 changeDone := TRUE;
1400 end if;
1401 end for;
1402 end for;
1403 end if;
1404 end if;
1405 end for;
1406 end for;
1407 end if;
1408 end for;
1409 end for;
1410 end if;
1411 end for;
1412 end for;
1413 end if;
1414 end for;
1415 end for;
1416 end func;
1417
1418
1419 const proc: checkNakedQuads (inout boolean: changeDone) is func
1420 local
1421 var integer: row is 0;
1422 var integer: column is 0;
1423 begin
1424 for row range 1 to 9 do
1425 checkNakedQuadsInRow(row, changeDone);
1426 end for;
1427 for column range 1 to 9 do
1428 checkNakedQuadsInColumn(column, changeDone);
1429 end for;
1430 for row range 1 to 7 step 3 do
1431 for column range 1 to 7 step 3 do
1432 checkNakedQuadsInBox(row, column, changeDone);
1433 end for;
1434 end for;
1435 end func;
1436
1437
1438 const proc: checkHiddenPairsInRow (in integer: row,
1439 inout boolean: changeDone) is func
1440 local
1441 var integer: column is 0;
1442 var integer: digit1 is 0;
1443 var integer: digit2 is 0;
1444 var array set of integer: columnsWithDigit is 9 times EMPTY_SET;
1445 var set of integer: pairColumns is EMPTY_SET;
1446 var set of integer: pairSet is EMPTY_SET;
1447 begin
1448 for column range 1 to 9 do
1449 for digit1 range candidates[row][column] do
1450 incl(columnsWithDigit[digit1], column);
1451 end for;
1452 end for;
1453 for digit1 range 1 to 8 do
1454 if card(columnsWithDigit[digit1]) = 2 then
1455 pairColumns := columnsWithDigit[digit1];
1456 for digit2 range succ(digit1) to 9 do
1457 if columnsWithDigit[digit2] = pairColumns then
1458 pairSet := {digit1, digit2};
1459 for column range pairColumns do
1460 if card(candidates[row][column] - pairSet) <> 0 then
1461 candidates[row][column] := pairSet;
1462 changeDone := TRUE;
1463 end if;
1464 end for;
1465 end if;
1466 end for;
1467 end if;
1468 end for;
1469 end func;
1470
1471
1472 const proc: checkHiddenPairsInColumn (in integer: column,
1473 inout boolean: changeDone) is func
1474 local
1475 var integer: row is 0;
1476 var integer: digit1 is 0;
1477 var integer: digit2 is 0;
1478 var array set of integer: rowsWithDigit is 9 times EMPTY_SET;
1479 var set of integer: pairRows is EMPTY_SET;
1480 var set of integer: pairSet is EMPTY_SET;
1481 begin
1482 for row range 1 to 9 do
1483 for digit1 range candidates[row][column] do
1484 incl(rowsWithDigit[digit1], row);
1485 end for;
1486 end for;
1487 for digit1 range 1 to 8 do
1488 if card(rowsWithDigit[digit1]) = 2 then
1489 pairRows := rowsWithDigit[digit1];
1490 for digit2 range succ(digit1) to 9 do
1491 if rowsWithDigit[digit2] = pairRows then
1492 pairSet := {digit1, digit2};
1493 for row range pairRows do
1494 if card(candidates[row][column] - pairSet) <> 0 then
1495 candidates[row][column] := pairSet;
1496 changeDone := TRUE;
1497 end if;
1498 end for;
1499 end if;
1500 end for;
1501 end if;
1502 end for;
1503 end func;
1504
1505
1506 const proc: checkHiddenPairsInBox (in integer: startRow, in integer: startColumn,
1507 inout boolean: changeDone) is func
1508 local
1509 var integer: row is 0;
1510 var integer: column is 0;
1511 var integer: digit1 is 0;
1512 var integer: digit2 is 0;
1513 var array set of integer: cellsWithDigit is 9 times EMPTY_SET;
1514 var set of integer: pairCells is EMPTY_SET;
1515 var set of integer: pairSet is EMPTY_SET;
1516 begin
1517 for row range startRow to startRow + 2 do
1518 for column range startColumn to startColumn + 2 do
1519 for digit1 range candidates[row][column] do
1520 incl(cellsWithDigit[digit1], succ(pred(row) * 3 + pred(column)));
1521 end for;
1522 end for;
1523 end for;
1524 for digit1 range 1 to 8 do
1525 if card(cellsWithDigit[digit1]) = 2 then
1526 pairCells := cellsWithDigit[digit1];
1527 for digit2 range succ(digit1) to 9 do
1528 if cellsWithDigit[digit2] = pairCells then
1529 pairSet := {digit1, digit2};
1530 for row range startRow to startRow + 2 do
1531 for column range startColumn to startColumn + 2 do
1532 if succ(pred(row) * 3 + pred(column)) in pairCells then
1533 if card(candidates[row][column] - pairSet) <> 0 then
1534 candidates[row][column] := pairSet;
1535 changeDone := TRUE;
1536 end if;
1537 end if;
1538 end for;
1539 end for;
1540 end if;
1541 end for;
1542 end if;
1543 end for;
1544 end func;
1545
1546
1547 const proc: checkHiddenPairs (inout boolean: changeDone) is func
1548 local
1549 var integer: row is 0;
1550 var integer: column is 0;
1551 begin
1552 for row range 1 to 9 do
1553 checkHiddenPairsInRow(row, changeDone);
1554 end for;
1555 for column range 1 to 9 do
1556 checkHiddenPairsInColumn(column, changeDone);
1557 end for;
1558 for row range 1 to 7 step 3 do
1559 for column range 1 to 7 step 3 do
1560 checkHiddenPairsInBox(row, column, changeDone);
1561 end for;
1562 end for;
1563 end func;
1564
1565
1566 const proc: checkHiddenTriplesInRow (in integer: row,
1567 inout boolean: changeDone) is func
1568 local
1569 var integer: column is 0;
1570 var integer: digit1 is 0;
1571 var integer: digit2 is 0;
1572 var integer: digit3 is 0;
1573 var array set of integer: columnsWithDigit is 9 times EMPTY_SET;
1574 var set of integer: tripleColumns is EMPTY_SET;
1575 var set of integer: tripleSet is EMPTY_SET;
1576 begin
1577 for column range 1 to 9 do
1578 for digit1 range candidates[row][column] do
1579 incl(columnsWithDigit[digit1], column);
1580 end for;
1581 end for;
1582 for digit1 range 1 to 7 do
1583 if card(columnsWithDigit[digit1]) in {2, 3} then
1584 for digit2 range succ(digit1) to 8 do
1585 if card(columnsWithDigit[digit2]) >= 2 and
1586 card(columnsWithDigit[digit1] | columnsWithDigit[digit2]) <= 3 then
1587 for digit3 range succ(digit2) to 9 do
1588 if card(columnsWithDigit[digit3]) >= 2 then
1589 tripleColumns := columnsWithDigit[digit1] | columnsWithDigit[digit2] |
1590 columnsWithDigit[digit3];
1591 if card(tripleColumns) = 3 then
1592 tripleSet := {digit1, digit2, digit3};
1593 for column range tripleColumns do
1594 if card(candidates[row][column] - tripleSet) <> 0 then
1595 candidates[row][column] := candidates[row][column] -
1596 (candidates[row][column] - tripleSet);
1597 changeDone := TRUE;
1598 end if;
1599 end for;
1600 end if;
1601 end if;
1602 end for;
1603 end if;
1604 end for;
1605 end if;
1606 end for;
1607 end func;
1608
1609
1610 const proc: checkHiddenTriplesInColumn (in integer: column,
1611 inout boolean: changeDone) is func
1612 local
1613 var integer: row is 0;
1614 var integer: digit1 is 0;
1615 var integer: digit2 is 0;
1616 var integer: digit3 is 0;
1617 var array set of integer: rowsWithDigit is 9 times EMPTY_SET;
1618 var set of integer: tripleRows is EMPTY_SET;
1619 var set of integer: tripleSet is EMPTY_SET;
1620 begin
1621 for row range 1 to 9 do
1622 for digit1 range candidates[row][column] do
1623 incl(rowsWithDigit[digit1], row);
1624 end for;
1625 end for;
1626 for digit1 range 1 to 7 do
1627 if card(rowsWithDigit[digit1]) in {2, 3} then
1628 for digit2 range succ(digit1) to 8 do
1629 if card(rowsWithDigit[digit2]) >= 2 and
1630 card(rowsWithDigit[digit1] | rowsWithDigit[digit2]) <= 3 then
1631 for digit3 range succ(digit2) to 9 do
1632 if card(rowsWithDigit[digit3]) >= 2 then
1633 tripleRows := rowsWithDigit[digit1] | rowsWithDigit[digit2] |
1634 rowsWithDigit[digit3];
1635 if card(tripleRows) = 3 then
1636 tripleSet := {digit1, digit2, digit3};
1637 for row range tripleRows do
1638 if card(candidates[row][column] - tripleSet) <> 0 then
1639 candidates[row][column] := candidates[row][column] -
1640 (candidates[row][column] - tripleSet);
1641 changeDone := TRUE;
1642 end if;
1643 end for;
1644 end if;
1645 end if;
1646 end for;
1647 end if;
1648 end for;
1649 end if;
1650 end for;
1651 end func;
1652
1653
1654 const proc: checkHiddenTriplesInBox (in integer: startRow, in integer: startColumn,
1655 inout boolean: changeDone) is func
1656 local
1657 var integer: row is 0;
1658 var integer: column is 0;
1659 var integer: digit1 is 0;
1660 var integer: digit2 is 0;
1661 var integer: digit3 is 0;
1662 var array set of integer: cellsWithDigit is 9 times EMPTY_SET;
1663 var set of integer: tripleCells is EMPTY_SET;
1664 var set of integer: tripleSet is EMPTY_SET;
1665 begin
1666 for row range startRow to startRow + 2 do
1667 for column range startColumn to startColumn + 2 do
1668 for digit1 range candidates[row][column] do
1669 incl(cellsWithDigit[digit1], succ(pred(row) * 3 + pred(column)));
1670 end for;
1671 end for;
1672 end for;
1673 for digit1 range 1 to 7 do
1674 if card(cellsWithDigit[digit1]) in {2, 3} then
1675 for digit2 range succ(digit1) to 8 do
1676 if card(cellsWithDigit[digit2]) >= 2 and
1677 card(cellsWithDigit[digit1] | cellsWithDigit[digit2]) <= 3 then
1678 for digit3 range succ(digit2) to 9 do
1679 if card(cellsWithDigit[digit3]) >= 2 then
1680 tripleCells := cellsWithDigit[digit1] | cellsWithDigit[digit2] |
1681 cellsWithDigit[digit3];
1682 if card(tripleCells) = 3 then
1683 tripleSet := {digit1, digit2, digit3};
1684 for row range startRow to startRow + 2 do
1685 for column range startColumn to startColumn + 2 do
1686 if succ(pred(row) * 3 + pred(column)) in tripleCells then
1687 if card(candidates[row][column] - tripleSet) <> 0 then
1688 candidates[row][column] := candidates[row][column] -
1689 (candidates[row][column] - tripleSet);
1690 changeDone := TRUE;
1691 end if;
1692 end if;
1693 end for;
1694 end for;
1695 end if;
1696 end if;
1697 end for;
1698 end if;
1699 end for;
1700 end if;
1701 end for;
1702 end func;
1703
1704
1705 const proc: checkHiddenTriples (inout boolean: changeDone) is func
1706 local
1707 var integer: row is 0;
1708 var integer: column is 0;
1709 begin
1710 for row range 1 to 9 do
1711 checkHiddenTriplesInRow(row, changeDone);
1712 end for;
1713 for column range 1 to 9 do
1714 checkHiddenTriplesInColumn(column, changeDone);
1715 end for;
1716 for row range 1 to 7 step 3 do
1717 for column range 1 to 7 step 3 do
1718 checkHiddenTriplesInBox(row, column, changeDone);
1719 end for;
1720 end for;
1721 end func;
1722
1723
1724 const proc: checkHiddenQuadsInRow (in integer: row,
1725 inout boolean: changeDone) is func
1726 local
1727 var integer: column is 0;
1728 var integer: digit1 is 0;
1729 var integer: digit2 is 0;
1730 var integer: digit3 is 0;
1731 var integer: digit4 is 0;
1732 var array set of integer: columnsWithDigit is 9 times EMPTY_SET;
1733 var set of integer: quadColumns is EMPTY_SET;
1734 var set of integer: quadSet is EMPTY_SET;
1735 begin
1736 for column range 1 to 9 do
1737 for digit1 range candidates[row][column] do
1738 incl(columnsWithDigit[digit1], column);
1739 end for;
1740 end for;
1741 for digit1 range 1 to 6 do
1742 if card(columnsWithDigit[digit1]) in {2, 3, 4} then
1743 for digit2 range succ(digit1) to 7 do
1744 if card(columnsWithDigit[digit2]) >= 2 and
1745 card(columnsWithDigit[digit1] | columnsWithDigit[digit2]) <= 4 then
1746 for digit3 range succ(digit2) to 8 do
1747 if card(columnsWithDigit[digit3]) >= 2 and
1748 card(columnsWithDigit[digit1] | columnsWithDigit[digit2] |
1749 columnsWithDigit[digit3]) <= 4 then
1750 for digit4 range succ(digit3) to 9 do
1751 if card(columnsWithDigit[digit4]) >= 2 then
1752 quadColumns := columnsWithDigit[digit1] | columnsWithDigit[digit2] |
1753 columnsWithDigit[digit3] | columnsWithDigit[digit4];
1754 if card(quadColumns) = 4 then
1755 quadSet := {digit1, digit2, digit3, digit4};
1756 for column range quadColumns do
1757 if card(candidates[row][column] - quadSet) <> 0 then
1758 candidates[row][column] := candidates[row][column] -
1759 (candidates[row][column] - quadSet);
1760 changeDone := TRUE;
1761 end if;
1762 end for;
1763 end if;
1764 end if;
1765 end for;
1766 end if;
1767 end for;
1768 end if;
1769 end for;
1770 end if;
1771 end for;
1772 end func;
1773
1774
1775 const proc: checkHiddenQuadsInColumn (in integer: column,
1776 inout boolean: changeDone) is func
1777 local
1778 var integer: row is 0;
1779 var integer: digit1 is 0;
1780 var integer: digit2 is 0;
1781 var integer: digit3 is 0;
1782 var integer: digit4 is 0;
1783 var array set of integer: rowsWithDigit is 9 times EMPTY_SET;
1784 var set of integer: quadRows is EMPTY_SET;
1785 var set of integer: quadSet is EMPTY_SET;
1786 begin
1787 for row range 1 to 9 do
1788 for digit1 range candidates[row][column] do
1789 incl(rowsWithDigit[digit1], row);
1790 end for;
1791 end for;
1792 for digit1 range 1 to 6 do
1793 if card(rowsWithDigit[digit1]) in {2, 3, 4} then
1794 for digit2 range succ(digit1) to 7 do
1795 if card(rowsWithDigit[digit2]) >= 2 and
1796 card(rowsWithDigit[digit1] | rowsWithDigit[digit2]) <= 4 then
1797 for digit3 range succ(digit2) to 8 do
1798 if card(rowsWithDigit[digit3]) >= 2 and
1799 card(rowsWithDigit[digit1] | rowsWithDigit[digit2] |
1800 rowsWithDigit[digit3]) <= 4 then
1801 for digit4 range succ(digit3) to 9 do
1802 if card(rowsWithDigit[digit4]) >= 2 then
1803 quadRows := rowsWithDigit[digit1] | rowsWithDigit[digit2] |
1804 rowsWithDigit[digit3] | rowsWithDigit[digit4];
1805 if card(quadRows) = 4 then
1806 quadSet := {digit1, digit2, digit3, digit4};
1807 for row range quadRows do
1808 if card(candidates[row][column] - quadSet) <> 0 then
1809 candidates[row][column] := candidates[row][column] -
1810 (candidates[row][column] - quadSet);
1811 changeDone := TRUE;
1812 end if;
1813 end for;
1814 end if;
1815 end if;
1816 end for;
1817 end if;
1818 end for;
1819 end if;
1820 end for;
1821 end if;
1822 end for;
1823 end func;
1824
1825
1826 const proc: checkHiddenQuadsInBox (in integer: startRow, in integer: startColumn,
1827 inout boolean: changeDone) is func
1828 local
1829 var integer: row is 0;
1830 var integer: column is 0;
1831 var integer: digit1 is 0;
1832 var integer: digit2 is 0;
1833 var integer: digit3 is 0;
1834 var integer: digit4 is 0;
1835 var array set of integer: cellsWithDigit is 9 times EMPTY_SET;
1836 var set of integer: quadCells is EMPTY_SET;
1837 var set of integer: quadSet is EMPTY_SET;
1838 begin
1839 for row range startRow to startRow + 2 do
1840 for column range startColumn to startColumn + 2 do
1841 for digit1 range candidates[row][column] do
1842 incl(cellsWithDigit[digit1], succ(pred(row) * 3 + pred(column)));
1843 end for;
1844 end for;
1845 end for;
1846 for digit1 range 1 to 6 do
1847 if card(cellsWithDigit[digit1]) in {2, 3, 4} then
1848 for digit2 range succ(digit1) to 7 do
1849 if card(cellsWithDigit[digit2]) >= 2 and
1850 card(cellsWithDigit[digit1] | cellsWithDigit[digit2]) <= 4 then
1851 for digit3 range succ(digit2) to 8 do
1852 if card(cellsWithDigit[digit3]) >= 2 and
1853 card(cellsWithDigit[digit1] | cellsWithDigit[digit2] |
1854 cellsWithDigit[digit3]) <= 4 then
1855 for digit4 range succ(digit3) to 9 do
1856 if card(cellsWithDigit[digit4]) >= 2 then
1857 quadCells := cellsWithDigit[digit1] | cellsWithDigit[digit2] |
1858 cellsWithDigit[digit3] | cellsWithDigit[digit4];
1859 if card(quadCells) = 4 then
1860 quadSet := {digit1, digit2, digit3, digit4};
1861 for row range startRow to startRow + 2 do
1862 for column range startColumn to startColumn + 2 do
1863 if succ(pred(row) * 3 + pred(column)) in quadCells then
1864 if card(candidates[row][column] - quadSet) <> 0 then
1865 candidates[row][column] := candidates[row][column] -
1866 (candidates[row][column] - quadSet);
1867 changeDone := TRUE;
1868 end if;
1869 end if;
1870 end for;
1871 end for;
1872 end if;
1873 end if;
1874 end for;
1875 end if;
1876 end for;
1877 end if;
1878 end for;
1879 end if;
1880 end for;
1881 end func;
1882
1883
1884 const proc: checkHiddenQuads (inout boolean: changeDone) is func
1885 local
1886 var integer: row is 0;
1887 var integer: column is 0;
1888 begin
1889 for row range 1 to 9 do
1890 checkHiddenQuadsInRow(row, changeDone);
1891 end for;
1892 for column range 1 to 9 do
1893 checkHiddenQuadsInColumn(column, changeDone);
1894 end for;
1895 for row range 1 to 7 step 3 do
1896 for column range 1 to 7 step 3 do
1897 checkHiddenQuadsInBox(row, column, changeDone);
1898 end for;
1899 end for;
1900 end func;
1901
1902
1903 const proc: checkXWingForDigit (in integer: digit,
1904 inout boolean: changeDone) is func
1905 local
1906 var integer: row is 0;
1907 var integer: row1 is 0;
1908 var integer: row2 is 0;
1909 var integer: column is 0;
1910 var integer: column1 is 0;
1911 var integer: column2 is 0;
1912 var array set of integer: rowsInColumn is 9 times EMPTY_SET;
1913 var array set of integer: columnsInRow is 9 times EMPTY_SET;
1914 var set of integer: xWingColumns is EMPTY_SET;
1915 var set of integer: xWingRows is EMPTY_SET;
1916 begin
1917 for row1 range 1 to 9 do
1918 for column1 range 1 to 9 do
1919 if digit in candidates[row1][column1] then
1920 incl(rowsInColumn[column1], row1);
1921 incl(columnsInRow[row1], column1);
1922 end if;
1923 end for;
1924 end for;
1925 for row1 range 1 to 8 do
1926 if card(columnsInRow[row1]) = 2 then
1927 xWingColumns := columnsInRow[row1];
1928 for row2 range succ(row1) to 9 do
1929 if columnsInRow[row2] = xWingColumns then
1930 for row range 1 to 9 do
1931 if row <> row1 and row <> row2 then
1932 if card(columnsInRow[row] & xWingColumns) <> 0 then
1933 for column range 1 to 9 do
1934 if column in xWingColumns then
1935 excl(candidates[row][column], digit);
1936 end if;
1937 end for;
1938 changeDone := TRUE;
1939 end if;
1940 end if;
1941 end for;
1942 end if;
1943 end for;
1944 end if;
1945 end for;
1946 for column1 range 1 to 8 do
1947 if card(rowsInColumn[column1]) = 2 then
1948 xWingRows := rowsInColumn[column1];
1949 for column2 range succ(column1) to 9 do
1950 if rowsInColumn[column2] = xWingRows then
1951 for column range 1 to 9 do
1952 if column <> column1 and column <> column2 then
1953 if card(rowsInColumn[column] & xWingRows) <> 0 then
1954 for row range 1 to 9 do
1955 if row in xWingRows then
1956 excl(candidates[row][column], digit);
1957 end if;
1958 end for;
1959 changeDone := TRUE;
1960 end if;
1961 end if;
1962 end for;
1963 end if;
1964 end for;
1965 end if;
1966 end for;
1967 end func;
1968
1969
1970 const proc: checkXWing (inout boolean: changeDone) is func
1971 local
1972 var integer: digit is 0;
1973 begin
1974 for digit range 1 to 9 do
1975 checkXWingForDigit(digit, changeDone);
1976 end for;
1977 end func;
1978
1979
1980 const proc: checkSwordfishForDigit (in integer: digit,
1981 inout boolean: changeDone) is func
1982 local
1983 var integer: row is 0;
1984 var integer: row1 is 0;
1985 var integer: row2 is 0;
1986 var integer: row3 is 0;
1987 var integer: column is 0;
1988 var integer: column1 is 0;
1989 var integer: column2 is 0;
1990 var integer: column3 is 0;
1991 var array set of integer: rowsInColumn is 9 times EMPTY_SET;
1992 var array set of integer: columnsInRow is 9 times EMPTY_SET;
1993 var set of integer: swordfishColumns is EMPTY_SET;
1994 var set of integer: swordfishRows is EMPTY_SET;
1995 begin
1996 for row1 range 1 to 9 do
1997 for column1 range 1 to 9 do
1998 if digit in candidates[row1][column1] then
1999 incl(rowsInColumn[column1], row1);
2000 incl(columnsInRow[row1], column1);
2001 end if;
2002 end for;
2003 end for;
2004 for row1 range 1 to 7 do
2005 if card(columnsInRow[row1]) in {2, 3} then
2006 for row2 range succ(row1) to 8 do
2007 if card(columnsInRow[row2]) >= 2 and
2008 card(columnsInRow[row1] | columnsInRow[row2]) <= 3 then
2009 for row3 range succ(row2) to 9 do
2010 if card(columnsInRow[row3]) >= 2 then
2011 swordfishColumns := columnsInRow[row1] | columnsInRow[row2] |
2012 columnsInRow[row3];
2013 if card(swordfishColumns) = 3 then
2014 for row range 1 to 9 do
2015 if row <> row1 and row <> row2 and row <> row3 then
2016 if card(columnsInRow[row] & swordfishColumns) <> 0 then
2017 for column range 1 to 9 do
2018 if column in swordfishColumns then
2019 excl(candidates[row][column], digit);
2020 end if;
2021 end for;
2022 changeDone := TRUE;
2023 end if;
2024 end if;
2025 end for;
2026 end if;
2027 end if;
2028 end for;
2029 end if;
2030 end for;
2031 end if;
2032 end for;
2033 for column1 range 1 to 7 do
2034 if card(rowsInColumn[column1]) in {2, 3} then
2035 for column2 range succ(column1) to 8 do
2036 if card(rowsInColumn[column2]) >= 2 and
2037 card(rowsInColumn[column1] | rowsInColumn[column2]) <= 3 then
2038 for column3 range succ(column2) to 9 do
2039 if card(rowsInColumn[column3]) >= 2 then
2040 swordfishRows := rowsInColumn[column1] | rowsInColumn[column2] |
2041 rowsInColumn[column3];
2042 if card(swordfishRows) = 3 then
2043 for column range 1 to 9 do
2044 if column <> column1 and column <> column2 and column <> column3 then
2045 if card(rowsInColumn[column] & swordfishRows) <> 0 then
2046 for row range 1 to 9 do
2047 if row in swordfishRows then
2048 excl(candidates[row][column], digit);
2049 end if;
2050 end for;
2051 changeDone := TRUE;
2052 end if;
2053 end if;
2054 end for;
2055 end if;
2056 end if;
2057 end for;
2058 end if;
2059 end for;
2060 end if;
2061 end for;
2062 end func;
2063
2064
2065 const proc: checkSwordfish (inout boolean: changeDone) is func
2066 local
2067 var integer: digit is 0;
2068 begin
2069 for digit range 1 to 9 do
2070 checkSwordfishForDigit(digit, changeDone);
2071 end for;
2072 end func;
2073
2074
2075 const proc: solve is func
2076 local
2077 var boolean: changeDone is FALSE;
2078 begin
2079 repeat
2080 changeDone := FALSE;
2081 excludeFields;
2082 if lookForSingles then
2083 checkSingles(changeDone);
2084 end if;
2085 if lookForHiddenSingles then
2086 checkHiddenSingles(changeDone);
2087 end if;
2088 if lookForLockedCandidates then
2089 checkLockedCandidates(changeDone);
2090 end if;
2091 if lookForNakedPairs then
2092 checkNakedPairs(changeDone);
2093 end if;
2094 if lookForNakedTriples then
2095 checkNakedTriples(changeDone);
2096 end if;
2097 if lookForNakedQuads then
2098 checkNakedQuads(changeDone);
2099 end if;
2100 if lookForHiddenPairs then
2101 checkHiddenPairs(changeDone);
2102 end if;
2103 if lookForHiddenTriples then
2104 checkHiddenTriples(changeDone);
2105 end if;
2106 if lookForHiddenQuads then
2107 checkHiddenQuads(changeDone);
2108 end if;
2109 if lookForXWing then
2110 checkXWing(changeDone);
2111 end if;
2112 if lookForSwordfish then
2113 checkSwordfish(changeDone);
2114 end if;
2115 until not changeDone;
2116 end func;
2117
2118
2119 const proc: blueChanges is func
2120 begin
2121 repeat
2122 blue_changes := FALSE;
2123 excludeFields;
2124 DRAW_FLUSH;
2125 until not blue_changes;
2126 end func;
2127
2128
2129 const func char: readCommand (in integer: row, in integer: column) is func
2130 result
2131 var char: command is ' ';
2132
2133 begin
2134 command := getc(KEYBOARD);
2135 box(X_SHIFT + STRETCH_FACTOR * succ(column) + CELL_SHIFT,
2136 Y_SHIFT + STRETCH_FACTOR * succ(row) + CELL_SHIFT,
2137 CELL_SIZE, CELL_SIZE, BACKGROUND);
2138 end func;
2139
2140
2141 const proc: showSolved is func
2142
2143 local
2144 var integer: row is 1;
2145 var integer: column is 1;
2146
2147 begin
2148 for row range 1 to 9 do
2149 for column range 1 to 9 do
2150 if not user_input[row][column] and field[row][column] <> 0 then
2151 clearField(row, column);
2152 setBlueDigit(row, column, field[row][column]);
2153 end if;
2154 end for;
2155 end for;
2156 end func;
2157
2158
2159 const proc: showNumberOfCandidates (in integer: number) is func
2160
2161 local
2162 var integer: row is 1;
2163 var integer: column is 1;
2164
2165 begin
2166 for row range 1 to 9 do
2167 for column range 1 to 9 do
2168 if field[row][column] = 0 then
2169 clearField(row, column);
2170 if card(candidates[row][column]) = number then
2171 markField(row, column);
2172 end if;
2173 end if;
2174 end for;
2175 end for;
2176 end func;
2177
2178
2179 const proc: showCandidatesDigit (in integer: number) is func
2180
2181 local
2182 var integer: row is 1;
2183 var integer: column is 1;
2184
2185 begin
2186 for row range 1 to 9 do
2187 for column range 1 to 9 do
2188 if field[row][column] = 0 then
2189 clearField(row, column);
2190 if number in candidates[row][column] then
2191 markField(row, column);
2192 end if;
2193 end if;
2194 end for;
2195 end for;
2196 end func;
2197
2198
2199 const proc: showCandidates is func
2200
2201 local
2202 var integer: row is 1;
2203 var integer: column is 1;
2204 var integer: digit is 0;
2205
2206 begin
2207 for row range 1 to 9 do
2208 for column range 1 to 9 do
2209 if field[row][column] = 0 then
2210 for digit range 1 to 9 do
2211 if digit in candidates[row][column] then
2212 writeSmallDigit(row, column, digit);
2213 end if;
2214 end for;
2215 end if;
2216 end for;
2217 end for;
2218 end func;
2219
2220
2221 const proc: showStrategyCheckboxes is func
2222 local
2223 var integer: number is 0;
2224 var boolean: button_is_on is FALSE;
2225 begin
2226 rect(RIGHT_BUTTON_X - 6, RIGHT_BUTTON_MIN_Y - 3 + 39 * 2, 256, 39 * 11, black);
2227 for number range 3 to 13 do
2228 box(RIGHT_BUTTON_X + 4, RIGHT_BUTTON_MIN_Y + 4 + 39 * pred(number), 24, 24, FOREGROUND);
2229 setPosXY(info, 45, RIGHT_BUTTON_MIN_Y + 18 + 39 * pred(number));
2230 case number of
2231 when {3}:
2232 write(info, "singles");
2233 button_is_on := lookForSingles;
2234 when {4}:
2235 write(info, "hidden singles");
2236 button_is_on := lookForHiddenSingles;
2237 when {5}:
2238 write(info, "locked candidates");
2239 button_is_on := lookForLockedCandidates;
2240 when {6}:
2241 write(info, "naked pairs");
2242 button_is_on := lookForNakedPairs;
2243 when {7}:
2244 write(info, "naked triples");
2245 button_is_on := lookForNakedTriples;
2246 when {8}:
2247 write(info, "naked quads");
2248 button_is_on := lookForNakedQuads;
2249 when {9}:
2250 write(info, "hidden pairs");
2251 button_is_on := lookForHiddenPairs;
2252 when {10}:
2253 write(info, "hidden triples");
2254 button_is_on := lookForHiddenTriples;
2255 when {11}:
2256 write(info, "hidden quads");
2257 button_is_on := lookForHiddenQuads;
2258 when {12}:
2259 write(info, "x-wing");
2260 button_is_on := lookForXWing;
2261 when {13}:
2262 write(info, "swordfish");
2263 button_is_on := lookForSwordfish;
2264 end case;
2265 if button_is_on then
2266 put(RIGHT_BUTTON_X + 8, RIGHT_BUTTON_MIN_Y + 8 + 39 * pred(number),
2267 checkmark_pixmap, PSET);
2268 else
2269 rect(RIGHT_BUTTON_X + 8, RIGHT_BUTTON_MIN_Y + 8 + 39 * pred(number),
2270 16, 16, BACKGROUND);
2271 end if;
2272 end for;
2273 end func;
2274
2275
2276 const proc: hideStrategyCheckboxes is func
2277 begin
2278 rect(RIGHT_BUTTON_X - 6, RIGHT_BUTTON_MIN_Y - 3 + 39 * 2, 256, 39 * 11, black);
2279 end func;
2280
2281
2282 const proc: showButtons is func
2283 local
2284 var integer: number is 0;
2285 begin
2286 for number range 0 to 12 do
2287 box(TOP_BUTTON_MIN_X + 48 * number, TOP_BUTTON_Y, 32, 32, FOREGROUND);
2288 case number of
2289 when {1 .. 9}:
2290 put(TOP_BUTTON_MIN_X + 8 + 48 * number, TOP_BUTTON_Y + 8,
2291 small_digits[number], PSET);
2292 when {10}:
2293 put(TOP_BUTTON_MIN_X + 8 + 48 * number, TOP_BUTTON_Y + 8,
2294 single_pixmap, PSET);
2295 when {11}:
2296 put(TOP_BUTTON_MIN_X + 8 + 48 * number, TOP_BUTTON_Y + 8,
2297 double_pixmap, PSET);
2298 when {12}:
2299 put(TOP_BUTTON_MIN_X + 8 + 48 * number, TOP_BUTTON_Y + 8,
2300 triple_pixmap, PSET);
2301 end case;
2302 end for;
2303 put(EXIT_BUTTON_X, TOP_BUTTON_Y, exit_pixmap, PSET);
2304 for number range 1 to 2 do
2305 box(RIGHT_BUTTON_X + 4, RIGHT_BUTTON_MIN_Y + 4 + 39 * pred(number), 24, 24, FOREGROUND);
2306 setPosXY(info, 45, RIGHT_BUTTON_MIN_Y + 18 + 39 * pred(number));
2307 case number of
2308 when {1}:
2309 write(info, "show candidates");
2310 when {2}:
2311 write(info, "show solution");
2312 end case;
2313 end for;
2314 end func;
2315
2316
2317 const proc: loadField (in string: stri) is func
2318 local
2319 var integer: number is 0;
2320 var integer: row is 0;
2321 var integer: column is 0;
2322 begin
2323 if length(stri) = 81 then
2324 for number range 1 to 81 do
2325 row := succ(pred(number) div 9);
2326 column := succ(pred(number) rem 9);
2327 if stri[number] in {'1' .. '9'} then
2328 setRedDigit(row, column, ord(stri[number]) - ord('0'));
2329 end if;
2330 end for;
2331 end if;
2332 end func;
2333
2334
2335 const proc: processCommand is func
2336
2337 local
2338 var integer: x is 0;
2339 var integer: y is 0;
2340 var integer: row is 1;
2341 var integer: column is 1;
2342 var integer: candidate_digit is 0;
2343 var integer: button_num is 0;
2344 var boolean: button_is_on is FALSE;
2345 var integer: digit is 0;
2346 var char: command is ' ';
2347
2348 begin
2349 # loadField("002090400050400000100005060000109000007000200000008070400060001001080300500200006");
2350 # loadField("003406080006700100080000050002045000305000900070000300001230000004007000560000000");
2351 # loadField("700000019460190000000682704090000007000300405006700000001000000200074000000200300");
2352 # loadField("001080604037600000500000000000005000006010800000400000000000003000007520802090700");
2353 # loadField("002090107038600000400000000000005000009010300000400000000000004000007920806030700");
2354 # loadField("460001000002096000030000068000000037000607000510000000840000050000710900000300024");
2355 # loadField("050709030708000000090200080603010005000305010005060400040001000900000507060504100");
2356 # loadField("146700200905800070003600000000400020000008000000056900070100000000040036000009001");
2357 showButtons;
2358 repeat
2359 box(X_SHIFT + STRETCH_FACTOR * succ(column) + CELL_SHIFT,
2360 Y_SHIFT + STRETCH_FACTOR * succ(row) + CELL_SHIFT,
2361 CELL_SIZE, CELL_SIZE, light_red);
2362 DRAW_FLUSH;
2363 (*
2364 if not keypressed(KEYBOARD) then
2365 blueChanges;
2366 end if;
2367 *)
2368 if show_solution then
2369 solve;
2370 showSolved;
2371 end if;
2372 if candidate_digit >= 10 then
2373 showNumberOfCandidates(candidate_digit - 9);
2374 else
2375 showCandidatesDigit(candidate_digit);
2376 end if;
2377 if show_candidates then
2378 showCandidates;
2379 end if;
2380 repeat
2381 command := readCommand(row, column);
2382 case command of
2383 when {KEY_DOWN}:
2384 if row < 9 then
2385 incr(row);
2386 else
2387 row := 1;
2388 end if;
2389 when {KEY_UP}:
2390 if row > 1 then
2391 decr(row);
2392 else
2393 row := 9;
2394 end if;
2395 when {KEY_RIGHT}:
2396 if column < 9 then
2397 incr(column);
2398 else
2399 column := 1;
2400 end if;
2401 when {KEY_LEFT}:
2402 if column > 1 then
2403 decr(column);
2404 else
2405 column := 9;
2406 end if;
2407 when {KEY_HOME}:
2408 row := 1;
2409 when {KEY_END}:
2410 row := 9;
2411 when {KEY_PGUP}:
2412 column := 1;
2413 when {KEY_PGDN}:
2414 column := 9;
2415 when {'q', 'Q', KEY_CLOSE}:
2416 quit := TRUE;
2417 when {KEY_ESC}:
2418 bossMode(quit);
2419 when {'1' .. '9'}:
2420 if field[row][column] <> 0 then
2421 clearDigit(row, column);
2422 blueChanges;
2423 end if;
2424 if ord(command) - ord('0') in candidates[row][column] then
2425 setRedDigit(row, column, ord(command) - ord('0'));
2426 blueChanges;
2427 (* if column < 9 then
2428 incr(column);
2429 end if; *)
2430 end if;
2431 when {' '}:
2432 clearDigit(row, column);
2433 (* if column < 9 then
2434 incr(column);
2435 end if; *)
2436 when {KEY_MOUSE1}:
2437 x := getxpos(KEYBOARD);
2438 y := getypos(KEYBOARD);
2439 if x >= X_SHIFT + STRETCH_FACTOR * 2 + 1 and
2440 x <= X_SHIFT + STRETCH_FACTOR * 11 and
2441 y >= Y_SHIFT + STRETCH_FACTOR * 2 + 1 and
2442 y <= Y_SHIFT + STRETCH_FACTOR * 11 then
2443 row := pred(y - Y_SHIFT) div STRETCH_FACTOR - 1;
2444 column := pred(x - X_SHIFT) div STRETCH_FACTOR - 1;
2445 elsif y >= TOP_BUTTON_Y and y <= TOP_BUTTON_Y + 32 and
2446 x >= TOP_BUTTON_MIN_X and x <= TOP_BUTTON_MIN_X + 32 + 48 * 12 and
2447 (x - TOP_BUTTON_MIN_X) rem 48 <= 32 then
2448 box(TOP_BUTTON_MIN_X + 4 + 48 * candidate_digit, TOP_BUTTON_Y + 4, 24, 24, BACKGROUND);
2449 candidate_digit := (x - TOP_BUTTON_MIN_X) div 48;
2450 box(TOP_BUTTON_MIN_X + 4 + 48 * candidate_digit, TOP_BUTTON_Y + 4, 24, 24, FOREGROUND);
2451 elsif y >= TOP_BUTTON_Y and y <= TOP_BUTTON_Y + 32 and
2452 x >= EXIT_BUTTON_X and x <= EXIT_BUTTON_X + 32 then
2453 quit := TRUE;
2454 elsif x >= RIGHT_BUTTON_X and x <= RIGHT_BUTTON_X + 32 and
2455 y >= RIGHT_BUTTON_MIN_Y and y <= RIGHT_BUTTON_MIN_Y + 32 + 39 * 12 and
2456 (y - RIGHT_BUTTON_MIN_Y) rem 39 <= 32 then
2457 button_num := (y - RIGHT_BUTTON_MIN_Y) div 39;
2458 case button_num of
2459 when {0}:
2460 show_candidates := not show_candidates;
2461 button_is_on := show_candidates;
2462 when {1}:
2463 show_solution := not show_solution;
2464 button_is_on := show_solution;
2465 if not show_solution then
2466 hideStrategyCheckboxes;
2467 initCandidates;
2468 blueChanges;
2469 else
2470 showStrategyCheckboxes;
2471 end if;
2472 end case;
2473 if show_solution then
2474 case button_num of
2475 when {2}:
2476 lookForSingles := not lookForSingles;
2477 if not lookForSingles then
2478 initCandidates;
2479 blueChanges;
2480 end if;
2481 button_is_on := lookForSingles;
2482 when {3}:
2483 lookForHiddenSingles := not lookForHiddenSingles;
2484 if not lookForHiddenSingles then
2485 initCandidates;
2486 blueChanges;
2487 end if;
2488 button_is_on := lookForHiddenSingles;
2489 when {4}:
2490 lookForLockedCandidates := not lookForLockedCandidates;
2491 if not lookForLockedCandidates then
2492 initCandidates;
2493 blueChanges;
2494 end if;
2495 button_is_on := lookForLockedCandidates;
2496 when {5}:
2497 lookForNakedPairs := not lookForNakedPairs;
2498 if not lookForNakedPairs then
2499 initCandidates;
2500 blueChanges;
2501 end if;
2502 button_is_on := lookForNakedPairs;
2503 when {6}:
2504 lookForNakedTriples := not lookForNakedTriples;
2505 if not lookForNakedTriples then
2506 initCandidates;
2507 blueChanges;
2508 end if;
2509 button_is_on := lookForNakedTriples;
2510 when {7}:
2511 lookForNakedQuads := not lookForNakedQuads;
2512 if not lookForNakedQuads then
2513 initCandidates;
2514 blueChanges;
2515 end if;
2516 button_is_on := lookForNakedQuads;
2517 when {8}:
2518 lookForHiddenPairs := not lookForHiddenPairs;
2519 if not lookForHiddenPairs then
2520 initCandidates;
2521 blueChanges;
2522 end if;
2523 button_is_on := lookForHiddenPairs;
2524 when {9}:
2525 lookForHiddenTriples := not lookForHiddenTriples;
2526 if not lookForHiddenTriples then
2527 initCandidates;
2528 blueChanges;
2529 end if;
2530 button_is_on := lookForHiddenTriples;
2531 when {10}:
2532 lookForHiddenQuads := not lookForHiddenQuads;
2533 if not lookForHiddenQuads then
2534 initCandidates;
2535 blueChanges;
2536 end if;
2537 button_is_on := lookForHiddenQuads;
2538 when {11}:
2539 lookForXWing := not lookForXWing;
2540 if not lookForXWing then
2541 initCandidates;
2542 blueChanges;
2543 end if;
2544 button_is_on := lookForXWing;
2545 when {12}:
2546 lookForSwordfish := not lookForSwordfish;
2547 if not lookForSwordfish then
2548 initCandidates;
2549 blueChanges;
2550 end if;
2551 button_is_on := lookForSwordfish;
2552 end case;
2553 end if;
2554 if show_solution or button_num <= 1 then
2555 if button_is_on then
2556 put(RIGHT_BUTTON_X + 8, RIGHT_BUTTON_MIN_Y + 8 + 39 * button_num,
2557 checkmark_pixmap, PSET);
2558 else
2559 rect(RIGHT_BUTTON_X + 8, RIGHT_BUTTON_MIN_Y + 8 + 39 * button_num,
2560 16, 16, BACKGROUND);
2561 end if;
2562 end if;
2563 end if;
2564 when {KEY_MOUSE3}:
2565 x := getxpos(KEYBOARD);
2566 y := getypos(KEYBOARD);
2567 if x >= X_SHIFT + STRETCH_FACTOR * 2 + 1 and
2568 x <= X_SHIFT + STRETCH_FACTOR * 11 and
2569 y >= Y_SHIFT + STRETCH_FACTOR * 2 + 1 and
2570 y <= Y_SHIFT + STRETCH_FACTOR * 11 then
2571 row := pred(y - Y_SHIFT) div STRETCH_FACTOR - 1;
2572 column := pred(x - X_SHIFT) div STRETCH_FACTOR - 1;
2573 x -:= pred(column) * STRETCH_FACTOR + FIELD_XPOS + 12;
2574 y -:= pred(row) * STRETCH_FACTOR + FIELD_YPOS + 12;
2575 if x >= 0 and x < 48 and y >= 0 and y < 48 then
2576 digit := 1 + x div 16 + 3 * (y div 16);
2577 if digit in candidates[row][column] then
2578 excl(candidates[row][column], digit);
2579 else
2580 incl(candidates[row][column], digit);
2581 end if;
2582 end if;
2583 end if;
2584 end case;
2585 until not keypressed(KEYBOARD);
2586 until quit;
2587 end func;
2588
2589
2590 const proc: writeCentered (inout text: screen, in integer: yPos, in string: stri) is func
2591 begin
2592 setPosXY(screen, (WINDOW_WIDTH - 632 - width(stdFont9, stri)) div 2, yPos);
2593 writeln(screen, stri);
2594 end func;
2595
2596
2597 const proc: main is func
2598 begin
2599 screen(WINDOW_WIDTH, WINDOW_HEIGHT);
2600 setCloseAction(curr_win, RETURN_KEY);
2601 clear(BACKGROUND);
2602 info := openPixmapFontFile(curr_win, 630, 0);
2603 setFont(info, stdFont9);
2604 # info := open(curr_win, 630, 0);
2605 color(info, white, black);
2606 KEYBOARD := GRAPH_KEYBOARD;
2607 writeCentered(info, 280, "S U D O K U 7");
2608 writeCentered(info, 312, "Copyright (C) 2006 Thomas Mertes");
2609 writeCentered(info, 344, "This program is free software under the");
2610 writeCentered(info, 360, "terms of the GNU General Public License");
2611 writeCentered(info, 392, "Sudoku7 is written in the");
2612 writeCentered(info, 408, "Seed7 programming language.");
2613 writeCentered(info, 440, "Homepage: http://seed7.sourceforge.net");
2614 initGrid;
2615 blue_digits := [0](
2616 createPixmap(blue_zero, 2, BACKGROUND),
2617 createPixmap(blue_one, 2, BACKGROUND),
2618 createPixmap(blue_two, 2, BACKGROUND),
2619 createPixmap(blue_three, 2, BACKGROUND),
2620 createPixmap(blue_four, 2, BACKGROUND),
2621 createPixmap(blue_five, 2, BACKGROUND),
2622 createPixmap(blue_six, 2, BACKGROUND),
2623 createPixmap(blue_seven, 2, BACKGROUND),
2624 createPixmap(blue_eight, 2, BACKGROUND),
2625 createPixmap(blue_nine, 2, BACKGROUND));
2626 red_digits := [0](
2627 createPixmap(red_zero, 2, BACKGROUND),
2628 createPixmap(red_one, 2, BACKGROUND),
2629 createPixmap(red_two, 2, BACKGROUND),
2630 createPixmap(red_three, 2, BACKGROUND),
2631 createPixmap(red_four, 2, BACKGROUND),
2632 createPixmap(red_five, 2, BACKGROUND),
2633 createPixmap(red_six, 2, BACKGROUND),
2634 createPixmap(red_seven, 2, BACKGROUND),
2635 createPixmap(red_eight, 2, BACKGROUND),
2636 createPixmap(red_nine, 2, BACKGROUND));
2637 small_digits := [0](
2638 createPixmap(blue_zero, 1, BACKGROUND),
2639 createPixmap(blue_one, 1, BACKGROUND),
2640 createPixmap(blue_two, 1, BACKGROUND),
2641 createPixmap(blue_three, 1, BACKGROUND),
2642 createPixmap(blue_four, 1, BACKGROUND),
2643 createPixmap(blue_five, 1, BACKGROUND),
2644 createPixmap(blue_six, 1, BACKGROUND),
2645 createPixmap(blue_seven, 1, BACKGROUND),
2646 createPixmap(blue_eight, 1, BACKGROUND),
2647 createPixmap(blue_nine, 1, BACKGROUND));
2648 single_pixmap := createPixmap(blue_single, 1, BACKGROUND);
2649 double_pixmap := createPixmap(blue_double, 1, BACKGROUND);
2650 triple_pixmap := createPixmap(blue_triple, 1, BACKGROUND);
2651 exit_pixmap := createPixmap(exit_pic, 2, BACKGROUND);
2652 checkmark_pixmap := createPixmap(checkmark_pic, 1, BACKGROUND);
2653 initCandidates;
2654 processCommand;
2655 end func;