program gravity7;
// LEM rotates now
// win scenario added
// later versions will attempt to draw the moon surface that enlarges as you get closer
// Keypad ...
// 5 - centers the LEM
// 2 - fires main thrusters (best when upright)
// 1 - right thrusters
// 3 - left thrusters
// Escape aborts the game
// if crashed or landed q/Q quits exits.
uses
windows,ptccrt, // keep this order of units
ptcgraph,sysutils,math;
const
gravitycyclemax = 8000;
thrustCycleMax = 5000;
MaxPoints = 13;
Type
VideoPages = (Page0,Page1);
trect = record
x1,y1,
x2,y2:integer;
end;
TSinglePoint = record
x, y: single;
end;
LemLanderType = record
points:array[0..MaxPoints] of tsinglepoint;
CenterX,
CenterY :single
end;
var
TheLem:LemLanderType;
Page:VideoPages = Page0;
LandingPadRect,
LemRect,
mainrect,inforect:Trect;
ThrustCycle,
gravitycycle:longint;
gdriver,gmode:smallint;
Speed,
Fuel,
SideThruster,
SideThrust,
Inertia,
thrust,
OldXposition,
OldYPosition,
xposition,
yposition,
gravity :single;
OldDegrees,
xpos,ypos:integer;
GoodLanding :boolean = false;
OutOfBounds:boolean = false;
SpeedString:string;
Key:Char;
Procedure SetTRect(Var T:Trect;X,Y,XX,YY:integer);
begin
With T do
begin
X1 := X;
Y1 := Y;
X2 := XX;
Y2 := YY;
end;
end;
Function PositionInRect(PX,PY:Integer;Rect:Trect):boolean;
Begin
PositionInRect := (Px >= Rect.X1) and (Px<=Rect.X2) and
(Py >= Rect.Y1) and (PY<=Rect.Y2);
end;
Function RectInRect(SmallRect,Bigrect:Trect):boolean;
Begin
Result := (SmallRect.x1 >=BigRect.X1) and (SmallRect.Y1 >= BigRect.Y1)
and (SmallRect.X2 <= bigrect.x2) and (SmallRect.Y2 <= BigRect.Y2);
end;
procedure rotatepoint(var P: Tsinglepoint; degrees, centerx, centerY: float);
var
newx, newy, angle: float;
cx, cy, y, x: single;
begin
angle := degTorad(degrees);
cx := centerx;
cy := centery;
x := p.x;
y := p.y;
x := x - cx;
Y := y - cy;
newx := (x * cos(angle)) - (y * sin(angle));
newy := (x * sin(angle)) + (y * cos(angle));
newx := newx + cx;
newy := newy + cy;
p.x := newx;
p.y := newy;
end;
procedure rotatelem(degrees:float);
var
index:integer;
begin
for index := 0 to MaxPoints do
rotatepoint(TheLem.points[index],degrees,TheLem.centerx,TheLem.centery);
end;
Procedure SetLEM2;
begin
with TheLem do
begin
centerx := xpos;
centerY := ypos;
Points[0].X := CenterX-8; Points[0].y := CenterY-8;
Points[1].x := CenterX+8; Points[1].y := CenterY-8; // top line main body
Points[2].x := Points[0].X; Points[2].Y := CenterY+4;
Points[3].x := Points[1].x; Points[3].y := Points[2].y;
// top
points[4].x := centerx-4;points[4].y := centerY-16;
points[5].x := centerx+4;points[5].y := centery-16;
points[6].x := centerx-4; points[6].y := centery-8;
points[7].x := centerx+4; points[7].y := centerY-8;
// legs
// left
points[8].x := centerx; points[8].y := centerY+4;
Points[9].x := centerx-6; Points[9].y := centerY+10;
// right
Points[10].x := CenterX; points[10].y := centerY+4;
Points[11].x := centerX+6;points[11].y := centery+10;
// thruster setup
points[12].x := CenterX; Points[12].y := CenterY+4;
Points[13].x := CenterX; Points[13].y := CenterY+12;
end;
end;
Procedure AdjustLEM;
var
index:integer;
Xc,Yc:Float;
begin
Xc := Xposition-OldXPosition;
Yc := YPosition-OldYPosition;
TheLem.centerX := TheLem.CenterX+XC;
TheLem.CenterY := TheLem.CenterY+YC;
for index := 0 to MaxPoints do
with TheLem do
begin
Points[index].X := Points[index].x+xc;
Points[Index].y := Points[index].y+yc;
end;
end;
Procedure DrawLem2;
begin
AdjustLEM;
SetTrect(LemRect,Xpos-8,ypos-16,xpos+8,ypos+10);
with TheLem do
begin
// main body
Line(round(points[0].x),Round(Points[0].y),round(Points[1].x),Round(Points[1].y));
Line(round(Points[0].x),round(Points[0].y),round(points[2].x),round(points[2].y));
line(round(points[2].x),round(points[2].y),round(points[3].x),round(points[3].y));
line(round(points[1].x),round(points[1].y),round(points[3].x),round(points[3].y));
// top
line(round(points[4].x),round(points[4].y),round(points[6].x),round(points[6].y));
line (round(points[4].x),round(points[4].y),round(points[5].x),round(points[5].y));
line (round(points[5].x),round(points[5].y),round(points[7].x),round(points[7].y));
Line(round(points[8].x),round(points[8].y),round(points[9].x),round(points[9].y));
line(round(points[10].x),round(points[10].y),round(points[11].x),round(points[11].y));
if thrust <> 0 then
line(round(points[12].x),round(points[12].y),round(points[13].x),round(points[13].y));
end;
end;
procedure Nextactivepage;
begin
if page = page0 then page := page1 else page := page0;
SetactivePage(ord(Page));
end;
Procedure NextVisualPage;
begin
SetVisualpage(Ord(Page));
end;
procedure updateinfo;
var
s:string;
begin
setcolor(15);
with inforect do
begin
setviewport(x1+1,y1+1,x2-1,y2-1,false); // info viewport
clearviewport;
str(Fuel:5:2,s);
outtextxy(4,4,'Fuel:'+s);
Speed := abs(gravity)*100;
str(Speed:5:2,s);
OutTextXY(4,12,'Speed:'+s);
end;
setviewport(0,0,getmaxx,getmaxy,true); // full screen
setcolor(14);
with mainrect do
begin
OutTextXY(x2+4,290,'Esc = abort');
OutTextXY(x2+4,302,'2 thrusters');
OutTextXY(x2+4,314,'1 right thrust');
OutTextXY(x2+4,326,'3 left thrust');
OutTextXY(x2+4,338,'5 upright');
end;
setcolor(15);
with mainrect do
begin
rectangle(x1,y1,x2,y2);
setviewport(x1+1,y1+1,x2-1,y2-1,true); // main display
setTrect(LandingPadRect,400,y2-20,425,y2-1);
end;
with landingpadrect do rectangle(x1,y1,x2,y2); // draw landing pad
end;
Procedure Init;
begin
gravitycycle := 0;
xpos := 300;
yposition := 200;
gravity := 0.05;
Inertia := 0.001;
ypos := round(YPosition);
xposition := xpos;
thrust := 0;
thrustcycle := 0;
SideThrust := 0;
Fuel := 2000;
SideThruster:= 0;
OldXposition := Xposition;
OldYPosition := YPosition;
OldDegrees := 0;
end;
begin
gdriver := vesa; // adjust initgraph for your system
Gmode := installusermode(800, 600, 256, 2, 8000, 6000); // two pages
WindowTitle := 'Play test';
initgraph(gdriver, gmode, '');
init;
SetLem2;
DrawLEM2; // draw the lander
OutTextXY(20,220,'2 = thrust; 1 = left side thruster; 3 = right side thruster');
OuttextXY(20,230,'5 straightens LEM');
OutTextXY(20,240,'Press any key to begin');
settRect(MainRect,0,0,getmaxx-120,getmaxy-20);
with Mainrect do
begin
rectangle(x1,y1,x2,y2);
SetTrect(InfoRect,x2+1,y1,getmaxx-1,y1+40);
setTrect(LandingPadRect,400,y2-20,425,y2-1);
end;
updateinfo;
readkey;
repeat
Speed := abs(gravity)*100;
if boolean(GetAsyncKeyState(VK_NUMPAD2)) then
begin
Thrust := -0.01;
thrustcycle := 0;
end;
if boolean(GetAsyncKeyState(VK_NUMPAD5)) then
begin
rotatelem(-OLDDEGREES);
olddegrees := 0;
end;
if boolean(GetAsyncKeyState(VK_NUMPAD1)) then
begin
Thrust := -0.01;
thrustcycle := 0;
SideThrust := sidethrust+inertia;
Sidethruster := sidethrust;
rotatelem(-OldDegrees);
rotatelem(45);
OldDegrees := 45;
end;
if boolean(GetAsyncKeyState(VK_NUMPAD3)) then
begin
thrustcycle := 0;
Thrust := -0.01;
sidethrust := sidethrust-inertia;
sidethruster := sidethrust;
rotatelem(-Olddegrees);
rotatelem(315);
OldDegrees := 315;
end;
gravitycycle := gravitycycle+1; // animation clock
if gravitycycle = gravitycyclemax then
begin
OldXposition := Xposition;
OldYPosition := YPosition;
ypos := round(YPosition);
xpos := round(Xposition);
nextvisualpage;
clearviewport; // clear active page
gravitycycle := 0;
yposition := yposition+gravity;
xposition := xposition+sidethrust;
gravity := gravity+thrust+inertia;
ypos := round(YPosition);
xpos := round(Xposition);
// set new activepage
nextactivepage;
DrawLEM2;
nextvisualpage; // show the lander
Fuel := fuel+(thrust-(abs(sidethruster)))*100;
updateinfo;
end;
thrustcycle := thrustcycle+1; // thruster duration clock
if ThrustCycle > ThrustCycleMax then
begin
updateinfo;
thrust := 0;
Thrustcycle := 0;
SideThruster := 0;
end;
If not RectInRect(LemRect,Mainrect) then OutofBounds := true;
if (olddegrees = 0) and (positioninrect(LemRect.x1,LemRect.y2,LandingPadRect) or Positioninrect(LemRect.x2,Lemrect.y2,landingpadrect))
and (speed <=15) then GoodLanding := true;
if (positioninrect(LemRect.x1,LemRect.y2,LandingPadRect) or Positioninrect(LemRect.x2,Lemrect.y2,landingpadrect)) and (speed> 15) then
OutofBounds := true;
if fuel <=0 then OutOfBounds := true;
until (boolean(GetAsyncKeyState(VK_ESCAPE))) or (Fuel <=0) or OutOfBounds or Goodlanding;
Str(Speed:5:2,speedstring);
setviewport(0,0,getmaxx,getmaxy,true);
key := ' ';
cleardevice;
if goodlanding then
begin
OutTextXY(200,300,'Congrats on the fine landing!');
end;
if outofbounds then
begin
OutTextXY(200,300,'You crashed!');
OutTextXY(200,312,'Your speed:'+SpeedString);
end;
OutTextXY(200,324,'Press q/Q to exit.');
repeat
if keypressed then Key := readkey;
until (key ='Q') or (Key='q');
closegraph;
end.
Recent
