From 7f021f36378b80ed0c689707b0dab06dea96c890 Mon Sep 17 00:00:00 2001 From: Erich Eckner Date: Sun, 12 Apr 2020 21:23:38 +0200 Subject: rechteckige Puzzleteile verfügbar MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- raetsel.lps | 110 +++++++++++++++++++++++--------------------------------- raetselunit.inc | 67 +++++++++++++++------------------- raetselunit.pas | 103 ++++++++++++++++++++++++++++++++++++++++++++++------ 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 @@ - + @@ -19,7 +19,7 @@ - + @@ -32,23 +32,25 @@ - + - - - + + + - + + + @@ -111,7 +113,7 @@ - + @@ -124,9 +126,9 @@ - - - + + + @@ -150,7 +152,7 @@ - + @@ -160,120 +162,123 @@ - + - + - - + + - + + - + - + - + + - + - + - + - + - + - + - + - + - + - + - + - + - + + - + - + - + - + - + - + - + @@ -281,29 +286,4 @@ - - - - - - - - - - - - - - - - - - - - - - - - - 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 (spalte0); 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 (i0) and (i0) 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} -- cgit v1.2.3-70-g09d2