unit UScrabble;
{ ********************************************************************************* }
{ (c) GNU                                                                           }
{ author: Heiko Tietze                                                              }
{ version: 1.0                                                                      }
{ date: 11.12.2004                                                                  }
{ description: basic scrabble rules, variable definitions, check of played letters  }
{              dimension is new to scrabble; a 3D visualization of the game         }
{              is coming "soon"; TScrabble has is instanciated in the main unit and }
{              transfered to the visualization (UScrabbleGrid.pas) and computation  }
{              (UBrutForce.pas}
{ ********************************************************************************* }

interface

uses Classes,ULanguage;

type TDimension=(dx,dy,dz);
     TDimensions = array[TDimension] of Integer;
     TMove = array of TDimensions;
     TFieldDimension=(D2,D3);

     TFieldType=(ftNormal,ftLetter,ftDoubleLetter,ftTripleLetter,ftDoubleWord,ftTripleWord,ftNewLetter,ftStart);
     TLetterState=(lsNormal=1, lsChange=2, lsPlaced=3, lsInvisible=4);
     TLetter=record //new letter of a move that has not been finished
               what       : Char;
               where      : TDimensions;
               State      : TLetterState;
             end;
     TPlaced=record //all letters that were placed
               what       : Char;
               who        : Byte;
               State      : (psClear, psNew, psPlaced);
               Letter     : Byte; //ID of FLetter;
             end;
     TPlayer=record //list of players
               Name       : string;
               Points     : Word;
             end;
     THistory=record
               PlacedWord : string;
               MoveNumber : Word;
               Value      : Word;
               Player     : Byte;
             end;
     TKnownWord=function(Value:string):boolean of Object;
     TLastError=(erNone,erSuccessive,erConnection,erRowCol,erFirstMove,erUnknownWord);
     TCheckMoveOptions=set of (cmAddToHistory,cmAskForWords);
     TScrabble=class
        private
           FFieldDimension     : TFieldDimension; //2 or 3 dimensions
           FLettersAvailable   : string;
           FLetterValue        : array[Char] of Byte;
           FDoubleFirstMove    : boolean;
           FLettersCount       : Byte;
           FPlayers            : array of TPlayer;
           FLetters            : array of array of TLetter;// [CurrentPlayer,Letter]

           FScrabblePlaced     : array[0..14,0..14,0..14] of TPlaced;
           FNoLetterPlaced     : Byte;
           FCurrentPlayer      : Byte;
           FLocalPlayer        : Byte;
           FGameEnd            : boolean;
           FMoveNumber         : Word;
           FKnownWord          : TKnownWord;
           FLastError          : TLastError;
           FHistory            : array of THistory;
           procedure NewLetters(Player:Byte);

           function CheckNoLetter(const Move : array of TDimensions): boolean;
           function CheckFirstMove(const Move : array of TDimensions):boolean;
           function CheckRowCol(const Move:array of TDimensions; const Dimension : TDimension):boolean;
           function CheckConnection(const Move:array of TDimensions; var Dimension:TDimension):boolean;
           function CheckSuccesssive(var Move:array of TDimensions; const Dimension : TDimension):boolean;

           function GetLetterValue(index: Char): Byte;
           function GetPlayerCount: Byte;
           function GetPlayer(index: Byte): TPlayer;
           function GetLastErrorname : string;
           function GetPlaced(x, y, z : Byte): TPLaced;
           function GetLetter(index: Byte): TLetter;
           procedure PrepareToChange(index: Byte; const Value: boolean);
           function GetHistory(index: integer): THistory;
           function GetHistoryCount: integer;
           procedure SetPlaceFromLetter(x,y,z: Byte; const Value: Byte);
        protected
        public
           constructor Create(Dimension:TFieldDimension);
           destructor Destroy; override;
           procedure GetWordAtPos(Dimension: TDimension; Where: TDimensions; var Name:string; var Value:Word);
           procedure ResetLetters;
           procedure InterChangeLetters(i,j:Byte;Player:Byte=255);
           procedure SaveToFile(const FileName:string;const IsHighScore:boolean=false);
           function LoadFromFile(const FileName:string) : boolean;
           function NewGame( PlayerNames      : string; //comma delimited string with all players -> player count is set here
                             LettersAvailable : string; //a string with all letters that can be used
                             LetterCount      : Byte;   //number of letters that are available at one single move
                             LetterValue      : array of Byte; //an array of Char with letter values
                             Seed             : Byte; //RandSeed
                             DoubleFirstMove  : boolean) : boolean;
           function NextPlayer(CheckMoveOptions:TCheckMoveOptions) : Word; //check the move with CheckMove(), update the game and returns the cummulated values
           function CheckMove(CheckMoveOptions:TCheckMoveOptions) : Word; //check the placed words only, FLastError is set to <> erNone, result are cummulated values or 0 in case of an error
           function GetFieldType(x,y,z:Byte;ftNew:boolean=true):TFieldType;
           property OnAskForWord : TKnownWord read FKnownWord write FKnownWord;
           property MoveNumber   : Word read FMoveNumber;
           property CurrentPlayer : Byte read FCurrentPlayer;
           property LocalPlayer : Byte read FLocalPlayer write FLocalPlayer;
           property Player[index:Byte] : TPlayer read GetPlayer;
           property PlayerCount : Byte read GetPlayerCount;
           property LetterValue[index:Char] : Byte read GetLetterValue;
           property Letter[index : Byte] : TLetter read GetLetter;
           property LetterPrepareToChange[index : Byte] : boolean write PrepareToChange;
           property LettersCount : Byte read FLettersCount;
           property GameEnd : Boolean read FGameEnd write FGameEnd;
           property LastError : TLastError read FLastError;
           property LastErrorName : string read GetLastErrorName;
           property Placed[index,index,index : Byte] : TPLaced read GetPlaced;
           property PlaceFromLetter[index,index,index : Byte] : Byte write SetPlaceFromLetter;
           property HistoryCount : integer read GetHistoryCount;
           property History[index : integer] : THistory read GetHistory;
           property FieldDimension : TFieldDimension read FFieldDimension;
           property LettersLeft : string read FLettersAvailable;
        end;

const scEmptyField=' ';
      plClear:TPlaced=(what:scEmptyField;who:0;State:psClear;Letter:0);
      ClearPlaced=255;

implementation

{ TScrabble }

constructor TScrabble.Create(Dimension:TFieldDimension);
var i,j,k : integer;
begin
   inherited Create;
   FFieldDimension:=Dimension;
   FLastError:=erNone;
   for i:=0 to 14 do
    for j:=0 to 14 do
     for k:=0 to 14 do
      FScrabblePlaced[i,j,k]:=plClear;
end;

destructor TScrabble.Destroy;
begin
   setlength(FLetters,0,0);
   setlength(FPlayers,0);
   setlength(FHistory,0);
   inherited;
end;

function TScrabble.NewGame(PlayerNames      : string;
                           LettersAvailable : string;
                           LetterCount      : Byte;
                           LetterValue      : array of Byte;
                           Seed             : Byte;
                           DoubleFirstMove  : boolean) : boolean;
const Delimiter=#9;
var i,j,k:integer;
begin
   try
     FLettersCount:=LetterCount;
     FLettersAvailable:=LettersAvailable;
     FCurrentPlayer:=0;
     FMoveNumber:=1;
     FNoLetterPlaced:=0;
     FDoubleFirstMove:=DoubleFirstMove;
     FGameEnd:=false;
     setlength(FHistory,0);
     RandSeed:=Seed;
     //set letter value
     for i:=0 to 255 do FLetterValue[chr(i)]:=LetterValue[i];
     //set player names
     setlength(FPlayers,1);
     FPlayers[0].Name:='';
     FPlayers[0].Points:=0;
     for i:=1 to length(PlayerNames) do
     begin
       if (PlayerNames[i]=Delimiter) then
       begin
         setlength(FPlayers,length(FPlayers)+1);
         FPlayers[length(FPlayers)-1].Points:=0;
       end else
         FPlayers[length(FPlayers)-1].Name:=FPlayers[length(FPlayers)-1].Name+PlayerNames[i];
     end;
     //clear the field
     for i:=0 to 14 do for j:=0 to 14 do for k:=0 to 14 do FScrabblePlaced[i,j,k]:=plClear;
     //allocate, clear and set letters
     setlength(FLetters,length(FPlayers),LetterCount);
     for i:=0 to length(FPlayers)-1 do
     begin
       for j:=0 to FLettersCount-1 do FLetters[i,j].State:=lsPlaced;
       NewLetters(i);
     end;
     Result:=true;
   except
     Result:=false;
   end;
end;

procedure TScrabble.NewLetters(Player:Byte);
var i,z:integer;
begin
   for i:=0 to FLettersCount-1 do
    if not (FLetters[Player,i].State in [lsNormal,lsInvisible]) then
    with FLetters[Player,i] do
    begin
      if State=lsChange then FLettersAvailable:=FLettersAvailable+what;
      if (length(FLettersAvailable)>0) then
      begin
        z:=random(length(FLettersAvailable))+1;
        where[dx]:=-1; where[dy]:=-1; where[dz]:=-1;
        what:=FLettersAvailable[z];
        State:=lsNormal;
        delete(FLettersAvailable,z,1);
      end else
        State:=lsInvisible; //length(FLettersAvailable)>0
    end; //for i:=0 to FLettersCount-1 do, with
end;

function TScrabble.CheckNoLetter(const Move : array of TDimensions): boolean;
begin
   Result:=length(Move)>0;
end;

function TScrabble.CheckFirstMove(const Move : array of TDimensions):boolean;
var i:integer;
begin
   if length(FHistory)=0 then //movenumber is incremented on possible changes therefore history is used
   begin
     Result:=false;
     for i:=0 to length(Move)-1 do
         if ((Move[i,dx]=7) and (Move[i,dy]=7) and (Move[i,dz]=7)) then Result:=true;
   end else Result:=true; //allways true after the first move
end;

function TScrabble.CheckConnection(const Move:array of TDimensions; var Dimension:TDimension):boolean;
var i : integer;
begin
   Result:=false;
   //connection is true if first move
   if length(FHistory)=0 then Result:=true else
   //else check all letters for surrounding places (and try to set dimension)
   for i:=0 to length(Move)-1 do
     if ((Move[i,dx]>0) and (FScrabblePlaced[Move[i,dx]-1,Move[i,dy],Move[i,dz]].State=psPlaced) or
         (Move[i,dx]<14) and (FScrabblePlaced[Move[i,dx]+1,Move[i,dy],Move[i,dz]].State=psPlaced)
         ) then begin Dimension:=dx; Result:=true; end else
     if ((Move[i,dy]>0) and (FScrabblePlaced[Move[i,dx],Move[i,dy]-1,Move[i,dz]].State=psPlaced) or
         (Move[i,dy]<14) and (FScrabblePlaced[Move[i,dx],Move[i,dy]+1,Move[i,dz]].State=psPlaced)
         ) then begin Dimension:=dy; Result:=true; end else
     if ((Move[i,dz]>0) and (FScrabblePlaced[Move[i,dx],Move[i,dy],Move[i,dz]-1].State=psPlaced) or
         (Move[i,dz]<14) and (FScrabblePlaced[Move[i,dx],Move[i,dy],Move[i,dz]+1].State=psPlaced)
         ) then begin Dimension:=dx; Result:=true; end;
   //set dimension correctly if more than only one letter  
   if length(Move)>1 then
   begin
      if (Move[0,dx]<>Move[1,dx]) then Dimension:=dx else
      if (Move[0,dy]<>Move[1,dy]) then Dimension:=dy else
      if (Move[0,dz]<>Move[1,dz]) then Dimension:=dz;
   end;
end;

function TScrabble.CheckRowCol(const Move:array of TDimensions; const Dimension : TDimension):boolean;
var RowCol : set of TDimension;
    i      : integer;
begin
   Result:=true;
   if length(Move)>1 then
   begin
      RowCol:=[dx,dy,dz];
      exclude(RowCol,Dimension);
      for i:=1 to length(Move)-1 do
      begin
         if dx in RowCol then if (Move[i,dx]<>Move[i-1,dx]) then Result:=false;
         if dy in RowCol then if (Move[i,dy]<>Move[i-1,dy]) then Result:=false;
         if dz in RowCol then if (Move[i,dz]<>Move[i-1,dz]) then Result:=false;
      end;
   end;
end;

function TScrabble.CheckSuccesssive(var Move:array of TDimensions; const Dimension : TDimension):boolean;

 procedure SortLetters;//Bubblesort
 var i,j    : integer;
     swaped : boolean;
     tmp    : TDimensions;
 begin
    for i:=1 to length(Move)-1 do
    begin
      swaped:=false;
      for j:=0 to length(Move)-2 do
      begin
        if Move[j,Dimension]>Move[j+1,Dimension] then
        begin
           tmp:=Move[j]; Move[j]:=Move[j+1]; Move[j+1]:=tmp;
           swaped:=true;
        end;
      end;
      if not swaped then break;
    end;//for i:=1 to high(Move) do
 end;

var i,j : integer;
begin
   Result:=true;
   if length(Move)>1 then
   begin
      SortLetters;
      for i:=0 to length(Move)-2 do
      begin
        for j:=Move[i,Dimension]+1 to Move[i+1,Dimension]-1 do
         case Dimension of
          dx : if FScrabblePLaced[j,Move[0,dy],Move[0,dz]].what=scEmptyField then Result:=false;
          dy : if FScrabblePLaced[Move[0,dx],j,Move[0,dz]].what=scEmptyField then Result:=false;
          dz : if FScrabblePLaced[Move[0,dx],Move[0,dy],j].what=scEmptyField then Result:=false;
         end;
      end;
   end;
end;

procedure TScrabble.GetWordAtPos(Dimension: TDimension; Where: TDimensions; var Name:string; var Value:Word);
var i, Mult : integer;
    s       : string;
    ft      : TFieldType;
begin
   s:='';
   ft:=ftNormal;
   for i:=0 to 14 do
   case Dimension of
     dx : s:=s+FScrabblePlaced[i,where[dy],where[dz]].what;
     dy : s:=s+FScrabblePlaced[where[dx],i,where[dz]].what;
     dz : s:=s+FScrabblePlaced[where[dy],where[dy],i].what;
   end;
   //find the first letter in s
   i:=where[Dimension]; while (i>0) and (s[i]<>scEmptyField) do dec(i);
   Name:='';Value:=0;
   if FDoubleFirstMove and (FScrabblePlaced[7,7,7].State=psNew) then Mult:=2 else Mult:=1;
   if s<>'' then
   repeat
      Name:=Name+s[i+1];
      case Dimension of
        dx : ft:=GetFieldType(i,where[dy],where[dz],false);
        dy : ft:=GetFieldType(where[dx],i,where[dz],false);
        dz : ft:=GetFieldType(where[dx],where[dy],i,false);
      end;
      case ft of
        ftNormal,ftLetter,ftStart : inc(Value,FLetterValue[s[i+1]]);
        ftDoubleLetter : inc(Value,FLetterValue[s[i+1]]*2);
        ftTripleLetter : inc(Value,FLetterValue[s[i+1]]*3);
        ftDoubleWord : begin
                          inc(Value,FLetterValue[s[i+1]]);
                          Mult:=Mult*2;
                       end;
        ftTripleWord : begin
                          inc(Value,FLetterValue[s[i+1]]);
                          Mult:=Mult*3;
                       end;
      end;
      inc(i);
   until (i>14) or (s[i+1]=scEmptyField);
   if Mult>0 then Value:=Value*Mult;
end;

function TScrabble.GetFieldType(x,y,z:Byte;ftNew:boolean=true):TFieldType;
begin
   if (x in [0..14]) and (y in [0..14]) and (z in [0..14]) then
   begin
     Result:=ftNormal;
     if ((x+3) mod 4=0) and ((y+3) mod 4=0) and ((FFieldDimension=D2) or ((z+3) mod 4=0)) then Result:=ftTripleLetter;
     if ((x=y) or (x+y=14)) and
        ((x=z) or (x+z=14) or (FFieldDimension=D2)) and
        ((x<5) or (x>9)) then Result:=ftDoubleWord;
     if (x in [0,7,14]) and (y in [0,7,14]) and (z in [0,7,14]) then Result:=ftTripleWord;
     if (x in [3,11]) and (y mod 7=0) and (z mod 7=0) or
        (x mod 7=0) and (y in [3,11]) and (z mod 7=0) or
        (x mod 7=0) and (y mod 7=0) and (z in [3,11]) or
        ((x in [2,12]) and (y in [6,8]) and ((FFieldDimension=D2) or (z in [6,8])) or
         (x in [6,8]) and (y in [2,12]) and ((FFieldDimension=D2) or (z in [6,8])) or
         (x in [6,8]) and (y in [6,8]) and ((FFieldDimension=D2) or (z in [2,12])))
        then Result:=ftDoubleLetter;
     if (x=7) and (y=7) and ((FFieldDimension=D2) or (z=7)) then Result:=ftStart;
     if FScrabblePlaced[x,y,z].State=psPlaced then Result:=ftLetter;
     if ftNew then if FScrabblePlaced[x,y,z].State=psNew then Result:=ftNewLetter;
   end;
end;

function TScrabble.CheckMove(CheckMoveOptions:TCheckMoveOptions) : Word;
type TWord=record
              Name  : string;
              Value : Word;
           end;
var Dimension : TDimension;
    Move      : TMove;
    Words     : array of TWord;
    i         : integer;
    s         : string;
begin
  try
    Result:=0;
    //collect placed letters
     for i:=0 to length(FLetters[FCurrentPlayer])-1 do
     if FLetters[FCurrentPlayer,i].State=lsPlaced then
     begin
        setlength(Move,length(Move)+1);
        Move[length(Move)-1]:=FLetters[FCurrentPlayer,i].where;
     end;
    //check placed letters for rules
    if CheckNoLetter(Move) then
     if CheckFirstMove(Move) then
      if CheckConnection(Move,Dimension) then
       if CheckRowCol(Move,Dimension) then
        if CheckSuccesssive(Move,Dimension) then
        try
           setlength(Words,1);
           for i:=0 to length(Move)-1 do
           begin
             if (Dimension<>dx) and
                (((Move[i,dx]>0) and (FScrabblePlaced[Move[i,dx]-1,Move[i,dy],Move[i,dz]].what<>scEmptyField)) or
                 ((Move[i,dx]<14) and (FScrabblePlaced[Move[i,dx]+1,Move[i,dy],Move[i,dz]].what<>scEmptyField))
                ) then GetWordAtPos(dx,Move[i],Words[length(Words)-1].Name,Words[length(Words)-1].Value) else
             if (Dimension<>dy) and
                (((Move[i,dy]>0) and (FScrabblePlaced[Move[i,dx],Move[i,dy]-1,Move[i,dz]].what<>scEmptyField)) or
                 ((Move[i,dy]<14) and (FScrabblePlaced[Move[i,dx],Move[i,dy]+1,Move[i,dz]].what<>scEmptyField))
                ) then GetWordAtPos(dy,Move[i],Words[length(Words)-1].Name,Words[length(Words)-1].Value) else
             if (Dimension<>dz) and
                (((Move[i,dz]>0) and (FScrabblePlaced[Move[i,dx],Move[i,dy],Move[i,dz]-1].what<>scEmptyField)) or
                 ((Move[i,dz]<14) and (FScrabblePlaced[Move[i,dx],Move[i,dy],Move[i,dz]+1].what<>scEmptyField))
                ) then GetWordAtPos(dz,Move[i],Words[length(Words)-1].Name,Words[length(Words)-1].Value) else
             continue;
             setlength(Words,length(Words)+1);
           end;
           GetWordAtPos(Dimension,Move[0],Words[length(Words)-1].Name,Words[length(Words)-1].Value);
           if (length(Move)=FLettersCount) then Words[length(Words)-1].Value:=Words[length(Words)-1].Value+50;
           FLastError:=erNone;
           //does the words are known
           if assigned(FKnownWord) and (cmAskForWords in CheckMoveOptions) then
           begin
             s:='';
             for i:=0 to length(Words)-1 do s:=s+Words[i].Name+','; //last separator will be deleted in askforwords
             if not FKnownWord(s) then FLastError:=erUnknownWord;
           end;
           //count points and add words to history if choosen
           if FLastError=erNone then
           begin
              for i:=0 to length(Words)-1 do
              begin
                 if (cmAddToHistory in CheckMoveOptions) then
                 begin
                   setlength(FHistory,length(FHistory)+1);
                   with FHistory[length(FHistory)-1] do
                   begin
                     PlacedWord:=Words[i].Name;
                     MoveNumber:=FMoveNumber;
                     Value:=Words[i].Value;
                     Player:=FCurrentPlayer;
                     inc(FPlayers[FCurrentPlayer].Points,Value);
                   end;
                 end;
                 inc(Result,Words[i].Value);
              end;
           end;
        finally
           setlength(Words,0);
        end else FLastError:=erSuccessive
       else FLastError:=erRowCol
      else FLastError:=erConnection
     else FLastError:=erFirstMove
    else FLastError:=erNone;//no letter = no error = result=0
  finally
    setlength(Move,0);
  end;
end;

procedure TScrabble.ResetLetters;
var i : integer;
begin
  for i:=0 to length(FLetters[FCurrentPlayer])-1 do
  with FLetters[FCurrentPlayer,i] do
  begin
    if State=lsPlaced then
    begin
       FScrabblePlaced[where[dx],where[dy],where[dz]]:=plClear;
       State:=lsNormal;
    end;
    where[dx]:=-1;
    where[dy]:=-1;
    where[dz]:=-1;
  end;
end;

function TScrabble.NextPlayer(CheckMoveOptions:TCheckMoveOptions): Word;
var i,j : integer;
begin
   Result:=CheckMove(CheckMoveOptions);
   if FLastError=erNone then
   begin //update game
     for i:=0 to length(FLetters[FCurrentPlayer])-1 do
     begin
       if FLetters[FCurrentPlayer,i].State=lsPlaced then
       with FScrabblePlaced[FLetters[FCurrentPlayer,i].where[dx],FLetters[FCurrentPlayer,i].where[dy],FLetters[FCurrentPlayer,i].where[dz]] do
       begin
          what:=FLetters[FCurrentPlayer,i].what;
          who:=FCurrentPlayer;
          State:=psPlaced;
          Letter:=0;
       end; //State=lsPlaced, with
     end;//for to
     //check for end of game
     if Result=0 then inc(FNoLetterPlaced) else FNoLetterPlaced:=0;
     if (FNoLetterPlaced>length(FPlayers)) and (length(FLettersAvailable)<length(FLetters[FCurrentPlayer])) then
     begin
        //subtract value of left letters for highscore
        if not FGameEnd then
           for i:=0 to length(FPlayers)-1 do
            for j:=0 to FLettersCount-1 do
            if FLetters[i,j].State=lsNormal then
            begin
               if FPlayers[i].Points>FLetterValue[FLetters[i,j].what] then
                  dec(FPlayers[i].Points,FLetterValue[FLetters[i,j].what]) else
                  FPlayers[i].Points:=0;
            end;
        FGameEnd:=true;
     end;
     if not FGameEnd then NewLetters(FCurrentPlayer);
     inc(FMoveNumber);
     if FCurrentPlayer>=length(FPlayers)-1 then FCurrentPlayer:=0
                                           else inc(FCurrentPlayer);
   end;
end;

function TScrabble.GetLetterValue(index: Char): Byte;
begin
   Result:=FLetterValue[index];
end;

function TScrabble.GetPlayerCount: Byte;
begin
   Result:=length(FPlayers);
end;

function TScrabble.GetPlayer(index: Byte): TPlayer;
begin
   if index<length(FPlayers) then Result:=FPlayers[index];
end;

function TScrabble.GetLastErrorName : string;
begin
  case FLastError of
   erNone        : Result:=Language.Translate['no error'];
   erSuccessive  : Result:=Language.Translate['letters not successive'];
   erConnection  : Result:=Language.Translate['no connection to placed words'];
   erRowCol      : Result:=Language.Translate['letters not placed in one row/col'];
   erFirstMove   : Result:=Language.Translate['first move have to include center square'];
   erUnknownWord : Result:=Language.Translate['unknown word'];
  end;//case
end;

function TScrabble.GetPlaced(x,y,z : Byte): TPLaced;
begin
   if (x in [0..14]) and (y in [0..14]) and (z in [0..14]) then
      Result:=FScrabblePlaced[x,y,z];
end;

function TScrabble.GetLetter(index: Byte): TLetter;
begin
   Result:=FLetters[FLocalPlayer,index];
end;

procedure TScrabble.PrepareToChange(index: Byte; const Value: boolean);
begin
   if length(FLettersAvailable)>0 then
   begin
      if Value then FLetters[FCurrentPlayer,index].State:=lsChange
               else FLetters[FCurrentPlayer,index].State:=lsNormal;
   end;
end;

function TScrabble.GetHistory(index: integer): THistory;
begin
   Result:=FHistory[index];
end;

function TScrabble.GetHistoryCount: integer;
begin
   Result:=length(FHistory);
end;

procedure TScrabble.SetPlaceFromLetter(x, y, z : Byte; const Value: Byte);
begin
   if (x in [0..14]) and (y in [0..14]) and (z in [0..14]) then
   begin
     if ((FScrabblePlaced[x,y,z].State=psClear) and (Value<FLettersCount)) then
     begin
       with FScrabblePlaced[x,y,z] do
       begin
         what:=FLetters[FCurrentPlayer,Value].what;
         who:=FCurrentPlayer;
         State:=psNew;
         Letter:=Value;
       end;
       with FLetters[FCurrentPlayer,Value] do
       begin
         where[dx]:=x; where[dy]:=y; where[dz]:=z;
         State:=lsPlaced;
       end;
     end else
     if ((FScrabblePlaced[x,y,z].State=psNew) and (Value=ClearPlaced)) then
     begin
       with FLetters[FCurrentPlayer,FScrabblePlaced[x,y,z].Letter] do
       begin
         where[dx]:=-1; where[dy]:=-1; where[dz]:=-1;
         State:=lsNormal;
       end;
       FScrabblePlaced[x,y,z]:=plClear;
     end;
   end;
end;

procedure TScrabble.InterChangeLetters(i, j: Byte;Player:Byte=255);
var tmp : TLetter;
begin
   if Player=255 then Player:=FCurrentPlayer;
   tmp:=FLetters[Player,i];
   FLetters[Player,i]:=FLetters[Player,j];
   FLetters[Player,j]:=tmp;
end;

function TScrabble.LoadFromFile(const FileName: string) : boolean;
{$IFDEF WIN32}
const fmOpenRead = $0000; //unit Sysutils;
{$ELSE}
const fmOpenRead = O_RDONLY;
{$ENDIF}
var i,j : integer;
    s   : ShortString;
begin
   with TFileStream.Create(FileName,fmOpenRead) do
   try
     Read(FFieldDimension,sizeof(FFieldDimension));
     Read(i,sizeof(integer)); Read(s,i); FLettersAvailable:=s;
     Read(FLetterValue,sizeof(FLetterValue));
     Read(i,sizeof(integer)); setlength(FPlayers,i);
     for i:=0 to length(FPLayers)-1 do
     begin
       Read(j,sizeof(integer)); Read(s,j); FPlayers[i].Name:=s;
       Read(FPLayers[i].Points,sizeof(Word));
     end;
     Read(FLettersCount,sizeof(FLettersCount));
     setlength(FLetters,length(FPlayers),FLettersCount);
     for i:=0 to length(FPlayers)-1 do
      for j:=0 to FLettersCount-1 do
      begin
        Read(FLetters[i,j].what,sizeof(Char));
        Read(FLetters[i,j].where,sizeof(TDimensions));
        Read(FLetters[i,j].State,sizeof(TLetterState));
      end;
      Read(FScrabblePlaced,sizeof(FScrabblePlaced));
      Read(FNoLetterPlaced,sizeof(Byte));
      Read(FCurrentPlayer,sizeof(Byte));
      Read(FGameEnd,sizeof(boolean));
      Read(FMoveNumber,sizeof(Word));
      Read(i,sizeof(integer)); setlength(FHistory,i);
      for i:=0 to length(FHistory)-1 do
      begin
         Read(j,sizeof(integer)); Read(s,j); FHistory[i].PlacedWord:=s;
         Read(FHistory[i].MoveNumber,sizeof(Word));
         Read(FHistory[i].Value,sizeof(Word));
         Read(FHistory[i].Player,sizeof(Byte));
      end;
      Read(Result,sizeof(boolean));
   finally
     Free;
   end;
end;

procedure TScrabble.SaveToFile(const FileName: string;const IsHighScore:boolean=false);
var i,j : integer;
    s   : ShortString;
begin
   with TFileStream.Create(FileName,fmCreate) do
   try
     Write(FFieldDimension,sizeof(FFieldDimension));
     s:=FLettersAvailable; i:=length(s)+1; Write(i,sizeof(integer)); Write(s,i);
     Write(FLetterValue,sizeof(FLetterValue));
     i:=length(FPlayers); Write(i,sizeof(integer));
     for i:=0 to length(FPLayers)-1 do
     begin
       s:=FPlayers[i].Name; j:=length(FPlayers[i].Name)+1; Write(j,sizeof(integer)); Write(s,j);
       Write(FPLayers[i].Points,sizeof(Word));
     end;
     Write(FLettersCount,sizeof(FLettersCount));
     for i:=0 to length(FPlayers)-1 do
      for j:=0 to FLettersCount-1 do
      begin
        Write(FLetters[i,j].what,sizeof(Char));
        Write(FLetters[i,j].where,sizeof(TDimensions));
        Write(FLetters[i,j].State,sizeof(TLetterState));
      end;
      Write(FScrabblePlaced,sizeof(FScrabblePlaced));
      Write(FNoLetterPlaced,sizeof(Byte));
      Write(FCurrentPlayer,sizeof(Byte));
      Write(FGameEnd,sizeof(boolean));
      Write(FMoveNumber,sizeof(Word));
      i:=length(FHistory); Write(i,sizeof(integer));
      for i:=0 to length(FHistory)-1 do
      begin
         s:=FHistory[i].PlacedWord; j:=length(FHistory[i].PlacedWord)+1; Write(j,sizeof(integer)); Write(s,j);
         Write(FHistory[i].MoveNumber,sizeof(Word));
         Write(FHistory[i].Value,sizeof(Word));
         Write(FHistory[i].Player,sizeof(Byte));
      end;
      Write(IsHighScore,sizeof(Boolean));
   finally
     Free;
   end;
end;

end.