{

    Copyright 2004 Marianne Wartoft, marianne at wartoft dot nu
    http://www.wartoft.nu, http://www.aw.nu

    This file is part of Sebran.

    Sebran is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    (at your option) any later version.

    Sebran is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with Sebran; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

}



unit Hangman;
{ The code for the hangman exercise}

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, ExtCtrls, Generell, StdCtrls, Message;

type
  TfrmOvHangman = class(TForm)
    imgHelp: TImage;
    imgExit: TImage;
    imgHm1: TImage;
    imgHm2: TImage;
    imgHM3: TImage;
    imgHm4: TImage;
    imgHM5: TImage;
    imgAlpha: TImage;
    imgWord: TImage;
    Shape1: TShape;
    imgHM6: TImage;
    imgHM7: TImage;
    imgHM9: TImage;
    imgHM8: TImage;
    imgHM10: TImage;
    imgHM11: TImage;
    imgSol: TImage;
    imgFace: TImage;
    imgStart: TImage;
    Shape3: TShape;
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure imgExitClick(Sender: TObject);
    procedure FormKeyPress(Sender: TObject; var Key: Char);
    procedure imgAlphaMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure imgStartClick(Sender: TObject);
    procedure imgHelpClick(Sender: TObject);
    function HangmanReplacements(strLetter: string):string;
    function HangmanReplacementsInverse(strLetter: string):string;
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    procedure DrawAlphabet;
    procedure DrawPicture(Errors: Integer);
    procedure DrawWord(Word: String);
    procedure CorrectLetter(Letter: String);
    Procedure DrawAll;

public
    procedure Start;
  end;

var
  RowHeight, ColWidth: Integer;
  frmOvHangman: TfrmOvHangman;
  Errors: Integer;
  LetterUsed : Array[1..40] of Boolean;
  TheWord: String;
  DisplayWord: String;
  AlphaString: String;
  LettersUsed: Integer;
  fPlaying: Boolean;

const
  Cols = 4;
  Rows = 8;


implementation

{$R *.DFM}
uses
    Hmeny;

procedure TfrmOvHangman.FormCreate(Sender: TObject);
begin
     FixForm(Self);
     GetHangman;
end;

procedure TfrmOvHangman.Start;
var
   i: Integer;
   intWordNr, intLoops: Integer;
begin
     Randomize;
     StopSong;
     imgFace.Canvas.Brush.Style := bsSolid;
     imgFace.Canvas.Brush.Color := clBlack;
     imgFace.Canvas.FillRect(Rect(0,0,imgFace.Width, imgFace.Height));
     Errors := 0;
     Show;
     AlphaString := strLang[21];
     For i:=1 to 40 do
         LetterUsed[i]:=False;
     LettersUsed := 0;
     intLoops := 0;
     repeat
         intLoops := intLoops + 1;
        intWordNr := Trunc(Random * NrOfstrHangman) + 1;
     until (strHangman[intWordNr].Used = False) or (intLoops > 30);
     if Sprak <> 20 then
        TheWord := CorrCase(AnsiUppercase(strHangman[intWordNr].Word))
     else
        TheWord := strHangman[intWordNr].Word   ;

     strHangman[intWordNr].Used := True;
     DisplayWord := TheWord ;
     For i:=1 to Length(TheWord) do begin
         DisplayWord[i] := '_';
         if TheWord[i]=' ' then DisplayWord[i] := ' ';
         if TheWord[i]='''' then DisplayWord[i] := '''';
         if TheWord[i]=',' then DisplayWord[i] := ',';
         if TheWord[i]='-' then DisplayWord[i] := '-';
         if TheWord[i]='!' then DisplayWord[i] := '!';
     end;
     DrawAll;
     fPlaying := True;
end;

procedure TfrmOvHangman.FormShow(Sender: TObject);
begin
     StopSong;
     SetPalette(imgAlpha);
     SetPalette(imgFace);
     SetPalette(imgSol);
     DrawChar(0, 0, imgSol, chr(Pics[4].ASCII),
                         Pics[4].Color, SYMBOLTYPEFACE, RefFontSize * 3 );
     SetPalette(imgWord);
     DrawButton(imgHelp,strLang[14], clWhite, TYPEFACE, ButtonFontSize * 2, 30, THINBORDER);
     DrawButton(imgExit, strLang[15], clWhite, TYPEFACE, ButtonFontSize, 30, THINBORDER);
     if Length(strLang[17]) > 9 then
        DrawButton(imgStart, strLang[17], clWhite, TYPEFACE, ButtonFontSize-3, 30, THINBORDER)
     else
         DrawButton(imgStart, strLang[17], clWhite, TYPEFACE, ButtonFontSize, 30, THINBORDER);
end;

procedure TfrmOvHangman.DrawAlphabet;
var
   i,j: Integer;
   X,Y: Real;
   LetterCol: LongInt;
begin
     ColWidth := imgAlpha.Width div Cols;
     RowHeight := imgAlpha.Height div Rows;
     imgAlpha.Canvas.Brush.Color := clBlack;
     imgAlpha.Canvas.FillRect(Rect(0,0,imgAlpha.Width, imgAlpha.Height));
     imgAlpha.Canvas.Pen.Color := clGray;
     For i:=1 to Cols - 1 do begin
         imgAlpha.Canvas.MoveTo(ColWidth * i, 0);
         imgAlpha.Canvas.LineTo(ColWidth * i, imgAlpha.Height);
     end;
     For j:=1 to Rows - 1 do begin
         imgAlpha.Canvas.MoveTo(0 , RowHeight * j);
         imgAlpha.Canvas.LineTo(imgAlpha.Width, RowHeight * j);
     end;
     For i:=1 to Cols - 1 do begin
         For j:=1 to Rows - 1 do begin
         end;
     end;

     For i:=1 to Length(AlphaString) do begin
         X := (((i-1) mod Cols) + 0.5) * ColWidth;
         Y := (((i-1) div Cols) + 0.5) * RowHeight;
         If LetterUsed[i] then LetterCol := $404040 else LetterCol := clWhite;
         DrawCharCenter(Trunc(X), Trunc(Y), imgAlpha, CorrCase(AlphaString[i]),
                         LetterCol, TYPEFACE, Trunc(RefFontSize  / 1.5) );
     end;

end;

procedure TfrmOvHangman.DrawPicture(Errors: Integer);
{ Display or hide the appropriate part of the Hangman picture}
const
     Cols = 4;
     Rows = 8;
var
   i,j: Integer;
   X,Y: Real;
begin
     imgHM1.Visible := (Errors >= 1);
     imgHM2.Visible := (Errors >= 2);
     imgHM3.Visible := (Errors >= 3);
     imgHM4.Visible := (Errors >= 4);
     imgHM5.Visible := (Errors >= 5);
     imgHM6.Visible := (Errors >= 6);
     imgHM7.Visible := (Errors >= 7);
     imgHM8.Visible := (Errors >= 8);
     imgHM9.Visible := (Errors >= 9);
     imgHM10.Visible := (Errors >= 10);
     imgHM11.Visible := (Errors >= 11);
end;

procedure TfrmOvHangman.DrawWord(Word: String);
var
   LetterWidth: Integer;
   i: Integer;
   WLen: Integer;
begin
     imgWord.Canvas.Brush.Color := clBlack;
     imgWord.Canvas.FillRect(Rect(0,0,imgWord.Width, imgWord.Height));
     WLen := Length(Word);
     If WLen < 10 then WLen := 10;
     LetterWidth := Trunc(imgWord.Width * 0.9) div WLen;
     For i:=1 to Length(Word) do begin
         DrawCharCenter(Trunc(imgWord.Width * 0.05) + Trunc((i - 0.5 + ((WLen - Length(Word)) / 2)) * LetterWidth),
                        imgWord.Height div 2, imgWord,
                        Word[i], $80FFFF, TYPEFACE, Trunc(RefFontSize * 10 / WLen) );
     end;
end;

procedure TfrmOvHangman.imgExitClick(Sender: TObject);
begin
     PlaySound('KLICK3.WAV', 1);
     Release;
end;

procedure TfrmOvHangman.FormKeyPress(Sender: TObject; var Key: Char);
begin
     CorrectLetter(AnsiUpperCase(Key));
     DrawAll;
end;

Procedure TfrmOvHangman.DrawAll;
begin
     DrawPicture(Errors);
     Application.ProcessMessages;
     DrawWord(DisplayWord);
     Application.ProcessMessages;
     DrawAlphabet;
     Application.ProcessMessages;
end;

procedure TfrmOvHangman.CorrectLetter(Letter: String);
var
   Occ: Integer;
   i,j: Integer;
begin
     If HangmanReplacementsInverse(Letter) <> '' then Letter :=  HangmanReplacementsInverse(Letter)[1];
     if ((Pos(Letter, AlphaString)=0)) or (not fPlaying) then Exit;
     Occ := 0;
     For i:=1 to Length(TheWord) do begin
         If (AnsiUppercase(TheWord[i])=Letter) Or (Pos(Ansiuppercase(TheWord[i]), HangmanReplacements(Letter))>0)  then begin
            DisplayWord[i]:=TheWord[i];
            Occ := Occ + 1;
         end;
     end;

     If Occ=0 then begin
        Errors := Errors + 1;
        If Length(AlphaString) < 18 then begin      { Fix for Samoan with very short alphabet, 17 letters}
           if Errors = 3 then Errors := 4;
           if Errors = 8 then Errors := 9;
           if Errors = 10 then Errors := 11;
        end;

        PlaySound('GNIRR5.WAV', 1);
     end else begin
        PlaySound('PLOPP2.WAV', 2);
     end;;

     if LetterUsed[Pos(Letter, AlphaString)] = False then begin
        LetterUsed[Pos(Letter, AlphaString)] := True;
        LettersUsed := LettersUsed + 1;

     end;
     If DisplayWord = TheWord then begin
        fPlaying := False;
        DrawAll;
        PlaySong('YAHOO.MID', 0, False);
        if Errors >=6 then DrawCharCenter(imgFace.Width div 2, Trunc(imgFace.Height *0.52), imgFace,
                 chr(HAPPYFACE), clGreen, SYMBOLTYPEFACE, Trunc(RefFontSize * 0.8) );

     end else If Errors = 11 Then begin
         fPlaying := False;
         PlaySong('HUNG_UP.MID', 0, False);
         DrawAll;
         DrawCharCenter(imgFace.Width div 2, Trunc(imgFace.Height *0.52), imgFace,
                 chr(SADFACE), clRed, SYMBOLTYPEFACE, Trunc(RefFontSize * 0.8) );
         DrawWord(TheWord);
         DisplayWord := TheWord;
     end;
end;

procedure TfrmOvHangman.imgAlphaMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
   Col,Row: Integer;
   TheString: String[1];
begin
     Col := X div ColWidth + 1;
     Row := Y div RowHeight + 1;
     TheString := 'X';
     TheString[1] := AlphaString[Col + (row - 1) * Cols];
     CorrectLetter(TheString);
     DrawAll;
end;

procedure TfrmOvHangman.imgStartClick(Sender: TObject);
begin
     PlaySound('KLICK3.WAV', 1);
     Start;
end;

procedure TfrmOvHangman.imgHelpClick(Sender: TObject);
begin
    PlaySound('KLICK3.WAV', 1);
    Application.HelpContext(HelpContext);
end;

function TfrmOvHangman.HangmanReplacements(strLetter: string):string;
var
    strResult: string;
    i: Integer;
begin
    strResult := '';
    for i:=1 to length(strLang[32]) div 2 do begin
        if AnsiUppercase(strLang[32][i*2-1]) = strLetter then strResult := strResult + AnsiUppercase(strLang[32][i*2])

    end;
    HangmanReplacements := strResult;
end;

function TfrmOvHangman.HangmanReplacementsInverse(strLetter: string):string;
var
    strResult: string;
    i: Integer;
begin
    strResult := '';
    for i:=1 to length(strLang[32]) div 2 do begin
        if AnsiUppercase(strLang[32][i*2]) = AnsiUppercase(strLetter) then strResult := strResult + AnsiUppercase(strLang[32][i*2-1])

    end;
    HangmanReplacementsInverse := strResult;
end;
procedure TfrmOvHangman.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
     If key=112 then begin
          ShowHelp(Handle);
     end;
end;

end.
