This chapter contains sample Pascal Next programs that demonstrate the syntax and capabilities of the programming language.
Hollow cylinder volume calculator
Weight converter from pounds to grams/kilograms
Current in a circuit consisting of two resistors
Table of values of the functions sin and cos
Sorting an array using the exchange method (Bubble sort)
Sorting a two-dimensional array
User-defined procedure and function
Recursive function Factorial and table of factorials
Recursion. Finding routes between two points in a graph
String processing. Trim and Capital functions
Display the contents of text file
// Hollow cylinder volume calculator
Program P1()
const
PI = 3.1415926;
var
diam:integer; // diameter
wal:integer; // wall thickness
len:integer; // length
volume: float; // volume
begin
writeln(' Hollow cylinder volume calculator');
write('Diameter, mm >');
readln(diam);
write('Wall thickness, mm >');
readln(wal);
write('Length, mm >');
readln(len);
volume := PI*diam*diam/4*len - PI*(diam -2*wal)*(diam -2*wal)/4*len;
volume := volume / 1000; // volume in cm. cubed
writeln('Hollow cylinder volume', volume:9:2, ' cm cubed');
writeln;
write('Press <Enter>');
readln;
end.
// Weight converter from pounds to grams/kilograms
program p1()
const
K = 453.59237;
var
Pounds: float; // weight in pounds
Grams: integer; // weight in grams
Kilograms: float; // weight in kilograms
// weight as kg + g
KG: integer;
GR: integer;
begin
writeln('Pounds to grams/kilograms converter');
writeln;
write('Pounds>');
readln(Pounds);
Grams := Round(Pounds * K);
if grams < 1000 then
writeln(Pounds:6:2, ' lb = ', Grams, ' g');
else
Kilograms := Grams / 1000;
KG := Grams DIV 1000;
GR := Grams mod 1000;
write(Pounds:6:2, ' lb = ', Kilograms:6:3);
writeln(' kg = ',KG,' kg ', GR:3, ' g');
end;
writeln;
write('Press <Enter>');
readln;
end.
// Current in a circuit consisting of two resistors, which can be connected in series or in parallel
program p()
var
R1,R2: float; // resistance values, Ohm
T: integer; // connection type: 1 - serial; 2 - parallel
U: float; // voltage
R: float; // circuit resistance
I: float; // current in the circuit
begin
writeln('Current in a circuit consisting of two resistors');
writeln;
write('R1, Ohm >');
readln(R1);
write('R2, Ohm >');
readln(R2);
write('Connection type (1 - serial; 2 – parallel) >');
readln(T);
write('U, Volt >');
readln(U);
if T = 1 OR T = 2 then
if T = 1 then
R := R1 + R2;
else
R := R1*R2/(R1+R2);
end;
writeln('Circuit resistance: ',R:6:2, ' Ohm');
I := U/R;
write('I = ');
if I < 0.1 then
I := I * 1000;
writeln(Round(I),' mA');
else
writeln(I:6:3,' A');
end;
else
writeln('Error! The connection type is incorrect.');
end;
write('Press <Enter>');
readln;
end.
// mass of a hollow rod (pipe)
Program P1()
const
PI = 3.1415926;
var
diam:integer; // diameter
wal:integer; // wall thickness
len:integer; // length
n:integer; // material number
material:string[15]; //material
density: float; //material density, gr/cm3
volume: float; // volume
mas: float; // mass, gr
begin
writeln('Mass of a hollow rod (pipe)');
write('Diameter, mm >');
readln(diam);
write('Wall thickness, mm>');
readln(wal);
write('Length, mm >');
readln(len);
writeln('Select material');
writeln('1. Aluminum');
writeln('2. Copper');
writeln('3. Steel');
writeln('4. Plastic');
write('>');
readln(n);
if ( n < 1 OR n > 4 ) then
writeln('Error! The material number is incorrect.');
else
if n = 1 then
material :='Aluminium';
density := 2.7;
else
if n = 2 then
material :='Copper';
density := 8.9;
else
if n = 3 then
material :='Steel';
density := 7.856;
else
material :='Plastic';
density := 1.9;
end;
end;
end;
writeln('');
// volume in mm3
volume := PI*diam*diam/4*len –
PI*(diam -2*wal)*(diam -2*wal)/4*len;
// volume in cm cubic.
volume := volume / 1000;
mas := volume * density;
writeln('Material: ', material, '(',density:6:3,'gr/cm3)');
writeln('Volume:', volume:9:2, ' cm3');
writeln('Mass:', mas:6:2);
end;
writeln;
write('Press <Enter>');
readln;
end.
// Table of trigonometric functions sin and cos.
// Demonstrates the use of the sin and cos functions,
// use of procedures, formatted output.
// Draws a line
procedure line(n:integer, ch: string)
var
i: integer;
begin
for i:=1 to n do
write(ch);
end;
writeln;
end;
// Displays a table of syn and cos values
// p1 - start angle, p2 – end angel, p3 – step
procedure tabsin(p1: float, p2: float, p3: float)
var
g:float; // angle in degrees
r:float; // angle in radians
k:integer; // line length (parameter f-i line)
begin
k:= 43;
Line(k,'_');
writeln(' Deg':7, ' Rad':12, ' Sin':12, ' Cos':12);
Line(k,'-');
g := p1;
while g <= p2 do
r := 3.14/180*g;
writeln(g:7:2, r:12:6, sin(r):12:6, cos(r):12:6 );
g:= g + p3;
end;
Line(k,'=');
writeln;
end;
program main()
begin
TabSin(0.0, 360.0, 15.0); // from 0 to 360 by step 15
write('Press <Enter>');
readln;
end.
// Maximum element of an array
program p5()
const
ARS = 5; // array size
var
a: array[1 .. ARS] of integer;
max: integer;
i,;
begin
a[1] := 8;
a[2] :=-8;
a[3] := -17;
a[4] := 25;
a[5] := 6;
write('Source array: ');
for i := 1 to ARS do
write(a[i]:4);
end;
writeln;
max:=1; // let the first element be maximum
for i := 2 to ARS do
if (a[i] > a[max]) then
max:=i;
end;
end;
writeln('Max element: ', a[max], 'Inex of element:', max);
write('Press <Enter>');
readln;
end.
// Sorting an array using the exchange method
program p5()
const
ARS = 5; // array size
var
a: array[1 .. ARS] of integer;
b: integer;
i,j: integer;
begin
a[1] := 8;
a[2] :=-8;
a[3] := -17;
a[4] := 25;
a[5] := 6;
write('Source array: ');
for i := 1 to ARS do
write(a[i]:4);
end;
writeln;
// sorting
for i:= 1 to ARS do
for j:=1 to ARS do
if (a[j+1] < a[j]) then
// exchange
b:= a[j];
a[j] := a[j+1];
a[j+1] := b;
end;
end;
end;
// display sorted array
write('Sorted array: ');
for i:=1 to ARS do
write(a[i]:4);
end;
writeln;
write('Press <Enter>');
readln;
end.
// Generates a value in Word for an integer in the range from 1 to 999
function Prop(n: integer): string
var
st: string[64]; // an integer in words
d1: array[1..19] of string[10]=
'one','two','three','four','five','six','seven',
'eight','nine','ten','eleven','twelve','thirteen',
'fourteen','fifteen','sixteen','seventeen','eighteen',
'nineteen';
d2: array[1..9] of string[10] =
'','twenty','thirty', 'forty', 'fifty', 'sixty',
'seventy', 'eighty', 'ninety';
// hundreds
d3: array[1..9] of string[10] =
'one','two','three','four','five',
'six','seven','eight','nine';
hund:integer; // number of hundreds
tens:integer; // number of tens if the number is greater than 19
un:integer; // number of units
begin
st:='';
hund := n div 100;
if hund != 0 then
st := d3[hund] + ' hundreds ';
n := n - hund *100;
end;
if N !=0 then
if (n <=19) then
st := st + d1[n];
else
tens := n div 10;
st:= st + d2[tens];
un := n - tens *10;
if (un !=0 ) then
st := st + ' ' + d1[un];
end;
end;
end;
return st;
end;
// converts the first letter of a string to uppercase
function Capital(st: string):string
var
res: string[128];
begin
res := UpCase(substr(st,1,1)) + LowCase(substr(st,2,length(st)-1));
return res;
end;
Program p()
var
n: integer;
st: string[128]; // an integer in words
i:integer;
begin
writeln('Type number from 1 to 999 and press <Enter>');
writeln('To stop type 0 or press <Enter>');
repeat
writeln;
write('>');
readln(n);
if (n >= 0) AND (n < 1000) then
st := Capital(Prop(n));
writeln(st);
end;
until(n = 0);
writeln;
for i:=1 to 25 do
n:= Random(999);
writeln(n:3, ' - ', Capital(Prop(n)));
end;
write('Press <Enter>');
readln;
end.
// Sorting a two-dimensional array
program TwoDimArrSorting ()
const
NR=6;
NC=16;
var
a: array[1..NR, 1..NC] of integer;
i,j: integer;
key: integer; // key column index
m: integer; // min rows element index
c: integer; // row index in
b: integer;
begin
// random array for sorting
for i:= 1 to NR do
for j:=1 to NC do
a[i,j,Random(100);
end;
end;
writeln('Source array:');
for i:= 1 to NR do
for j:=1 to NC do
write(a[i,j]: 4);
end;
writeln;
end;
key:=1; // key column
for i:=1 to NR do // repeat as many times as there are rows in the array
// find the minimum element in the key column of the array
// from the j-th element
m:=i;
for j:=i+1 to NR do
if a[j,key] < a[m,key] then
m:=j;
end;
end;
if m != i then
// exchange the i-th and m-th rows of the array
for c:=1 to NC do
b:=a[i,c];
a[i,c]:=a[m,c];
a[m,c]:=b;
end;
end;
end;
writeln;
writeln('Key column: ', key);
writeln('Sorted array:');
for i:= 1 to NR do
for j:=1 to NC do
write(a[i,j]: 4);
end;
writeln;
end;
writeln;
write('Press <Enter>');
readln;
end.
// User function the Volume – volume of a cylinder
Function CylinderVolume(d: integer, len: integer):float
const
PI = 3.1415926;
begin
return PI*(d/2)*(d/2)*len;
end;
// Volume of a hollow cylinder
Program P1()
var
diam:integer; // diameter
wal:integer; // wall thickness
len:integer; // length
volume: float; // volume
begin
writeln('Volume of a hollow cylinder');
write('Diameter, mm >');
readln(diam);
write('Wall thickness, mm>');
readln(wal);
write('Length, mm >');
readln(len);
// volume in mm3
volume := CylinderVolume(diam,len) - CylinderVolume(diam-2*wal,len);
volume := volume / 1000; // volume in cm3
writeln('Volume of a hollow cylinder', volume:9:2, 'cm3');
writeln;
write('Press <Enter>');
readln;
end.
// User-defined procedure and function
// displays a greeting in Russian, Italian, Spanish or English
procedure hi(lang: string)
begin
if lang = 'ru' then
writeln('Привет!');
else
if lang = 'it' then
writeln('Ciao!');
else
if lang = 'es' then
writeln('Ola!');
else
writeln('Hi!');
end;
end;
end;
end;
// returns a greeting string in Russian, Italian. Spanish or English
function GoodDay(lang: string): string
var
msg: string[15];
begin
if lowcase(lang) = 'ru' then
msg:='Добрый день!';
else
if lowcase(lang) = 'it' then
msg:='Buongiorno!';
else
if lowcase(lang) = 'es' then
msg:='Buones dias!';
else
msg:='Good day!';
end;
end;
end;
return msg;
end;
program p()
var
LangID: string[10]; // language identifier:
// ru - Russian
// en - English
// it - Italian
// es – Spanish
begin
repeat
write('Language ID (ru, en, it, es)>');
readln(LangID);
if length(LangID) !=0 then
hi(lowcase(LangID));
writeln(GoodDay(LangID));
else
hi(lowcase('ru'));
writeln(GoodDay('ru'));
end;
until length(LangID) = 0;
write('Press <Enter>');
readln;
end.
// Recursive function Factorial and table of factorials from 1 to 12
// Function Factorial
function fac(n: integer): integer
var
f: integer;
begin
if n = 1 then
f:=1;
else
f:= n*fac(n-1);
end;
return f;
end;
// Table of factorials from 1 to 12
program p28()
var
i: integer;
begin
for i:=1 to 12 do
writeln(i:2, ' - ', fac(i));
end;
write('Press <Enter>');
readln;
end.
// Recursion. Finding routes between two points in a graph
program findRoad()
var
n:integer; //number of graph vertices
// map (graph): map[i,j] not 0 if points i and j are connected
map:array[1..7,1..7] of integer;
road:array[1..7] of integer; // road - map point numbers
incl:array[1..7] of integer; // incl[i]=1, if point
// number i is included in road
start: integer; // starting point (from)
finish:integer; // end point (to)
i,j: integer;
r: integer;
function step(s: integer,f: integer,p:integer): integer
// s - the point from which the step is taken
// f - the point where you need to get (final)
// p - number of the required route point
var
c:integer;// Number of the point at which the next step is taken
r: integer;
begin
if s = f then // The current point is where you need to go
// Display found route
write('Route: ');
for i:=1 to p-1 do
write(road[i],' ');
end;
writeln;
else
// Selecting the next point
for c:=1 to N do // Check all vertices
if(map[s,c] !=0) and (incl[c]=0)
// The point С is connected to the S poin,
// but yet not included to the route then
road[p]:=c; // Add a point to the route
incl[c]:=1; // and mark it as included
r:=step(c,f,p+1); // find next point
incl[c]:=0;
road[p]:=0;
end;
end;
end;
end; // end of the Step function
// main program
begin
N:=7;
for i:=1 to N do
for j:=1 to N do
map[i,j]:=0;
end;
end;
// The Map. map[i,j] = 1 if point i is connected to point j
map[1,2]:=1;
map[1,3]:=1;
map[1,4]:=1;
map[2,1]:=1;
map[3,1]:=1;
map[3,4]:=1;
map[3,7]:=1;
map[4,1]:=1;
map[4,3]:=1;
map[4,6]:=1;
map[5,6]:=1;
map[5,7]:=1;
map[6,4]:=1;
map[6,5]:=1;
map[6,7]:=1;
map[7,3]:=1;
map[7,5]:=1;
map[7,6]:=1;
// Display the map
for i:=1 to N do
for j:=1 to N do
write(map[i,j]:3);
end;
writeln;
end;
repeat
for i:=1 to N do
road[i]:=0; // no route
incl[i]:=0; // no points included
end;
writeln('Search for route');
write('Starting point ->');
readln(start);
if start != 0 then
write('End point ->');
readln(finish);
writeln;
road[1]:= start; // add the start point to the route
incl[start]:=1; // and mark it as included in the route
r:=step(start,finish,2); // find the second waypoint
end;
until start = 0;
writeln;
write('Press <Enter>');
readln;
end.
// String processing. Trim and Capital functions
// Converts the first letter of a string to uppercase
function Capital(st: string):string
var
res: string[128];
begin
res := UpCase(substr(st,1,1)) + LowCase(substr(st,2,length(st)-1));
return res;
end;
// removes leading and trailing spaces
function Trim(st: string):string
var
trs: string[64]; // string without leading or trailing spaces
p:integer; // pointer to space at the beginning of the line
lch: string[1]; // last character of the line
begin
trs:=st;
// remove leading spaces
p:= pos(' ',trs);
while p = 1 do
trs:=substr(trs,2,length(trs)-1);
p:= pos(' ',trs);
end;
// remove trailing spaces
lch := substr(trs,length(trs),1);
while lch = ' ' do
trs:=substr(trs,1,length(trs)-1);
lch := substr(trs,length(trs),1);
end;
return trs;
end;
program p1()
var
name: string[25];
lastName: string[15];
firstName: string[15];
p: integer; //space position between first name and last name
begin
repeat
writeln;
write('name>');
readln(name);
if (Length(name) != 0) then
name := Trim(name); // remove leading and trailing spaces
p:= Pos(' ', name);
if p !=0 then
firstName := Capital(LowCase(Substr(name, 1, p-1)));
lastName:=
Capital(LowCase(Trim(Substr(name, p+1, length(name)-p))));
else
firstName := Capital(LowCase(name));
lastName:='';
end;
writeln('Name:', name);
writeln('First Name:', firstName, ': Last name:', lastName, ':');
name := firstname + ' ' + lastname;
writeln('Name:', name, ':');
end;
until (length(name) = 0);
write('Press <Enter>');
readln;
end.
// Cryptographer. Encrypts/decrypts text
program crypto()
var
alf: string[64]; // alphabet
src: string[128]; // original text
dst: string[128]; // ciphertext
rst: string[128]; // decoded text
key: string[32]; // key
n:integer; // number of the key letter used for
// encoding/decoding the current message character
// "character code" is the serial number
// of the character in the alphabet alf
pk:integer; // key symbol code
ps:integer; // character code of the original message
pd:integer; // character code that replaces the message character
i: integer;
begin
alf:= 'abcdefghijklnmopqrstuwvxyz0123456789 .,!?$';
// the codeword must consist of alphabetic characters
key := 'bartsimpson';
src := 'Hello, James Bond! Die Another Day... $100.00';
src := LowCase(src);
// encrypt
n:=1;
for i:=1 to length(src) do
ps:= pos(substr(src,i,1),alf);
if ( ps !=0) then // is the symbol in the alphabet?
// encrypt
pk:= pos(substr(key,n,1),alf);
ps:= ps+pk;
if ps > length(alf) then
ps:= ps-length(alf);
end;
dst:=dst+substr(alf,ps,1);
else
// not encrypt
dst:=dst+ substr(src,i,1);
end;
n := n + 1;
if n > length(key) then
n := 1;
end;
end;
// decrypt
n:=1;
for i:=1 to length(dst) do
ps:= pos(substr(dst,i,1),alf);
if ( ps !=0) then
pk:= pos(substr(key,n,1),alf);
ps:= ps-pk;
if ps < 1 then
ps:= ps+length(alf);
end;
rst:=rst+substr(alf,ps,1);
else
rst:= rst+ substr(dst,i,1);
end;
n := n + 1;
if n > length(key) then
n := 1;
end;
end;
writeln(' Source message:', src);
writeln('Encrypted message:', dst);
writeln;
writeln('Decrypted message:', rst);
write('Press <Enter>');
readln;
end.
// Password generator
program PWGen()
const
PWLEN = 10; // password length
N=5; // number of password options
var
pw: string[PWLEN]; // password
alp: string[64]; // alphabet
r:integer; // random number - alphabet character number
i:integer; // number of the generated password character
up:integer; // 1 - convert the letter to lowercase; 2 - leave as is
j: integer;
begin
// character set
alp := 'abcdefghijklmnopqrstuwvxyz0123456789!$?#_';
for j:=1 to N do
// generate password
pw := '';
for i:= 1 to PWLEN do
r := Random(length(alp));
up := Random(2);
if ( up = 1) then
pw:=pw + Upcase(substr(alp,r,1));
else
pw:=pw + substr(alp,r,1);
end;
end;
writeln(j:3, '. ', pw);
end;
writeln;
write('Press <Enter>');
readln;
end.
// Convert integers to a string and write to a file
program p23()
const
K = 10; // amount of numbers
var
f:text; // text file
fn: string[64]; // file name
i:integer;
begin
fn:= 'c:\temp\data.dat';
writeln('Data file: ',fn);
f:=rewrite(fn); // open the file to rewriting
for i:=1 to K do
writestring(f, IntToStr( random(100)) );
end;
close(f);
writeln(K, ' numbers written to file:',fn);
write('Press <Enter>');
readln;
end.
// Reading lines from a file and converting them to an integer.
program p23()
var
f:text; // text file
fn: string[64]; // file name
st: string[15]; // line read from file
k:integer; // number
sum: integer; // sum of numbers
n:integer; // count of numbers
med: float; // average
begin
fn:= 'c:\temp\data.dat';
writeln('Data file: ', fn);
f:= reset(fn); // open the file to reading
if (f = -1) then
writeln('Path/File access error!');
else
// read numbers from the file
n:=0;
sum:=0;
while (eof(f) != 1) do
n:=n+1;
k:= StrToInt(readstring(f));
sum:= sum + k;
writeln(k:4);
end;
close(f);
if n != 0 then
med:= sum/n;
end;
writeln('Numbers in file:',n:5);
writeln('Sum of numbers:',sum:5);
writeln('Arithmetic mean:',med:6:2);
end;
write('Press <Enter>');
readln;
end.
// Display the contents of text file
// Draw a line
procedure Line(ch: string, n: integer)
var
i: integer;
begin
for i := 1 to n do
write(ch);
end;
writeln;
end;
program p20()
var
f:text; // text file
fn:string[64]; // file name
st: string[128]; // line read from file
n:integer; // number of lines
begin
fn:= 'C:\Users\nikita\documents\pas\p20.pas';
f:=reset(fn); // Оpen file for reading.
// The Reset function returns -1 if for some reason
// access to the file was not obtained
if f != -1 then
writeln(fn);
Line('-',length(fn));
n:=0;
while (eof(f) != 1) do // while not end of file
n:=n+1;
st := readstring(f); // read line from file
writeln(n:3, ' ', st);
end;
Line('-',length(fn));
else
writeln('File access error: ', fn);
writeln('Invalid name/path or file is in use by another application');
end;
writeln;
write('Press <Enter>');
readln;
end.
// Demonstrates the use of the GetTime, GetDay,
// GetMonth, GetYear, DayOfWeek functions
// Returns time in hh:mm:ss format
function TimeToStr(time: integer):string
var
st: string[8];
hour: integer;
min: integer;
sec: integer;
begin
hour:= Trunc(time/60/60);
min:= Trunc((time - hour*3600)/60);
sec:= time- hour*3600 -min*60;
st:='';
if hour < 9 then
st:= '0';
end;
st:= st + IntToStr(hour) +':';
if min < 9 then
st:= st + '0';
end;
st:= st + IntToStr(min) + ':';
if sec < 9 then
st:= st+ '0';
end;
st:= st + IntToStr(sec);
return st;
end;
// returns date in dd/mm/yyyy format
function ShortDate(day: integer, month: integer, year: integer): string
var
st: string[10];
begin
st:='';
day := getDay();
if day < 10 then
st:='0';
end;
st:= st + IntToStr(day)+'/';
month := getMonth();
if month < 10 then
st:=st+'0';
end;
st:= st+IntToStr(month)+'/';
year := getYear();
st:=st+ IntToStr(year);
return st;
end;
program p1()
var
day: integer;
month: integer;
year: integer;
dayOfweek: integer;
weekDay: array[1..7] of string[10] =
'Sunday', 'Monday', 'Tuesday', 'Wednesday',
'Thursday Friday Saturday';
monthName: array[1..12] of string[10] =
'January', 'February', 'March', 'April', 'May', 'June',
'July', 'August', 'September', 'October', ,'December';
hour: integer;
min: integer;
sec: integer;
time: integer;
time2: integer;
dtime: integer;
i: integer;
begin
writeln('Today is ', getDay(), ' ', monthName[getMonth()],
getYear():5, ', ' , weekDay[getDayOfWeek()+1]);
day := getDay();
dayOfweek:= getDayOfWeek();
month := getMonth();
year := getYear();
writeln('Today is ', day, ' ', monthName[month],
year:5, ', ' , weekDay[dayOfweek+1]);
writeln('Today is ', day, ' ', monthName[month] , year:5);
writeln('Today is ', day, '-', month, '-', year);
time := getTime();
hour:= time div 60 div 60;
min:= (time - hour*3600) div 60;
sec:= time- hour*3600 - min*60;
writeln('It is ', hour, ':', min, ':', sec, 'now');
writeln;
writeln;
for i:=1 to 7 do
writeln(i-1:2,' - ', weekDay[i]);
end;
writeln;
day := getDay();
month := getMonth();
year := getYear();
dayOfweek := getDayOfWeek();
time := getTime();
writeln('Today ', ShortDate(day, month, year), ' ',
weekDay[dayOfWeek+1], ' (',dayOfWeek, ')');
writeln;
writeln('Now ', TimeToStr(time));
write('Wait 15 sec and press <Enter>');
readln;
time2:=getTime();
writeln('Now ', TimeToStr(time2));
dtime:= time2- time;
writeln('You where waiting ', TimeToStr(dtime));
write('Press <Enter>');
readln;
end.
// Hangman game
Program HangmanGame()
const
NW = 5; // number of words
LW = 15; // maximum number of letters in a word
TRUE = 1;
FALSE = 0;
var
words: array[1..NW] of string[15] =
'hangman', 'apple', 'pascal', 'spaceman', 'italia';
secretWord:string[LW];
userWord:string[LW];
ch: string[1]; // letter entered by the player
k:integer; // number of letters entered by the player
misses:string[15]; //missing characters (8 letters + 7 commas)
st2: string[LW];
found:integer;
i,j: integer;
debug: integer;
begin
writeln;
writeln('Welcome to the Hangman game!');
writeln;
secretWord := words[Random(NW)+1];
for i := 1 to Length(secretWord) do
userWord := userWord + '-';
end;
//WriteLn('Secret word:',secretWord);
//WriteLn('User word:',userWord);
k := 0;
repeat
writeln;
WriteLn('Word:', UpCase(userWord));
WriteLn('Misses:', UpCase(misses));
Write('Guess:');
ReadLn(ch);; // the first character of the entered line
found := false;
for i := 1 to Length(secretWord) do
if substr(secretWord,i,1) = ch then
//the player guessed the letter
found := TRUE;
// replace the current character of the userWord string
// with the ch character
t2 := '';
for j := 1 to Length(secretWord) do
if j = i then
st2 := st2 + ch;
else
st2 := st2 + Substr(userWord,j,1);
end;
end;
userWord := st2;
end;
end;
if NOT found then
if Length(misses) = 0 then
misses := misses + ch;
else
misses := misses +',' + ch;
end;
end;
k := k + 1; // number of letters entered
until (k = 8) OR (userWord = secretWord);
writeln;
if (userWord = secretWord) then
WriteLn('You are win!');
else
WriteLn('You are lost!');
end;
WriteLn('The seecret word is ', UpCase(secretWord));
Write('Press <Enter>');
Readln;
end.