(***********************************************)
(*                                             *)
(* Life (GUI Demo Game)                        *)
(* Copyright (c) 1999 by TMT Development Corp. *)
(* Author: Vadim Bodrov, TMT Development Corp. *)
(*                                             *)
(* Targets:                                    *)
(*   WIN32 GUI application                     *)
(*                                             *)
(***********************************************)

program Life;

{$ifndef __WIN32__}
{$define INVALID_TARGET}
{$endif}
{$ifndef __GUI__}
{$define INVALID_TARGET}
{$endif}
{$ifdef INVALID_TARGET}
  This program must be compiled as Win32 GUI application only
{$endif}

uses Windows, Messages, CommDlg, Math, Strings, MMSystem;

{$r life.res}

const
  MAIN_DIALOG        = 101;
  ABOUT_DIALOG       = 102;

  CLEAR_BUTTON       = 1000;
  GENERATE_BUTTON    = 1001;
  RUN_BUTTON         = 1002;
  SINGLE_STEP_BUTTON = 1003;
  DRAWING_FIELD      = 1005;
  CLOSE_BUTTON       = 1006;
  ABOUT_BUTTON       = 1007;

  FIELD_SX           = 50;  // Width of field
  FIELD_SY           = 50;  // Height of field

type
  TGameField = array [0..FIELD_SX - 1, 0..FIELD_SY - 1] of Boolean;

var
  mainDlg, hTimer:    THandle := 0;
  PaintStruct:        TPaintStruct;
  Msg:                TMsg;
  Buffer:             array [0..255] of Char;
  ErrCode:            Longint;
  Res:                Extended;
  ResStr:             String;

  DC:                 hDC := 0;
  Brush1, Brush2:     hBrush := 0;
  Pen:                hPen := 0;
  LifeRunning:        Boolean := FALSE;
  OldField, NewField: TGameField;
  dx, dy, cx, cy:     DWord := 0;

procedure MutateLife;

function Lives(x, y: Longint): Boolean;
begin
  if (x < 0) or ( x>= FIELD_SX) or
     (y < 0) or ( y>= FIELD_SY)
  then
    Result := False
  else
    Result := OldField[x,y];
end;

function Neighbors(x, y: Longint): Longint;
var
  dx, dy: Longint;
begin
  Result := -Longint(Lives(x, y));
  for dx := -1 to 1 do
    for dy := -1 to 1 do
      inc(Result, Longint(Lives(x + dx, y + dy)));
end;

var
  i, j : Longint;
begin
  for i := 0 to FIELD_SX - 1 do
    for j := 0 to FIELD_SY - 1 do
    begin
      if OldField [i, j] then
        NewField[i, j] := Neighbors(i, j) in [2, 3]
      else
        NewField[i, j] := Neighbors(i, j) = 3;
  end;
  Move(NewField, OldField, SizeOf(OldField));
end;

procedure GenerateLife;
var
  i, j: DWord;
begin
  Randomize;
  for i := 0 to FIELD_SX - 1 do
    for j := 0 to FIELD_SY - 1 do
    begin
      NewField[i, j] := Random < 0.5;
      OldField[i, j] := not NewField[i, j];
    end;
end;

procedure DrawField;
var
  rect: TRect;
  i, j, x, y: DWord;
begin
  GetClientRect(GetDlgItem(mainDlg, DRAWING_FIELD), rect);
  SelectObject(DC, Pen);

  dx := rect.Right div FIELD_SX;
  dy := rect.Bottom div FIELD_SY;
  cx := (rect.Right mod FIELD_SX + 1) div 2;
  cy := (rect.Bottom mod FIELD_SY + 1) div 2;

  j := cy;
  y := 0;
  repeat
    i := cx;
    x := 0;
    repeat
      if NewField[x, y] then
        SelectObject(DC, Brush2)
      else
        SelectObject(DC, Brush1);
      Rectangle(DC, i, j, i + dx - 1, j + dy - 1);
      i +:= dx;
      x +:= 1;
    until x = FIELD_SX;
    j +:= dy;
    y +:= 1;
  until y = FIELD_SY;
end;

procedure ClearField;
begin
  FillChar(NewField, SizeOf(NewField), 0);
  FillChar(OldField, SizeOf(OldField), 0);
end;

function AboutDlgProc conv arg_stdcall (Dialog: HWND; Mess: UINT; WParam: WParam; LParam: LParam): LongInt;
const
  MEM_AVAIL_CAPTION = 1000;
  MEM_INUSE_CAPTION = 1001;
var
  Txt: String;
  MS: TMemoryStatus;
begin
  Result := 0;
  case Mess of
    WM_INITDIALOG:
      begin
        GlobalMemoryStatus(MS);
        Txt := IntToStr(MS.dwTotalPhys div 1024) + ' KB' + #0;
        SendDlgItemMessage(Dialog, MEM_AVAIL_CAPTION, WM_SETTEXT, 0, DWORD(@Txt[1]));
        Txt := IntToStr(MS.dwMemoryLoad) + ' %' + #0;
        SendDlgItemMessage(Dialog, MEM_INUSE_CAPTION, WM_SETTEXT, 0, DWORD(@Txt[1]));
      end;
    WM_CLOSE:
      EndDialog(Dialog, 0);
    WM_COMMAND:
      if LoWord(WParam) = IDOK then SendMessage(Dialog, WM_CLOSE, 0, 0);
  end;
end;

procedure GetFieldPos(var x, y: DWord);
var
 mPoint, dPoint: TPoint;
begin
  FillChar(mPoint, SizeOf(mPoint), 0);
  FillChar(dPoint, SizeOf(dPoint), 0);
  ClientToScreen(mainDlg, mPoint);
  ClientToScreen(GetDlgItem(mainDlg, DRAWING_FIELD), dPoint);
  x := dPoint.X - mPoint.X + cx;
  y := dPoint.Y - mPoint.Y + cx;
end;

var
  ClickState: Boolean := FALSE;

function MainDlgProc conv arg_stdcall (Dialog: HWND; Mess: UINT; WParam: WParam; LParam: LParam): LongInt;
begin
  case Mess of
  WM_INITDIALOG:
    Result := 0;
  WM_CLOSE:
    begin
      Result := 1;
      DestroyWindow(Dialog);
    end;
  WM_TIMER:
    begin
      if LifeRunning then
      begin
        MutateLife;
        DrawField;
      end;
    end;
  WM_PAINT:
    begin
      if not LifeRunning then DrawField;
      Result := 0;
    end;
  WM_COMMAND:
    begin
      Result := 0;
      if LoWord(WParam) = CLOSE_BUTTON then
        DestroyWindow(Dialog);
      if LoWord(WParam) = GENERATE_BUTTON then
      begin
        MMSystem.PlaySound(MAKEINTRESOURCE(104), HInstance, SND_ASYNC or SND_RESOURCE);
        if LifeRunning then
          SendMessage(mainDlg, WM_COMMAND, RUN_BUTTON, 0);
        GenerateLife;
        DrawField;
      end;
      if LoWord(WParam) = SINGLE_STEP_BUTTON then
      begin
        MMSystem.PlaySound(MAKEINTRESOURCE(104), HInstance, SND_ASYNC or SND_RESOURCE);
        if LifeRunning then
          SendMessage(mainDlg, WM_COMMAND, RUN_BUTTON, 0);
        MutateLife;
        DrawField;
      end;
      if LoWord(WParam) = CLEAR_BUTTON then
      begin
        MMSystem.PlaySound(MAKEINTRESOURCE(104), HInstance, SND_ASYNC or SND_RESOURCE);
        if LifeRunning then
          SendMessage(mainDlg, WM_COMMAND, RUN_BUTTON, 0);
        ClearField;
        DrawField;
      end;
      if LoWord(WParam) = ABOUT_BUTTON then
      begin
         MMSystem.PlaySound(MAKEINTRESOURCE(104), HInstance, SND_ASYNC or SND_RESOURCE);
         DialogBoxParam(hInstance, MAKEINTRESOURCE(ABOUT_DIALOG), mainDlg, @AboutDlgProc, 0);
      end;
      if LoWord(WParam) = RUN_BUTTON then
      begin
        MMSystem.PlaySound(MAKEINTRESOURCE(104), HInstance, SND_ASYNC or SND_RESOURCE);
        declare
        var Message: String;
        begin
          LifeRunning := not LifeRunning;
          if LifeRunning then
            Message := 'Stop' + #0
              else
            Message := 'Run' + #0;
          SendDlgItemMessage(mainDlg, RUN_BUTTON, WM_SETTEXT, 0, DWORD(@Message[1]));
        end;
      end;
    end;
  WM_LBUTTONDOWN:
    ClickState := TRUE;
  WM_LBUTTONUP:
    begin
      if ClickState then
      begin
        declare
        var
          x, y: DWORD;
          fx, fy: DWORD;
        begin
          GetFieldPos(fx, fy);
          x := (LoWord(LParam) - fx) div dx;
          y := (HiWord(LParam) - fy) div dy;

          if (x in [0..FIELD_SX-1]) and (y in [0..FIELD_SY-1]) then
          begin
            NewField[x, y] := not NewField[x, y];
            OldField[x, y] := not OldField[x, y];
            MMSystem.PlaySound(MAKEINTRESOURCE(105), HInstance, SND_ASYNC or SND_RESOURCE);
            DrawField;
          end;
        end;
        ClickState := FALSE;
      end;
    end;
  WM_DESTROY:
    begin
      PostQuitMessage(0);
      Result := 0;
    end;
  else
    Result := 0;
  end;
end;

var Mess: String;
begin
  maindlg := CreateDialog(hInstance, MakeIntResource(MAIN_DIALOG), 0, @MainDlgProc);
  ShowWindow(maindlg, SW_RESTORE);
  ClearField;
  DrawField;

  hTimer := SetTimer(mainDlg, $FFFF, 300, NIL);
  DC := BeginPaint(GetDlgItem(mainDlg, DRAWING_FIELD), PaintStruct);
  Brush1 := CreateSolidBrush($FFFFFF);
  Brush2 := CreateSolidBrush($FF0000);
  Pen := CreatePen(PS_SOLID, 0, $000000);
  SendMessage(mainDlg, WM_SETICON, ICON_SMALL, LoadIcon(hInstance, MAKEINTRESOURCE(103)));

  while GetMessage(Msg, 0, 0, 0) do
  begin
    TranslateMessage(Msg);
    DispatchMessage(Msg);
  end;

  KillTimer(mainDlg, hTimer);
  EndPaint(GetDlgItem(mainDlg, DRAWING_FIELD), PaintStruct);
  DeleteObject(Brush1);
  DeleteObject(Brush2);
  DeleteObject(Pen);
end.
