ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/PROG/PASCAL/TPHRT3.ZIP/WATCH.PAS

Pascal/Delphi Source File | 1990-07-23 | 19.3 KB | 467 lines

program watch;
{----------------------------------------------------------------------------
 |  Program WATCH.PAS                                                       |
 |                                                                          |
 |  This program creates a stopwatch on the display with "Taylor" split     |
 |  capability.  It is meant to show how to use TPHRT with a hardware       |
 |  interrupt in Turbo Pascal.                                              |
 |                                                                          |
 |  This program uses two timers to keep track of total and lap times.      |
 |  This method can result in a least significant digit "jitter" of .01 sec |
 |  on the lap timer.  A better, but more complex method is to use a single |
 |  timer to keep track of both.  The dual timer method makes for better    |
 |  demo code and was chosen for that reason only.                          |
 |                                                                          |
 |  This program uses BIOS interrupt F2h, which is unused in the current    |
 |  interrupt map.  If a TSR program is using interrupt F2h, unpredictable  |
 |  results will occur.  The original F2h interrupt vector is restored when |
 |  the program completes.                                                  |
 |                                                                          |
 |  Environment: Turbo Pascal / Stack check OFF                             |
 |                                                                          |
 |  (c)1989 Ryle Design, P.O. Box 22, Mt. Pleasant, Michigan 48804          |
 |                                                                          |
 |  V3.00 Shareware Evaluation Version                                      |
 ----------------------------------------------------------------------------}

{$S-}                                                   { stack check off }

uses
    dos, crt, tphrt;

const
    TIMEROFF  = 0;
    TIMERON   = 1;
    LAPSTOP   = 0;
    LAPRUN    = 1;
    F1        = 59;
    F2        = 60;
    KEYPORT   = $60;
    OLD09V    = $F2;

    MSMINS    = 60000000;
    MSSECS    = 1000000;
    MSHUNDS   = 10000;

var
    tstring   : string[8];
    lstring   : string[8];

    atom      : char;

    tstate    : integer;
    lstate    : integer;
    laps      : integer;
    cursor    : integer;

    ltime     : longint;
    ttime     : longint;
    hits      : longint;

    dtime     : array [1..2] of pchrt_type;

    old_keybd_int : pointer;
    old_f2_int    : pointer;



function hide_cursor : integer;
{---------------------------------------------------------------------------
 |  This function disables the cursor.                                     |
 |                                                                         |
 |  Globals referenced: none                                               |
 |                                                                         |
 |  Arguments : void                                                       |
 |                                                                         |
 |  Returns   : (integer) cursor shape for later restoration               |
 ---------------------------------------------------------------------------}
var
    regs        : registers;

begin
    regs.ah := 15;                                              { get current video page }
    intr($10,regs);

    regs.ah := 3;                                               { request cursor shape }
    intr($10,regs);                                             { regs.bh has video page from last int86() call }

    hide_cursor := regs.cl + ( regs.ch shl 8);                  { store cursor start & stop rasters }

    regs.ah := 1;                                               { set cursor shape             }
    regs.ch := 32;                                              { set bit 5 - turns cursor off }
    intr($10,regs);                                             { and disable cursor           }

end; { hide_cursor }



procedure set_cursor(cursortype : integer);
{----------------------------------------------------------------------------
 |  This procedure sets the cursor to a new shape.                          |
 |                                                                          |
 |  Globals referenced: none                                                |
 |                                                                          |
 |  Arguments : (integer) cursortype - high 8 bits is start raster          |
 |                                     low 8 bits is stop raster            |
 |  Returns   : void                                                        |
 ----------------------------------------------------------------------------}
var
    regs    : registers;

begin
    regs.ah := 1;                                               { set cursor shape       }
    regs.ch := (cursortype and $FF00) shr 8;                    { cursor start raster    }
    regs.cl := (cursortype and $00FF);                          { cursor stop raster     }
    intr($10,regs);                                             { call BIOS interupt 10h }

end; { set_cursor }



procedure new_keybd_int; interrupt;
{----------------------------------------------------------------------------
 |  This procedure is our new interrupt service routine for interrupt 9h.   |
 |  The following occurs:                                                   |
 |      1. The keyboard hardware port is read to see what key was pressed.  |
 |      2. If F1 or F2 were pressed, the watch state is checked and         |
 |         appropriate action is taken.                                     |
 |      3. The old keyboard interrupt is called.                            |
 |                                                                          |
 |  Since this function is invoked by a hardware interrupt, it functions    |
 |  asynchronously to the main program execution and provides extremely     |
 |  high timing accuracy.                                                   |
 |                                                                          |
 |  Globals referenced: tstate                                              |
 |                      lstate                                              |
 |                      ltime                                               |
 |                      ttime                                               |
 |                      laps                                                |
 |                      old_keybd_int                                       |
 |                                                                          |
 |  Arguments: void                                                         |
 |                                                                          |
 |  Returns  : void                                                         |
 ----------------------------------------------------------------------------}
var
    scan_code   : byte;
    regs        : registers;

begin
    scan_code := port[KEYPORT];                     { read keyboard }
    if (scan_code = F1) then                        { check for F1 key }
    begin
        if (tstate = TIMEROFF) then                 { if the watch is off ... }
        begin
            t_entry(1);                             { start main timer }
            t_entry(2);                             { start lap timer  }
            tstate := TIMERON;                      { set state flags  }
            lstate := LAPRUN;
        end
        else                                        { the watch was on ... }
        begin
            t_exit(1);                              { stop main timer }
            t_exit(2);                              { stop lap timer  }
            tstate := TIMEROFF;                     { set flags       }
            lstate := LAPSTOP;
        end;
    end
    else if (scan_code = F2) then                   { check for F2 key }
    begin
        if (tstate = TIMEROFF) then                 { if watch was off }
        begin
            t_reset(1);                             { master reset     }
            t_reset(2);
            ttime := 0;
            ltime := 0;
            laps := 0;
        end
        else                                        { if watch was running }
        begin
            if (lstate = LAPRUN) then               { end of lap if lap was running }
            begin
                t_exit(2);
                t_ask_timer(2,hits,ltime);
                t_reset(2);
                t_entry(2);
                lstate := LAPSTOP;
                laps := laps + 1;
            end
            else                                    { current lap continues if lap was off }
            begin
                lstate := LAPRUN;
            end;
        end;
    end;

    intr($F2,regs);                                 { call the old keyboard ISR }

end; { new_keybd_int }



procedure restore_old_keybd_int;
{----------------------------------------------------------------------------
 |  This procedure restores the original keyboard interrupt and must be     |
 |  called prior to program completion.                                     |
 |                                                                          |
 |  Globals referenced: old_keybd_int                                       |
 |                                                                          |
 |  Arguments: void                                                         |
 |                                                                          |
 |  Returns  : void                                                         |
 ----------------------------------------------------------------------------}
begin
    setintvec(9,old_keybd_int);                       { restore old ISR vectors }
    setintvec($F2,old_f2_int);

end; { restore_old_keybd_int }



procedure install_new_keybd_int;
{----------------------------------------------------------------------------
 |  This procedure saves the original keyboard interrupt vector and installs|
 |  the address of our user written interrupt handler in the ISR vector     |
 |  table.                                                                  |
 |                                                                          |
 |  Globals referenced: old_keybd_int                                       |
 |                      new_keybd_int                                       |
 |                                                                          |
 |  Arguments: void                                                         |
 |                                                                          |
 |  Returns  : void                                                         |
 ----------------------------------------------------------------------------}
begin
    getintvec(9,old_keybd_int);                             { save old ISR vector    }
    setintvec(9,addr(new_keybd_int));                       { install new ISR vector }

    getintvec($F2,old_f2_int);                              { save old ISR vector    }
    setintvec($F2,old_keybd_int);                           { install new ISR vector }

end; { install_new_keybd_int }



procedure make_time_string(tval : longint; var tstring : string);
{----------------------------------------------------------------------------
 |  This procedure converts a quantity of microseconds into a displayable   |
 |  string in the form MM:SS.HH .                                           |
 |                                                                          |
 |  Globals referenced: none                                                |
 |                                                                          |
 |  Arguments: (longint) tval - time in microseconds to convert             |
 |             (string) tstring - string to receive time conversion         |
 |                                                                          |
 |  Returns  : void                                                         |
 ----------------------------------------------------------------------------}
var
    mins, secs, hunds  : integer;
    smins,ssecs,shunds : string[2];

begin
    mins := tval div MSMINS;
    tval := tval - (mins * MSMINS);

    secs := tval div MSSECS;
    tval := tval - (secs * MSSECS);

    hunds := tval div MSHUNDS;

    str(mins,smins);                                    { mins to string }
    if (length(smins) = 1) then smins := '0' + smins;

    str(secs,ssecs);                                    { secs to string }
    if (length(ssecs) = 1) then ssecs := '0' + ssecs;

    str(hunds,shunds);                                  { hundreds to string }
    if (length(shunds) = 1) then shunds := '0' + shunds;

    tstring := smins + ':' + ssecs + '.' + shunds;      { build final string }

end; { make_time_string }



procedure draw_watch;
{----------------------------------------------------------------------------
 |  This procedure draws the stopwatch on the display.                      |
 |                                                                          |
 |  Globals referenced: none                                                |
 |                                                                          |
 |  Arguments: void                                                         |
 |                                                                          |
 |  Returns  : void                                                         |
 ----------------------------------------------------------------------------}
var
    indx    : integer;

begin
    gotoxy(33,9);   write(chr(218));                     { draw the corners }
    gotoxy(46,9);   write(chr(191));
    gotoxy(33,15);  write(chr(192));
    gotoxy(46,15);  write(chr(217));

    for indx :=34 to 45 do                              { draw horizontal lines }
    begin
        gotoxy(indx,9);   write(chr(196));
        gotoxy(indx,15);  write(chr(196));
        gotoxy(indx,12);  write(chr(196));
    end;

    for indx :=10 to 14 do                              { draw vertical lines }
    begin
        gotoxy(33,indx);  write(chr(179));
        gotoxy(46,indx);  write(chr(179));
    end;

    gotoxy(33,12); write(chr(195));                      { draw vert/horiz intersections }
    gotoxy(46,12); write(chr(180));

    gotoxy(35,10); write('Total Time');
    gotoxy(37,13); write('Lap 00');

end; { draw_watch }



procedure show_total_time(ttime : longint);
{----------------------------------------------------------------------------
 |  This procedure displays the total time accumulated by the watch in the  |
 |  appropriate area of the watch face.                                     |
 |                                                                          |
 |  Globals referenced: none                                                |
 |                                                                          |
 |  Arguments: (longint) ttime - time to display                            |
 |                                                                          |
 |  Returns  : void                                                         |
 ----------------------------------------------------------------------------}
var
    tstring : string;

begin
    make_time_string(ttime,tstring);    { convert microseconds to MM:SS.HH }

    gotoxy(36,11);  write(tstring);

end; { show_total_time }



procedure show_lap_time(ltime : longint);
{----------------------------------------------------------------------------
 |  This procedure displays the current lap time accumulated by the watch in|
 |  the appropriate area of the watch face.                                 |
 |                                                                          |
 |  Globals referenced: none                                                |
 |                                                                          |
 |  Arguments: (longint) ltime - time to display                            |
 |                                                                          |
 |  Returns  : void                                                         |
 ----------------------------------------------------------------------------}
var
    tstring : string;

begin
    make_time_string(ltime,tstring);    { convert microseconds to MM:SS.HH }

    gotoxy(36,14);  write(tstring);

end; { show_lap_time }



procedure show_lap(lap : integer);
{----------------------------------------------------------------------------
 |  This procedure displays the current lap the watch is timing in the      |
 |  appropriate area of the watch face.                                     |
 |                                                                          |
 |  Globals referenced: none                                                |
 |                                                                          |
 |  Arguments: (int) lap - lap to display                                   |
 |                                                                          |
 |  Returns: void                                                           |
 ----------------------------------------------------------------------------}
begin
    if (lap = 100) then lap := 0;            { roll over after 99 laps }

    gotoxy(41,13);  write(lap:2);

end; { show_lap }


begin

    { initialize things }

    t_start;

    ltime := 0;
    ttime := 0;
    laps  := 0;
    tstate := TIMEROFF;
    lstate := LAPSTOP;
    atom := chr(0);

    { set up the display }

    clrscr;
    cursor := hide_cursor;

    gotoxy(26,6); write('TPHRT Demonstration Series');
    gotoxy(32,7); write('StopWatch V3.00');

    draw_watch;

    gotoxy(14,17); write('F1 Starts/Stops Watch          F2 Lap Splits/Resets Watch');
    gotoxy(35,19); write('<ESC> quits');

    show_total_time(ttime);
    show_lap_time(ltime);
    show_lap(laps);

    install_new_keybd_int;

    { watch display update loop }

    repeat
        if (tstate = TIMEROFF) then
        begin
            t_ask_timer(1,hits,ttime);
            t_ask_timer(2,hits,ltime);
            show_total_time(ttime);
            show_lap_time(ltime);
            show_lap(laps);
        end
        else
        begin
            t_get(dtime[1]);
            ttime := t_diff(tdata[1]^.tstart,dtime[1]) + tdata[1]^.elapsed;
            show_total_time(ttime);
            if (lstate = LAPRUN) then
            begin
                t_get(dtime[2]);
                ltime := t_diff(tdata[2]^.tstart,dtime[2]) + tdata[2]^.elapsed;
                show_lap_time(ltime);
            end
            else
            begin
                show_lap_time(ltime);
                show_lap(laps);
            end;
        end;

        if keypressed then atom := readkey;

    until (atom = chr(27));

    { if user presses <ESC>, we fall through to here.  Clean up and exit }

    restore_old_keybd_int;

    set_cursor(cursor);
    gotoxy(1,23);  writeln('StopWatch complete.');

    t_stop;

end.