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

program Tetris;

{$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, CommCtrl, Math, Strings, MMSystem, ShellAPI;

{$r tetris.res}

const
  MAIN_DIALOG          = 0101;
  ABOUT_DIALOG         = 0102;
  LEVEL_TXT            = 0103;
  SCORE_TXT            = 0104;
  LINES_TXT            = 0105;
  FRAME_1              = 1000;
  FRAME_2              = 1001;
  FRAME_3              = 1002;
  FRAME_4              = 1003;
  SCORE_LBL            = 1004;
  LEVEL_LBL            = 1005;
  LINES_LBL            = 1006;
  ABOUT_ITEM           = 2000;
  NEW_GAME_ITEM        = 2001;
  SOUND_ITEM           = 2002;
  COLORED_FIGURES_ITEM = 2003;
  USE_GRID_ITEM        = 2004;
  GAME_LEVEL_ITEM      = 2005;
  AUTO_LEVEL_ITEM      = 2006;
  EXIT_ITEM            = 2007;
  MUSIC_ITEM           = 2008;
  HOME_PAGE_ITEM       = 2009;

var
  mainDlg, hTimer:    THandle := 0;
  PaintStruct:        TPaintStruct;
  Msg:                TMsg;

  Bitmap:             array[0..3] of hBitMap;
  iDC:                array[0..3] of hDC;
  Menu:               hMenu;
  DC:                 hDC;
  Brush:              hBrush;

  GridN, GridS:       array [0..19, 0..9] of Byte;
  Ch:                 Char := #0;
  Figure:             Longint := 0;
  X, Y:               Longint := 0;
  OldX, OldY, OldNo:  Longint := 0;
  Drop, DelayVal, i:  Longint := 0;
  Ok:                 Longint := 0;
  FigureA, FigureB:   Longint := 0;
  Level, Score:       Longint := 0;
  Lines, StoreLines:  Longint :=0;
  KeyboardDelay:      DWORD   := 0;
  SlideNo:            DWORD   := 0;
  MS:                 DWORD   := 0;
  Paused:             Boolean := FALSE;
  UseGrid:            Boolean := TRUE;
  UseSound:           Boolean := TRUE;
  ColoredFigures:     Boolean := TRUE;
  AutoLevel:          Boolean := TRUE;
  UseMusic:           Boolean := TRUE;
  MIDIName:           String[12];

const
Tetromino: array [0..27, 0..7] of Longint =
  (( 0,  0,  1,  0,  0,  1,  1,  1),
   ( 0,  0,  1,  0,  0,  1,  1,  1),
   ( 0,  0,  1,  0,  0,  1,  1,  1),
   ( 0,  0,  1,  0,  0,  1,  1,  1),
   (-2,  0, -1,  0,  0,  0,  1,  0),
   ( 0, -1,  0,  0,  0,  1,  0,  2),
   (-2,  0, -1,  0,  0,  0,  1,  0),
   ( 0, -1,  0,  0,  0,  1,  0,  2),
   (-1,  0,  0,  0,  0,  1,  1,  1),
   ( 1, -1,  0,  0,  1,  0,  0,  1),
   (-1,  0,  0,  0,  0,  1,  1,  1),
   ( 1, -1,  0,  0,  1,  0,  0,  1),
   ( 0,  0,  1,  0, -1,  1,  0,  1),
   ( 0, -1,  0,  0,  1,  0,  1,  1),
   ( 0,  0,  1,  0, -1,  1,  0,  1),
   ( 0, -1,  0,  0,  1,  0,  1,  1),
   ( 0, -1, -1,  0,  0,  0,  1,  0),
   ( 0, -1, -1,  0,  0,  0,  0,  1),
   (-1,  0,  0,  0,  1,  0,  0,  1),
   ( 0, -1,  0,  0,  1,  0,  0,  1),
   ( 1, -1, -1,  0,  0,  0,  1,  0),
   (-1, -1,  0, -1,  0,  0,  0,  1),
   (-1,  0,  0,  0,  1,  0, -1,  1),
   ( 0, -1,  0,  0,  0,  1,  1,  1),
   (-1, -1, -1,  0,  0,  0,  1,  0),
   ( 0, -1,  0,  0, -1,  1,  0,  1),
   (-1,  0,  0,  0,  1,  0,  1,  1),
   ( 0, -1,  1, -1,  0,  0,  0,  1));


procedure OpenMIDI;
var
  Mess: String;
begin
  Mess := 'open sequencer!music1.mid alias music1' + #0;
  mciSendString(@Mess[1], nil, 0, 0);
  Mess := 'open sequencer!music2.mid alias music2' + #0;
  mciSendString(@Mess[1], nil, 0, 0);
end;

procedure CloseMIDI;
var
  Mess: String;
begin
  if MIDIName = '' then exit;
  Mess := 'close music1' + #0;
  mciSendString(@Mess[1], nil, 0, 0);
  Mess := 'close music2' + #0;
  mciSendString(@Mess[1], nil, 0, 0);
  MIDIName := '';
end;

procedure PlayMIDI(Name, Flags: String);
var
  Mess: String;
begin
  MIDIName := Name;
  Mess := 'play ' + Name + ' from 0 ' + Flags + #0;
  if UseMusic then
    mciSendString(@Mess[1], nil, 0, mainDlg);
end;

procedure StopMIDI(Name: String);
var
  Mess: String;
begin
  Mess := 'stop ' + Name + #0;
  mciSendString(@Mess[1], nil, 0, 0);
end;

procedure ClearArea(X, Y, DX, DY: Longint);
var
  Rect: TRect;
begin
  with ReCt do
  begin
    Left   := X;
    Top    := Y;
    Right  := X + DX;
    Bottom := Y + DY;
  end;
  FillRect(DC, Rect, Brush);
end;

procedure DrawBox(X, Y, DX, DY: Longint);
var
  Rect: TRect;
begin
  if UseGrid then
    BitBlt(DC, X, Y, DX, DY, iDC[0], 144 , 0, SRCCOPY)
  else begin
    with Rect do
    begin
      Left   := X;
      Top    := Y;
      Right  := X + DX;
      Bottom := Y + DY;
    end;
    FillRect(DC, Rect, Brush);
  end;
end;

procedure Print(X, Y: Longint; Color: DWord; Text: String);
begin
  TextOut(DC, X * 2, Y * 2, @Text[1], Length(Text));
end;

procedure PutElement(X, Y, DX, DY, Figure: Longint);
begin
  if ColoredFigures then
    BitBlt(DC, X, Y, 16, 16, iDC[0], 16 * (Figure div 4) , 0, SRCCOPY)
  else
    BitBlt(DC, X, Y, 16, 16, iDC[0], 128 , 0, SRCCOPY);
end;

procedure PutBitmap(X, Y, DX, DY, Offset: Longint; ID: DWORD);
begin
  BitBlt(DC, X, Y, DX, DY, iDC[ID], Offset, 0, SRCCOPY);
end;

procedure PutBlock(X, Y, Figure: Longint);
var
  i, Xp, Yp: Longint;
begin
  for i := 0 to 3 do begin
    Xp := 16 * Tetromino[Figure, 2 * i] + X;
    Yp := 16 * Tetromino[Figure, 2 * i + 1] + Y;
    PutElement(Xp, Yp, 16, 16, Figure);
  end;
end;

procedure EraseBlock(X, Y, Figure: Longint);
var
  i, Xp, Yp: Longint;
begin
  for i := 0 to 3 do begin
    Xp := 16 * Tetromino[Figure, 2 * i] + X;
    Yp := 16 * Tetromino[Figure, 2 * i + 1] + Y;
    DrawBox(Xp, Yp, 16, 16);
  end;
end;

procedure DrawGrid;
var
  X, Y: DWord;
begin
  for Y := 0 to 19 do
    for X := 0 to 9 do
      if GridS[Y, X] = 1 then
        PutElement(8 + 16 * X, 8 + 16 * Y, 16, 16, GridN[Y, X])
      else
        DrawBox(8 + 16 * X, 8 + 16 * Y, 16, 16)
end;

procedure Screen;
var
  tmp: array [0..127] of Char;
begin
  DrawGrid;
  PutBitmap(178, 8, 176, 113, 176 * SlideNo, 2);
  SendDlgItemMessage(mainDlg, SCORE_TXT, WM_SETTEXT, 0, DWORD(StrPCopy(tmp, IntToStr(Score))));
  SendDlgItemMessage(mainDlg, LEVEL_TXT, WM_SETTEXT, 0, DWORD(StrPCopy(tmp, IntToStr(Level))));
  SendDlgItemMessage(mainDlg, LINES_TXT, WM_SETTEXT, 0, DWORD(StrPCopy(tmp, IntToStr(Lines))));
end;

procedure ShowNextFigure;
begin
  ClearArea(196, 236, 140, 88);
  PutBlock(260, 276, FigureB);
end;

procedure ParseKeys;
var
  i: Longint;
begin
  if Ch <> #0 then
  begin
    case Ch of
      #37:
        begin
          X -:= 1;
          for i := 0 to 3 do
            if (Tetromino[Figure, 2 * i] + X < 0) or
               (GridS[Tetromino[Figure, 2 * i + 1] + Y, Tetromino[Figure, 2 * i] + X] = 1)
            then
              X +:= 1;
          EraseBlock(8 + 16 * OldX, 8 + 16 * OldY, OldNo);
          PutBlock(8 + 16 * X, 8 + 16 * Y, Figure);
        end;
      #39:
        begin
          X +:= 1;
          for i := 0 to 3 do
            if (Tetromino[Figure, 2 * i] + X > 9) or
               (GridS[Tetromino[Figure, 2 * i + 1] + Y, Tetromino[Figure, 2 * i] + X] = 1)
            then
              X := X - 1;
          EraseBlock(8 + 16 * OldX, 8 + 16 * OldY, OldNo);
          PutBlock(8 + 16 * X, 8 + 16 * Y, Figure);
        end;
      #38:
        begin
          Figure +:= 1;
          if Figure mod 4 = 0 then Figure -:= 4;
          for i := 0 to 3 do
            if (Tetromino[Figure, 2 * i] + X < 0) or (Tetromino[Figure, 2 * i] + X > 9) or
               (Tetromino[Figure, 2 * i + 1] + Y < 0) or (Tetromino[Figure, 2 * i + 1] + Y > 19) or
               (GridS[Tetromino[Figure, 2 * i + 1] + Y, Tetromino[Figure, 2 * i] + X] = 1)
            then
              if Figure mod 4 = 0 then
                Figure +:= 3
              else
                Figure -:= 1;
          EraseBlock(8 + 16 * OldX, 8 + 16 * OldY, OldNo);
          PutBlock(8 + 16 * X, 8 + 16 * Y, Figure);
          end;
      #40, #32:
          DelayVal := 0;
    end;
    Ch := #0;
  end;
  OldX  := X;
  OldY  := Y;
  OldNo := Figure;
end;

procedure EraseLines;
var
  N: array [1..4] of Byte;
  Ok, M, i, J, Num: Longint := 0;
begin
  for J := 0 to 19 do
  begin
    Ok := 0;
    for i := 0 to 9 do
      if GridS[J, i] = 0 then Ok := 1;
      if Ok = 0 then
      begin
        Num +:= 1;
        N[Num]:=J;
      end;
  end;
  for J := 1 to Num do
  begin
    for i := N[J] downto 1 do
    begin
      Move(GridS[i - 1], GridS[i], 10);
      Move(GridN[i - 1], GridN[i], 10);
    end;
    DrawGrid;
  end;
  if Num > 0 then
  begin
    Lines +:= Num;
    if UseSound then
      MMSystem.PlaySound(MAKEINTRESOURCE(120), HInstance, SND_ASYNC or SND_RESOURCE);
    if Lines > (10 * (StoreLines div 10) + 9) then
    begin
      if (AutoLevel) and (Level < 9) then Level +:= 1;
      StoreLines := Lines;
      SlideNo +:= 1;
      if SlideNo mod 5 = 0 then SlideNo -:= 5;
    end;
  end else
  if UseSound then
    MMSystem.PlaySound(MAKEINTRESOURCE(110), HInstance, SND_ASYNC or SND_RESOURCE);
end;

procedure InitGame;
begin
  Level := 0;
  Score := 0;
  Lines := 0;
  StoreLines := 0;
  Randomize;
  Ch := #0;
  Drop := 0;
  Ok := 0;
  FillChar(GridS, SizeOf(GridS), 0);
  FillChar(GridN, SizeOf(GridN), 0);
  SlideNo := 0;
  Screen;
  EnableMenuItem(Menu, NEW_GAME_ITEM, MF_GRAYED);
  PlayMIDI('music1', 'notify');
end;

function AboutDlgProc conv arg_stdcall (Dialog: HWND; Mess: UINT; WParam: WParam; LParam: LParam): LongInt;
begin
  if (Mess = WM_CLOSE) or ((Mess = WM_COMMAND) and
     (LoWord(WParam) = IDOK)) then
  begin
    EndDialog(Dialog, 0);
    Result := 1;
  end else
    Result := 0;
end;

function ChooseLevelDlgProc conv arg_stdcall (Dialog: HWND; Mess: UINT; WParam: WParam; LParam: LParam): LongInt;
var
  tmp: array [0..127] of Char;
begin
  Result := 0;
  case Mess of
     WM_INITDIALOG:
       begin
         SendDlgItemMessage(Dialog, 1001, UDM_SETRANGE, 0, MAKELONG(9, 0));
         SendDlgItemMessage(Dialog, 1001, UDM_SETPOS, 0, MAKELONG(Level, 0));
         StrPCopy(tmp, IntToStr(Level));
         SendDlgItemMessage(Dialog, 1000, WM_SETTEXT, 0, DWORD(@tmp));
         Result := 1;
       end;

     WM_VSCROLL:
       begin
         StrPCopy(tmp, IntToStr(HiWord(wParam)));
         SendDlgItemMessage(Dialog, 1000, WM_SETTEXT, 0, DWORD(@tmp));
       end;

     WM_CLOSE:
       begin
         EndDialog(Dialog, 0);
       end;

     WM_COMMAND:
       begin
         case LoWord(WParam) of
           IDOK:
             begin
               SendDlgItemMessage(Dialog, 1000, WM_GETTEXT, 127, DWORD(@tmp));
               Level := StrToInt(StrPas(tmp));
               DelayVal := 32 - 3 * (Level mod 10);
               SendMessage(Dialog, WM_CLOSE, 0, 0);
               Screen;
             end;
           IDCANCEL: SendMessage(Dialog, WM_CLOSE, 0, 0);
         end;
       end;
  end;
end;

function MainDlgProc conv arg_stdcall (Dialog: HWND; Mess: UINT; WParam: WParam; LParam: LParam): LongInt;
var
  Rect: TRect;
begin
  Result := 0;
  case Mess of
    WM_INITDIALOG:
      begin
        GetWindowRect(Dialog, Rect);
        SetWindowPos(Dialog, HWND_TOP, Rect.Left, Rect.Top, 366, 366 + GetSystemMetrics(SM_CYMENUSIZE), 0);
        SetWindowPos(GetDlgItem(Dialog, FRAME_1), HWND_TOP, 6, 6, 164, 324, 0);
        SetWindowPos(GetDlgItem(Dialog, FRAME_2), HWND_TOP, 176, 0, 180, 122, 0);
        SetWindowPos(GetDlgItem(Dialog, FRAME_3), HWND_TOP, 176, 120, 180, 100, 0);
        SetWindowPos(GetDlgItem(Dialog, FRAME_4), HWND_TOP, 176, 218, 180, 112, 0);
        SetWindowPos(GetDlgItem(Dialog, SCORE_LBL), HWND_TOP, 202, 140, 80, 24, 0);
        SetWindowPos(GetDlgItem(Dialog, LEVEL_LBL), HWND_TOP, 202, 164, 80, 24, 0);
        SetWindowPos(GetDlgItem(Dialog, LINES_LBL), HWND_TOP, 202, 188, 80, 24, 0);
        SetWindowPos(GetDlgItem(Dialog, SCORE_TXT), HWND_TOP, 292, 140, 40, 24, 0);
        SetWindowPos(GetDlgItem(Dialog, LEVEL_TXT), HWND_TOP, 292, 164, 40, 24, 0);
        SetWindowPos(GetDlgItem(Dialog, LINES_TXT), HWND_TOP, 292, 188, 40, 24, 0);
      end;

    WM_SYSKEYDOWN:
      begin
        if (wParam <> 19) and Paused then Screen;
        Paused := wParam = 19;
        if (Ch = #0) and (GetTickCount >= KeyboardDelay + 120) then
        begin
          Ch := Char(wParam);
          KeyboardDelay := GetTickCount;
        end;
      end;

    WM_SYSCHAR:
      begin
        if wParam in [32, 37, 38, 39, 40] then
          Result := 1
        else
          Result := 0;
      end;

    WM_COMMAND:
      begin
        case LoWord(WParam) of
           EXIT_ITEM:
             SendMessage(Dialog, WM_CLOSE, 0, 0);

           ABOUT_ITEM:
             DialogBoxParam(HInstance, MAKEINTRESOURCE(102), mainDlg, @AboutDlgProc, 0);

           GAME_LEVEL_ITEM:
             DialogBoxParam(HInstance, MAKEINTRESOURCE(103), mainDlg, @ChooseLevelDlgProc, 0);

           NEW_GAME_ITEM:
               Ok := 0;

           SOUND_ITEM:
             begin
               UseSound := not UseSound;
               CheckMenuItem(Menu, SOUND_ITEM, DWORD(UseSound) * MF_CHECKED or MF_BYCOMMAND);
             end;

           MUSIC_ITEM:
             begin
               UseMusic := not UseMusic;
               CheckMenuItem(Menu, MUSIC_ITEM, DWORD(UseMusic) * MF_CHECKED or MF_BYCOMMAND);
               if not UseMusic then
                 StopMIDI(MIDIName)
               else
                 PlayMIDI(MIDIName, 'notify');
             end;

           USE_GRID_ITEM:
             begin
               UseGrid := not UseGrid;
               CheckMenuItem(Menu, USE_GRID_ITEM, DWORD(UseGrid) * MF_CHECKED or MF_BYCOMMAND);
               Screen;
             end;

           COLORED_FIGURES_ITEM:
             begin
               ColoredFigures := not ColoredFigures;
               CheckMenuItem(Menu, COLORED_FIGURES_ITEM, DWORD(ColoredFigures) * MF_CHECKED or MF_BYCOMMAND);
               Screen;
               ShowNextFigure;
             end;

           HOME_PAGE_ITEM:
             ShellExecute(Dialog, 'open', 'http://www.tmt.com', nil, nil, SW_SHOWDEFAULT);

           AUTO_LEVEL_ITEM:
             begin
               AutoLevel := not AutoLevel;
               CheckMenuItem(Menu, AUTO_LEVEL_ITEM, DWORD(AutoLevel) * MF_CHECKED or MF_BYCOMMAND);
             end;
        end;
      end;

    WM_PAINT:
      begin
        if (mainDlg = Dialog) and (mainDlg <> 0) then
        begin
          Screen;
          PutBlock(8 + 16 * X, 8 + 16 * Y, Figure);
          ShowNextFigure;
        end;
      end;

    MM_MCINOTIFY:
      if wParam = 1 then PlayMIDI(MIDIName, 'notify');

    WM_CLOSE:
      DestroyWindow(Dialog);

    WM_DESTROY:
      PostQuitMessage(0);
  end;
end;

procedure ExitGame;
begin
  ReleaseDC(mainDlg, DC);
  CloseMIDI;
  DeleteObject(Brush);
  for i := 0 to 3 do
  begin
    DeleteObject(BitMap[i]);
    DeleteDC(iDC[i]);
  end;
  Halt(0);
end;

begin
  InitCommonControls;
  Menu := LoadMenu(hInstance, MAKEINTRESOURCE(101));
  mainDlg := CreateDialog(hInstance, MakeIntResource(MAIN_DIALOG), 0, @MainDlgProc);
  SetMenu(mainDlg, Menu);
  SendMessage(mainDlg, WM_SETICON, ICON_SMALL, LoadIcon(hInstance, MAKEINTRESOURCE(101)));
  ShowWindow(mainDlg, SW_SHOW);

  OpenMIDI;

  DC := GetDC(mainDlg);
  Brush := CreateSolidBrush(GetSysColor(COLOR_BTNFACE));
  SelectObject(DC, Brush);

  for i := 0 to 3 do
  begin
    BitMap[i] := LoadBitmap(hInstance, MAKEINTRESOURCE(1000 + i));
    iDC[i] := CreateCompatibleDC(0);
    SeleCtOBjeCt(iDC[i], BitMap[i]);
  end;

  repeat
    InitGame;

    repeat
      X := 4;
      Y := 1;
      OldX := 4;
      OldY := 1;
      DelayVal := 32 - 3 * (Level mod 10);

      FigureB := 4 * Random(7);
      ShowNextFigure;

      Figure := FigureA;
      OldNo := Figure;
      FigureA := FigureB;
      repeat

        MS := GetTickCount + DelayVal;
        repeat

          if GetActiveWindow = mainDlg then
            if GetFocus <> 0 then SetFocus(0);

          if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then
          begin
            TranslateMessage(Msg);
            DispatchMessage(Msg);
          end;

          if Msg.Message = WM_QUIT then ExitGame;

        until GetTickCount >= MS;

        if not Paused then
        begin
          ParseKeys;
          Drop +:= 1;
          if Drop > 20 then
          begin
            Drop := 0;
            Ok := 0;
            Y +:= 1;
            for i := 0 to 3 do
              if (Tetromino[Figure, 2 * i + 1] + Y > 19) or
                 (GridS[Tetromino[Figure, 2 * i + 1] + Y, Tetromino[Figure, 2 * i] + X] = 1)
            then
            begin
              Y -:= 1;
              Ok := 1;
            end;
            EraseBlock(8 + 16 * OldX, 8 + 16 * OldY, OldNo);
            PutBlock(8 + 16 * X,  8 + 16 * Y, Figure);
            OldX  := X;
            OldY  := Y;
            OldNo := Figure;
          end;
        end else
        PutBitmap(30, 140, 120, 40, 0, 1);
      until Ok = 1;

      KeyboardDelay := GetTickCount + 50;

      Score +:= 15 + 5 * (Level mod 10);
      Ok := 0;
      for i := 0 to 3 do
      begin
        GridS[Tetromino[Figure, 2 * i + 1] + Y, Tetromino[Figure, 2 * i] + X] := 1;
        GridN[Tetromino[Figure, 2 * i + 1] + Y, Tetromino[Figure, 2 * i] + X] := Figure;
      end;
      for i := 0 to 3 do
        if Tetromino[Figure, 2 * i + 1] + Y = 1 then Ok := 1;
      EraseLines;
      Screen;
    until Ok = 1;

    EnableMenuItem(Menu, NEW_GAME_ITEM, MF_ENABLED);

    StopMIDI(MIDIName);
    PutBitmap(27, 140, 123, 40, 0, 3);
    PlayMIDI('music2', 'notify');

    while (GetMessage(Msg, 0, 0, 0)) and (Ok = 1) do
    begin
      TranslateMessage(Msg);
      DispatchMessage(Msg);
      PutBitmap(27, 140, 123, 40, 0, 3);
    end;
    if Ok = 1 then ExitGame;
    StopMIDI(MIDIName);

  until FALSE;
end.