path: root/raetselunit.inc

{$IFDEF interface}

type
{$IFDEF hochhaus}
  tHochhausRaetsel = class(tFelderRaetsel)
{$ENDIF}
{$IFDEF buchstaben}
  tBuchstabenRaetsel = class(tFelderRaetsel)
{$ENDIF}
  private
//    procedure relativeInhaltsAenderung(diff: longint); override;
//    function absoluteInhaltsAenderung(key: word): boolean; override;
  public
    {$IFDEF buchstaben}
    NBuchst,
    NLeer,
    {$ENDIF}
    NSqrt:               integer;
    AMoeglich,EMoeglich: array of boolean;
    constructor create(aOwner: tForm);
    destructor destroy; override;
    procedure gesamtRaenderErzeugen;
(*    function  passtZumZeichnen(Spalte,Zeile: integer): boolean;
    procedure Zeichnen;
    procedure schreibe(was: String; Spalte,Zeile: integer); *)
    function  passt(spalte,zeile: integer): boolean; override;
//    function  Loesen(lPos: integer): boolean;
    function  geloest: boolean;
(*    procedure leeren;
    procedure RandErzeugen;
    function  anzLoesungen(lPos: integer): integer;
    procedure Image2Bemalen; *)
  end;

{$IFDEF hochhaus}
function zahlenAlphabetFunktion(i: longint): string;
{$ENDIF}
{$IFDEF buchstaben}
function buchstabenAlphabetFunktion(i: longint): string;
{$ENDIF}
        
{$ENDIF}

{$IFDEF alphabetFunktion}
// function *AlphabetFunktion(i: longint): string;
begin
  if i<0 then
    result:=''
  else if i=0 then
    result:='-'
{$IFDEF hochhaus}
  else
    result:=inttostr(i);
{$ENDIF}
{$IFDEF buchstaben}
  else begin
    result:='';
    while i>0 do begin
      dec(i);
      result:=char(ord('A')+(i mod 26))+result;
      i:=i div 26;
    end;
  end;
{$ENDIF}
end;
{$ENDIF}

{$IFDEF create}
// constructor tHochhausRaetsel.create(aOwner: tForm);
begin
{$IFDEF hochhaus}
  inherited create(aOwner,1,@zahlenAlphabetFunktion);
  spinEdits[1].showHint:=true;
  spinEdits[1].hint:='Anzahl Spalten';
  spinEdits[1].value:=5;
{$ENDIF}
{$IFDEF buchstaben}
  inherited create(aOwner,2,@buchstabenAlphabetFunktion);
  spinEdits[1].showHint:=true;
  spinEdits[1].hint:='Anzahl Buchstaben';
  spinEdits[1].value:=5;
  spinEdits[2].showHint:=true;
  spinEdits[2].hint:='Anzahl Leerfelder';
  spinEdits[2].value:=1;
{$ENDIF}
  aktualisiereGroesze;
end;
{$ENDIF}

{$IFDEF destroy}
// destructor tHochhausRaetsel.destroy;
begin
  inherited destroy;
end;
{$ENDIF}

{$IFDEF passt}
// function  tHochhausRaetsel.passt(spalte,zeile: integer): boolean;
var
  I,KZ,KS: Integer;
  W,S,K:   Longint;
begin
  W:=0;
  S:=0;
  K:=0;
  if sudokuCB.checked then begin
    KZ:=(Zeile div dim)*dim;
    KS:=(Spalte div dim)*dim;
    for I:=0 to dim-1 do begin
      {$IFDEF buchstaben}
      W:=W*(NBuchst+2)+inhalt[Zeile*dim+I]+1;
      S:=S*(NBuchst+2)+inhalt[I*dim+Spalte]+1;
      K:=K*(NBuchst+2)+inhalt[(KZ+(I div NSqrt))*dim+KS+(I mod NSqrt)]+1;
      {$ENDIF}
      {$IFDEF hochhaus}
      W:=W*(dim+1)+inhalt[Zeile*dim+I];
      S:=S*(dim+1)+inhalt[I*dim+Spalte];
      K:=K*(dim+1)+inhalt[(KZ+(I div NSqrt))*dim+KS+(I mod NSqrt)];
      {$ENDIF}
    end;
    result:=
      {$IFDEF buchstaben}
      AMoeglich[K*(NBuchst+1)] and
      EMoeglich[S*(NBuchst+1)+Rand[Spalte]] and
      AMoeglich[W*(NBuchst+1)+Rand[dim+Zeile]] and
      AMoeglich[S*(NBuchst+1)+Rand[2*dim+Spalte]] and
      EMoeglich[W*(NBuchst+1)+Rand[3*dim+Zeile]];
      {$ENDIF}
      {$IFDEF hochhaus}
      AMoeglich[K*(dim+1)] and
      EMoeglich[S*(dim+1)+Rand[Spalte]] and
      AMoeglich[W*(dim+1)+Rand[dim+Zeile]] and
      AMoeglich[S*(dim+1)+Rand[2*dim+Spalte]] and
      EMoeglich[W*(dim+1)+Rand[3*dim+Zeile]];
      {$ENDIF}
  end
  else begin
    for I:=0 to dim-1 do begin
      {$IFDEF buchstaben}
      W:=W*(NBuchst+2)+inhalt[Zeile*dim+I]+1;
      S:=S*(NBuchst+2)+inhalt[I*dim+Spalte]+1;
      {$ENDIF}
      {$IFDEF hochhaus}
      W:=W*(dim+1)+inhalt[Zeile*dim+I];
      S:=S*(dim+1)+inhalt[I*dim+Spalte];
      {$ENDIF}
    end;
    result:=
      {$IFDEF buchstaben}
      EMoeglich[S*(NBuchst+1)+Rand[Spalte]] and
      AMoeglich[W*(NBuchst+1)+Rand[dim+Zeile]] and
      AMoeglich[S*(NBuchst+1)+Rand[2*dim+Spalte]] and
      EMoeglich[W*(NBuchst+1)+Rand[3*dim+Zeile]];
      {$ENDIF}
      {$IFDEF hochhaus}
      EMoeglich[S*(dim+1)+Rand[Spalte]] and
      AMoeglich[W*(dim+1)+Rand[dim+Zeile]] and
      AMoeglich[S*(dim+1)+Rand[2*dim+Spalte]] and
      EMoeglich[W*(dim+1)+Rand[3*dim+Zeile]];
      {$ENDIF}
  end;
  if diagonalenCB.checked then begin
    if Zeile=Spalte then begin
      W:=0;
      {$IFDEF buchstaben}
      for I:=0 to dim-1 do
        W:=W*(NBuchst+2)+inhalt[I*(dim+1)]+1;
      Result:=Result and AMoeglich[W*(NBuchst+1)];
      {$ENDIF}
      {$IFDEF hochhaus}
      for I:=0 to dim-1 do
        W:=W*(dim+1)+inhalt[I*(dim+1)];
      result:=result and AMoeglich[W*(dim+1)];
      {$ENDIF}
    end;
    if Zeile+Spalte=dim-1 then begin
      W:=0;
      {$IFDEF buchstaben}
      for I:=0 to dim-1 do
        W:=W*(NBuchst+2)+inhalt[(I+1)*(dim-1)]+1;
      Result:=Result and AMoeglich[W*(NBuchst+1)];
      {$ENDIF}
      {$IFDEF hochhaus}
      for I:=0 to dim-1 do
        W:=W*(dim+1)+inhalt[(I+1)*(dim-1)];
      Result:=Result and AMoeglich[W*(dim+1)];
      {$ENDIF}
    end;
  end;
end;
{$ENDIF}

{$IFDEF geloest}
// function  tHochhausRaetsel.geloest: boolean;
var
  i,j: integer;
begin
  result:=false;
  for i:=0 to dim-1 do
    for j:=0 to dim-1 do
      if (not passt(i,j)) or (inhalt[i+dim*j]<0)
    {$IFDEF hochhaus}
    or (inhalt[I+dim*j]=0)
    {$ENDIF}
    then exit;
  result:=true;
end;
{$ENDIF}

{$IFDEF gesamtRaenderErzeugen}
// procedure tHochhausRaetsel.gesamtRaenderErzeugen;
var
  I,J,K,Nullen:      Integer;
  {$IFNDEF buchstaben}
  AZ,
  {$ENDIF}
  AR:                Integer;
  AK,EK,NAK,NEK:     Longint;
  Nums:              tLongintArray;
  B:                 Boolean;
  Basis,Faktor:      Integer;
  Schritt:           Longint;
  dat:               File of Cardinal;
  lw1,lw2,L:         Cardinal;

const dat_name =
{$IFDEF buchstaben}
  'Buchstabenraetsel.dat';
{$ENDIF}
{$IFDEF hochhaus}
  'Hochhausraetsel.dat';
{$ENDIF}

function calcNums(I: Longint): tLongintArray;
var
  J: Integer;
begin
  Setlength(Result,dim);
  For J:=0 to dim-1 do begin
    Result[J]:=I mod Basis;
    I:=I div Basis;
  end;
end;

function calcIndex(Nums: TLongintArray): Longint;
var
  j: integer;
begin
  Result:=0;
  For j:=0 to dim-1 do
    Result:=Result*Basis + Nums[dim-J-1];
end;

function swapIndex(I: Longint): Longint;
var
  j: integer;
begin
  Result:=0;
  for J:=0 to dim-1 do begin
    Result:=Result*Basis+(I mod Basis);
    I:=I div Basis;
  end;
end;

begin
  {$IFDEF buchstaben}
  Basis:=NBuchst+2;
  Faktor:=NBuchst+1;
  {$ENDIF}
  {$IFDEF hochhaus}
  Basis:=dim+1;
  Faktor:=dim+1;
  {$ENDIF}
  AK:=round(power(Basis,dim)*Faktor);

  if (length(AMoeglich) = AK) and
     (length(EMoeglich) = AK) then
    exit;

  if fileexists(extractfilepath(application.exename)+dat_name) then begin
    assignfile(dat,extractfilepath(application.exename)+dat_name);
    reset(dat);
    while not eof(dat) do begin
      read(dat,lw1);
      if lw1=AK then begin
        Setlength(AMoeglich,AK);
        Setlength(EMoeglich,AK);
        for L:=0 to length(AMoeglich)-1 do begin
          if L mod 32 = 0 then
            if not eof(dat) then
              read(dat,lw2)
            else begin
              messageDlg('Frühzeitiges Dateiende!',mterror,[mbOk],0);
              exit;
            end;
          AMoeglich[L]:=odd(lw2 shr (L mod 32));
        end;
        For L:=0 to length(EMoeglich)-1 do begin
          if L mod 32 = 0 then
            if not eof(dat) then
              read(dat,lw2)
            else begin
              messageDlg('Frühzeitiges Dateiende!',mterror,[mbOk],0);
              exit;
            end;
          EMoeglich[L]:=odd(lw2 shr (L mod 32));
        end;
        exit;
      end
      else
        Seek(dat,Filepos(dat)+((lw1-1) div 32 +1)*2);
    end;
    closefile(dat);
  end;

  Progressbar1.Visible:=true;
  Progressbar1.Min:=0;
  Progressbar1.Max:=1000;
  Progressbar1.Position:=0;

  Setlength(AMoeglich,AK);
  Setlength(EMoeglich,AK);
  For AK:=0 to length(AMoeglich)-1 do begin
    AMoeglich[AK]:=False;
    EMoeglich[AK]:=False;
  end;
  Setlength(Nums,0);

  Schritt:=max(1,round((length(AMoeglich) div Faktor) / Progressbar1.Max));
  For AK:=0 to length(AMoeglich) div Faktor -1 do begin
    if AK mod Schritt = 0 then
     Progressbar1.StepIt;
    Nums:=calcNums(AK);
    B:=true;
    {$IFDEF buchstaben}
    Nullen:=NLeer;
    For I:=0 to length(Nums)-1 do
     begin
      B:=B and (Nums[I]<>0);
      if Nums[I]=1 then dec(Nullen)
       else
        For J:=0 to I-1 do
         B:=B and (Nums[I]<>Nums[J]);
     end;
    B:=B and (Nullen>=0);
    {$ENDIF}
    {$IFDEF hochhaus}
    For I:=0 to length(Nums)-1 do begin
      B:=B and (Nums[I]<>0);
      For J:=0 to I-1 do
       B:=B and (Nums[I]<>Nums[J]);
    end;
    {$ENDIF}
    if B then begin
      EK:=swapIndex(AK);
      AR:=0;
      {$IFNDEF buchstaben}
      AZ:=0;
      {$ENDIF}
      For I:=0 to dim-1 do begin
        {$IFDEF buchstaben}
        if Nums[I]>1 then begin
          AR:=Nums[I]-1;
          break;
        end;
        {$ENDIF}
        {$IFDEF hochhaus}
        if Nums[I]>AZ then begin
          inc(AR);
          AZ:=Nums[I];
        end;
        {$ENDIF}
      end;

      AMoeglich[AK*Faktor+AR]:=true;
      EMoeglich[EK*Faktor+AR]:=true;
      AMoeglich[AK*Faktor]:=true;
      EMoeglich[EK*Faktor]:=true;
    end;
  end;

  Progressbar1.Position:=0;
  Schritt:=Max(round(((length(AMoeglich) div Faktor)*dim) / Progressbar1.Max),1);
  For Nullen:=1 to dim do
    For AK:=0 to length(AMoeglich) div Faktor -1 do begin
      if AK mod Schritt = 0 then
        Progressbar1.StepIt;
      Nums:=calcNums(AK);
      J:=Nullen;
      For I:=0 to dim-1 do
        if Nums[I]=0 then
          dec(J);
      if J<>0 then
        continue;
      EK:=swapIndex(AK);
      For I:=0 to dim-1 do
        if Nums[I]=0 then begin
          For J:=1 to Basis-1 do begin
            Nums[I]:=J;
            NAK:=calcIndex(Nums);
            NEK:=swapIndex(NAK);
            For K:=0 to Faktor-1 do begin
              AMoeglich[AK*Faktor+K]:=AMoeglich[AK*Faktor+K] or AMoeglich[NAK*Faktor+K];
              EMoeglich[EK*Faktor+K]:=EMoeglich[EK*Faktor+K] or EMoeglich[NEK*Faktor+K];
            end;
          end;
          break;
        end;
    end;
  Progressbar1.Visible:=False;

  assignfile(dat,extractfilepath(application.exename)+dat_name);
  if Fileexists(extractfilepath(application.exename)+dat_name) then begin
    reset(dat);
    Seek(dat,Filesize(dat));
  end
  else
    Rewrite(dat);

  lw1:=length(AMoeglich);
  write(dat,lw1);
  lw1:=0;
  For I:=0 to length(AMoeglich)-1 do begin
    lw1:=lw1 or (Byte(AMoeglich[I]) shl (I mod 32));
    if ((I mod 32) = 31) or (I = length(AMoeglich)-1) then begin
      write(dat,lw1);
      lw1:=0;
    end;
  end;
  For I:=0 to length(EMoeglich)-1 do begin
    lw1:=lw1 or (Byte(EMoeglich[I]) shl (I mod 32));
    if ((I mod 32) = 31) or (I = length(EMoeglich)-1) then begin
      write(dat,lw1);
      lw1:=0;
    end;
  end;
  closefile(dat);
end;
{$ENDIF}