program ForestQuest;
{$apptype GUI}
uses
SysUtils, Classes,
CastleWindow, CastleVectors, CastleColors, CastleUIControls, CastleControls,
CastleScene, CastleTransform, CastleViewport, CastleCameras, CastlePrimitives,
CastleApplicationProperties, CastleKeysMouse, CastleLog, CastleFonts;
type
TGameState = (gsNone, gsQuestOffered, gsQuestAccepted, gsAppleCollected, gsQuestComplete);
var
Window: TCastleWindowBase;
Viewport: TCastleViewport;
Root: TCastleRootTransform;
// Monde
Camera: TCastleCamera;
Ground: TCastleScene;
TreesParent: TCastleTransform;
// Objets
AppleScene: TCastleScene;
NpcBillboard: TCastleTransform;
// UI
LabelInfo: TCastleLabel;
// Quête
GameState: TGameState = gsNone;
HasApple: Boolean = False;
procedure UpdateUI;
begin
case GameState of
gsNone:
LabelInfo.Caption := 'Approche le PNJ pour parler.';
gsQuestOffered:
LabelInfo.Caption := 'PNJ: Salut! Peux-tu me rapporter une pomme de la forêt? [E: accepter / Echapp: refuser]';
gsQuestAccepted:
if HasApple then
LabelInfo.Caption := 'Tu as la pomme! Retourne voir le PNJ. [E: remettre]'
else
LabelInfo.Caption := 'Quête: Trouver une pomme dans la forêt.';
gsAppleCollected:
LabelInfo.Caption := 'Tu as ramassé une pomme. Retourne voir le PNJ. [E: remettre]';
gsQuestComplete:
LabelInfo.Caption := 'Merci! Quête terminée.';
end;
end;
function MakeTree(const Pos: TVector3; const Height: Single = 4.0): TCastleTransform;
var
Trunk, Crown: TCastleScene;
begin
Result := TCastleTransform.Create(nil);
// Tronc (cylindre)
Trunk := TCastleScene.Create(nil);
Trunk.Load(CreateCylinder(0.25, Height, 16, true));
Trunk.Color := Vector4(0.5, 0.3, 0.1, 1.0);
Trunk.Translation := Vector3(0, Height * 0.5, 0);
// Feuillage (sphère)
Crown := TCastleScene.Create(nil);
Crown.Load(CreateSphere(1.2, 24, 24));
Crown.Color := Vector4(0.1, 0.6, 0.2, 1.0);
Crown.Translation := Vector3(0, Height + 1.0, 0);
Result.Add(Trunk);
Result.Add(Crown);
Result.Translation := Pos;
end;
function MakeApple(const Pos: TVector3): TCastleScene;
begin
Result := TCastleScene.Create(nil);
Result.Load(CreateSphere(0.3, 24, 24));
Result.Color := Vector4(0.9, 0.1, 0.1, 1.0);
Result.Translation := Pos;
Result.Exists := true;
end;
function MakeNPC(const Pos: TVector3): TCastleTransform;
var
Body: TCastleScene;
NameLabel: TCastleScene;
begin
Result := TCastleTransform.Create(nil);
// Corps simple (capsule)
Body := TCastleScene.Create(nil);
Body.Load(CreateCylinder(0.4, 1.6, 24, true));
Body.Color := Vector4(0.8, 0.8, 1.0, 1.0);
Body.Translation := Vector3(0, 0.8, 0);
Result.Add(Body);
// “Panneau” au-dessus (petite boîte)
NameLabel := TCastleScene.Create(nil);
NameLabel.Load(CreateBox(Vector3(-0.6, 2.2, -0.05), Vector3(0.6, 2.5, 0.05)));
NameLabel.Color := Vector4(1.0, 1.0, 0.6, 1.0);
Result.Add(NameLabel);
Result.Translation := Pos;
end;
procedure CreateGround;
begin
Ground := TCastleScene.Create(nil);
Ground.Load(CreateBox(Vector3(-50, 0, -50), Vector3(50, 0.2, 50)));
Ground.Color := Vector4(0.4, 0.7, 0.3, 1.0);
Ground.Pickable := false;
Root.Add(Ground);
end;
procedure PopulateForest;
var
i: Integer;
pos: TVector3;
begin
TreesParent := TCastleTransform.Create(nil);
for i := 0 to 24 do
begin
pos := Vector3(Random * 40 - 20, 0, Random * 40 - 20);
TreesParent.Add(MakeTree(pos, 3.5 + Random));
end;
Root.Add(TreesParent);
end;
procedure StartQuestOffer;
begin
if GameState = gsNone then
begin
GameState := gsQuestOffered;
UpdateUI;
end;
end;
procedure AcceptQuest;
begin
if GameState = gsQuestOffered then
begin
GameState := gsQuestAccepted;
UpdateUI;
end;
end;
procedure RefuseQuest;
begin
if GameState = gsQuestOffered then
begin
GameState := gsNone;
UpdateUI;
end;
end;
procedure GiveAppleToNPC;
begin
if (GameState in [gsQuestAccepted, gsAppleCollected]) and HasApple then
begin
GameState := gsQuestComplete;
UpdateUI;
end;
end;
function Distance2D(const A, B: TVector3): Single;
var
d: TVector2;
begin
d := Vector2(A.X - B.X, A.Z - B.Z);
Result := Sqrt(Sqr(d.X) + Sqr(d.Y));
end;
procedure OnUpdate(Container: TCastleContainer);
begin
// Ramassage de la pomme si proche
if (AppleScene <> nil) and AppleScene.Exists then
begin
if Distance2D(Camera.Translation, AppleScene.Translation) < 1.0 then
begin
HasApple := true;
AppleScene.Exists := false;
GameState := gsAppleCollected;
UpdateUI;
end;
end;
// Afficher un petit prompt près du PNJ si proche
if (NpcBillboard <> nil) then
begin
if Distance2D(Camera.Translation, NpcBillboard.Translation) < 2.0 then
begin
if GameState = gsNone then
LabelInfo.Caption := 'Appuie sur E pour parler au PNJ.'
else
UpdateUI;
end;
end;
end;
procedure OnPress(Container: TCastleContainer; const Event: TInputPressRelease);
begin
// E = interagir
if Event.IsKey(keyE) then
begin
// Interaction avec PNJ si proche
if (NpcBillboard <> nil) and (Distance2D(Camera.Translation, NpcBillboard.Translation) < 2.2) then
begin
case GameState of
gsNone: StartQuestOffer;
gsQuestOffered: AcceptQuest;
gsQuestAccepted, gsAppleCollected:
if HasApple then
GiveAppleToNPC;
end;
end;
end;
// Echap = refuser la quête à l'offre
if Event.IsKey(keyEscape) then
RefuseQuest;
// Déplacement simple caméra (ZQSD/wasd)
if Event.IsKey(keyW) or Event.IsKey(keyUp) then
Camera.Translation := Camera.Translation + Vector3(0, 0, -0.5);
if Event.IsKey(keyS) or Event.IsKey(keyDown) then
Camera.Translation := Camera.Translation + Vector3(0, 0, 0.5);
if Event.IsKey(keyA) or Event.IsKey(keyLeft) then
Camera.Translation := Camera.Translation + Vector3(-0.5, 0, 0);
if Event.IsKey(keyD) or Event.IsKey(keyRight) then
Camera.Translation := Camera.Translation + Vector3(0.5, 0, 0);
end;
procedure Initialize;
begin
ApplicationProperties.OnInitialize := nil;
Window := TCastleWindowBase.Create(nil);
Window.Width := 1280;
Window.Height := 720;
Window.Caption := 'Forêt + PNJ + Quête (CGE/Pascal)';
Viewport := TCastleViewport.Create(Window);
Viewport.FullSize := true;
Root := TCastleRootTransform.Create(Window);
Viewport.Items := Root;
Viewport.AutoCamera := false;
Viewport.AutoNavigation := false;
// Caméra
Camera := TCastleCamera.Create(Window);
Camera.Translation := Vector3(0, 1.6, 10);
Camera.Direction := Vector3(0, 0, -1);
Viewport.Camera := Camera;
// Sol + arbres
CreateGround;
PopulateForest;
// Pomme
AppleScene := MakeApple(Vector3(5, 0.3, -6));
Root.Add(AppleScene);
// PNJ
NpcBillboard := MakeNPC(Vector3(0, 0, 0));
Root.Add(NpcBillboard);
// UI
LabelInfo := TCastleLabel.Create(Window);
LabelInfo.Color := Yellow;
LabelInfo.Anchor(vpTop);
LabelInfo.Padding := 10;
LabelInfo.AutoSize := true;
LabelInfo.Caption := 'Approche le PNJ pour parler.';
Window.Controls.InsertFront(Viewport);
Window.Controls.InsertFront(LabelInfo);
// Events
Window.OnUpdate := @OnUpdate;
Window.OnPress := @OnPress;
Window.Open;
end;
begin
Initialize;
Application.Run;
end.
this is a code IA made for me in my site, now only for registration mmembers only, and we can will save the file in txt, or in the future test in html window