Who Wants To Be A Millionaire
{==============================================
Program: who wants to be a millionaire
Author: http://www.pascalprogramming.info
Last Modified: 10/10/08
==============================================}
{----------------PROGRAM-----------------------}
program
millionaire;
{-----------------USES-------------------------}
uses
WinCrt;
{---------------CONSTANTS----------------------}
const
max = 15; {how many questions there are}
arrow = '->';
{---------------VARIABLES----------------------}
var
{question data}
question_amount : array[1..max] of longint;
question : array[1..max] of string;
question_answer : array[1..max] of char;
question_a : array[1..max] of string;
question_b : array[1..max] of string;
question_c : array[1..max] of string;
question_d : array[1..max] of string;
{life lines}
phone,fifty,audience :string[3];
{50/50}
takea,takeb :string[3];
takec, taked :string[3];
{misc}
user_answer, choice : char;
i,rand,rand2,rand3 : integer;
lost : string[3];
keya,keyb,keyc,keyd : integer;
store,n : integer;
mark : array[1..max] of string[5];
{------------VARIABLE DELCARATION--------------}
procedure variable;
begin
phone := 'yes';
fifty := 'yes';
audience := 'yes';
lost := 'no';
i := 0;
n := 0;
takea := 'no';
takeb := 'no';
takec := 'no';
taked := 'no';
end;
{---------------QUESTION DATA------------------}
procedure question_data;
begin
{question one}
question_amount[1] := 100;
question[1] := 'What is the capital of England? (£100)';
question_answer[1] := 'b';
question_a[1] := 'England';
question_b[1] := 'London';
question_c[1] := 'Madrid';
question_d[1] := 'Paris';
{question two}
question_amount[2] := 200;
question[2] := 'Who won the first rugby world cup? (£200)';
question_answer[2] := 'c';
question_a[2] := 'South Africa';
question_b[2] := 'Australia';
question_c[2] := 'New Zealand';
question_d[2] := 'England';
{question three}
question_amount[3] := 300;
question[3] := 'The River Foyle is found in which part of the UK? (£300)';
question_answer[3] := 'a';
question_a[3] := 'Ireland';
question_b[3] := 'England';
question_c[3] := 'Scotland';
question_d[3] := 'Wales';
{question four}
question_amount[4] := 500;
question[4] := 'The chemical symbol for Silver is what? (£500)';
question_answer[4] := 'a';
question_a[4] := 'Ag';
question_b[4] := 'Si';
question_c[4] := 'Zi';
question_d[4] := 'Ga';
{question five}
question_amount[5] := 1000;
question[5] := 'How many stomachs does a cow have? (£1000)';
question_answer[5] := 'd';
question_a[5] := '1';
question_b[5] := '2';
question_c[5] := '3';
question_d[5] := '4';
{question six}
question_amount[6] := 2000;
question[6] := 'Gazpacho is from which country? (£2000)';
question_answer[6] := 'c';
question_a[6] := 'Italy';
question_b[6] := 'Argentina';
question_c[6] := 'Spain';
question_d[6] := 'Maxico';
{question seven}
question_amount[7] := 4000;
question[7] := 'Which ocean goes to the deepest depths? (£4000)';
question_answer[7] := 'a';
question_a[7] := 'Pacific';
question_b[7] := 'Atlantic';
question_c[7] := 'Arctic';
question_d[7] := 'Indian';
{question eight}
question_amount[8] := 8000;
question[8] := 'What year did the London Underground first open? (£8000)';
question_answer[8] := 'd';
question_a[8] := '1860';
question_b[8] := '1862';
question_c[8] := '1901';
question_d[8] := '1863';
{question nine}
question_amount[9] := 16000;
question[9] := 'What is the currency in Chili? (£16,000)';
question_answer[9] := 'd';
question_a[9] := 'Dollar';
question_b[9] := 'Real';
question_c[9] := 'Nuevo Sol';
question_d[9] := 'Peso';
{question ten}
question_amount[10] := 32000;
question[10] := 'A Ruby Aniversary is after how many years of being married? (£32,000)';
question_answer[10] := 'b';
question_a[10] := '20';
question_b[10] := '40';
question_c[10] := '30';
question_d[10] := '50';
{question eleven}
question_amount[11] := 64000;
question[11] := 'What is the highest mountain in Africa? (£64,000)';
question_answer[11] := 'b';
question_a[11] := 'Mount Kenya';
question_b[11] := 'Mount Kiimanjaro';
question_c[11] := 'Mawesi';
question_d[11] := 'Mount Luigi di Savoia';
{question twelve}
question_amount[12] := 125000;
question[12] := 'What is the worlds longest snake? (£125,000)';
question_answer[12] := 'a';
question_a[12] := 'Python';
question_b[12] := 'Anaconda';
question_c[12] := 'Boa';
question_d[12] := 'Viper';
{question thirteen}
question_amount[13] := 250000;
question[13] := 'What was Shakespeares first performed play?? (£250,000)';
question_answer[13] := 'd';
question_a[13] := 'Comedy of Errors';
question_b[13] := 'Richard III';
question_c[13] := 'Henry VI, part I';
question_d[13] := 'Henry VI, part II';
{question fourteen}
question_amount[14] := 500000;
question[14] := 'Who was the first prime mininster of England? (£500,000)';
question_answer[14] := 'c';
question_a[14] := 'The Earl of Wilmington';
question_b[14] := 'Henry Palham';
question_c[14] := 'Sir Robert Walpole';
question_d[14] := 'The Duke of Newcastle';
{question fifteen}
question_amount[15] := 1000000;
question[15] := 'How old is the earth? (£1,000,000)';
question_answer[15] := 'd';
question_a[15] := '8.7 Billion';
question_b[15] := '3 Billion';
question_c[15] := '6.5 Billion';
question_d[15] := '4.5 Billion';
end;
{---------------------HEADER------------------------}
procedure header; {displays life lines remaining}
begin
writeln( '------------------------------------------------------------------------------' );
write( 'Lifelines: ' );
if phone <> 'no' then
write( 'Phone a Friend (x) ');
if fifty <> 'no' then
write( '50/50 (y) ');
if audience <> 'no' then
write( 'Ask the Audience (z) ' );
if phone = 'no' then
if fifty = 'no' then
if audience = 'no' then
write( 'You have no more life lines!' );
writeln;
writeln( '------------------------------------------------------------------------------' );
end;
{-------------------- MONEY CLIMB---------------------}
procedure money_climb;
begin
for n:=1 to 15 do
begin
mark[n] := '';
end;
writeln( '==============================');
{set marker/arrow}
if question_amount[i] = 100 then
mark[1] := arrow;
if question_amount[i] = 200 then
mark[2] := arrow;
if question_amount[i] = 300 then
mark[3] := arrow;
if question_amount[i] = 500 then
mark[4] := arrow;
if question_amount[i] = 1000 then
mark[5] := arrow;
if question_amount[i] = 2000 then
mark[6] := arrow;
if question_amount[i] = 4000 then
mark[7] := arrow;
if question_amount[i] = 8000 then
mark[8] := arrow;
if question_amount[i] = 16000 then
mark[9] := arrow;
if question_amount[i] = 32000 then
mark[10] := arrow;
if question_amount[i] = 64000 then
mark[11] := arrow;
if question_amount[i] = 125000 then
mark[12] := arrow;
if question_amount[i] = 250000 then
mark[13] := arrow;
if question_amount[i] = 500000 then
mark[14] := arrow;
if question_amount[i] = 100000 then
mark[15] := arrow;
{display money!}
writeln( mark[15],'£1 MILLION' );
writeln( mark[14],'£500,000' );
writeln( mark[13],'£250,000' );
writeln( mark[12],'£125,000' );
writeln( mark[11],'£64,000' );
writeln( mark[10],'£32,000' );
writeln( mark[9],'£16,000' );
writeln( mark[8],'£8,000' );
writeln( mark[7],'£4,000' );
writeln( mark[6],'£2,000' );
writeln( mark[5],'£1,000' );
writeln( mark[4],'£500' );
writeln( mark[3],'£300' );
writeln( mark[2],'£200' );
writeln( mark[1],'£100' );
writeln( '==============================');
end;
{----------------------LOOSE------------------------}
procedure loose;
begin
clrscr;
writeln( 'Answer Incorrect. The correct answer was: ',question_answer[i] );
if question_amount[i] <= 1000 then
begin
writeln( 'You go home with nothing!' );
end else
if question_amount[i] <= 32000 then
begin
writeln( 'You go home with £1000!' );
end else
if question_amount[i] <= 1000000 then
writeln('You go home with £32,000!' );
readln;
donewincrt;
end;
{-----------------------WINNER----------------------}
procedure winner;
begin
writeln( 'YOU JUST WON 1 MILLION POUNDS!' );
readln;
writeln( 'If only this was the real game though...' );
writeln( 'CONGRATULATIONS on winning!' );
readln;
donewincrt;
end;
{------------------PHONE A FRIEND-------------------}
procedure phone_friend;
begin
if phone <> 'no' then
begin
phone := 'no';
writeln( 'You phone your friend....' );
readln;
writeln( 'He picks up the phone, you ask the question, and he replies:' );
readln;
writeln( '-Hi, im pretty sure the answer is ',question_answer[i],' , good luck!-' );
readln;
end; {end if statement -> phone isnt equal to no}
end;
{-------------ASK THE AUDIENCE-----------------}
procedure ask_audience;
begin
if audience <> 'no' then
begin
audience := 'no';
writeln( 'The audience vote on their keypads...' );
readln;
{create 4 random numbers which all add up to 100}
randomize;
repeat
keya := random(100);
until keya > 60;
keyb := random(100 - keya);
keyc := random(100 - keya - keyc);
keyd := 100 - keya - keyb - keyc;
{make it so correct answer has highest percentage/number}
if question_answer[i] = 'b' then
begin
store := keyb;
keyb := keya;
keya := store;
end;
if question_answer[i] = 'c' then
begin
store := keyc;
keyc := keya;
keya := store;
end;
if question_answer[i] = 'd' then
begin
store := keyd;
keyd := keya;
keya := store;
end;
writeln( keya,'% of the audience think the answer is A' );
readln;
writeln( keyb,'% of the audience think the answer is B' );
readln;
writeln( keyc,'% of the audience think the answer is C' );
readln;
writeln( keyd,'% of the audience think the answer is D' );
readln;
end; {end if statement -> audience isnt equal to no}
end;
{------------------50/50-----------------------}
procedure fifty_fifty;
begin
if fifty <> 'no' then
begin
fifty := 'no';
writeln( 'Computer, please take away 2 random wrong answers!' );
readln;
{set rand3 a number according to correct answer}
if question_answer[i] = 'a' then
rand3 := 1;
if question_answer[i] = 'b' then
rand3 := 2;
if question_answer[i] = 'c' then
rand3 := 3;
if question_answer[i] = 'd' then
rand3 := 4;
{generate a random number}
randomize;
repeat
rand2 := random(4)+1;
until rand2{random number} <> rand3{question to keep number};
{choose whice answers to take away}
if question_answer[i] <> 'a' then
begin
if rand2 <> 1 then
takea := 'yes';
end;
if question_answer[i] <> 'b' then
begin
if rand2 <> 2 then
takeb := 'yes';
end;
if question_answer[i] <> 'c' then
begin
if rand2 <> 3 then
takec := 'yes';
end;
if question_answer[i] <> 'd' then
begin
if rand2 <> 4 then
taked := 'yes';
end;
end;
end;
{--------------QUESTION ASKER------------------}
procedure question_ask;
begin
while lost <> 'yes' do
begin
clrscr;
question_data;
i := i + 1;
header;
writeln( question[i] );
if takea <> 'yes' then writeln( 'A - ',question_a[i] );
if takeb <> 'yes' then writeln( 'B - ',question_b[i] );
if takec <> 'yes' then writeln( 'C - ',question_c[i] );
if taked <> 'yes' then writeln( 'D - ',question_d[i] );
if i = 16 then
begin
clrscr;
winner;
end;
readln( user_answer );
case user_answer of
'a':begin
if question_answer[i] <> 'a' then
begin
lost := 'yes';
loose;
end;
end;
'b':begin
if question_answer[i] <> 'b' then
begin
lost := 'yes';
loose;
end;
end;
'c':begin
if question_answer[i] <> 'c' then
begin
lost := 'yes';
loose;
end;
end;
'd':begin
if question_answer[i] <> 'd' then
begin
lost := 'yes';
loose;
end;
end;
'x':begin
phone_friend;
i := i - 1;
question_ask;
end;
'z':begin
ask_audience;
i := i - 1;
question_ask;
end;
'y':begin
fifty_fifty;
i := i - 1;
question_ask;
end;
else
begin
i := i- 1;
question_ask;
end;
end;{ends case}
writeln( 'Well done! That was the correct answer!' );
readln;
clrscr;
header;
money_climb;
readln;
if fifty = 'no' then
begin
takea := 'no';
takeb := 'no';
taked := 'no';
takec := 'no';
end;
end; {end while loop}
end; {ends procedure}
begin
variable;
question_ask;
end.
Categories: General