program Schachdomino; {$APPTYPE CONSOLE} {$R *.res} uses System.SysUtils; const BOARD_SIZE = 8; type TBoard = Array[1..BOARD_SIZE,1..BOARD_SIZE] of Integer; type TResult = record possible:Boolean; field:TBoard; tryCount:Integer; end; const sLineBreak = {$IFDEF LINUX} AnsiChar(#10) {$ENDIF} {$IFDEF MSWINDOWS} AnsiString(#13#10) {$ENDIF}; var LogFile:TextFile; // Write a board to console and log file procedure WriteBoard(field:TBoard); var S1: String; C1: Integer; C2: Integer; begin S1:='['; for C2 := 1 to BOARD_SIZE do begin S1:=S1 + sLineBreak; for C1 := 1 to BOARD_SIZE do begin S1:=S1 + Format('%2d',[field[C1,C2]])+ ', '; end; end; S1:=S1 + ']'; Writeln(S1); Writeln(logFile,S1); end; // Write placing a brick at a given position and check if it is still possible // to fill the remaining free space of the board function tryBrick(posX,posY:Integer; field:TBoard; TryCount:Integer; BrickNum:Integer):TResult; var nextBrickX: Integer; nextBrickY: Integer; newField: TBoard; resultRight: TResult; resultBot: TResult; rightPossible: Boolean; botPossible: Boolean; begin if (posX=BOARD_SIZE) and (posY=BOARD_SIZE) then begin result.possible:=True; result.field:=field; result.tryCount:=TryCount+1; Exit; end; if posX = BOARD_SIZE then begin nextBrickX:=1; nextBrickY:=posY+1; end else begin nextBrickX:=posX+1; nextBrickY:=posY; end; Result.possible:=false; Result.tryCount:=TryCount; if field[posX,posY]<>0 then begin Result:=tryBrick(nextBrickX,nextBrickY,field,TryCount,BrickNum); Exit; end else begin //rechts rightPossible:=((posX+2<=BOARD_SIZE-1) or ((posY<=BOARD_SIZE-1) and (posX+2<=BOARD_SIZE))) and (field[posX+1,posY]=0) and (field[posX+2,posY]=0); if rightPossible then begin newField:=field; newField[posX,posY]:=BrickNum; newField[posX+1,posY]:=BrickNum; newField[posX+2,posY]:=BrickNum; resultRight:=tryBrick(nextBrickX,nextBrickY,newField,Result.tryCount,BrickNum+1); Result.tryCount:=resultRight.tryCount; if resultRight.possible then begin Result:=resultRight; Exit; end end; //unten botPossible:=((posY+2<=BOARD_SIZE-1) or ((posX<=BOARD_SIZE-1) and (posY+2<=BOARD_SIZE))) {and (field[posX,posY+1]=0) //always true and (field[posX,posY+2]=0)}; if botPossible then begin newField:=field; newField[posX,posY]:=BrickNum; newField[posX,posY+1]:=BrickNum; newField[posX,posY+2]:=BrickNum; resultBot:=tryBrick(nextBrickX,nextBrickY,newField,Result.tryCount,BrickNum+1); Result.tryCount:=resultBot.tryCount; Result.possible:=resultBot.possible; if resultBot.possible then begin Result:=resultBot; Exit; end end; end; if not rightPossible and not botPossible then begin result.tryCount:=result.tryCount+1; Writeln('Try No. ' + IntToStr(result.TryCount) + ':'); Writeln(logFile, 'Try No. ' + IntToStr(result.TryCount) + ':'); WriteBoard(field); end; end; // Write a result to console and log file procedure WriteResult(result:TResult); var C1: Integer; C2: Integer; S1: string; begin if result.possible then begin Writeln('It is possible to fill this board.'); Writeln(LogFile, 'It is possible to fill this board.'); Writeln('This is the result:'); Writeln(LogFile, 'This is the result:'); WriteBoard(result.field); end else begin Writeln('It is not possible to fill this board.'); Writeln(LogFile, 'It is not possible to fill this board.'); end; Writeln('Program finished after '+IntToStr(result.tryCount) + ' tries. A log has been written to log.txt'); Writeln(LogFile, 'Program finished after '+IntToStr(result.tryCount) + ' tries. A log has been written to log.txt'); ReadLn; end; // main program var Field: TBoard; result:TResult; begin AssignFile(logFile, 'log.txt'); ReWrite(logFile); result := tryBrick(1,1,Field,0,1); WriteResult(result); CloseFile(logFile); end.