Исходный код таков:
uses crt, graph;
type str20 = string[20];
menu = array [1..3] of str20;
const mm:menu=('Free Motion ','With Keyboard','Exit ');
var i,j:integer;
gD,gM:integer;
x,y:word;
dx,dy:shortint;
ch:char;
k:byte;
function readChar:char;
var c:char;
begin
c:=readkey;
if c=#0 then c:=readkey;
readchar:=c;
end;
function case_k(ch:char; k:byte):byte;
begin
case ch of
#72: if k>1 then k:=k-1 else k:=3;
#80: if k<3 then k:=k+1 else k:=1;
end;
case_k:=k;
end;
procedure showstring(k1,k2:byte; s:str20; gr,cl:byte);
begin
textbackground(gr);
textcolor(cl);
gotoXY(k1,k2);
write(s);
end;
procedure redraw;
begin
setcolor(0);
circle(x-dx,y-dy,20);
line(x-dx,y-dy-5,x-dx,y-dy+5);
circle(x-dx+10,y-dy-8,5);
circle(x-dx-10,y-dy-8,5);
circle(x-dx+23,y-dy-5,3);
circle(x-dx-23,y-dy-5,3);
arc(x-dx,y-dy+8,180,360,7);
setcolor(15);
circle(x,y,20);
line(x,y-5,x,y+5);
circle(x+10,y-8,5);
circle(x-10,y-8,5);
circle(x+23,y-5,3);
circle(x-23,y-5,3);
arc(x,y+8,180,360,7);
end;
BEGIN
clrscr;
window(31,11,50,16);
for k:=3 downto 1 do showstring(1,k,mm[k],1,14);
repeat
showstring(15,k,' ',0,4);
showstring(1,k,mm[k],1,14);
k:=case_k(ch,k);
showstring(15,k,chr(17),0,4);
showstring(1,k,mm[k],7,1);
ch:=readchar;
until (ch=#13) or (ch=#32);
textbackground(0);
textcolor(15);
window(1,1,80,25);
clrscr;
gD:=Detect;
initgraph(gD,gM,'');
SetLineStyle(UserBitLn, $C3, NormWidth);
SetColor(GetMaxColor);
dx:=5;
dy:=5;
x:=50;
y:=50;
case k of
1: while not keypressed do
begin
if (x>=610) or (x<=30) then dx:=-dx;
if (y>=455) or (y<=30) then dy:=-dy;
x:=x+dx;
y:=y+dy;
redraw;
delay(1100);
end;
2: repeat
redraw;
ch:=readkey;
if (ch=#75) and (x>30) then
begin
dx:=-3;
dy:=0;
x:=x+dx;
end;
if (ch=#77) and (x<610) then
begin
dx:=3;
dy:=0;
x:=x+dx;
end;
if (ch=#72) and (y>30) then
begin
dx:=0;
dy:=-3;
y:=y+dy;
end;
if (ch=#80) and (y<455) then
begin
dx:=0;
dy:=3;
y:=y+dy;
end;
until (ch=#13) or (ch=#32);
3: halt;
end;
closegraph;
END.