Code examples

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

Mass of a hollow rod

Table of values of the functions sin and cos

Maximum element of an array

Sorting an array using the exchange method (Bubble sort)

Number to words converter

Sorting a two-dimensional array

User function CylinderVolume

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

Cryptographer

Password generator

Writing to a file

Reading from file

Display the contents of text file

Date and time

Hangman game

 

Hollow cylinder volume calculator

// 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

// 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

// 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

// 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 values of the functions sin and cos

// 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

// 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 (Bubble sort)

// 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.

 

Number to words converter

// 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

// 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 CylinderVolume

// 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

// 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

// 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

// 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

// 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

// 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

// 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.

 

Writing to a file

// 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 from file

// 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

// 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.

 

Date and time

// 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

// 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.