program IO20DEMO ;
  { This program demonstrates Turbo Pascal I/O routines
    developed by Wm Meacham.
    Revised 4/18/86 }

  { For CP/M, compile to COM file with End address of $7000. }

{$c-,v-}
{$i io20.inc }
{$i date20.inc }

var
    choice           : integer ;    { to get menu choice }
    quitnow          : boolean ;    { to get user Y/N input }

{ ------------------------------------------------------------ }

procedure title_screen ;
    begin
        clrscr;
        write_str ('-------------------',30,6) ;
        write_str ('                   ',30,7) ;
        write_str ('   Demonstration   ',30,8) ;
        write_str ('        of         ',30,9) ;
        write_str ('   Turbo Pascal    ',30,10) ;
        write_str ('   I/O routines    ',30,11) ;
        write_str ('                   ',30,12) ;
        write_str ('-------------------',30,13) ;
        write_str ('    Reliance Software Services',23,18) ;
        write_str ('1004 Elm Street, Austin, Tx  78703',23,19) ;
        write_str ('   Public Domain - No Copyright',23,21) ;
        fld := 0 ;
        hard_pause ;
        if fld = maxint then halt
    end ; { proc title_screen }

{ ------------------------------------------------------------ }

procedure display_menu ;
begin
    clrscr ;
    write_str('I/O DEMONSTRATION',32,3) ;
    write_str('MAIN MENU',36,4) ;
    write_str('Please select:',26,6) ;
    write_str('1    Display instructions',26,8) ;
    write_str('2    Data entry and display demo for',26,10) ;
    write_str('Strings, Integers, Reals and Booleans',31,11) ;
    write_str('3    Data entry and display demo for Dates',26,13) ;
    write_str('ESC  Exit the program',26,15) ;
    write_str('==>',26,17)
end ; { proc display_menu }

{ ------------------------------------------------------------ }

procedure display_instructions ;
begin
    clrscr;
    write_str('   COMMAND             Labelled     Arrow   Ctrl     Function',7,1) ;
    write_str('                         key         key    key      key (IBM)',7,2) ;
    write_str('   ------              --------     -----   ----     ---------',7,3) ;
    write_str('*  DELETE character      Del,       left      S         F1',7,4) ;
    write_str('   to left             Backspace',7,5) ;
    write_str('*  DELETE entire                              Y         F2',7,6) ;
    write_str('   entry',7,7) ;
    write_str('*  MOVE DOWN            Return,     down      X         F4',7,8) ;
    write_str('   a line               Enter',7,9) ;
    write_str('*  MOVE UP                           up       E         F3',7,10) ;
    write_str('   a line',7,11) ;
    write_str('*  PAGE FORWARD                     PgDn      C         F8',7,12) ;
    write_str('   to next screen                   (IBM)',7,13) ;
    write_str('*  PAGE BACKWARD                    PgUp      R         F7',7,14) ;
    write_str('   to prev. screen                  (IBM)',7,15) ;
    write_str('*  CANCEL data entry     Esc',7,16) ;
    write_str('*  TO ENTER DATA:    Type the data & press Enter or another',7,18) ;
    write_str('cursor movement key.',28,19) ;
    write_str('*  TO ENTER YES/NO:  Type "Y" or "N;" don''t press Enter.',7,20) ;
    write_str('*  TO ENTER A DATE:  Type the month & press Enter, type the day',7,21) ;
    write_str('& press Enter, type the year & press Enter.',28,22) ;
    hard_pause ;
    fld := 1 { reset FLD for calling proc }
end ; { proc display_instructions }

{ ------------------------------------------------------------ }

procedure io_demo ;
  { demonstrate I/O of strings, integers, reals and booleans }

var
    first, last, addr1, addr2, city,
          state, zip : str_type ;   { for string demo }
    i1, i2, i3, itot : integer ;    { for integer demo }
    r1, r2, r3, rtot : real ;       { for real demo }
    b1, b2, b3, b4   : boolean ;    { for boolean demo }

{ ==================== }

procedure init_io_vars ;
  { Initializes global variables }
    begin
        first := '' ;
        last  := '' ;
        addr1 := '' ;
        addr2 := '' ;
        city  := '' ;
        state := '' ;
        zip   := '' ;
        i1 := 0 ;
        i2 := 0 ;
        i3 := 0 ;
        itot := 0 ;
        r1 := 0 ;
        r2 := 0 ;
        r3 := 0 ;
        rtot := 0 ;
        b1 := false ;
        b2 := false ;
        b3 := false ;
        b4 := false
    end ; { proc init_io_vars }

{ ==================== }

procedure strings ;
  { This procedure demonstrates reading and writing strings. }

    var
        i  : integer ; { For loop control }
        ok : boolean ; { Whether zip code is numeric }

    begin
        clrscr ;
        write ('SCREEN ', scrn, ' -- STRINGS') ;
        write_str ('First name:',9,8) ;
        write_str (first,21,8 ) ;
        write_str ('Last name:',9,9) ;
        write_str (last,21,9) ;
        write_str ('Address 1:',9,10) ;
        write_str (addr1,21,10) ;
        write_str ('Address 2:',9,11) ;
        write_str (addr2,21,11) ;
        write_str ('City:',9,12) ;
        write_str (city,21,12) ;
        write_str ('State:',9,13) ;
        write_str (state,21,13) ;
        write_str ('Zip:',9,14) ;
        write_str (zip,21,14) ;
        fld := 1 ;
        repeat
                case fld of
                  1: read_str (first, 15, 21, 8) ;
                  2: read_str (last, 10, 21, 9) ;
                  3: read_str (addr1, 15, 21, 10) ;
                  4: read_str (addr2, 15, 21, 11) ;
                  5: read_str (city, 15, 21, 12) ;
                  6: read_str (state, 2, 21, 13) ;
                  7: begin
                       repeat
                           read_str (zip, 5, 21, 14) ;
                           ok := true ;
                           if not (zip = '') then
                               begin
                                   if length (zip) < 5 then
                                           ok := false
                                   else
                                           for i:= 1 to 5 do
                                               if (zip[i] <'0')
                                               or (zip[i] >'9') then
                                                   ok := false
                               end ;
                           if not ok then
                             begin
                               show_msg ('MUST BE NUMERIC OR NOT ENTERED') ;
                               zip := '' ;
                               fld := 7
                             end
                       until ok ;
                     end ; { 7: }
                end ; { case }
        until (fld < 1) or (fld > 7) ;
        do_scrn_ctl
    end ; { proc strings }

{ ==================== }

procedure integers ;
  { This procedure demonstrates reading & writing integers. }

    procedure sum_int ;
        begin
            itot := i1 + i2 + i3 ;
            write_int (itot, 5, 13, 12)
        end ;

    begin { integers }
        clrscr ;
        write ('SCREEN ', scrn, ' -- INTEGERS') ;
        write_str ('==>', 9, 8) ;
        write_int (i1,4,14,8) ;
        write_str ('==>', 9, 9) ;
        write_int (i2,4,14,9) ;
        write_str ('==>', 9, 10) ;
        write_int (i3,4,14,10) ;
        write_str ('TOTAL', 7, 12) ;
        write_int (itot,5,13,12) ;
        fld := 1 ;
        repeat
                case fld of
                  1: begin
                       read_int (i1, 4, 14, 8) ;
                       sum_int ;
                     end ;
                  2: begin
                       read_int (i2, 4, 14, 9) ;
                       sum_int ;
                     end ;
                  3: begin
                       read_int (i3, 4, 14, 10) ;
                       sum_int ;
                     end ;
                  4: pause ;
                end ; { case }
        until (fld < 1) or (fld > 4 ) ;
        do_scrn_ctl
    end ; { proc integers }

{ ==================== }

procedure reals ;
  { This procedure demonstrates reading & writing reals. }

    const
        tot  = 11 ;
        frac = 3  ;

    procedure sum_real ;
        begin
            rtot := r1 + r2 + r3 ;
            write_real (rtot, tot+1, frac, 13, 12)
        end ;

    begin { proc reals }
        clrscr ;
        write ('SCREEN ', scrn, ' -- REALS') ;
        write_str ('==>', 9, 8) ;
        write_real (r1,tot,frac,14,8) ;
        write_str ('==>', 9, 9) ;
        write_real (r2,tot,frac,14,9) ;
        write_str ('==>', 9, 10) ;
        write_real (r3,tot,frac,14,10) ;
        write_str ('TOTAL', 7, 12) ;
        write_real (rtot,12,3,13,12) ;
        fld := 1 ;
        repeat
                case fld of
                  1: begin
                       read_real (r1, tot,frac, 14, 8) ;
                       sum_real ;
                     end ;
                  2: begin
                       read_real (r2, tot,frac, 14, 9) ;
                       sum_real ;
                     end ;
                  3: begin
                       read_real (r3, tot,frac, 14, 10) ;
                       sum_real ;
                     end ;
                  4: pause ;
                end ; { CASE }
        until (fld < 1) or (fld > 4 ) ;
        do_scrn_ctl
    end ; { proc reals }

{ ==================== }

procedure booleans ;
  { This procedure demonstrates reading & writing booleans }
    begin
        clrscr;
        write ('SCREEN ', scrn, ' -- BOOLEANS') ;
        write_str ('TYPE OF CO-BORROWER.  Type "Y" for all that apply.',3,8) ;
        write_str ('"No" will be assumed if you just press <RETURN>.',3,9) ;
        write_str ('1 - Another person will be jointly obligated with borrower',5,10) ;
        write_str ('2 - Borrower is relying on income of another person',5,11) ;
        write_str ('3 - Married, living in a community property state',5,12) ;
        write_bool (b1, 71, 10) ;
        write_bool (b2, 71, 11) ;
        write_bool (b3, 71, 12) ;
        write_str ('Epimenides the Cretan says, "All Cretans are liars!"  Is he lying?',3,14) ;
        write_bool (b4, 71, 14) ;
        fld := 1 ;
        repeat
            case fld of
              1: read_bool (b1, 71, 10) ;
              2: read_bool (b2, 71, 11) ;
              3: read_bool (b3, 71, 12) ;
              4: read_bool (b4, 71, 14) ;
              5: pause ;
            end ; { case }
        until (fld <1) or (fld > 5) ;
        do_scrn_ctl
    end ; { booleans }

{ ==================== }

procedure final_screen ;
  { The final screen -- demonstrates proc Read_YN }
    var
        more : boolean ;
    begin
        clrscr ;
        write_str ('End of demonstration.',20, 10) ;
        write_str ('Do it again?',20, 12) ;
        read_yn (more, 34, 12) ;
        if more then
            scrn := 1
        else
            scrn := succ(scrn)
    end ; { proc final_screen }

{ ==================== }

begin { ----- proc io_demo ----- }
    scrn := 1 ;
    init_io_vars ;
    repeat
        case scrn of
          1 : strings  ;
          2 : integers ;
          3 : reals ;
          4 : booleans ;
          5 : final_screen
        end ; { case }
        if scrn < 1 then
              scrn := 1           { no going backward from first screen }
        else if scrn > 6 then
              scrn := 5           { trap ESC }
    until scrn > 5 ;
    fld := 1 ;                    { reset FLD for calling proc }
end ; { proc io_demo }

{ ------------------------------------------------------------------------ }

procedure date_demo ;
  { demonstrates the things you can do with dates }

const
    null_jul : juldate = (yr:0 ; day:0) ;
    blanks   : string[10] = '          ' ;

var
    date1,
    date2,
    temp1,
    temp2    : date ;
    workjul  : juldate ;
    juldtst  : juldatestring ;
    dtst     : datestring ;
    diff     : string[7] ;
    n        : integer ;
    prevfld  : integer ;

{ ==================== }

procedure display_diff ;
  begin
    if equal_date (date1,null_date)
    or equal_date (date2,null_date) then
        for n := 18 to 21 do
            clrline (16,n)
    else if equal_date(date1,date2) then
      begin
        write_str ('The dates are equal',16,18) ;
        write ('':20) ;
        for n := 20 to 21 do
            clrline (16,n)
      end
    else
      begin
        write_date (date1,16,18) ;
        if greater_date(date1,date2) = 1 then
          begin
            write (' is later than ') ;
            temp1 := date2 ;
            temp2 := date1
          end
        else
          begin
            write (' is earlier than ') ;
            temp1 := date1 ;
            temp2 := date2
          end ;
        dtst := mk_dt_st(date2) ;
        write (dtst) ;
        write ('':20) ;
        write_str ('There are ',16,20) ;
        str(date_diff(temp1,temp2):7:0,diff) ;
        diff := purgech(diff,' ') ;
        write (diff,' days (about ') ;
        write (month_diff(temp1,temp2)) ;
        write (' months) between') ;
        write ('':20) ;
        write_str ('the two dates.',16,21)
      end
  end ;

{ ==================== }

begin { proc date_demo }
    clrscr ;
    write_str('Enter two dates, press ESC to quit.',16,1) ;
    write_str('DATE 1               DATE 2',32,3) ;
    write_str('------               ------',32,4) ;
    write_str('==>                  ==>',26,6) ;
    write_str('Julian date:',17,8) ;
    write_str('Next day:',20,10) ;
    write_str('Previous day:',16,12) ;
    write_str('Leap year?',19,14) ;
    write_str('=============================================',16,16) ;
    date1 := null_date ;
    date2 := null_date ;
    fld := 1 ;
    repeat
        case fld of
         1: begin
              prevfld := 1 ;
              read_date (date1,30,6) ;
              if not (equal_date(date1,null_date)) then
                begin
                  greg_to_jul (date1,workjul) ;
                  juldtst := mk_jul_dt_st (workjul) ;
                  write_str (juldtst,32,8) ;
                  temp1 := date1 ;
                  next_day (temp1) ;
                  write_date (temp1,30,10) ;
                  temp1 := date1 ;
                  prev_day (temp1) ;
                  write_date (temp1,30,12) ;
                  write_bool (leapyear(date1.yr),32,14) ;
                end
              else
                  for n := 8 to 14 do
                      write_str (blanks,30,n) ;
              display_diff
            end ; { 1 }
         2: begin
              prevfld := 2 ;
              read_date (date2,51,6) ;
              if not (equal_date(date2,null_date)) then
                begin
                  greg_to_jul (date2,workjul) ;
                  juldtst := mk_jul_dt_st (workjul) ;
                  write_str (juldtst,53,8) ;
                  temp1 := date2 ;
                  next_day (temp1) ;
                  write_date (temp1,51,10) ;
                  temp1 := date2 ;
                  prev_day (temp1) ;
                  write_date (temp1,51,12) ;
                  write_bool (leapyear(date2.yr),53,14) ;
                end
              else
                  for n := 8 to 14 do
                      write_str (blanks,51,n) ;
              display_diff
            end ; { 2 }
         3: begin
              prevfld := 3 ;
              pause
            end
        end ; { case }
        if fld < 1 then                           { can't go back from 1 }
            fld := 1
        else if (fld > 3) and (fld < maxint) then
          begin
            if prevfld = 3 then
                fld := 1                          { back to beginning from 3 }
            else
                fld := 3                          { trap next_page }
          end
    until fld = maxint ;
    fld := 1  { reset FLD for calling proc }
end ; { proc date_demo }

{ ------------------------------------------------------------ }

begin { --- program IO20DEMO --- }
    title_screen ;
    repeat
        display_menu ;
        repeat
            fld := 1 ;
            choice := 0 ;
            read_int (choice,1, 31,17) ;
            if fld < 1 then choice := 0 ;
            if fld = maxint then
              begin
                write_str (' ',31,17) ;
                write_str ('QUIT NOW? (Y/N)',26,19) ;
                read_yn (quitnow,42,19) ;
                if not quitnow then
                  begin
                    fld := 1 ;
                    choice := 0 ;
                    clrline (26,19)
                  end
              end ;
        until (choice in [1 .. 3]) or (fld = maxint) ;
        if not (fld = maxint) then
            case choice of
              1: display_instructions ;
              2: io_demo ;
              3: date_demo ;
            else
                 beep
            end  { case }
    until fld = maxint ;
    clrscr ;
    write_str ('Thank you for trying the Reliance I/O Demonstration',12,5) ;
    write_str ('Program.  Please send me your comments and suggestions.',12,6) ;
    write_str ('Bill Meacham',30,10) ;
    write_str ('Reliance Software Services',24,11) ;
    write_str ('1004 Elm Street',29,12) ;
    write_str ('Austin, Tx  78703',28,13) ;
    writeln ; writeln
end.