unit demo18;
{$mode objfpc}{$H+}
// RU: В данной демке свои файлы настроек "zglCustomConfig.cfg" и "zgl_config.cfg". В файле "zgl_config.cfg" включено определение "USE_INIT_HANDLE" для работы с LCL(VCL).
// EN: This demo has its own settings files "zglCustomConfig.cfg" and "zgl_config.cfg". The "zgl_config.cfg" file includes a definition of "USE_INIT_HANDLE" to work with LCL(VCL).
{$I zglCustomConfig.cfg}
{$I zgl_config.cfg}
interface
// RU: обратите внимание!!!
// Проекты LCL имеют свои конфигурационные файлы "zgl_config.cfg". Лучше всего для каждого вашего проекта иметь свой
// конфигурационный файл, это может решить многие проблемы, если вдруг вы будете вносить изменения в конфигурацию проекта
// и, это отобразится на других ваших проектах использующих тот же конфигурационный файл.
// EN: note!!!
// LCL projects have their own configuration files "zgl_config.cfg". It's best to have a separate config file for each of
// your projects, this can solve many problems if you suddenly make changes to the project config and it will show up on
// your other projects using the same config file.
uses
Classes,
SysUtils,
Forms,
Controls,
Graphics,
Dialogs,
ExtCtrls,
{$IFDEF LINUX}
{$IFDEF LCLGTK2}
GTK2, GDK2x, GTK2Proc,
{$ENDIF}
{$IfDef LCLGTK3}
Gtk3Widgets, LazGdk3, LazGtk3, x,
{$EndIf}
{$ENDIF}
{$IFDEF USE_ZENGL_STATIC}
zgl_application,
zgl_window,
zgl_screen,
zgl_render_2d,
zgl_joystick,
zgl_fx,
zgl_font,
zgl_text,
zgl_textures,
zgl_collision_2d,
zgl_sprite_2d,
// sound
zgl_sound,
zgl_sound_wav,
zgl_sound_ogg,
zgl_utils,
{$ELSE}
zglHeader,
{$ENDIF}
zgl_types,
LCLType;
type
{ TForm1 }
TForm1 = class(TForm)
Timer1: TTimer;
procedure FormActivate(Sender: TObject);
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure FormDeactivate(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure Timer1Timer(Sender: TObject);
private
public
mouseX, mouseY: Integer;
end;
{$IfDef LCLGTK3}
function gdk_x11_window_get_xid(window: PGdkWindow): TXID; cdecl; external LazGtk3_library name 'gdk_x11_window_get_xid';
{$EndIf}
var
Form1: TForm1;
//-----------------------------------------
dirRes : UTF8String {$IFNDEF MACOSX} = '../data/' {$ENDIF};
fntMain : Integer;
MyIcon : array[ 0..1 ] of Cardinal;
sound, audio : zglPSound;
audioPlay : Boolean = false;
state : Integer;
text : UTF8String;
textX : Single;
textY : Single;
r : zglTRect2D;
p : Integer;
r1, r2 : zglTRect2D;
// добавляем номер звука, пока для одного звука
IDSound: array[0..1] of Integer;
joyCount : Integer;
// для возможности изменения экрана
ScreenWidth : integer = 800;
ScreenHeight : integer = 600;
//------------------------------------------
implementation
{$R *.lfm}
// RU: Т.к. звуковая подсистема нацелена на 3D, для позиционирования звуков в 2D нужны некоторые ухищрения.
// EN: Because sound subsystem using 3D, there is some tricky way to calculate sound position in 2D.
function CalcX2D( const X : Single ) : Single;
begin
Result := ( X - ScreenWidth / 2 ) * ( 5 / ScreenHeight / 2 );
end;
function CalcY2D( const Y : Single ) : Single;
begin
Result := ( Y - ScreenWidth / 2 ) * ( 5 / ScreenHeight / 2 );
end;
procedure Draw;
begin
setFontSize(20, fntMain);
text_Draw( fntMain, 0, 0, 'Escape - Exit' );
// RU: Координаты мыши можно получить при помощи функций mouse_X и mouse_Y.
// EN: Mouse coordinates can be got using functions mouse_X and mouse_Y.
text_Draw( fntMain, 0, 18, 'Mouse X, Y: ' + u_IntToStr( Form1.mouseX ) + '; ' + u_IntToStr( Form1.mouseY ) );
ssprite2d_Draw(MyIcon[ state ], r1, 0);
text_Draw(fntMain, textX, textY, text);
if col2d_PointInRect( Form1.mouseX, Form1.mouseY, r ) Then
begin
fx_SetBlendMode( FX_BLEND_ADD );
ssprite2d_Draw(MyIcon[state], r2, 0, 155);
fx_SetBlendMode( FX_BLEND_NORMAL );
end;
Application.ProcessMessages;
end;
procedure Init;
begin
wnd_SetSize( Form1.ClientWidth, Form1.ClientHeight );
// RU: Инициализируем звуковую подсистему. Для Windows можно сделать выбор между DirectSound и OpenAL отредактировав файл zgl_config.cfg.
// EN: Initializing sound subsystem. For Windows can be used DirectSound or OpenAL, see zgl_config.cfg.
snd_Init();
// RU: Инициализируем обработку ввода джойстиков и получаем количество подключенных джойстиков.
// EN: Initialize processing joystick input and get count of plugged joysticks.
joyCount := joy_Init();
// RU: Загружаем текстуры, которые будут индикаторами.
// EN: Load the textures, that will be indicators.
MyIcon[ 0 ] := tex_LoadFromFile( dirRes + 'audio-stop.png' );
MyIcon[ 1 ] := tex_LoadFromFile( dirRes + 'audio-play.png' );
fntMain := font_LoadFromFile( dirRes + 'font.zfi' );
// RU: Загружаем звуковой файл и устанавливаем для него максимальноe количество проигрываемых источников в 2.
// EN: Load the sound file and set maximum count of sources that can be played to 2.
sound := snd_LoadFromFile( dirRes + 'click.wav', 2 );
audio := snd_LoadFromFile(dirRes + 'music.ogg', 2);
r1.X := ( ScreenWidth - 128 ) / 2; r1.Y := ( ScreenHeight - 128 ) / 2;
r1.W := 128; r1.H := 128;
r2.X := ( ScreenWidth - 132 ) / 2; r2.Y := ( ScreenHeight - 132 ) / 2;
r2.W := 132; r2.H := 132;
scr_SetClearColor($7090af);
text := 'Skillet - Comatose - Whispers In The Dark';
textX := zgl_Get(WINDOW_WIDTH) / 2 - text_GetWidth(fntMain, text) / 2;
textY := zgl_get(WINDOW_HEIGHT) / 2 + 64;
end;
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
{$IFNDEF USE_ZENGL_STATIC}
if not zglLoad( libZenGL ) then
begin
Application.Terminate;
Exit;
end;
{$ENDIF}
// RU: вариант для неизменного окна или выбирайте нужный вариант в настройках формы.
// EN: option for a fixed window or select the desired option in the form settings.
// Form1.BorderStyle := bsSingle;
end;
procedure TForm1.FormDeactivate(Sender: TObject);
begin
Timer1.Enabled := false;
end;
// закрываем форму
procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
Timer1.Enabled := false;
zgl_Exit;
{$IFNDEF USE_ZENGL_STATIC}
zglFree;
{$EndIf}
Application.Terminate;
end;
procedure TForm1.FormActivate(Sender: TObject);
{$IFDEF LINUX}
var
widget : PGtkWidget;
{$ENDIF}
begin
Timer1.Enabled := False;
// Rus: если инициализации ещё не было, то производим инициализацию окна.
// Eng: if initialization has not yet taken place, then we initialize the window.
if zgl_Get(APP_INITED_TO_HANDLE) = 0 then
begin
// Производим инициализацию -------------------------------------------
// RU: Вертикальная синхронизация поможет избежать загрузки процессора.
// EN: Vertical synchronization will decrease a CPU loading.
zgl_SetParam(Form1.ClientWidth, Form1.ClientHeight, False, True);
// RU: Перед стартом необходимо настроить viewport.
// EN: Before the start need to configure a viewport.
wnd_SetPos( Form1.Left, Form1.Top );
// wnd_SetSize( Form1.ClientWidth, Form1.ClientHeight );
Form1.BringToFront();
r.X := ( Form1.ClientWidth - 128 ) / 2;
r.Y := ( Form1.ClientHeight - 128 ) / 2;
r.W := 128;
r.H := 128;
//------------------------------------------------------------
zgl_Reg(SYS_LOAD, @Init);
zgl_Reg( SYS_DRAW, @Draw );
{$IFDEF LINUX}
{$IFDEF LCLGTK2}
widget := GetFixedWidget( PGtkWidget( Handle ) );
gtk_widget_realize( widget );
if not zgl_InitToHandle( GDK_WINDOW_XID( widget^.window ) ) then
begin
Application.Terminate;
Exit;
end;
{$ENDIF}
{$IfDef LCLGTK3}
widget := TGtk3Window(Handle).GetContainerWidget;
//gtk_widget_realize( widget ); // это нужно здесь???
if not zgl_InitToHandle( gdk_x11_window_get_xid( widget^.window ) ) then
begin
Application.Terminate;
Exit;
end;
{$EndIf}
{$ENDIF}
{$IFDEF WINDOWS}
if not zgl_InitToHandle( Handle ) then
begin
Application.Terminate;
Exit;
end;
{$ENDIF}
end;
// RU: таймер должен быть изначально выключен! Включаем таймер только когда окно инициализировано.
// EN: the timer must be initially turned off! We turn on the timer only when the window is initialized.
Timer1.Enabled := True;
end;
// RU: проверка нажатия клавиши.
// EN: keypress check.
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
if Key = 27 then
Form1.Close;
end;
// RU: обработка мыши и проигрывание музыки.
// EN: mouse handling and music playback.
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Timer1.Enabled := false;
if Button = mbLeft then
begin
mouseX := X;
mouseY := Y;
// RU: В данном случае мы начинаем воспроизводить звук сразу в указанных координатах, но их можно менять и в процессе используя процедуру snd_SetPos.
// Важно: Для OpenAL можно позиционировать только mono-звуки.
//
// EN: In this case, we begin to play the sound directly in these coordinates, but they can be changed later using procedure snd_SetPos.
// Important: OpenAL can position only mono-sounds.
// !!! -------------------------------------------------------------------------
// RU: эта часть изменена!!! Теперь можно заново воспроизводить звуки, даже если они не закончили играть.
// EN: this part has changed! Sounds can now be replayed even if they haven't finished playing.
if snd_Get(sound, IDSound[0], SND_STATE_PLAYING) = IDSound[0] then
snd_Stop(sound, IDSound[0]);
IDSound[0] := snd_Play(sound, FALSE, CalcX2D(X), CalcY2D(Y));
// !!! -------------------------------------------------------------------------
// RU: добавляем проверку на проигрывание звука, только если много разных звуков/музыки, то номера надо менять (не только 1!!!).
// EN: we add a check for sound playback, only if there are many different sounds / music, then the numbers must be changed (not only 1 !!!).
if col2d_PointInRect(X, Y, r) Then
begin
if audioPlay then
snd_Stop(audio, IDSound[1])
else
IDSound[1] := snd_Play(audio, False);
audioPlay := not audioPlay;
end;
end;
Timer1.Enabled := true;
end;
// RU: для примера использования перемещения мышки.
// EN: for an example of using mouse movement.
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
// RU: это пример если вы создаёте корректированное окно для LCL.
// EN: This is an example if you are creating an adjusted window for LCL.
mouseX := X;
mouseY := Y;
app_MouseProc(mouseX, mouseY);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled := False;
app_MainLoopHandle;
// RU: Проверяем играет ли музыка(1 - играет, 0 - не играет). Так же можно проверить и звуки - подставив zglPSound и ID вот так:
// snd_Get( Sound, ID...
// ID возвращается функцией snd_Play.
//
// EN: Check if music playing(1 - playing, 0 - not playing). Sounds also can be checked this way - just use zglPSound and ID:
// snd_Get( Sound, ID...
// ID returns by function snd_Play.
state := snd_Get( audio, IDSound[1], SND_STATE_PLAYING );
if state = 0 Then
audioPlay := False;
// RU: Получаем в процентах позицию проигрывания аудиопотока и ставим громкость для плавных переходов.
// EN: Get position in percent's for audio stream and set volume for smooth playing.
p := snd_Get( audio, IDSound[1], SND_STATE_PERCENT );
if ( p >= 0 ) and ( p < 25 ) Then
snd_SetVolume(audio, IDSound[1], ( 1 / 24 ) * p );
if ( p >= 75 ) and ( p < 100 ) Then
snd_SetVolume(audio, IDSound[1], 1 - ( 1 / 24 ) * ( p - 75 ) );
Timer1.Enabled := True;
end;
end.
Recent
