From 63e9f7dac0afc46c12375b3c66339e7bab9e5bce Mon Sep 17 00:00:00 2001 From: Erich Eckner Date: Mon, 11 May 2020 15:37:01 +0200 Subject: Puzzleteile gehen für kleine Rätsel - für große Rätsel (n>=5) noch zu langsam MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- raetselunit.inc | 2 +- raetselunit.pas | 129 +++++++++++++++++++++++++++++++++++++++++++++++++++++--- 2 files changed, 124 insertions(+), 7 deletions(-) diff --git a/raetselunit.inc b/raetselunit.inc index 6f9dbcf..6eade98 100644 --- a/raetselunit.inc +++ b/raetselunit.inc @@ -454,7 +454,7 @@ begin result:=result and (s>0); end; end; - if sudokuCB.checked then begin + if puzzleTeile[0][0]>=0 then begin kachel:=invPuzzleTeile[zeile*dim+spalte]['x']; s:=w+1; for i:=0 to dim-1 do diff --git a/raetselunit.pas b/raetselunit.pas index 5eae72a..f430e79 100644 --- a/raetselunit.pas +++ b/raetselunit.pas @@ -79,7 +79,7 @@ type tFelderRaetsel = class(tRaetsel) private spinEdits: array of tSpinEdit; - diagonalenCB,sudokuCB: tSmarterCheckBox; + diagonalenCB,sudokuCB,puzzleCB: tSmarterCheckBox; groeszen,inhalt,rand: array of longint; invPuzzleTeile: array of tIntPoint; // Ort -> [Teil, Kachel] puzzleTeile: array of array of longint; // [Teil,Kachel] -> Ort @@ -480,6 +480,13 @@ begin sudokuCB.left:=diagonalenCB.left+diagonalenCB.width+spacing; sudokuCB.onKeyDown:=@onKeyDown; sudokuCB.onChange:=@cbOnChange; + puzzleCB:=tSmarterCheckBox.create(besitzer); + puzzleCB.parent:=besitzer; + puzzleCB.caption:='Puzzle'; + puzzleCB.top:=sudokuCB.top; + puzzleCB.left:=sudokuCB.left+sudokuCB.width+spacing; + puzzleCB.onKeyDown:=@onKeyDown; + puzzleCB.onChange:=@cbOnChange; farbWahlFlaeche.left:=spacing; farbWahlFlaeche.top:=diagonalenCB.top+diagonalenCB.height+spacing; farbWahlFlaeche.height:=16; @@ -505,7 +512,19 @@ begin end; procedure tFelderRaetsel.cbOnChange(sender: tObject); +var + i: longint; begin + if sender=sudokuCB then begin + puzzleCB.enabled:=not sudokuCB.checked; + if puzzleCB.checked and not puzzleCB.enabled then + puzzleCB.checked:=false; + end; + if sender=puzzleCB then begin + sudokuCB.enabled:=(intRoot(dim)>1) and not puzzleCB.checked; + if sudokuCB.checked and not sudokuCB.checked then + sudokuCB.checked:=false; + end; findePuzzelierung; zeichnen; end; @@ -695,8 +714,8 @@ begin zeichenFlaecheNeuKreieren; besitzer.height:=besitzerHoehe; besitzer.width:=besitzerBreite; - if assigned(sudokuCB) then - besitzer.width:=max(besitzer.width,sudokuCB.left+sudokuCB.width+spacing); + if assigned(puzzleCB) then + besitzer.width:=max(besitzer.width,puzzleCB.left+puzzleCB.width+spacing); if length(spinEdits)>0 then if assigned(spinEdits[length(spinEdits)-1]) then besitzer.width:=max(besitzer.width,spinEdits[length(spinEdits)-1].left+spinEdits[length(spinEdits)-1].width+spacing); @@ -763,7 +782,7 @@ procedure tFelderRaetsel.zeichnen(cursor: boolean = true); var i,j: longint; begin - if not assigned(sudokuCB) then + if not (assigned(sudokuCB) and assigned(puzzleCB)) then exit; zeichenFlaeche.canvas.brush.color:=$ffffff; zeichenFlaeche.canvas.rectangle(-10,-10,zeichenFlaeche.width+10,zeichenFlaeche.height+10); @@ -872,6 +891,10 @@ begin blockWrite(datei,b,1); b:=byte(sudokuCB.checked); blockWrite(datei,b,1); + b:=byte(puzzleCB.enabled); + blockWrite(datei,b,1); + b:=byte(puzzleCB.checked); + blockWrite(datei,b,1); i:=length(groeszen); blockWrite(datei,i,sizeOf(i)); if length(groeszen)>0 then @@ -929,6 +952,12 @@ begin blockRead(datei,b,1); assert(b<=1,'Syntaxfehler in Datei!'); sudokuCB.checked:=odd(b); + blockRead(datei,b,1); + assert(b<=1,'Syntaxfehler in Datei!'); + puzzleCB.enabled:=odd(b); + blockRead(datei,b,1); + assert(b<=1,'Syntaxfehler in Datei!'); + puzzleCB.checked:=odd(b); blockRead(datei,i,sizeOf(i)); assert(length(groeszen)=i,'Falsche Anzahl freier Paraemeter in gespeichertem Spiel!'); if length(groeszen)>0 then @@ -970,7 +999,11 @@ end; procedure tFelderRaetsel.findePuzzelierung; var - i,j,k,l: longint; + i,j,k: longint; + perms: array of array of longint; + kAnzs: array of longint; + lw: longword; + gefunden: boolean; begin if sudokuCB.checked then begin k:=intRoot(dim); @@ -989,7 +1022,91 @@ begin end; exit; end; - puzzleTeile[0][0]:=-1; + if not puzzleCB.checked then begin + puzzleTeile[0][0]:=-1; + exit; + end; + + setLength(perms,dim*dim); + for i:=0 to dim*dim-1 do begin + invPuzzleTeile[i]:=intPoint(-1,-1); + perms[i]:=permutation(dim); + end; + setLength(kAnzs,dim); + for i:=0 to dim-1 do + kAnzs[i]:=0; + + //invPuzzleTeile: array of tIntPoint; // Ort -> [Teil, Kachel] + //puzzleTeile: array of array of longint; // [Teil,Kachel] -> Ort + + i:=0; + while i=0 then begin + repeat + inc(j); + until (j>=dim) or (perms[i][j]=invPuzzleTeile[i]['x']); + assert(perms[i][j]=invPuzzleTeile[i]['x'], 'Could not invert '+intToStr(invPuzzleTeile[i]['x'])+' (dim='+intToStr(dim)+')!'); + dec(kAnzs[perms[i][j]]); // Kachel vom Puzzleteil entfernen + end; + inc(j); // nächsten Wert nehmen + while (j=dim) do + inc(j); + if (j>=dim) then begin + // hier passt nichts + invPuzzleTeile[i]:=intPoint(-1,-1); + dec(i); + continue; + end; + invPuzzleTeile[i]:=intPoint(perms[i][j],kAnzs[perms[i][j]]); // Kachel anfügen + puzzleTeile[perms[i][j]][kAnzs[perms[i][j]]]:=i; + inc(kAnzs[perms[i][j]]); + if kAnzs[perms[i][j]]=dim then begin + // prüfen, ob Puzzleteil zusammenhängt + lw:=(1 shl dim) - 2; + repeat + gefunden:=false; + for k:=0 to dim-1 do begin + if odd(lw shr k) then + continue; + if (puzzleTeile[perms[i][j]][k] mod dim > 0) and + (invPuzzleTeile[puzzleTeile[perms[i][j]][k]-1]['x']=perms[i][j]) and + odd(lw shr invPuzzleTeile[puzzleTeile[perms[i][j]][k]-1]['y']) then begin + lw:=lw and not (1 shl invPuzzleTeile[puzzleTeile[perms[i][j]][k]-1]['y']); + gefunden:=true; + end; + if (puzzleTeile[perms[i][j]][k] mod dim < dim-1) and + (invPuzzleTeile[puzzleTeile[perms[i][j]][k]+1]['x']=perms[i][j]) and + odd(lw shr invPuzzleTeile[puzzleTeile[perms[i][j]][k]+1]['y']) then begin + lw:=lw and not (1 shl invPuzzleTeile[puzzleTeile[perms[i][j]][k]+1]['y']); + gefunden:=true; + end; + if (puzzleTeile[perms[i][j]][k] div dim > 0) and + (invPuzzleTeile[puzzleTeile[perms[i][j]][k]-dim]['x']=perms[i][j]) and + odd(lw shr invPuzzleTeile[puzzleTeile[perms[i][j]][k]-dim]['y']) then begin + lw:=lw and not (1 shl invPuzzleTeile[puzzleTeile[perms[i][j]][k]-dim]['y']); + gefunden:=true; + end; + if (puzzleTeile[perms[i][j]][k] div dim < dim-1) and + (invPuzzleTeile[puzzleTeile[perms[i][j]][k]+dim]['x']=perms[i][j]) and + odd(lw shr invPuzzleTeile[puzzleTeile[perms[i][j]][k]+dim]['y']) then begin + lw:=lw and not (1 shl invPuzzleTeile[puzzleTeile[perms[i][j]][k]+dim]['y']); + gefunden:=true; + end; + end; + until not gefunden; + if lw<>0 then begin + // nicht zusammenhängend + dec(kAnzs[perms[i][j]]); + invPuzzleTeile[i]:=intPoint(-1,-1); + dec(i); + continue; + end; + end; + inc(i); + end; end; // tHochhausRaetsel und tBuchstabenRaetsel -- cgit v1.2.3-54-g00ecf