-
Notifications
You must be signed in to change notification settings - Fork 0
/
GSODOKU.PAS
127 lines (116 loc) · 2.55 KB
/
GSODOKU.PAS
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
{ @author: Sylvain Maltais (support@gladir.com)
@created: 2023
@website(https://www.gladir.com/vie)
@abstract(Target: Turbo Pascal 7, Free Pascal 3.2)
}
Program GSODOKU;
Var
ShowTry:Boolean;
SolutionGrid:Array[1..9,1..9] of Integer;
Function StrToUpper(S:String):String;
Var
I:Byte;
Begin
For I:=1 to Length(S)do Begin
If S[I] in['a'..'z']Then S[I]:=Chr(Ord(S[I])-32);
End;
StrToUpper:=S;
End;
Function Left(Const Str:String;Num:Byte):String;Begin
Left:=Copy(Str,1,Num);
End;
Procedure DelChrAt(Var S:String;P:Byte);Begin
If P=1Then S:=Copy(S,2,255)
Else S:=Left(S,P-1)+Copy(S,P+1,255)
End;
Function VerticalFound(X,YMax,Number:Integer):Boolean;
Var
J:Integer;
Begin
VerticalFound:=False;
For J:=1 to YMax do Begin
If(SolutionGrid[J,X]=Number)Then Begin
VerticalFound:=True;
Exit;
End;
End;
End;
Function FindZero:Boolean;
Var
I,J:Integer;
Begin
FindZero:=False;
For J:=1 to 9 do For I:=1 to 9 do Begin
If SolutionGrid[J,I]=0 Then Begin
FindZero:=True;
End;
End;
End;
Procedure FindSolution;
Var
Base:String;
I,J,K,L:Integer;
R,P:Integer;
Begin
Randomize;
For K:=1 to 5000 do Begin
For J:=1 to 9 do Begin
Base[0]:=#9;
For I:=1 to 9 do Base[I]:=Chr(I);
For I:=1 to 9 do Begin
R:=Random(Length(Base))+1;
If VerticalFound(I,J,Byte(Base[R]))Then Begin
For L:=1 to Length(Base)do Begin
If Not VerticalFound(I,J,Byte(Base[L]))Then Begin
SolutionGrid[J,I]:=Byte(Base[L]);
DelChrAt(Base,L);
Break;
End;
End;
End
Else
Begin
SolutionGrid[J,I]:=Byte(Base[R]);
DelChrAt(Base,R);
End;
End;
End;
If Not FindZero Then Begin
If(ShowTry)Then Begin
WriteLn('Nombre d''essaie : ',K);
WriteLn;
End;
Break;
End;
End;
End;
Var
I,J:Byte;
BEGIN
If(ParamStr(1)='/?')or(ParamStr(1)='--help')or(ParamStr(1)='-h')or
(ParamStr(1)='/h')or(ParamStr(1)='/H')Then Begin
WriteLn('GSODOKU : Cette commande permet de g‚n‚rer une matrice de ',
'nombre de 9 x 9 pour une solution possible ',
'dans une grille du jeu Sodoku.');
WriteLn;
WriteLn('Syntaxe : GSODOKU [/SHOWTRY]');
WriteLn;
WriteLn(' /SHOWTRY Ce paramŠtre permet d''afficher le nombre d''essaie.');
End
Else
Begin
ShowTry:=False;
For I:=1 to ParamCount do Begin
If StrToUpper(ParamStr(I))='/SHOWTRY'Then ShowTry:=True;
End;
FindSolution;
If(FindZero)Then Begin
WriteLn('Nombre d''essaie insuffisant !');
Halt;
End;
For J:=1 to 9 do Begin
For I:=1 to 9 do Write(SolutionGrid[J,I],' ');
WriteLn;
End;
End;
END.