program RetroLEM;
// 3/29/25
uses
Windows,
ptccrt, // keep this order of units
ptcgraph,
SysUtils,
Math,
dos;
const
gravitycyclemax = 8000;
thrustCycleMax = 5000;
MaxPoints = 23;
Filename = 'LEMHScore.HS';
type
VideoPages = (Page0, Page1);
SkillLevelType = (Easy, Medium, Hard);
const
LevelAdjustment: array[Easy..Hard] of single = (0.70, 0.80, 1.0);
LevelChars: set of char = ['E', 'e', 'M', 'm', 'H', 'h'];
FuelLevels: array[easy..hard] of single = (1500, 1400, 1300);
LevelWidth:array[Easy..Hard] of byte = (40,25,15);
type
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;
HighPointsType = record
HPoints: single;
end;
var
DegreePoints:array[0..360] of byte;
Level: SkillLevelType;
Hscore: HighPointsType;
dir: searchrec;
HighScoreFile: file of HighPointsType;
TheLem: LemLanderType;
Page: VideoPages = Page0;
LandingPadRect, LemRect, mainrect, inforect: Trect;
ThrustCycle, gravitycycle: longint;
gdriver, gmode: smallint;
Points: single = 100;
FuelBonus,DistanceBonus,
CenterScoreAdjustment, Speed, Fuel, SideThruster, SideThrust,
Inertia, thrust, OldXposition, OldYPosition, xposition, yposition,
gravity: single;
PadX, Degrees, TotalDegrees, xpos, ypos: integer;
GoodLanding: boolean = False;
OutOfBounds: boolean = False;
InfoString: string;
Key: char;
Function AddStrLen(s:string;NewLen:integer):string;
begin
if length(s)< NewLen then
while length(s) < NewLen do s := ' '+s;
result := s;
end;
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; deg, centerx, centerY: float);
var
newx, newy, angle: float;
cx, cy, y, x: single;
begin
angle := degTorad(deg);
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(deg: float);
var
index: integer;
begin
for index := 0 to MaxPoints do
rotatepoint(TheLem.points[index], deg, TheLem.centerx, TheLem.centery);
end;
procedure SetLem;
begin
with TheLem do
begin
CenterX := Xpos;
CenterY := Ypos;
// main base
Points[0].X := CenterX - 3;
Points[0].y := CenterY - 1;
Points[1].X := CenterX + 3;
Points[1].Y := CenterY - 1;
Points[2].x := CenterX - 3;
Points[2].Y := CenterY + 1;
Points[3].X := CenterX + 3;
Points[3].Y := CenterY + 1;
//top
Points[4].X := CenterX - 1;
Points[4].Y := CenterY - 1;
Points[5].X := CenterX - 3;
Points[5].Y := CenterY - 3;
Points[6].x := centerX - 3;
Points[6].Y := CenterY - 5;
Points[7].x := CenterX - 1;
Points[7].y := CenterY - 7;
Points[8].X := CenterX + 1;
Points[8].y := CenterY - 7;
Points[9].x := CenterX + 3;
Points[9].Y := CenterY - 5;
Points[10].x := CenterX + 3;
Points[10].Y := CenterY - 3;
Points[11].x := CenterX + 1;
Points[11].Y := CenterY - 1;
// right leg
Points[12].x := CenterX + 1;
Points[12].y := CenterY + 1;
Points[13].X := CenterX + 3;
Points[13].Y := CenterY + 3;
Points[14].X := CenterX + 2;
Points[14].Y := CenterY + 3;
Points[15].X := CenterX + 4;
Points[15].y := CenterY + 3;
// left leg
Points[16].x := CenterX - 1;
Points[16].Y := CenterY + 1;
Points[17].x := CenterX - 3;
Points[17].Y := CenterY + 3;
Points[18].x := CenterX - 4;
Points[18].Y := CenterY + 3;
Points[19].X := CenterX - 2;
Points[19].y := CenterY + 3;
// thruster setup
Points[20].x := CenterX - 2;
Points[20].Y := CenterY + 1;
Points[21].x := CenterX;
Points[21].Y := CenterY + 8;
Points[22].X := CenterX + 2;
Points[22].y := CenterY + 1;
Points[23].X := CenterX;
Points[23].Y := CenterY + 8;
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 DrawLem;
var
i: integer;
begin
Setcolor(7);
AdjustLem;
with TheLem do
begin
SetTrect(LemRect, round(CenterX - 3), Round(CenterY - 7), round(centerX + 3),
round(centery + 3));
// main base
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[1].x), round(points[1].y), Round(points[3].x), Round(Points[3].y));
Line(Round(points[2].x), round(Points[2].y), round(points[3].x), round(points[3].y));
// top of module (chase around)
for i := 4 to 10 do
Line(round(points[i].x), round(points[i].y), round(points[i + 1].x),
round(Points[i + 1].y));
// legs
// right side
line(round(points[12].x), round(points[12].y), round(points[13].x),
round(points[13].y));
Line(Round(points[14].x), round(points[14].y), round(points[15].x),
round(Points[15].y));
// left side
line(round(Points[16].x), round(points[16].y), round(Points[17].x),
round(points[17].y));
Line(Round(points[18].x), round(Points[18].y), round(points[19].x),
round(Points[19].y));
// thrusters
if thrust <> 0 then
begin
line(round(points[20].x), round(points[20].y), round(points[21].x),
round(points[21].y));
line(round(points[22].x), round(points[22].y), round(points[23].x),
round(points[23].y));
end;
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, true); // info viewport
clearviewport;
str(Fuel: 5: 2, s);
if fuel < 100 then setcolor(4);
outtextxy(4, 4, 'Fuel:' + s);
Speed := abs(gravity) * 100;
str(Speed: 5: 2, s);
SetColor(15);
OutTextXY(4, 14, 'Speed:' + s);
Str(TotalDegrees, s);
OutTextXY(4, 26, 'Degrees:' + s);
str(HScore.HPoints: 5: 2, s);
OutTextXY(4, 38, 'High score:' + s);
end;
setviewport(0, 0, getmaxx, getmaxy, True); // full screen
with inforect do rectangle(x1,y1,x2,y2);
with mainrect do
begin
rectangle(x1, y1, x2, y2);
setviewport(x1 + 1, y1 + 1, x2 - 1, y2 - 1, True); // main display
end;
with landingpadrect do
rectangle(x1, y1, x2, y2); // draw landing pad
end;
procedure Init;
var
Pts,
i:integer;
begin
fillchar(degreepoints,sizeof(degreepoints),0);
Pts := 100;
for i := 0 to 5 do
begin
degreepoints[i] := pts;
dec(pts,10);
end;
pts := 100;
for i := 355 to 360 do
begin
degreepoints[i] := pts;
dec(pts,10);
end;
SetFillstyle(solidfill, 7);
gravitycycle := 0;
xpos := 300;
yposition := 30;
gravity := 0.038;
Inertia := 0.0015;
ypos := round(YPosition);
xposition := xpos;
thrust := 0;
thrustcycle := 0;
SideThrust := 0;
Fuel := FuelLevels[Level];
SideThruster := 0;
OldXposition := Xposition;
OldYPosition := YPosition;
TotalDegrees := 0;
Degrees := 0;
end;
begin
gdriver := vesa; // adjust initgraph for your system
Gmode := installusermode(800, 600, 256, 2, 8000, 6000); // two pages
WindowTitle := 'RetroLEM';
initgraph(gdriver, gmode, '');
hscore.HPoints := 0;
// get high score if file is there
findfirst(filename, archive, dir);
if doserror = 0 then
begin
Assign(Highscorefile, filename);
reset(Highscorefile, 1);
Read(highscorefile, Hscore);
Close(highscorefile);
end;
Randomize;
settRect(MainRect, 0, 0, getmaxx, getmaxy - 60);
with mainrect do SetTrect(InfoRect, x1 + 250, y2 + 2, x1 + 400, y2 + 50);
repeat
cleardevice;
setcolor(14);
with mainrect do
begin
OutTextXY(x1 + 240, 220, ' Skill level to play?');
OutTextXY(x1 + 270, 232, '<E>asy');
OutTextXY(x1 + 270, 244, '<M>edium');
OutTextXY(x1 + 270, 256, '<H>ard');
end;
repeat
key := readkey;
until key in Levelchars;
case key of
'e', 'E': level := easy;
'm', 'M': level := medium;
'h', 'H': level := hard;
end;
cleardevice;
init;
SetLem;
DrawLEM; // draw the lander
Setcolor(14);
with mainrect do
begin
OutTextXY(x1 + 200, 220, '2 = main thruster');
OutTextXY(x1 + 200, 230, '1 = rotate right');
OuttextXY(x1 + 200, 240, '3 = rotate left');
OutTextXY(x1 + 200, 250, 'Press escape to exit game');
OutTextXY(x1 + 100, 270, 'To avoid crashing you must land on the pad, your speed must be <=15');
OuttextXY(x1 + 100, 280, 'and your vertical orientation must be between');
OutTextXY(x1 + 100, 290, '355 and 5 degrees.');
OutTextXY(x1 + 100, 310, 'Press any key to begin');
end;
with Mainrect do
begin
rectangle(x1, y1, x2, y2);
case level of
Easy: padx := random(500)+125;
Medium: padx := random(600)+100;
Hard: padx := random(700)+25;
end;
setTrect(LandingPadRect, padx, y2 - 6, padx + LevelWidth[level], y2 - 1);
end;
CenterScoreAdjustment := (abs(400 - Landingpadrect.x1 +
((landingpadrect.x2 - landingpadrect.x1) div 2))) * leveladjustment[level];
updateinfo;
outofbounds := False;
goodlanding := False;
readkey;
repeat
Speed := abs(gravity) * 100;
if fuel > 0 then
begin
if boolean(GetAsyncKeyState(VK_NUMPAD2)) then
begin
if (totaldegrees > 90) and (totaldegrees < 270) then
thrust := 0.015
else
Thrust := -0.015;
thrustcycle := 0;
end;
if boolean(GetAsyncKeyState(VK_NUMPAD1)) then
begin
Thrust := -0.01;
degrees := 1;
rotatelem(degrees);
TotalDegrees := totaldegrees + degrees;
if totaldegrees > 359 then totaldegrees := 0;
if (totaldegrees > 90) and (Totaldegrees < 270) then
begin
SideThrust := -inertia;
end
else
SideThrust := sidethrust + inertia;
thrustcycle := 0;
Sidethruster := sidethrust;
end;
if boolean(GetAsyncKeyState(VK_NUMPAD3)) then
begin
thrustcycle := 0;
Thrust := -0.01;
degrees := -1;
rotatelem(degrees);
TotalDegrees := Totaldegrees + degrees;
if totaldegrees < 0 then totaldegrees := 360;
if (totaldegrees > 90) and (totaldegrees < 270) then
begin
sidethrust := -inertia;
end
else
sidethrust := sidethrust - inertia;
sidethruster := sidethrust;
end;
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;
DrawLEM;
nextvisualpage; // show the lander
if fuel > 0 then
Fuel := fuel + (thrust - (abs(sidethruster))) * 100;
if fuel <0 then fuel := 0;
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 ((totaldegrees <= 5) or (totaldegrees >= 355)) 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;
until (boolean(GetAsyncKeyState(VK_ESCAPE))) or OutOfBounds or Goodlanding;
setviewport(0, 0, getmaxx, getmaxy, True);
key := ' ';
cleardevice;
Points := Points - Gravity * 100;
if goodlanding then
begin
setcolor(14);
OutTextXY(250, 170, 'Congrats on the fine landing!');
if fuel>0 then
begin
FuelBonus := fuel * leveladjustment[level];
Str(FuelBonus:4: 2, Infostring);
infostring := AddStrLen(infostring,8);
OutTextXY(250,192,infostring+' - Fuel bonus:');
end
else
fuelbonus := 0;
DistanceBonus := CenterScoreAdjustment;
Str(DistanceBonus:4:2,InfoString);
infostring := AddStrLen(infostring,8);
OutTextXY(250,204,infostring+' - Distance bonus');
Points := Points * leveladjustment[level];
if points <0 then
points := 0;
Str(Points: 4: 2, InfoString);
infostring := AddStrLen(infostring,8);
OutTextXY(250,216,infostring+' - Landing points');
Speed := abs(gravity) * 100;
str(Speed: 4: 2, InfoString);
infostring := AddStrLen(infostring,8);
SetColor(4);
OutTextXY(250,228,infostring +' - Speed penalty');
Str(degreepoints[TotalDegrees], InfoString);
setcolor(14);
infostring := AddStrLen(infostring,5);
OutTextXY(250,240,infostring+'.00'+ ' - Position points');
Points := Points + FuelBonus + DistanceBonus-speed+degreepoints[totaldegrees];
Str(Points: 4: 2, Infostring);
infostring := AddStrLen(infostring,8);
OutTextXY(250,252, infostring + ' - Total Points');
if points > Hscore.Hpoints then
begin
Setcolor(4);
OutTextXY(250, 300, 'NEW HIGH SCORE!');
hscore.Hpoints := points;
Assign(highscorefile, filename);
rewrite(Highscorefile, 1);
Write(highscorefile, hscore);
Close(highscorefile);
setcolor(15);
end;
end;
if outofbounds then
begin
OutTextXY(250, 300, 'You crashed! Try again!');
Speed := abs(gravity) * 100;
str(Speed: 5: 2, InfoString);
SetColor(15);
OutTextXY(250, 314, 'Speed:' + InfoString);
Str(TotalDegrees, InfoString);
OutTextXY(250, 326, 'Degrees:' + InfoString);
end;
OutTextXY(250, 364, 'Play again? y/n ');
repeat
if keypressed then Key := readkey;
until (key = 'y') or (Key = 'n');
until (key = 'n') or (key = 'N');
closegraph;
end.
WIKI Timeout issues
