{$R-,S+,I+,D+,T-,F-,V-,B-,N-,L+ }
{$M 16384,0,655360 }

PROGRAM License;
  {     This program will figure out your Wisconsin drivers license number
  based on your name, age, and sex.  Only the last number of your license
  cannot be determined.  The last number indicates the number of people that
  had the exact same license number as you at the time you got your
  license. h}

Uses Crt;

Type
   NameType = String[30];

Var
   LastName,
   FirstName       : NameType;
   Middle,Sex      : Char;
   Year,Day,Month  : Byte;
   X, Y            : Integer;

{-----------------------PROCEDURES and FUNCTIONS-----------------------------}

PROCEDURE UpperCase(var S : String);
  {     This Procedure converts the passed string into all uppercase
  characters.}

  Var
     I       : Byte;

BEGIN
   For I:= 1 to Length(S) do
      S[I]:= UpCase(S[I]);
END;  {---End of UpperCase---}



PROCEDURE ClearLine;
  {    This routine clears the line at X,Y for the next question and
  positions the cursor at X,Y.}

Var
   I        :Byte;

BEGIN
   Window(X,Y,50,Y);
   TextColor(White);
   Textbackground(Blue);
   ClrScr;
END;  {---End of ClearLine---}



FUNCTION LastNameCode(LastName : NameType) : NameType;
  {    Given a last name string (this string must not be null, and should
  be all caps), this function will return the code for the lastName part
  of the drivers license as a four character string. }

  Var
    Letter          : BYTE;
    NameCode        : NameType;
    FirstLetter     : Char;

  BEGIN                                            {--Start of LastNameCode--}
    FirstLetter:=LastName[1];                      {save the first letter    }
    Delete(LastName,1,1);                          {remove 1st ch from name  }
    NameCode:= '';                                 {initialise the code      }
    While Length(LastName)>=2 Do Begin             {while at 2 or > char     }
      If LastName[1]=LastName[2]                   {  If  double letters     }
        Then Delete(LastName,1,2)                  {    then delete them     }
      Else Begin                                   {  Else                   }
        NameCode:= NameCode+LastName[1];           {    add this char on     }
        Delete(LastName,1,1)                       {    and delete it        }
      End;                                         {                         }
    End;                                           {                         }
    NameCode:= NameCode+LastName;                  {   add whatever is left  }
    LastName:= NameCode;                           {set lastname to code     }
    NameCode:= '';                                 {clear out namecode       }
    While Length(LastName)>0 Do Begin              {while another char left  }
      If NOT (LastName[1] IN  ['A','E','I','O','U','H','W','Y']) {f not vowel}
        Then NameCode:= NameCode + LastName[1];    {   add char to the code  }
      Delete(LastName,1,1)                         {   done with this char   }
    End;                                           {go back for another      }
    For Letter:=1 to Length(NameCode) do           {For all lettters left    }
      Case NameCode[Letter] of                     {  Replace the letter     }
        'R'              : NameCode[Letter]:= '6'; {  with the appropriate   }
        'M','N'          : NameCode[Letter]:= '5'; {  number as shown in     }
        'L'              : NameCode[Letter]:= '4'; {  this case statement    }
        'T','D'          : NameCode[Letter]:= '3'; {                         }
        'B','F','P','V'  : NameCode[Letter]:= '1'; {                         }
      Else                                         {  ... or if no match     }
        NameCode[Letter]:= '2'                     {  use the number 2       }
      End;                                         {                         }
    While Length(NameCode)<3 do                    {If the number is < 3 char}
      NameCode:= NameCode + '0';                   {  fill it in with 0's    }
    If Length(NameCode)>3                          {If it's greater than 3   }
      Then NameCode:= Copy(NameCode,1,3);          {  use the 1st 3 charactrs}
    LastNameCode:= FirstLetter+NameCode;           {pass the function back   }
  END;  {---End of LastNameCode---}




FUNCTION FirstNameCode(FirstName : NameType; Middle : Char) : NameType;
  {    Given a first name string (this string must not be null, and should
  be all caps), this function will return the code for the FirstName part
  of the drivers license as a three character string. }

  Var
    NameCode        : NameType;
    NameNo          : Integer;
    Letter          : Byte;

BEGIN                                              {-Start of FirstNameCode--}
  If (FirstName='ALBERT') or (FirstName='ALICE')   {see if first name matches}
    Then NameNo:=20 Else                           {any standard name        }
  If (FirstName='ANN') or (FirstName='ANNE') or (FirstName='ANNA')
    or (FirstName='ANNIE') or (FirstName='ARTHUR')
    Then NameNo:=40 Else                           {if a match is found, set }
  If (FirstName='BERNARD') or (FirstName='BETTY')  {the name number equal to }
    or (FirstName='BETTE') or (FirstName='BETTIE') {predefined number for    }
    Then NameNo:=80 Else                           {that name                }
  If (FirstName='CARL') or (FirstName='CATHERINE')
    Then NameNo:=120 Else
  If (FirstName='CHARLES') or (FirstName='CLARA')
    Then NameNo:=140 Else
  If (FirstName='DONALD') or (FirstName='DOROTHY')
    Then NameNo:=180 Else
  If (FirstName='EDWARD') or (FirstName='ELIZABETH')
    Then NameNo:=220 Else
  If (FirstName='FLORENCE') or (FirstName='FRANK')
    Then NameNo:=260 Else
  If (FirstName='GEORGE') or (FirstName='GRACE')
    Then NameNo:=300 Else
  If (FirstName='HAROLD') or (FirstName='HARRIET')
    Then NameNo:=340 Else
  If (FirstName='HARRY') or (FirstName='HAZEL')
    Then NameNo:=360 Else
  If (FirstName='HELEN') or (FirstName='HENRY')
    Then NameNo:=380 Else
  If (FirstName='JAMES') or (FirstName='JANE') or (FirstName='JAYNE')
    Then NameNo:=440 Else
  If (FirstName='JEAN') or (FirstName='JOHN')
    Then NameNo:=460 Else
  If (FirstName='JOAN') or (FirstName='JOSEPH')
    Then NameNo:=480 Else
  If (FirstName='MARGARET') or (FirstName='MARTIN')
    Then NameNo:=560 Else
  If (FirstName='MARVIN') or (FirstName='MARY')
    Then NameNo:=580 Else
  If (FirstName='MELVIN') or (FirstName='MILDRED')
    Then NameNo:=600 Else
  If (FirstName='PATRICIA') or (FirstName='PAUL')
    Then NameNo:=680 Else
  If (FirstName='RICHARD') or (FirstName='RUBY')
    Then NameNo:=740 Else
  If (FirstName='ROBERT') or (FirstName='RUTH')
    Then NameNo:=760 Else
  If (FirstName='THELMA') or (FirstName='THOMAS')
    Then NameNo:=820 Else
  If (FirstName='WALTER') or (FirstName='WANDA')
    Then NameNo:=900 Else
  If (FirstName='WILLIAM') or (FirstName='WILMA')
    Then NameNo:=920
  Else
    Case FirstName[1] of                           {if no match is found for  }
      'A' : NameNo:=0  ;                           {the first name, just match}
      'B' : NameNo:=60 ;                           {the codes to the first    }
      'C' : NameNo:=100;                           {letter of the first name  }
      'D' : NameNo:=160;
      'E' : NameNo:=200;
      'F' : NameNo:=240;
      'G' : NameNo:=280;
      'H' : NameNo:=320;
      'I' : NameNo:=400;
      'J' : NameNo:=420;
      'K' : NameNo:=500;
      'L' : NameNo:=520;
      'M' : NameNo:=540;
      'N' : NameNo:=620;
      'O' : NameNo:=640;
      'P' : NameNo:=660;
      'Q' : NameNo:=700;
      'R' : NameNo:=720;
      'S' : NameNo:=780;
      'T' : NameNo:=800;
      'U' : NameNo:=840;
      'V' : NameNo:=860;
      'W' : NameNo:=880;
      'X' : NameNo:=940;
      'Y' : NameNo:=960;
      'Z' : NameNo:=980;
    End;
  Case Middle of
    'A'..'M'        : NameNo:= NameNo + ORD(Middle) - 64;
    'N','O'         : NameNo:= NameNo + 14;        {add on to the name number}
    'P','Q'         : NameNo:= NameNo + 15;        {the number for the middle}
    'R'             : NameNo:= NameNo + 16;        {initial                  }
    'S'             : NameNo:= NameNo + 17;
    'T','U','V'     : NameNo:= NameNo + 18;
    'W','X','Y','Z' : NameNo:= NameNo + 19;
  End;
  STR(NameNo:3, NameCode);                         {convert the number code  }
  For Letter:=1 to 3 do                            {to a 3 character string  }
    If NameCode[Letter]=' '                        {replace any leading blank}
       Then NameCode[Letter]:= '0';                {with a zero              }
  FirstNameCode:= NameCode;                        {pass back the code       }
END;  {---End of FirstNameCode---}




FUNCTION DateSexCode(Year,Month,Day :Byte;  Sex :CHAR ) : NameType;
  {     This function takes your birthdate and sex and converts this
  information to the date code part of the license number.  A six
  character string is returned from this routine. }

  Var
    DateNo          : Integer;
    DateCode        : NameType;
    YearStr         : String[2];
    DateStr         : String[3];
    Letter          : 1..5;

BEGIN                                     {  ---Start of DateSexCode---   }
  DateNo:=(Month-1) * 40 + Day;           {calculate date code            }
  If Sex='F' then DateNo:= DateNo+500;    {if female add on 500 more      }
  STR(Year:2,YearStr);                    {convert year to string         }
  STR(DateNo:3,DateStr);                  {convert date number to string  }
  DateCode:=YearStr+DateStr;              {add the strings together       }
  For Letter:= 1 to 5 Do                  {if there are any blanks in the }
    If DateCode[Letter]=' '               {  string, replace them with    }
      Then DateCode[Letter]:='0';         {  zeros.                       }
  Insert('-',DateCode,2);                 {put in the hyphen              }
  DateSexCode:= DateCode                  {pass back the answer           }
END;  {---End of DateSexCode---}



{+-------------------------------------------------------------------------+
 |         M A I N   P R O G R A M   ------> LICENSE.PAS                   |
 |          by  William Edstrom, Jr.                                       |
 |               July, 1986                                                |
 +-------------------------------------------------------------------------+}

BEGIN
  TextBackground(Black);
  TextColor(Yellow);
  Writeln('');
  Writeln('WISCONSIN DRIVERS LICENSE CALCULATOR   Version 1.0');
  X:= WhereX; Y:= WhereY;
  ClearLine;
  Write('Input your last Name: ');
  ReadLn(LastName); UpperCase(LastName);

  ClearLine;
  Write('Input your first Name: ');
  Readln(FirstName); UpperCase(FirstName);

  ClearLine;
  Write('Input your middle initial: ');
  Readln(Middle); Middle:= UpCase(Middle);

  ClearLine;
  Write('Input your Sex (M or F): ');
  Readln(Sex); Sex:= UpCase(Sex);


  ClearLine;
  Write('Input the month you were born (eg. 11): ');
  Readln(Month);

  ClearLine;
  Write('Input the day you were born (eg. 26): ');
  Readln(Day);

  ClearLine;
  Write('Input the year you were born (eg. 62): ');
  ReadLn(Year);

  ClearLine;
  Write('   Your WI DL Number: ');
  Write(LastNameCode(lastName)+'-');
  Write(FirstNameCode(FirstName,Middle));
  Write(DateSexCode(Year,Month,Day,Sex)+'-0?');

  TextBackground(Black);
  TextColor(Yellow);
  Window(1,1,80,25);
  GotoXY(X,Y);
  Writeln; Writeln;
  Writeln('     The last digit is the number of people ');
  Writeln('     with the exact same license number at ');
  Writeln('     the time you got your license, therefore');
  Writeln('     it cannot be determined.');
END.