program password1;

uses crt;

const
   RETURN_KEY     = #13;
   SPACEBAR       = #32;
   ESCAPE_KEY     = #27;
   DELETE_KEY     = #8;

   password : string = 'pass';
   question : string = 'Which city was I born?';
   reminder : string = 'Glasgow';

   c1 : integer = 9;
   c2 : integer = 12;
   c3 : integer = 14;
   c4 : integer = 11;


procedure pause(var ch : char);

begin
   textcolor(black);
   ch := readkey;
   if ch = 'X' then
   begin
      textcolor(lightgray);
      clrscr;
      halt;
   end;
end;


procedure clrwin(x1,y1,x2,y2 : integer);

begin
   window(x1,y1,x2,y2);
   clrscr;
   window(1,1,80,25);
end;


function convert_to_lowercase(tmpstr : string) : string;

var
   i,tmpnum : integer;

begin
   for i := 1 to length(tmpstr) do
      if tmpstr[i] in ['A'..'Z'] then
      begin
         tmpnum := ord(tmpstr[i]);
         inc(tmpnum,32);
         tmpstr[i] := chr(tmpnum);
      end;
   convert_to_lowercase := tmpstr;
end;


function conv(number : longint): string;

var
   tmpstr : string;

begin
   str(number,tmpstr);
   conv := tmpstr;
end;


function return_column(len : integer): integer;

begin
   return_column := 40-(len div 2);
end;


procedure writeto(text : string;
                   x,y : integer;
                colour : integer);

begin
   textcolor(colour);
   gotoxy(x,y);
   write(text);
end;


procedure writexy(text : string;
                   row : integer;
                colour : integer);

var
   len    : integer;
   column : integer;

begin
   len := length(text);
   column := return_column(len);
   writeto(text,column,row,colour);
end;


procedure readxy(var text : string;
           row,colour,max : integer;
                   choice : byte);

var
   count : integer;
   ch    : char;

begin
   count := 1;
   text := '';
   repeat
      pause(ch);
      case ch of
         ESCAPE_KEY :
         begin
            clrwin(1,row,80,row);
            count := 1;
            text := '';
         end;
         DELETE_KEY :
         if count > 1 then
         begin
            dec(count);
            write(DELETE_KEY,' ',DELETE_KEY);
            delete(text,count,1);
            clrwin(1,row,80,row);
            writexy(text,row,colour);
         end;
         SPACEBAR..#127,#156 :
         if count <= max then
         begin
            inc(count);
            text := text + ch;
            writexy(text,row,colour);
         end;
      end;
   until ch = RETURN_KEY;
end;


procedure change_password;

const
   MAX = 4;

var
   tmpstr      : string;
   new,confirm : string;
   ok          : boolean;
   ch          : char;

begin
   ok := false;
   repeat
      clrscr;
      writexy('Press x to quit',8,{c2}12);
      writexy('Type current password',10,6);
      readxy(tmpstr,11,4,MAX,0);

      if length(tmpstr) <> MAX then
      begin
         writexy('Password has to be '+conv(MAX)+' letters',13,6);
         pause(ch);
      end else
      if tmpstr <> password then
      begin
         writexy('This is the wrong password',13,6);
         pause(ch);
      end;

      if tmpstr = password then
      begin
         repeat
            writexy('Type new password',13,6);
            readxy(new,14,4,MAX,0);

            if new = tmpstr then
            begin
               writexy('Password has to be different from the original',16,6);
               pause(ch);
               clrwin(1,14,80,16);
            end;
            if length(new) <> MAX then
            begin
               writexy('Password has to be '+conv(MAX)+' letters',16,6);
               pause(ch);
               clrwin(1,14,80,16);
            end;
         until (length(new) = MAX) and (new <> tmpstr);

         repeat
            writexy('Confirm new password',16,6);
            readxy(confirm,17,MAX,4,0);

            if new = confirm then
            begin
               ok := true;
               password := confirm;
            end
            else
            begin
               writexy('This does not match',19,4);
               pause(ch);
               clrwin(1,17,80,19);
            end;
         until new = confirm;
      end;
   until ok;
   halt;
end;


procedure password_reminder;

var
   tmpstr : string;
   ch     : char;

begin
   textcolor(black);
   clrscr;
   writexy('Password incorrect',10,c1);
   writexy('Possible causes could be :-',11,c2);
   writeto('1.  Password is CaSe SeNSiTiVe',25,13,c1);
   writeto('2.  Spelling mistake',25,14,c1);
   writeto('3.  Password has 4 letters',25,15,c1);
   writexy('To retrieve your password answer the password reminder',18,c3);

   writexy(question,19,c4);
   readxy(tmpstr,20,c3,20,0);

   tmpstr := convert_to_lowercase(tmpstr);
   reminder := convert_to_lowercase(reminder);

   clrscr;
   if tmpstr = reminder then
      writexy('Password : '+password,13,c1)
   else
      writexy('Your answer to the password reminder is incorrect',13,c1);

   writexy('Press spacebar to re-enter password',15,c2);

   while ch <> SPACEBAR do
      pause(ch);
   clrscr;
end;


procedure enter_password(var result : boolean);

const
   colour1 = 11;
   colour2 = 14;

   msgcolour1  = 12;
   msgcolour2  = 13;

   MAX = 4;

var
   text   : string;
   count  : byte;
   x,y,y1 : byte;
   m,trys : byte;
   ch     : char;

begin
   clrscr;
   result := false;
   text := '';
   count := 0;
   x := 38;
   y := 11;
   y1 := 10;
   trys := 2;
   for m := 1 to 3 do
   begin
      while count <> MAX do
      begin
         textcolor(colour1);
         gotoxy(33,y1);
         write('Enter password');
         pause(ch);
         gotoxy(x,y);
         textcolor(colour2);
         if ch = DELETE_KEY then
         begin
            if count <> 0 then
            begin
               write(DELETE_KEY,' ',DELETE_KEY);
               delete(text,count,1);
               dec(count);
               dec(x);
            end;
         end else
         begin
            write('*');
            text := text + ch;
            inc(count);
            inc(x);
         end;
      end;
      if text = password then
      begin
         writexy('Correct Password',22,msgcolour1);
         writexy('Press Return',24,msgcolour2);
         repeat
            pause(ch);
         until ch = RETURN_KEY;
         result := true;
         break;
      end
      else
      begin
         if trys = 0 then
         begin
            result := false;
            break;
         end;
         gotoxy(33,y+2);
         write(trys,' try(s) left');
         dec(trys);
         inc(y,4);
         inc(y1,4);
      end;
      x := 38;
      count := 0;
      text := '';
   end;
end;


procedure password_screen;

var
   count  : byte;
   result : boolean;
   ch     : char;

begin
   count := 1;
   repeat
      enter_password(result);

      if (count = 3) and (not result) then
      begin
         textcolor(black);
         clrscr;
         writexy('Program Terminated',13,c1);
         writexy('Press SPACEBAR to exit',15,c2);
         while ch <> SPACEBAR do
            pause(ch);
         textcolor(lightgray);
         clrscr;
         halt;
      end;

      inc(count);

      if not result then
         password_reminder;
   until result;
end;

begin
   textmode(80);
   textcolor(black);
   clrscr;

   password_screen;
end.