summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--raetsel.lps110
-rw-r--r--raetselunit.inc67
-rw-r--r--raetselunit.pas103
3 files changed, 166 insertions, 114 deletions
diff --git a/raetsel.lps b/raetsel.lps
index 09d01c0..44c4c43 100644
--- a/raetsel.lps
+++ b/raetsel.lps
@@ -9,7 +9,7 @@
<IsPartOfProject Value="True"/>
<EditorIndex Value="2"/>
<CursorPos X="30" Y="19"/>
- <UsageCount Value="73"/>
+ <UsageCount Value="78"/>
<Loaded Value="True"/>
</Unit0>
<Unit1>
@@ -19,7 +19,7 @@
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<CursorPos Y="16"/>
- <UsageCount Value="73"/>
+ <UsageCount Value="78"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
</Unit1>
@@ -32,23 +32,25 @@
<UnitName Value="Unit2"/>
<EditorIndex Value="-1"/>
<CursorPos X="11" Y="27"/>
- <UsageCount Value="72"/>
+ <UsageCount Value="77"/>
</Unit2>
<Unit3>
<Filename Value="raetselunit.pas"/>
<IsPartOfProject Value="True"/>
<IsVisibleTab Value="True"/>
<EditorIndex Value="1"/>
- <TopLine Value="378"/>
- <CursorPos X="56" Y="389"/>
- <UsageCount Value="67"/>
+ <TopLine Value="661"/>
+ <CursorPos Y="681"/>
+ <UsageCount Value="72"/>
<Loaded Value="True"/>
</Unit3>
<Unit4>
<Filename Value="raetselunit.inc"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="6"/>
- <UsageCount Value="53"/>
+ <TopLine Value="394"/>
+ <CursorPos X="34" Y="401"/>
+ <UsageCount Value="58"/>
<Loaded Value="True"/>
</Unit4>
<Unit5>
@@ -111,7 +113,7 @@
<Unit13>
<Filename Value="../units/lowlevelunit.pas"/>
<EditorIndex Value="4"/>
- <UsageCount Value="14"/>
+ <UsageCount Value="16"/>
<Loaded Value="True"/>
</Unit13>
<Unit14>
@@ -124,9 +126,9 @@
<Unit15>
<Filename Value="../units/matheunit.pas"/>
<EditorIndex Value="5"/>
- <TopLine Value="307"/>
- <CursorPos X="9" Y="327"/>
- <UsageCount Value="14"/>
+ <TopLine Value="983"/>
+ <CursorPos X="17" Y="1009"/>
+ <UsageCount Value="16"/>
<Loaded Value="True"/>
</Unit15>
<Unit16>
@@ -150,7 +152,7 @@
<EditorIndex Value="3"/>
<TopLine Value="22"/>
<CursorPos X="59" Y="58"/>
- <UsageCount Value="14"/>
+ <UsageCount Value="16"/>
<Loaded Value="True"/>
</Unit19>
</Units>
@@ -160,120 +162,123 @@
<JumpHistory Count="30" HistoryIndex="29">
<Position1>
<Filename Value="raetselunit.pas"/>
- <Caret Line="568" Column="11" TopLine="541"/>
+ <Caret Line="478" Column="11" TopLine="452"/>
</Position1>
<Position2>
<Filename Value="raetselunit.pas"/>
- <Caret Line="688" Column="11" TopLine="661"/>
+ <Caret Line="479" Column="11" TopLine="453"/>
</Position2>
<Position3>
- <Filename Value="raetselunit.inc"/>
- <Caret Line="737" Column="37" TopLine="725"/>
+ <Filename Value="raetselunit.pas"/>
+ <Caret Line="480" Column="11" TopLine="454"/>
</Position3>
<Position4>
<Filename Value="raetselunit.pas"/>
- <Caret Line="746" Column="34" TopLine="744"/>
+ <Caret Line="481" Column="11" TopLine="455"/>
</Position4>
<Position5>
<Filename Value="raetselunit.pas"/>
+ <Caret Line="485" Column="25" TopLine="459"/>
</Position5>
<Position6>
<Filename Value="raetselunit.pas"/>
- <Caret Line="76" Column="23" TopLine="49"/>
+ <Caret Line="486" Column="40" TopLine="460"/>
</Position6>
<Position7>
<Filename Value="raetselunit.pas"/>
- <Caret Line="116" Column="40" TopLine="89"/>
+ <Caret Line="517" Column="21" TopLine="490"/>
</Position7>
<Position8>
<Filename Value="raetselunit.pas"/>
- <Caret Line="351" Column="12" TopLine="324"/>
+ <Caret Line="518" Column="35" TopLine="491"/>
</Position8>
<Position9>
<Filename Value="raetselunit.pas"/>
+ <Caret Line="523" Column="13" TopLine="496"/>
</Position9>
<Position10>
<Filename Value="raetselunit.pas"/>
- <Caret Line="76" Column="46" TopLine="49"/>
+ <Caret Line="524" Column="41" TopLine="497"/>
</Position10>
<Position11>
<Filename Value="raetselunit.pas"/>
- <Caret Line="116" Column="46" TopLine="89"/>
+ <Caret Line="525" Column="15" TopLine="498"/>
</Position11>
<Position12>
<Filename Value="raetselunit.pas"/>
- <Caret Line="351" Column="11" TopLine="324"/>
+ <Caret Line="613" Column="11" TopLine="586"/>
</Position12>
<Position13>
<Filename Value="raetselunit.pas"/>
- <Caret Line="381" Column="13" TopLine="354"/>
+ <Caret Line="614" Column="11" TopLine="587"/>
</Position13>
<Position14>
<Filename Value="raetselunit.pas"/>
- <Caret Line="392" Column="13" TopLine="365"/>
+ <Caret Line="770" Column="28" TopLine="743"/>
</Position14>
<Position15>
<Filename Value="raetselunit.pas"/>
- <Caret Line="513" Column="11" TopLine="486"/>
+ <Caret Line="873" Column="19" TopLine="846"/>
</Position15>
<Position16>
<Filename Value="raetselunit.pas"/>
- <Caret Line="392" Column="43" TopLine="377"/>
+ <Caret Line="875" Column="19" TopLine="848"/>
</Position16>
<Position17>
<Filename Value="raetselunit.pas"/>
- <Caret Line="514" Column="11" TopLine="487"/>
+ <Caret Line="934" Column="11" TopLine="907"/>
</Position17>
<Position18>
<Filename Value="raetselunit.pas"/>
- <Caret Line="528" Column="13" TopLine="501"/>
+ <Caret Line="937" Column="11" TopLine="910"/>
</Position18>
<Position19>
<Filename Value="raetselunit.pas"/>
- <Caret Line="560" Column="11" TopLine="534"/>
+ <Caret Line="1010" Column="27" TopLine="1001"/>
</Position19>
<Position20>
<Filename Value="raetselunit.pas"/>
- <Caret Line="569" Column="11" TopLine="542"/>
+ <Caret Line="34" TopLine="33"/>
</Position20>
<Position21>
<Filename Value="raetselunit.pas"/>
- <Caret Line="689" Column="11" TopLine="662"/>
+ <Caret Line="55" Column="29" TopLine="33"/>
</Position21>
<Position22>
<Filename Value="raetselunit.pas"/>
- <Caret Line="783" Column="48" TopLine="763"/>
+ <Caret Line="227" Column="38" TopLine="200"/>
</Position22>
<Position23>
<Filename Value="raetselunit.pas"/>
+ <Caret Line="342" TopLine="325"/>
</Position23>
<Position24>
<Filename Value="raetselunit.pas"/>
- <Caret Line="76" Column="23" TopLine="49"/>
+ <Caret Line="635" TopLine="610"/>
</Position24>
<Position25>
<Filename Value="raetselunit.pas"/>
- <Caret Line="116" Column="23" TopLine="89"/>
+ <Caret Line="636" TopLine="610"/>
</Position25>
<Position26>
<Filename Value="raetselunit.pas"/>
- <Caret Line="351" Column="11" TopLine="324"/>
+ <Caret Line="343" TopLine="327"/>
</Position26>
<Position27>
<Filename Value="raetselunit.pas"/>
- <Caret Line="381" Column="13" TopLine="354"/>
+ <Caret Line="344" TopLine="327"/>
</Position27>
<Position28>
<Filename Value="raetselunit.pas"/>
- <Caret Line="393" Column="9" TopLine="365"/>
+ <Caret Line="345" TopLine="327"/>
</Position28>
<Position29>
<Filename Value="raetselunit.pas"/>
- <Caret Line="39" Column="7" TopLine="22"/>
+ <Caret Line="346" TopLine="327"/>
</Position29>
<Position30>
<Filename Value="raetselunit.pas"/>
- <Caret Line="401" Column="14" TopLine="376"/>
+ <Caret Line="347" TopLine="327"/>
</Position30>
</JumpHistory>
<RunParams>
@@ -281,29 +286,4 @@
<Modes Count="0" ActiveMode="default"/>
</RunParams>
</ProjectSession>
- <Debugging>
- <Watches Count="7">
- <Item1>
- <Expression Value="W"/>
- </Item1>
- <Item2>
- <Expression Value="S"/>
- </Item2>
- <Item3>
- <Expression Value="inhalt[Zeile*dim+I]"/>
- </Item3>
- <Item4>
- <Expression Value="inhalt[I*dim+Spalte]"/>
- </Item4>
- <Item5>
- <Expression Value="inhalt"/>
- </Item5>
- <Item6>
- <Expression Value="loesen"/>
- </Item6>
- <Item7>
- <Expression Value="p"/>
- </Item7>
- </Watches>
- </Debugging>
</CONFIG>
diff --git a/raetselunit.inc b/raetselunit.inc
index 90315bf..025d68a 100644
--- a/raetselunit.inc
+++ b/raetselunit.inc
@@ -89,50 +89,39 @@ end;
{$IFDEF passt}
// function tHochhausRaetsel.passt(spalte,zeile: integer): boolean;
var
- i,KZ,KS: integer;
- w,s,k: longint;
+ i: integer;
+ w,s,k: longint;
+ kachel: longint;
begin
w:=0;
s:=0;
k:=0;
- if sudokuCB.checked then begin
- KZ:=(zeile div nSqrt)*nSqrt;
- KS:=(spalte div nSqrt)*nSqrt;
- for i:=0 to dim-1 do begin
- {$IFDEF buchstaben}
- w:=w*(groeszen[0]+2)+inhalt[zeile*dim+i]+1;
- s:=s*(groeszen[0]+2)+inhalt[i*dim+spalte]+1;
- k:=k*(groeszen[0]+2)+inhalt[(KZ+(i div nSqrt))*dim+KS+(i mod nSqrt)]+1;
- {$ENDIF}
- {$IFDEF hochhaus}
- w:=w*(dim+1)+max(0,inhalt[zeile*dim+i]);
- s:=s*(dim+1)+max(0,inhalt[i*dim+spalte]);
- k:=k*(dim+1)+max(0,inhalt[(KZ+(i div nSqrt))*dim+KS+(i mod nSqrt)]);
- {$ENDIF}
- end;
- result:=
- AMoeglich[k*(groeszen[0]+1)] and
- EMoeglich[s*(groeszen[0]+1)+max(0,rand[spalte])] and
- AMoeglich[w*(groeszen[0]+1)+max(0,rand[dim+zeile])] and
- AMoeglich[s*(groeszen[0]+1)+max(0,rand[2*dim+spalte])] and
- EMoeglich[w*(groeszen[0]+1)+max(0,rand[3*dim+zeile])];
- end
- else begin
+ for i:=0 to dim-1 do begin
+ {$IFDEF buchstaben}
+ w:=w*(groeszen[0]+2)+inhalt[zeile*dim+i]+1;
+ s:=s*(groeszen[0]+2)+inhalt[i*dim+spalte]+1;
+ {$ENDIF}
+ {$IFDEF hochhaus}
+ w:=w*(dim+1)+max(0,inhalt[zeile*dim+i]);
+ s:=s*(dim+1)+max(0,inhalt[i*dim+spalte]);
+ {$ENDIF}
+ end;
+ result:=
+ EMoeglich[s*(groeszen[0]+1)+max(0,rand[spalte])] and
+ AMoeglich[w*(groeszen[0]+1)+max(0,rand[dim+zeile])] and
+ AMoeglich[s*(groeszen[0]+1)+max(0,rand[2*dim+spalte])] and
+ EMoeglich[w*(groeszen[0]+1)+max(0,rand[3*dim+zeile])];
+ if puzzleTeile[0][0]>=0 then begin
+ kachel:=invPuzzleTeile[zeile*dim+spalte]['x'];
for i:=0 to dim-1 do begin
{$IFDEF buchstaben}
- w:=w*(groeszen[0]+2)+inhalt[zeile*dim+i]+1;
- s:=s*(groeszen[0]+2)+inhalt[i*dim+spalte]+1;
+ k:=k*(groeszen[0]+2)+inhalt[puzzleTeile[kachel][i]]+1;
{$ENDIF}
{$IFDEF hochhaus}
- w:=w*(dim+1)+max(0,inhalt[zeile*dim+i]);
- s:=s*(dim+1)+max(0,inhalt[i*dim+spalte]);
+ k:=k*(dim+1)+max(0,inhalt[puzzleTeile[kachel][i]]);
{$ENDIF}
end;
- result:=
- EMoeglich[s*(groeszen[0]+1)+max(0,rand[spalte])] and
- AMoeglich[w*(groeszen[0]+1)+max(0,rand[dim+zeile])] and
- AMoeglich[s*(groeszen[0]+1)+max(0,rand[2*dim+spalte])] and
- EMoeglich[w*(groeszen[0]+1)+max(0,rand[3*dim+zeile])];
+ result:=result and AMoeglich[k*(groeszen[0]+1)];
end;
if diagonalenCB.checked then begin
if zeile=spalte then begin
@@ -411,8 +400,9 @@ end;
{$IFDEF passtZumZeichnen}
// function tHochhausRaetsel.passtZumZeichnen(spalte,zeile: integer): boolean;
var
- i,KS,KZ: integer;
- w,s: longint;
+ i: integer;
+ w,s: longint;
+ kachel: longint;
begin
result:=false;
if (spalte>=0) and (zeile>=0) and (spalte<dim) and (zeile<dim) then begin // im inneren
@@ -464,11 +454,10 @@ begin
end;
end;
if sudokuCB.checked then begin
- KZ:=(zeile div nSqrt)*nSqrt;
- KS:=(spalte div nSqrt)*nSqrt;
+ kachel:=invPuzzleTeile[zeile*dim+spalte]['x'];
s:=w+1;
for i:=0 to dim-1 do
- if inhalt[(KZ+(i div nSqrt))*dim+KS+(i mod nSqrt)]=inhalt[zeile*dim+spalte] then
+ if inhalt[puzzleTeile[kachel][i]]=inhalt[zeile*dim+spalte] then
dec(s);
result:=result and (s>0);
end;
diff --git a/raetselunit.pas b/raetselunit.pas
index 90d49ff..e5f9f47 100644
--- a/raetselunit.pas
+++ b/raetselunit.pas
@@ -59,6 +59,7 @@ type
procedure farbWahlFlaecheBemalen;
procedure loeschen; dynamic; abstract;
procedure leeren; dynamic; abstract;
+ procedure vorbereiten; dynamic; abstract;
function loesen(lPos: longint): boolean; dynamic; abstract;
function anzLoesungen(lPos: longint): longint; dynamic; abstract;
function passtZumZeichnen(spalte,zeile: integer): boolean; dynamic; abstract;
@@ -80,8 +81,10 @@ type
spinEdits: array of tSpinEdit;
diagonalenCB,sudokuCB: tSmarterCheckBox;
groeszen,inhalt,rand: array of longint;
+ invPuzzleTeile: array of tIntPoint; // Ort -> [Teil, Kachel]
+ puzzleTeile: array of array of longint; // [Teil,Kachel] -> Ort
AMoeglich,EMoeglich: array of boolean;
- dim,nSqrt,schriftGroesze,
+ dim,schriftGroesze,
cursorPosition: longint;
zellGroesze: extended;
uebersetze: tAlphabetFunktion;
@@ -95,6 +98,7 @@ type
procedure aktualisiereGroesze;
procedure loeschen; override;
procedure leeren; override;
+ procedure vorbereiten; override;
procedure aktualisiereZeichenflaechenGroesze;
function besitzerHoehe: longint; override;
function besitzerBreite: longint; override;
@@ -106,6 +110,7 @@ type
procedure alsZugSpeichern;
procedure speichern(var datei: file); override;
procedure laden(var datei: file); override;
+ procedure findePuzzelierung;
public
constructor create(aOwner: tForm; anzInhTypen: longint; alphabetFunktion: tAlphabetFunktion);
destructor destroy; override;
@@ -133,7 +138,7 @@ const
implementation
uses
- math, dialogs, lclintf, extDlgs;
+ math, dialogs, lclintf, extDlgs, matheunit;
{$DEFINE alphabetFunktion}
function zahlenAlphabetFunktion(i: longint): string;
@@ -339,6 +344,7 @@ begin
if assigned(onSetCaption) then
onSetCaption(intToStr(zufallSE.value));
zufallSE.value:=random(zufallSE.maxValue+1);
+ vorbereiten;
loesen(-1);
randErzeugen;
leeren;
@@ -499,6 +505,7 @@ end;
procedure tFelderRaetsel.cbOnChange(sender: tObject);
begin
+ findePuzzelierung;
zeichnen;
end;
@@ -571,11 +578,19 @@ begin
setLength(startFeld,dim*dim);
setLength(feldFarben,dim*dim);
setLength(rand,4*dim);
+ setLength(invPuzzleTeile,dim*dim);
+ for i:=0 to length(puzzleTeile)-1 do
+ setLength(puzzleTeile[i],0);
+ setLength(puzzleTeile,dim);
+ for i:=0 to dim-1 do
+ setLength(puzzleTeile[i],dim);
- nSqrt:=round(sqrt(dim));
- sudokuCB.enabled:=Sqr(nSqrt)=dim;
- if (not sudokuCB.enabled) and sudokuCB.checked then
- sudokuCB.checked:=false;
+ puzzleCB.enabled:=dim>2;
+ if puzzleCB.checked and not puzzleCB.enabled then
+ puzzleCB.checked:=false;
+
+ sudokuCB.enabled:=(intRoot(dim)>1) and not puzzleCB.checked;
+ sudokuCB.checked:=false;
loeschen;
cursorPosition:=0;
@@ -634,6 +649,17 @@ begin
progressBar1.visible:=false;
end;
+procedure tFelderRaetsel.vorbereiten;
+var
+ i: longint;
+begin
+ for i:=0 to dim*dim-1 do begin
+ puzzleTeile[i div dim][i mod dim]:=-1;
+ invPuzzleTeile[i]:=intPoint(-1,-1);
+ end;
+ findePuzzelierung;
+end;
+
procedure tFelderRaetsel.aktualisiereZeichenflaechenGroesze;
begin
zeichenFlaeche.canvas.font.size:=schriftGroesze;
@@ -716,7 +742,7 @@ end;
procedure tFelderRaetsel.zeichnen(cursor: boolean = true);
var
- i: longint;
+ i,j: longint;
begin
if not assigned(sudokuCB) then
exit;
@@ -742,13 +768,29 @@ begin
end;
for i:=0 to dim do
with zeichenFlaeche.canvas do begin
- pen.width:=3-2*byte((not sudokuCB.checked or (i mod nSqrt <> 0)) and (i>0) and (i<dim));
+ pen.width:=3-2*byte((i>0) and (i<dim));
moveTo(round((i+1)*zellGroesze),round(zellGroesze));
lineTo(round((i+1)*zellGroesze),round((dim+1)*zellGroesze));
moveTo(round(zellGroesze),round((i+1)*zellGroesze));
lineTo(round((dim+1)*zellGroesze),round((i+1)*zellGroesze));
end;
zeichenFlaeche.canvas.pen.width:=3;
+ if (length(invPuzzleTeile)>0) and (puzzleTeile[0][0]>=0) then begin
+ for i:=0 to dim-1 do
+ for j:=1 to dim-1 do
+ if invPuzzleTeile[i+j*dim]['x']<>invPuzzleTeile[i+(j-1)*dim]['x'] then
+ with zeichenFlaeche.canvas do begin
+ moveTo(round((i+1)*zellGroesze),round((j+1)*zellGroesze));
+ lineTo(round((i+2)*zellGroesze),round((j+1)*zellGroesze));
+ end;
+ for j:=0 to dim-1 do
+ for i:=1 to dim-1 do
+ if invPuzzleTeile[i+j*dim]['x']<>invPuzzleTeile[(i-1)+j*dim]['x'] then
+ with zeichenFlaeche.canvas do begin
+ moveTo(round((i+1)*zellGroesze),round((j+1)*zellGroesze));
+ lineTo(round((i+1)*zellGroesze),round((j+2)*zellGroesze));
+ end;
+ end;
zeichenFlaeche.canvas.pen.color:=$8080ff;
if (cursorPosition>=0) and (dim>0) and cursor then begin
zeichenFlaeche.canvas.brush.color:=
@@ -822,7 +864,14 @@ begin
if length(rand)>0 then
blockWrite(datei,rand[0],length(rand)*sizeOf(rand[0]));
blockWrite(datei,dim,sizeOf(dim));
- blockWrite(datei,nSqrt,sizeOf(nSqrt));
+ i:=length(puzzleTeile);
+ blockWrite(datei,i,sizeOf(i));
+ if length(puzzleTeile)>0 then
+ blockWrite(datei,puzzleTeile[0],length(puzzleTeile)*sizeOf(puzzleTeile[0]));
+ i:=length(invPuzzleTeile);
+ blockWrite(datei,i,sizeOf(i));
+ if length(invPuzzleTeile)>0 then
+ blockWrite(datei,invPuzzleTeile[0],length(invPuzzleTeile)*sizeOf(invPuzzleTeile[0]));
blockWrite(datei,cursorPosition,sizeOf(cursorPosition));
i:=length(feldFarben);
blockWrite(datei,i,sizeOf(i));
@@ -874,7 +923,14 @@ begin
if length(rand)>0 then
blockRead(datei,rand[0],length(rand)*sizeOf(rand[0]));
blockRead(datei,dim,sizeOf(dim));
- blockRead(datei,nSqrt,sizeOf(nSqrt));
+ blockRead(datei,i,sizeOf(i));
+ setLength(puzzleTeile,i);
+ if length(puzzleTeile)>0 then
+ blockRead(datei,puzzleTeile[0],length(puzzleTeile)*sizeOf(puzzleTeile[0]));
+ blockRead(datei,i,sizeOf(i));
+ setLength(invPuzzleTeile,i);
+ if length(invPuzzleTeile)>0 then
+ blockRead(datei,invPuzzleTeile[0],length(invPuzzleTeile)*sizeOf(invPuzzleTeile[0]));
blockRead(datei,cursorPosition,sizeOf(cursorPosition));
blockRead(datei,i,sizeOf(i));
setLength(feldFarben,i);
@@ -891,6 +947,33 @@ begin
inherited laden(datei);
end;
+procedure tFelderRaetsel.findePuzzelierung;
+var
+ i,j,k,l: longint;
+begin
+ if sudokuCB.checked then begin
+ k:=intRoot(dim);
+ l:=dim div k;
+ for i:=0 to dim-1 do
+ for j:=0 to dim-1 do begin
+ invPuzzleTeile[i*dim + j]:=
+ intPoint(
+ j div l + (i div k) * k,
+ j mod l + (i mod k) * l
+ );
+ puzzleTeile[
+ invPuzzleTeile[i*dim + j]['x'],
+ invPuzzleTeile[i*dim + j]['y']
+ ]:=i*dim + j;
+ end;
+ exit;
+ end;
+ if not puzzleCB.checked then begin
+ puzzleTeile[0][0]:=-1;
+ exit;
+ end;
+end;
+
// tHochhausRaetsel und tBuchstabenRaetsel
{$DEFINE create}
generated by cgit v1.2.3-70-g09d2 (git 2.47.0) at 2024-11-21 19:58:43 +0000