program sd(input,output);

uses portfolio;

var
   sel, year, month, date, hr, min : integer;
   stardate,tmp : real;
   x : char;

function mth(mon : integer) : integer;
var x : integer;
begin
   case mon of
        0: x := 0;
        1: x := 31;
        2: if year/4 = year div 4 then
                x := 29 + mth(mon - 1)
           else x := 28 + mth(mon - 1);
        3: x := 31 + mth(mon - 1);
        4: x := 30 + mth(mon - 1);
        5: x := 31 + mth(mon - 1);
        6: x := 30 + mth(mon - 1);
        7: x := 31 + mth(mon - 1);
        8: x := 31 + mth(mon - 1);
        9: x := 30 + mth(mon - 1);
        10: x := 31 + mth(mon - 1);
        11: x := 30 + mth(mon - 1);
        12: x := 31 + mth(mon - 1);
   end;
   mth := x;
end;

procedure convert;
begin
   year := trunc(tmp);
   tmp := (tmp - year)*mth(12);
   hr := trunc((tmp-trunc(tmp))*24);
   min := trunc(((tmp-trunc(tmp))*24 - hr)*60);
   hr := hr * 100 + min;
   if tmp-mth(1) < 0 then begin
        month := 1;
        date := trunc(tmp);
   end else
   if tmp-mth(2) < 0 then begin
        month := 2;
        date := trunc(tmp-mth(month - 1));
   end else
   if tmp-mth(3) < 0 then begin
      month := 3;
      date := trunc(tmp-mth(month - 1));
   end else
   if tmp-mth(4) < 0 then begin
      month := 4;
      date := trunc(tmp-mth(month - 1));
   end else
   if tmp-mth(5) < 0 then begin
      month := 5;
      date := trunc(tmp-mth(month - 1));
   end else
   if tmp-mth(6) < 0 then begin
      month := 6;
      date := trunc(tmp-mth(month - 1));
   end else
   if tmp-mth(7) < 0 then begin
      month := 7;
      date := trunc(tmp-mth(month - 1));
   end else
   if tmp-mth(8) < 0 then begin
      month := 8;
      date := trunc(tmp-mth(month - 1));
   end else
   if tmp-mth(9) < 0 then begin
      month := 9;
      date := trunc(tmp-mth(month - 1));
   end else
   if tmp-mth(10) < 0 then begin
      month := 10;
      date := trunc(tmp-mth(month - 1));
   end else
   if tmp-mth(11) < 0 then begin
      month := 11;
      date := trunc(tmp-mth(month - 1));
   end else begin
      month := 12;
      date := trunc(tmp-mth(month - 1));
   end;
   write('Stardate: ',stardate:1:2,' = ',month:1,'/',date + 1:1,'/',year:1,'  ');
   if hr < 1000 then write('0');
   if hr = 0000 then write('00');
   writeln(hr:1);
   writeln;
   writeln;
end;

procedure TOSstd;
begin
   tmp := stardate/1095.75 + 2270;
   convert;
end;

procedure TNGstd;
begin
   tmp := stardate/730.5 + 2306;
   convert;
end;

procedure TOSdts;
begin
   tmp := year + (mth(month-1) + date - 1 + hr/2400)/mth(12);
   stardate := (tmp - 2270)*1095.75;
   writeln;
   writeln(month:1,'/',date:1,'/',year:1,'  ',hr:1);
   writeln('TOS Stardate: ',stardate:1:2);
   writeln;
end;

procedure TNGdts;
begin
   tmp := year + (mth(month-1) + date - 1 + hr/2400)/mth(12);
   stardate := (tmp - 2306)*730.5;
   writeln;
   writeln(month:1,'/',date:1,'/',year:1,'  ',hr:1);
   writeln('TNG Stardate: ',stardate:1:2);
   writeln;
end;

begin
  repeat
   clrscr;

   sel := portmenu(1,1,1,4,0,0,'Stardate Converter',
         '1 : TOS stardate to Real Year'+chr(0)+
         '2 : TNG stardate to Real Year'+chr(0)+
         '3 : Real Year to stardate'+chr(0)+
         '4 : Quit'+chr(0)+chr(0),
         ' ') + 1;
   clrscr;
   if sel=0 then sel:=4;
   case sel of
      1: begin
                   write('Enter TOS stardate: ');
                   readln(stardate);
                   TOSstd;
         end;
      2: begin
                   write('Enter TNG stardate: ');
                   readln(stardate);
                   TNGstd;
        end;
      3: begin
                   write('Enter Year: ');
                   readln(year);
                   write('Enter Month: ');
                   readln(month);
                   write('Enter Day: ');
                   readln(date);
                   write('Enter Hour: ');
                   readln(hr);
                   if year < 2306 then
                         TOSdts
                   else
                         TNGdts;
        end;
     4: writeln('Have a nice day (stardate, whatever)');
  end;
   if sel<>4 then begin
      write('Press a Key...');
      x:=readkey;
      writeln;
   end;
  until (sel = 4);
end.
