home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / TP003.ZIP / CLKDEM.420 < prev    next >
Encoding:
Text File  |  1986-08-03  |  7.3 KB  |  192 lines
  1. {------------------------------------------------------------------}
  2. {                 C L O C K      D E M O                           }
  3. {------------------------------------------------------------------}
  4. (* file CLOCKDEM.414
  5.  
  6.    TO convert your stayres demo to a TIMER,
  7.    a) comment out the line "Procedure Get_File"
  8.    b) replace STAYDEM.400 with CLOCKDEM.400
  9.    c) just before the $I STAYI8.OBJ, insert the line "{$I clock_I8.inl}"
  10.  
  11. 13-Jun-86 12:11 PDT
  12. Sb:  CLOCKDEM.400
  13. Fm: Neil J. Rubenking [72267,1531]
  14. To: 70357,2716
  15.  
  16.  *)
  17.  
  18.   VAR
  19.     hiclock : Integer ABSOLUTE $40 : $6E;        {High Word of Bios Timer Count}
  20.     Loclock : Integer ABSOLUTE $40 : $6C;        {Low Wrod of Bios Timer Count}
  21.   const
  22.     timer_hi : integer = 0;
  23.     timer_lo : integer = 0;
  24.     timer_message : string[80] = '';
  25.     timer_on = 4;                  { The Demo timer is active (running) }
  26.     from_timer = 8;                { The Demo timer has finished (posted)}
  27.  
  28. function get_integer(MAX : integer) : integer;
  29. VAR CH : char;
  30.     temp : real;
  31. BEGIN
  32.   temp := 0;
  33.   repeat
  34.     repeat read(Kbd,CH) until CH in ['0'..'9',#8,#13];
  35.     case CH of
  36.       #8 : IF temp > 0 THEN
  37.              BEGIN
  38.                temp := INT(temp/10);
  39.                write(#8,' ',#8);
  40.              END;
  41.       #13:;
  42.       ELSE
  43.         temp := temp * 10 + ord(CH) - ord('0');
  44.         IF temp > MAX THEN
  45.           BEGIN
  46.             write(#7);
  47.             temp := INT(temp/10);
  48.           END
  49.         ELSE write(CH);
  50.     END; {case}
  51.   until CH = #13;
  52.   get_integer := trunc(temp);
  53. END;
  54.  
  55.   procedure BeBeep;
  56.   VAR N : byte;
  57.   BEGIN
  58.     nosound;
  59.     FOR N := 1 to 3 do
  60.       BEGIN
  61.         sound(800); delay(50);
  62.         sound(400); delay(50);
  63.       END;
  64.     nosound;
  65.   END;
  66.  
  67.  
  68. procedure Clock_Demo;
  69.   CONST
  70.     ampm : ARRAY[0..1] OF STRING[2] = ('am', 'pm');
  71.  
  72.   VAR
  73.     tics, HiWord, LoWord : Real;
  74.     hours, mins, secs    : STRING[2];
  75.     time                 : STRING[10];
  76.     am_or_pm             : Integer;
  77.     timer_time           : Integer;
  78.     countDown            : Integer;
  79.  
  80.    {-------------------------------------------------------------}
  81.    {         D o u b l e  to  R e a l  number conversion         }
  82.    {-------------------------------------------------------------}
  83.    function double_to_real(I,J : integer):real;
  84.    var temp : real;
  85.    BEGIN
  86.      temp := I; IF temp < 0 THEN temp := temp + 65536.0;
  87.      temp := temp * 65536.0;
  88.      IF J < 0 THEN temp := temp + 65536.0 + J ELSE temp := temp + J;
  89.      double_to_real := temp;
  90.    END;
  91.  
  92.    {-------------------------------------------------------------}
  93.    {           R e a l  t o  D o u b l e    number conversion    }
  94.    {-------------------------------------------------------------}
  95.    procedure Real_to_double(R : real; VAR I, J : integer);
  96.    var It, Jt : real;
  97.    BEGIN
  98.        It := Int(R/65536.0);
  99.        Jt := R - It*65536.0;
  100.        IF It > MaxInt THEN I := trunc(It - 65536.0) ELSE I := trunc(It);
  101.        IF Jt > MaxInt THEN J := trunc(Jt - 65536.0) ELSE J := trunc(Jt);
  102.    END;
  103.  
  104.    {-------------------------------------------------------------}
  105.    {           S e t   T i m e    Turn timer on                  }
  106.    {-------------------------------------------------------------}
  107.    PROCEDURE Set_Timer(the_time : integer);
  108.    BEGIN
  109.      tics := double_to_real(HiClock, LoClock);
  110.      tics := tics + 60*the_time*18.206481934;
  111.      real_to_double(tics, timer_hi, timer_lo);
  112.      Status := status or Timer_On;
  113.  
  114.    END;
  115.  
  116. begin
  117.   While Keypressed DO read(Kbd,KeyChr); {clear any waiting keys}
  118.   GotoXY(1,1);
  119.   tics := double_to_real(HiClock, LoClock) /18.206481934; {current timer tics}
  120.   Str(Trunc(tics/3600.0) MOD 12, hours);            {Get Hour of Day   }
  121.   am_or_pm := Trunc(tics/3600.0);                   {pm if > 12        }
  122.   IF hours = '0' THEN hours := '12';                {adjust for noon   }
  123.   IF hours[0] = #1 THEN hours := '0'+hours;         {right justify hours}
  124.   Str(Trunc(tics/60.0) MOD 60, mins);               {Get minutes in hour}
  125.   IF mins[0] = #1 THEN mins := '0'+mins;            {Right justify minutes}
  126.   Str(Trunc(tics-Int(tics/60)*60), secs);           {Get partial minutes}
  127.   IF secs[0] = #1 THEN secs := '0'+secs;            {Right justify seconds}
  128.   time := hours+':'+mins+':'+secs                   {concatenate all elements}
  129.                    +ampm[am_or_pm DIV 12];          {get index to ampm array }
  130.   WriteLn('THE CURRENT TIME is ',time);             {What time is it Prez ?  }
  131.  
  132.   IF (status AND timer_on) = timer_on THEN          {If our timer is ticking ..}
  133.     BEGIN
  134.       IF (status AND from_timer) = from_timer THEN  {and the timer has finished..}
  135.         BEGIN                                  {then clear the timer request }
  136.           status := status and not (timer_on + from_timer);
  137.           bebeep;                              {Beep the user and pass the msg}
  138.           writeLn(timer_message);
  139.         END
  140.       ELSE                             {If timer is active but not finished ..}
  141.         BEGIN                          {then the user the time.               }
  142.           tics := double_to_real(timer_Hi, timer_Lo) -
  143.                   double_to_real(HiClock, LoClock);
  144.           tics := tics / 18.206481934;
  145.           Str(Trunc(tics/60.0) MOD 60, mins);
  146.           IF mins[0] = #1 THEN mins := '0'+mins;
  147.           Str(Trunc(tics-Int(tics/60)*60), secs);
  148.           IF secs[0] = #1 THEN secs := '0'+secs;
  149.           WriteLn(mins,':',secs,' to go on timer.');
  150.         END;
  151.     END
  152.   ELSE                                  {If timer is not active then get info }
  153.     BEGIN                               {to set it running                    }
  154.       Write('How many minutes should timer run (0..60)? : ');
  155.       timer_time := Get_Integer(60);writeLn;
  156.       IF timer_time > 0 THEN
  157.         BEGIN
  158.           write('MESSAGE: ');
  159.           ReadLn(Timer_Message);
  160.           set_timer(timer_time);
  161.         END;
  162.     END;
  163.  
  164.   Get_Abs_Cursor(x,y);        { Get Absolute Cursor Position  }
  165.   MkWin(x,y,x+16,y+1,Cyan,Black,0);   { Put Window at Cursor   }
  166.   GotoXY(1,1);
  167.   Write('Press a key ...');   { Wait for user key or time out period }
  168.   countDown := 10000;
  169.   repeat
  170.     countDown := countDown - 1;
  171.   until (CountDown = 0) or keypressed;
  172.   IF countDOwn = 0 THEN set_timer(1); { If no user input, set one minute timer}
  173.   KeyChr := #0;                       { Clear any residual key code }
  174.   While Keypressed do         { Get terminate key maybe }
  175.     Keychr := Keyin;          { Read the users Key      }
  176.   If Keychr = Quit_key then Terminate := true;
  177.   RmWin ;                     { Remove "press a key" Window }
  178. end;
  179.  
  180. {----------------------------------------------------------------------}
  181. {        D   E  M  O                                                   }
  182. {----------------------------------------------------------------------}
  183. Procedure Demo ;                   { Give Demonstration of Code        }
  184.  
  185.   begin
  186.        KeyChr := #0;               { Clear any residual krap    }
  187.        MkWin(5,5,75,11,Bright+Cyan,Black,3); { Make a Biiiiiiig window}
  188.        Clrscr;                     { Clear screen out           }
  189.        Clock_Demo;                 { Set the clock              }
  190.        RmWin;                      { Remove the big window      }
  191.   end; { Demo }
  192.