unit Unit1;

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, ExtCtrls, StdCtrls, ImgList, MMSystem;

TForm1 = class(TForm)

Image1: TImage;

Render: TTimer;

WrdRs: TImageList;

Player: TImageList;

Move: TTimer;

Water: TImageList;

DbgInfo: TTimer;

procedure FormCreate(Sender: TObject);

procedure FormKeyDown(Sender: TObject; var Key: Word;

Shift: TShiftState);

procedure RenderTimer(Sender: TObject);

procedure MoveTimer(Sender: TObject);

procedure FormKeyUp(Sender: TObject; var Key: Word;

Shift: TShiftState);

procedure DbgInfoTimer(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

LvlWdt=10;

LvlHdt=7;

PxlSz=32;

Form1: TForm1;

//Êîîðäèíàòû èãðîêà íà êàðòå

PX, PY: integer;

//Êîîðäèíàòû êàìåðû

CMR: integer=0;

CMB: integer=0;

//Èíäåêñ ìàòåðèàëà äëÿ ñîçäàíèÿ

Mtrl: integer=0;

//Âçãëÿä èãðîêà

SeeDRT: integer=3;

//Äâèæåíèå

MoveL, MoveR, MoveU, MoveD: boolean;

//Óðîâåíü

LvlDsn: array of array of string;

//Actn - îòîðáðàæåíèå óâåäîìëåíèÿ "Èñïîëüçîâàòü"

SVMapT, DLG, Actn: boolean;

TmOut: integer=30;

//Àíèìàöèÿ âîäû

WtrC: integer=0;

DLGL: TStringList;

DLGC: integer=0;

fps: integer=0;

//MapL - íàçâàíèå ôàéëà çàãðóæåííîé êàðòû

ResH, MapL: string;

procedure LDMap(MapN:string);

WdtAr, HdtAr: integer; s: string; f: TextFile;

WdtAr:=-1;

HdtAr:=-1;

MapL:=MapN;

AssignFile(f, MapN);

Reset(f);

while not Eof(f) do begin

ReadLn(f,s);

if trim(s)<>'' then begin

inc(HdtAr);

SetLength(LvlDsn,HdtAr+1);

while pos(';',s)>0 do begin

inc(WdtAr);

SetLength(LvlDsn[HdtAr],WdtAr+1);

LvlDsn[HdtAr,WdtAr]:=copy(s,1,pos(';',s)-1);

delete(s,1,pos(';',s));

end;

WdtAr:=-1;

end;

end;

CloseFile(f);

Form1.Render.Enabled:=true;

Form1.Move.Enabled:=true;

end;

procedure TForm1.FormCreate(Sender: TObject);

//Ðåñóðñû èãðîêà

ResH:='';

LDMap('map.txt');

//Randomize;

//DoubleBuffered:=true;

//Ðàçìåð

Image1.Width:=(LvlWdt+1)*PxlSz;

Image1.Height:=(LvlHdt+1)*PxlSz;

Form1.ClientWidth:=(LvlWdt+1)*PxlSz;

Form1.ClientHeight:=(LvlHdt+1)*PxlSz;

//Êîîðäèíàòû èãðîêà

PY:=3;

PX:=5;

//mciSendString('play Overworld_Day.wav',nil,0,0);

end;

function TextDraw(text: string): boolean; //Âûâîä òåêñòà

Form1.Image1.Canvas.Brush.Color:=clGray;

Form1.Image1.Canvas.Rectangle(Form1.Image1.Width div 2 - Form1.Image1.Canvas.TextWidth(text) div 2 - 7,Form1.Image1.Height - Form1.Image1.Canvas.TextHeight(text)-17,Form1.Image1.Width div 2 + Form1.Image1.Canvas.TextWidth(text) div 2 + 10,Form1.Image1.Height - Form1.Image1.Canvas.TextHeight(text)+11);

Form1.Image1.Canvas.Font.Color:=clWhite;

Form1.Image1.Canvas.TextOut(Form1.Image1.Width div 2 - Form1.Image1.Canvas.TextWidth(text) div 2,Form1.Image1.Height - Form1.Image1.Canvas.TextHeight(text)-10,text);

//Form1.Image1.Canvas.Font.Color:=clWhite;

//Form1.Image1.Canvas.TextOut(Form1.Image1.Width div 2 - Form1.Image1.Canvas.TextWidth(text) div 2 + 1,Form1.Image1.Height - Form1.Image1.Canvas.TextHeight(text)-11,text);

end;

function ChkEdt(Y, X: integer): boolean; //Ïðîâåðêà íà âîçìîæíîñòü ðåäàêòèðîâàíèÿ áëîêà

result:=true;

if Y<0 then result:=false;

if X<0 then result:=false;

if X>Length(LvlDsn[0])-1 then result:=false;

if Y>Length(LvlDsn)-1 then result:=false;

end;

function ChkMv(Y, X: integer):boolean; //Ïðîâåðêà ÿ÷ååê íà âîçìîæíîñòü õîäèòü ïî íèì, à òàêæå òðèããåðû

TGRT: string;

result:=false;

if (Y<0) or (X<0) or (X>Length(LvlDsn[0])-1) or (Y>Length(LvlDsn)-1) then begin result:=false; exit; end;

if (LvlDsn[Y,X]='OBJ:0') or (LvlDsn[Y,X]='OBJ:2') or (LvlDsn[Y,X]='OBJ:12') or (LvlDsn[Y,X]='OBJ:13')

or (LvlDsn[Y,X]='OBJ:38') or (LvlDsn[Y,X]='OBJ:41') or (LvlDsn[Y,X]='OBJ:42') or (LvlDsn[Y,X]='OBJ:54')

or (LvlDsn[Y,X]='OBJ:55') then result:=true;

if copy(LvlDsn[Y,X],1,4)='TGR:' then begin //Òðèããåðû

TGRT:=copy(LvlDsn[Y,X],pos('TGR:',LvlDsn[Y,X])+4,length(LvlDsn[Y,X])-pos('TGR:',LvlDsn[Y,X])-3);

//Îòêëþ÷àåì äâèæåíèå

MoveL:=false;

MoveR:=false;

MoveU:=false;

MoveD:=false;

//Äèàëîãè

if pos('&DLG',TGRT)>0 then begin

DLGL:=TStringList.Create;

DLG:=true;

DLGL.Text:=StringReplace(TGRT,'<BR>',#13#10,[rfReplaceAll]);

DLGL.Delete(0);

//ShowMessage(DLGL.Text);

end;

//Íàéäåííûå ïðåäìåòû

if pos('&RES',TGRT)>0 then begin

ResH:=ResH+copy(TGRT,pos('&RES ',TGRT)+5,Length(TGRT)-pos('&RES ',TGRT)-4);

//LvlDsn[Y,X]:='OBJ:'+copy(TGRT,1,pos('&',TGRT)-1);

LvlDsn[Y,X]:='OBJ:1';

DLGL:=TStringList.Create;

DLG:=true;

DLGL.Text:='Ïîäîáðàí '+copy(TGRT,pos('&RES ',TGRT)+5,Length(TGRT)-pos('&RES ',TGRT)-4);

end;

//Çàêðûòûå äâåðè

if pos('&DOOR',TGRT)>0 then

if pos(copy(TGRT,pos('&DOOR ',TGRT)+6,Length(TGRT)-pos('&DOOR ',TGRT)-5),ResH)>0 then begin

LvlDsn[Y,X]:='OBJ:'+copy(TGRT,1,pos('&',TGRT)-1);

DLGL:=TStringList.Create;

DLG:=true;

DLGL.Text:='Äâåðü îòêðûòà ñ ïîìîùüþ '+copy(TGRT,pos('&DOOR ',TGRT)+6,Length(TGRT)-pos('&DOOR ',TGRT)-5);

end else begin

DLGL:=TStringList.Create;

DLG:=true;

DLGL.Text:='Äâåðü çàêðûòà, íåîáõîäèì '+copy(TGRT,pos('&DOOR ',TGRT)+6,Length(TGRT)-pos('&DOOR ',TGRT)-5);

end;

if pos('&LDMAP',TGRT)>0 then begin

Form1.Move.Enabled:=false;

Form1.Render.Enabled:=false;

PY:=1;

PX:=1;

CMR:=-4;

CMB:=-2;

LDMap(copy(TGRT,pos('&LDMAP ',TGRT)+7,Length(TGRT)-pos('&LDMAP ',TGRT)-6));

end;

//Òðèããåðû

end;

end;

procedure SvMap(MapN:string);

i, j: integer; s: string; f: TStringList;

for i:=0 to Length(LvlDsn)-1 do begin

for j:=0 to Length(LvlDsn[0])-1 do

s:=s+LvlDsn[i,j]+';';

s:=s+#13#10;

end;

f:=TStringList.Create;

f.Text:=s;

f.SaveToFile(MapN);

f.Free;

SvMapT:=true;

end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;

Shift: TShiftState);

//Äâèæåíèå ïåðñîíàæà

if Key=ord('A') then MoveL:=true;

if Key=ord('D') then MoveR:=true;

if Key=ord('W') then MoveU:=true;

if Key=ord('S') then MoveD:=true;

//Ïåðåéòè ê ñëåäóþùåìó ôðàçå äèàëîãà èëè çàêðûòü åãî

if DLG then if Key=13 then if DLGC<DLGL.Count-1 then inc(DLGC) else begin DLG:=false; DLGC:=0; DLGL.Free; end;

//Ñîçäàíèå áëîêà

if Key=ord('U') then begin

case SeeDRT of

1: if ChkEdt(PY,PX-1) then LvlDsn[PY,PX-1]:='OBJ:'+IntToStr(Mtrl);

2: if ChkEdt(PY,PX+1) then LvlDsn[PY,PX+1]:='OBJ:'+IntToStr(Mtrl);

3: if ChkEdt(PY-1,PX) then LvlDsn[PY-1,PX]:='OBJ:'+IntToStr(Mtrl);

0: if ChkEdt(PY+1,PX) then LvlDsn[PY+1,PX]:='OBJ:'+IntToStr(Mtrl);

end;

PlaySound('wood2.wav', 0, SND_ASYNC);

end;

//Ìàòåðèàëû

if Key=ord('H') then if Mtrl>0 then dec(Mtrl);

if Key=ord('K') then if Mtrl<71 then inc(Mtrl);

if Key=ord('J') then Mtrl:=0;

if Key=ord('I') then Mtrl:=StrToInt(InputBox('Ìàòåðèàë', 'Íîìåð ìàòåðèàëà', '0'));

//Ñîçäàíèå è ðåäàêòèðîâàíèå òðèããåðà

if Key=ord('T') then

case SeeDRT of

1: if ChkEdt(PY,PX-1) then LvlDsn[PY,PX-1]:=InputBox('Ñîçäàíèå òðèããåðà', 'Äåéñòâèå òðèããåðà', LvlDsn[PY,PX-1]);

2: if ChkEdt(PY,PX+1) then LvlDsn[PY,PX+1]:=InputBox('Ñîçäàíèå òðèããåðà', 'Äåéñòâèå òðèããåðà', LvlDsn[PY,PX+1]);

3: if ChkEdt(PY-1,PX) then LvlDsn[PY-1,PX]:=InputBox('Ñîçäàíèå òðèããåðà', 'Äåéñòâèå òðèããåðà', LvlDsn[PY-1,PX]);

0: if ChkEdt(PY+1,PX) then LvlDsn[PY+1,PX]:=InputBox('Ñîçäàíèå òðèããåðà', 'Äåéñòâèå òðèããåðà', LvlDsn[PY+1,PX]);

end;

//Âêëþ÷èòü èëè îòêëþ÷èòü ïîêàç îòëàäî÷íîé èíôîðìàöèè

if Key=ord('P') then if DbgInfo.Enabled then begin Caption:='Vris Engine'; DbgInfo.Enabled:=false; end else DbgInfo.Enabled:=true;

//Ñîõðàíåíèå êàðòû

if Key=VK_F5 then SVMap(MapL);

end;

procedure TForm1.RenderTimer(Sender: TObject);

i, j: integer; OBJT: string;

inc(fps);

Image1.Canvas.Brush.Color:=clBlack;

//Î÷èùàåì ïðåäûäóùóþ ñöåíó

Image1.Canvas.FillRect(Rect(0,0,(LvlWdt+1)*PxlSz,(LvlHdt+1)*PxlSz));

for i:=CMB to (LvlHdt+1)+CMB do

for j:=CMR to (LvlWdt+1)+CMR do begin

//Îòðèñîâûâàåì òîëüêî çàãðóæåííûå ÿ÷åéêè

if (i>-1) and (j>-1) and (j<Length(LvlDsn[0])) and (i<Length(LvlDsn)) then begin

//Îòðèñîâêà îáúåêòîâ

if copy(LvlDsn[i,j],1,4)='OBJ:' then begin

OBJT:=copy(LvlDsn[i,j],pos('OBJ:',LvlDsn[i,j])+4,length(LvlDsn[i,j])-pos('OBJ:',LvlDsn[i,j])-3);

WrdRs.Draw(Image1.Canvas,(j-CMR)*PxlSz,(i-CMB)*PxlSz,StrToInt(OBJT));

end;

//Îòðèñîâêà òðèããåðîâ

if copy(LvlDsn[i,j],1,4)='TGR:' then begin

OBJT:=copy(LvlDsn[i,j],pos('TGR:',LvlDsn[i,j])+4,length(LvlDsn[i,j])-pos('OBJ:',LvlDsn[i,j])-3);

if pos('&',OBJT)>0 then OBJT:=copy(OBJT,1,pos('&',OBJT)-1);

WrdRs.Draw(Image1.Canvas,(j-CMR)*PxlSz,(i-CMB)*PxlSz,StrToInt(OBJT));

end;

//Âîäà c àíèìàöèåé

//if LvlDsn[i,j]=25 then Water.Draw(Image1.Canvas,(j-CMR)*PxlSz,(i-CMB)*PxlSz,WtrC);

{if LvlDsn[i,j]=0 then begin

end;

end;

//Àíèìàöèÿ âîäû

//if WtrC=31 then WtrC:=0 else inc(WtrC);

//Îòðèñîâêà èãðîêà

Player.Draw(Image1.Canvas,(PX-CMR)*PxlSz,(PY-CMB)*PxlSz,SeeDRT);

//Ðàçðåøåíèå èãðû

Image1.Canvas.Brush.Style:=bsClear;

Image1.Canvas.Font.Color:=clGray;

Image1.Canvas.TextOut(6,6,IntToStr(Image1.Width)+'x'+IntToStr(Image1.Height));

Image1.Canvas.Font.Color:=clWhite;

Image1.Canvas.TextOut(5,5,IntToStr(Image1.Width)+'x'+IntToStr(Image1.Height));

//Óâåäîìëåíèå î ñîõðàíåíèè

if SVMapT then if TmOut>0 then begin

dec(TmOut);

Image1.Canvas.Font.Color:=clGray;

Image1.Canvas.TextOut(6,20,'Êàðòà ñîõðàíåíà');

Image1.Canvas.Font.Color:=clWhite;

Image1.Canvas.TextOut(5,19,'Êàðòà ñîõðàíåíà');

end else begin TmOut:=30; SVMapT:=false; end;

//Ïðîâåðêà òðèããåðû è îòðèñîâêà äèàëîãîâ

if DLG then TextDraw(DLGL.Strings[DLGC]) else

case SeeDRT of

1: if ChkEdt(PY,PX-1) then if copy(LvlDsn[PY,PX-1],1,4)='TGR:' then TextDraw('Íàæìèòå âëåâî, ÷òîáû èñïîëüçîâàòü');

2: if ChkEdt(PY,PX+1) then if copy(LvlDsn[PY,PX+1],1,4)='TGR:' then TextDraw('Íàæìèòå âïðàâî, ÷òîáû èñïîëüçîâàòü');

3: if ChkEdt(PY-1,PX) then if copy(LvlDsn[PY-1,PX],1,4)='TGR:' then TextDraw('Íàæìèòå ââåðõ, ÷òîáû èñïîëüçîâàòü');

0: if ChkEdt(PY+1,PX) then if copy(LvlDsn[PY+1,PX],1,4)='TGR:' then TextDraw('Íàæìèòå âíèç, ÷òîáû èñïîëüçîâàòü');

end;

//HUD

Image1.Canvas.Brush.Color:=clGray;

Image1.Canvas.Rectangle(5,35,45,75);

WrdRs.Draw(Image1.Canvas,9,39,Mtrl);

end;

procedure TForm1.MoveTimer(Sender: TObject);

//Äâèøåíèå äîñòóïíî òîëüêî âíå äèàëîãîâ

if DLG=false then begin

//Äâèæåíèå

if MoveL then begin if ChkMv(PY,PX-1) then if SeeDRT=1 then begin dec(PX); dec(CMR); end; SeeDRT:=1; end;

if MoveR then begin if ChkMv(PY,PX+1) then if SeeDRT=2 then begin inc(PX); inc(CMR); end; SeeDRT:=2; end;

if MoveU then begin if ChkMv(PY-1,PX) then if SeeDRT=3 then begin dec(PY); dec(CMB); end; SeeDRT:=3; end;

if MoveD then begin if ChkMv(PY+1,PX) then if SeeDRT=0 then begin inc(PY); inc(CMB); end; SeeDRT:=0; end;

end;

end;

procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word;

Shift: TShiftState);

if (MoveL=true) or (MoveR=true) or (MoveU=true) or (MoveD=true) then begin

PlaySound('wood2_.wav', 0, SND_ASYNC);

//if LvlDsn[PY,PX]=320 then PlaySound('door_open.wav', 0, SND_ASYNC);

end;

//Ïðè îòïóñêàíèè êëàâèø ïåðåñòàâàòü äâèãàòñÿ

if Key=ord('A') then MoveL:=false;

if Key=ord('D') then MoveR:=false;

if Key=ord('W') then MoveU:=false;

if Key=ord('S') then MoveD:=false;

end;

procedure TForm1.DbgInfoTimer(Sender: TObject);

//Îòëàäî÷íàÿ èíôîðìàöèÿ

case SeeDRT of

1: if ChkEdt(PY,PX-1) then Caption:='FPS='+IntToStr(fps)+' X='+IntToStr(PX) + ' Y='+IntToStr(PY)+' CX='+IntToStr(CMR)+' CY='+IntToStr(CMB)+' ResSee='+LvlDsn[PY,PX-1];

2: if ChkEdt(PY,PX+1) then Caption:='FPS='+IntToStr(fps)+' X='+IntToStr(PX) + ' Y='+IntToStr(PY)+' CX='+IntToStr(CMR)+' CY='+IntToStr(CMB)+' ResSee='+LvlDsn[PY,PX+1];

3: if ChkEdt(PY-1,PX) then Caption:='FPS='+IntToStr(fps)+' X='+IntToStr(PX) + ' Y='+IntToStr(PY)+' CX='+IntToStr(CMR)+' CY='+IntToStr(CMB)+' ResSee='+LvlDsn[PY-1,PX];

0: if ChkEdt(PY+1,PX) then Caption:='FPS='+IntToStr(fps)+' X='+IntToStr(PX) + ' Y='+IntToStr(PY)+' CX='+IntToStr(CMR)+' CY='+IntToStr(CMB)+' ResSee='+LvlDsn[PY+1,PX];

else Caption:='FPS='+IntToStr(fps)+' X='+IntToStr(PX) + ' Y='+IntToStr(PY)+' CX='+IntToStr(CMR)+' CY='+IntToStr(CMB);

end;

fps:=0;

end;

end.