{

    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 Memory;
{The code for the memory exercises}

interface

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

type
  TCard = Record
       Up: Boolean;
       Picture: Byte;
       Color: TColor;
       FontSize: Integer;
       Ready: Boolean;
       Solved: Boolean;
       IsText: Boolean;
       Text: String;
  end;

type
  TfrmOvMemory = class(TForm)
    Image1: TImage;
    imgHelp: TImage;
    imgExit: TImage;
    imgCards1: TImage;
    imgCards2: TImage;
    imgCards3: TImage;
    imgScore: TImage;
    imgStart: TImage;
    imgBlad: TImage;
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure imgStartClick(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure imgExitClick(Sender: TObject);
    procedure Start(ExTyp: Integer);
    procedure imgCards3Click(Sender: TObject);
    procedure imgCards2Click(Sender: TObject);
    procedure imgCards1Click(Sender: TObject);
    procedure imgHelpClick(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    Procedure DrawButtons;
    Procedure DrawBoard;
    Procedure DrawScore;
    Procedure DrawCard(i: Integer);
    Procedure RestoreBoard;
    Function GetCardNumber(X,Y: Longint): integer;
  public
    { Public declarations }
  end;

const
  Space = 6;
var
  NrOfCards, Rows, Cols: Integer;
  NewNrOfCards, NewRows, NewCols: Integer;
  frmOvMemory: TfrmOvMemory;
  Cards: Array[0..50] of TCard;
  PicWidth, PicHeight: Integer;
  CardUp1: Integer;
  CardUp2: Integer;
  SolvedCards: Integer;
  ExerciseType: Integer;
  Tries: integer;

implementation

uses
    Hmeny;

{$R *.DFM}

procedure TfrmOvMemory.Start(ExTyp: Integer);
begin
     Show;

     ExerciseType := ExTyp;
     case ExerciseType of
     MEMORYY: begin
          NewNrOfCards := 24;
          NewRows :=5;
          NewCols := 5;
     end;
     ORDMEMORY: begin
          NewNrOfCards := 12;
          NewRows := 4;
          NewCols := 3;
     end;
     end;
     SolvedCards := 0;
     DrawButtons;
     RestoreBoard;
     DrawBoard;
end;
procedure TfrmOvMemory.FormCreate(Sender: TObject);
begin
     FixForm(Self);
end;

procedure TfrmOvMemory.DrawBoard;
var
   i: Integer;
begin
   Image1.Canvas.Brush.Color := clBlack;
   Image1.Canvas.Brush.Style := bsSolid;
   Image1.Canvas.Font.Name := SYMBOLTYPEFACE;
   Image1.Canvas.FillRect(Rect(0, 0, Image1.Width, Image1.Height));
   PicWidth := Image1.Width div Cols - Space;
   PicHeight := Image1.Height div Rows - Space;
   for i:=0 to NrOfCards - 1 do begin
       DrawCard(i);
   end;
   DrawScore;
end;

procedure TfrmOvMemory.DrawScore;
begin
   imgScore.Canvas.Brush.Color := clBlack;
   imgScore.Canvas.FillRect(Rect(0, 0, imgScore.Width, imgScore.Height));
   DrawCharCenter(imgScore.Width div 2, imgScore.Height div 2, imgScore,
                            IntToStr(Tries),  clWhite, TYPEFACE, RefFontSize div 2)
end;

Procedure TfrmOvMemory.DrawCard(I: Integer);
var
   X1,X2,Y1,Y2: Integer;
   DX,DY: Integer;
   intSmallerTypeface: Integer;
begin
       X1 := (i mod Cols ) * (PicWidth + Space);
       X2 := X1 + PicWidth;
       Y1 := (i div cols ) * (PicHeight + Space);
       Y2 := Y1 + PicHeight;
       Image1.Canvas.Brush.Style := bsSolid;
       If Cards[i].Up then begin
           Image1.Canvas.Brush.Color := clBlack;
           if Cards[i].Solved then begin
              Image1.Canvas.Pen.Color := clWhite;
              Image1.Canvas.Pen.Width := 3;
           end else begin
              Image1.Canvas.Pen.Color := clGray;
              Image1.Canvas.Pen.Width := 1;
           end;
       end else begin
           Image1.Canvas.Brush.Color := (02 shl 24) or $202020;
           Image1.Canvas.Pen.Color := clGray;
           Image1.Canvas.Pen.Width := 1;
       end;
       Image1.Canvas.Rectangle(X1,Y1,X2,Y2);
       if intCapital=1 then intSmallerTypeface:=1 else intSmallerTypeface:=0;
       If Cards[i].Up then begin

          If Cards[i].IsText then
             if length(Cards[i].Text) > 9 then
             DrawCharCenter(X1 + PicWidth div 2, Y1 + PicHeight div 2, Image1,
                            CorrCase(Cards[i].Text),  clWhite, TYPEFACE, Cards[i].FontSize div (6 + intSmallerTypeface))
             else
             DrawCharCenter(X1 + PicWidth div 2, Y1 + PicHeight div 2, Image1,
                            CorrCase(Cards[i].Text),  clWhite, TYPEFACE, Cards[i].FontSize div (4 + intSmallerTypeface))
          else
             DrawCharCenter(X1 + PicWidth div 2, Y1 + PicHeight div 2, Image1,
                            Chr(Pics[Cards[i].Picture].ASCII),  (02 shl 24) or Cards[i].Color,
                            SYMBOLTYPEFACE, Cards[i].FontSize);


       end;
end;

procedure TfrmOvMemory.RestoreBoard;
var
   i: Integer;
   C1,C2,Pic: Integer;
   Svar: Integer;
begin
   StopSong;
   Tries := 0;
   If (SolvedCards <> NrOfCards) and (SolvedCards <> 0) then begin
      Svar := ShowMessage(strLang[22], strLang[23], strLang[24]);
      If Svar = 2 then Exit
   end;
   NrOfCards := NewNrOfCards;
   Rows := NewRows;
   Cols := NewCols;
   for i:=0 to NrOfCards - 1 do begin
       Cards[i].Up := False;
       Cards[i].FontSize := RefFontSize * 9 Div Rows;;
       Cards[i].Ready := False;
       Cards[i].Solved := False;
       Cards[i].Picture := 1;
       Cards[i].Color := clLime;
       Cards[i].IsText := False;
   end;
   for i := 1 to  NrOfPics do begin
       Pics[i].Ready := False;
   end;
   Randomize;
   for i:=1 to NrOfCards div 2 do begin
       Repeat
             Pic := Trunc(Random * NrOfPics) + 1
       Until (Pics[Pic].Ready = False) and ((ExerciseType = MEMORYY) or (Pics[Pic].Singular <> ''));

       Repeat
             C1 := Trunc(Random * NrOfCards)
       Until Cards[C1].Ready = False;
       Cards[C1].Ready := True;

       Repeat
             C2 := Trunc(Random * NrOfCards)
       Until Cards[C2].Ready = False;
       Cards[C2].Ready := True;

       Pics[Pic].Ready := True;

       Cards[C1].Picture := Pic;
       Cards[C1].Color := Pics[Pic].Color;

       case ExerciseType of
       MEMORYY: begin
          Cards[C2].Picture := Pic;
          Cards[C2].Color := Pics[Pic].Color;
       end;
       ORDMEMORY: begin
          Cards[C2].Color := clSilver;
          Cards[C2].Picture := Pic;
          Cards[C2].IsText := True;
          Cards[C2].Text := Pics[Pic].Singular;
       end;
      end;

   end;
   CardUp1 := -1;
   CardUp2 := 1;
   SolvedCards := 0;
end;

Function TfrmOvMemory.GetCardNumber(X,Y: Longint): integer;
begin
end;



procedure TfrmOvMemory.FormShow(Sender: TObject);
begin
     StopSong;
     SetPalette(imgBlad);
     SetPalette(imgCards1);
     SetPalette(imgCards2);
     SetPalette(imgCards3);
     SetPalette(Image1);
     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);
     imgBlad.Canvas.FillRect(Rect(0 ,0 ,imgBlad.Width, imgBlad.Height));
     DrawCharCenter(imgBlad.Width div 2, imgBlad.Height div 2, imgBlad,
                            Chr(Pics[5].ASCII),  Pics[5].Color, SYMBOLTYPEFACE, Trunc(RefFontSize * 2.2))
end;                  

procedure TfrmOvMemory.imgStartClick(Sender: TObject);
begin
     PlaySound('KLICK3.WAV', 1);
     RestoreBoard;
     DrawBoard;

end;

procedure TfrmOvMemory.Image1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
   CardX, CardY, Card: Integer;
begin
     CardX := X div (PicWidth + Space);
     CardY := Y div (PicHeight + Space);
     Card := CardX + Cols * CardY;
     If (Card > (NrOfCards -1)) then
        {BEEP}
     else if Cards[Card].Up then
        {BEEP}
     else begin
          Cards[Card].Up := True;
          If CardUp2 <> -1 then begin {Turn up first card}
             PlaySound('VAND.WAV', 1);
             If CardUp1 <> -1 then begin
                {Turn back the cards}
                if Cards[CardUp1].Picture <> Cards[CardUp2].Picture then begin
                   Cards[CardUp1].Up := False;
                   Cards[CardUp2].Up := False;
                   DrawCard(CardUp1);
                   DrawCard(CardUp2);
                end;
             end;
             CardUp1 := Card;
             Cards[CardUp1].Up := True;
             DrawCard(CardUp1);
             Application.ProcessMessages;
             CardUp2 := -1;
          end else begin  {Turn up second card}
              CardUp2 := Card;
              Cards[CardUp2].Up := True;
              Tries := Tries + 1;
              DrawScore;
              if Cards[CardUp1].Picture = Cards[CardUp2].Picture then begin

                SolvedCards := SolvedCards + 2;
                PlaySound('PLOPP4.WAV', 1);

                Application.ProcessMessages;
                Cards[CardUp1].Solved := True;
                Cards[CardUp2].Solved := True;
                DrawCard(CardUp1);
                DrawCard(CardUp2);
              end else begin
                  DrawCard(CardUp2);
                  Application.ProcessMessages;
                  PlaySound('VAND.WAV', 1);
              end;;
         end;
     end;
      If SolvedCards = NrOfCards then begin
         PlaySong('HURRA1.MID', 0, False);
         {if (ShowMessage('BRAVO. Vill du spela en gång till?', 'Ja', 'Nej') = 1) then begin
            RestoreBoard;
            DrawBoard;
         end else begin
             Close;
         end; }

     end;
end;

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

procedure TfrmOvMemory.DrawButtons;
begin
     Case ExerciseType of
     MEMORYY: begin
              DrawButton(imgCards1,Concat('36 ', strLang[18]), $800000, TYPEFACE, ButtonFontSize, -1, NOBORDER);
              DrawButton(imgCards2,Concat('24 ', strLang[18]), $800000, TYPEFACE, ButtonFontSize, -1, NOBORDER);
              DrawButton(imgCards3,Concat('16 ', strLang[18]), $800000, TYPEFACE, ButtonFontSize, -1, NOBORDER);
              case NewNrOfCards of
              16:
                 DrawButton(imgCards3,Concat('16 ', strLang[18]), clWhite, TYPEFACE, RefFontSize div 3, -1, NOBORDER);
              24:
                 DrawButton(imgCards2,Concat('24 ', strLang[18]), clWhite, TYPEFACE, RefFontSize div 3, -1, NOBORDER);
              36:
                 DrawButton(imgCards1,Concat('36 ', strLang[18]), clWhite, TYPEFACE, RefFontSize div 3, -1, NOBORDER);
              end;
     end;
     ORDMEMORY: begin
              DrawButton(imgCards1,Concat('28 ', strLang[18]), $800000, TYPEFACE, RefFontSize div 3, -1, NOBORDER);
              DrawButton(imgCards2,Concat('18 ', strLang[18]), $800000, TYPEFACE, RefFontSize div 3, -1, NOBORDER);
              DrawButton(imgCards3,Concat('12 ', strLang[18]), $800000, TYPEFACE, RefFontSize div 3, -1, NOBORDER);
              case NewNrOfCards of
              12:
                 DrawButton(imgCards3,Concat('12 ', strLang[18]), clWhite, TYPEFACE, RefFontSize div 3, -1, NOBORDER);
              18:
                 DrawButton(imgCards2,Concat('18 ', strLang[18]), clWhite, TYPEFACE, RefFontSize div 3, -1, NOBORDER);
              28:
                 DrawButton(imgCards1,Concat('28 ', strLang[18]), clWhite, TYPEFACE, RefFontSize div 3, -1, NOBORDER);
              end;
     end;
     end;
end;

procedure TfrmOvMemory.imgCards3Click(Sender: TObject);
begin
     Case ExerciseType of
     MEMORYY: begin
          NewRows := 4;
          NewCols := 4;
          NewNrOfCards := 16;
          DrawButtons;
     end;
     ORDMEMORY: begin
          NewRows := 4;
          NewCols := 3;
          NewNrOfCards := 12;
          DrawButtons;
     end;
     end;


end;

procedure TfrmOvMemory.imgCards2Click(Sender: TObject);
begin
     Case ExerciseType of
     MEMORYY: begin
         NewRows := 5;
         NewCols := 5;
         NewNrOfCards := 24;
         DrawButtons;
     end;
     ORDMEMORY: begin
          NewRows := 6;
          NewCols := 3;
          NewNrOfCards := 18;
          DrawButtons;
     end;
     end;

end;

procedure TfrmOvMemory.imgCards1Click(Sender: TObject);
begin
     Case ExerciseType of
     MEMORYY: begin
        NewRows := 6;
        NewCols := 6;
        NewNrOfCards := 36;
        DrawButtons;
     end;
     ORDMEMORY: begin
        NewRows := 7;
        NewCols := 4;
        NewNrOfCards := 28;
        DrawButtons;
     end;
     end;

end;

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

end;

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

end.
