home *** CD-ROM | disk | FTP | other *** search
/ SPACE 2 / SPACE - Library 2 - Volume 1.iso / program / 167 / pascal / dclock.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-08-18  |  16.1 KB  |  501 lines
  1. PROGRAM DCLOCK ;    { by Steve Pauley  7/25/87 }
  2.                     { a digital clock/time using 200hz timer }
  3.  
  4. CONST
  5.    {$I GEMCONST.PAS}
  6.    Zero = 0 ;
  7.    DY = 35 ;
  8. TYPE
  9.    {$I gemtype.pas}    { note that case doesn't matter }
  10.    (* ... your TYPEs ... *)
  11.    Pic_Dat = PACKED ARRAY [ 1..32034 ] of Byte;
  12.                 { this is for our off screen buffer }
  13.    scrn_memory = PACKED ARRAY[1..32000] of Byte;
  14.    S_Ptr = ^scrn_memory;     { pointer to screen data }
  15.    Path_Chars = PACKED ARRAY [ 1..80 ] OF Char ;
  16.  
  17. VAR
  18.    (* ... your VARiables ... *)
  19.    x, y                  : integer ;
  20.    Start,So_Far          : long_integer;
  21.    Total_Sec             : Long_Integer ;
  22.    Original_Sec          : Long_Integer ;
  23.    Temp_Sec,N            : Long_Integer ;
  24.    BSec, BMin, BHr       : Integer ;
  25.    Sec, Min, Hr          : Integer ;
  26.    Temp_Time, Temp_Date  : Integer ;
  27.    Sec_1, Sec_10         : Integer ;
  28.    Min_1, Min_10         : Integer ;
  29.    Hr_1,  Hr_10          : Integer ;
  30.    Old_Sec_1, Old_Sec_10 : Integer ;
  31.    Old_Min_1, Old_Min_10 : Integer ;
  32.    Old_Hr_1,  Old_Hr_10  : Integer ;
  33.    Day, Mon, Yr          : Integer ;
  34.    Old_Day               : Integer ;
  35.    Old_Mon               : Integer ;
  36.    Old_Yr                : Integer ;
  37.    Day_1, Day_10         : Integer ;
  38.    Mon_1, Mon_10         : Integer ;
  39.    Yr_1,  Yr_10          : Integer ;
  40.    PM_Flag, Keep_Running : Boolean ;
  41.    DX                    : Integer ;  { pionts to location of digit on screen }
  42.    L                     : Integer ;  { for FOR loop }
  43.    Pic_Buf      : Pic_Dat;  { a place to read picture file data into }
  44.    Scn_buf      : scrn_memory;    { a place to stash the screen }
  45.    Scn_ptr      : S_Ptr;     { a pointer to screen }
  46.    Dat_Ptr      : Integer ;  { position of next pixil data in Pic_Buf array }
  47.    Scn_Buf_Ptr  : Integer ;  { position of next pixil data in Scn_Buf array }
  48.    Starting_Rez : Integer ;  { resolution program was run from }
  49.    Pic_Rez      : Integer ;  { store picture resolution value }
  50.    Kolor_Reg         : ARRAY[ 0..15 ] OF Integer;  { stores color registers }
  51.    Starting_Kolor_Reg: ARRAY[ 0..15 ] OF Integer;  { stores color registers }
  52.    X_Screen     : Long_Integer ; { screen location return from xbios call }
  53.    More         : Boolean ;  { if true show another picture }
  54.    Valid_Name   : Boolean;   { flag for valid file name extender }
  55.    F_Name, P_Name : Path_Name ;  { file an path names for gem dialoge box }
  56.  
  57.    {$I gemsubs}          { and that ".PAS" is default }
  58.    {$I rezcolor}     { resolution check/change and color stuff }
  59.    {$I srcnload}     { load and display Tiny format background of clock }
  60.    {$I timestuf}     { time, date, 200hz timer and event loop stuff }
  61.    {$I digits}       { procedures for plotting digits on screen }
  62.    {$I time}         { gets time from system and converts to total sec.}
  63.    {$I stopwatc}     { run the stop watch procedure }
  64.    {$I date}         { gets date from system }
  65.  
  66.  
  67. PROCEDURE Keep_Time;
  68. VAR
  69.    which,
  70.    dummy,
  71.    key_state, W_key,
  72.    x, y : integer ;
  73.    msg : Message_Buffer ;
  74. BEGIN
  75.    Total_Sec := 0;
  76.    Hide_Mouse ;
  77.    REPEAT             { wait for button up }
  78.       which := Get_Event( E_Timer | E_Button, $0001, 0, 0,
  79.                0, { time count of zero - quik return }
  80.                false, 0, 0, 0, 0, false, 0, 0, 0, 0, { no rect's }
  81.                msg, W_Key,   { what key }
  82.                dummy, dummy, x, y, key_state ) ;
  83.    UNTIL which>33;
  84.    REPEAT
  85.       { Get a left mouse button event. check for button push to stop clock }
  86.       which := Get_Event( E_Timer | E_Button, $0001, 0, 0,
  87.                           0, { time count of zero - quik return }
  88.                           false, 0, 0, 0, 0, false, 0, 0, 0, 0, { no rect's }
  89.                           msg, W_Key,   { what key }
  90.                           dummy, dummy, x, y, key_state ) ;
  91.       So_Far := Ticks ;
  92.       Temp_Sec := So_Far - Start ; { how many seconds times 200 have past }
  93.       Temp_Sec := Temp_Sec DIV 200 ;  { convert to seconds }
  94.       Total_Sec := Original_Sec + Temp_Sec ;  { original time + time elapesed }
  95.       { ** if greater than 24 hrs start counting over ** }
  96.       IF Total_Sec > 86399 THEN
  97.       BEGIN
  98.       { get time from regular system clock and break into hrs., mins. and sec.}
  99.          Start := Ticks;               { starting point for second counter }
  100.          Temp_Time := T_Gettime ;               { get system time }
  101.          Sec := ( Temp_Time & 31 );             { Seconds * 2 }
  102.          Sec := Sec * 2 ;
  103.          Min := SHR( ( Temp_Time & 2016 ),5 );  { Minutes }
  104.          Hr  := SHR( Temp_Time,11 );{ Hours - military }
  105.          Hr  := Hr & 31 ;
  106.          { calculate total seconds from midnight on system clock }
  107.          Total_Sec := 0 ;
  108.          Temp_Sec := Hr ;
  109.          Temp_Sec := ( Temp_Sec*3600 );
  110.          Total_Sec := Temp_Sec ;
  111.          Temp_Sec := Min ;
  112.          Temp_Sec := ( Temp_Sec*60 ) ;
  113.          Total_Sec := Total_Sec + Temp_Sec ;
  114.          Temp_Sec := Sec ;
  115.          Total_Sec := Total_Sec + Temp_Sec ;
  116.          Temp_Sec := Total_Sec ;
  117.          Original_Sec := Total_Sec ;
  118.          So_Far := Ticks ;
  119.          Temp_Sec := So_Far - Start ; { how many seconds times 200 have past }
  120.          Temp_Sec := Temp_Sec DIV 200 ;  { convert to seconds }
  121.          Total_Sec := Original_Sec + Temp_Sec ; {original time + time elapesed}
  122.       END;
  123.            { check for pm or am time in seconds and set our flag }
  124.       PM_Flag := False ;
  125.       IF Total_Sec > 43199 THEN PM_Flag := True ;
  126.            { now break down Total_Sec into hours, minutes and seconds }
  127.       Hr := INT( Total_Sec DIV 3600 ) ;
  128.       N := Hr ;
  129.       Total_Sec := Total_Sec - N*3600 ;
  130.       Min := INT( Total_Sec DIV 60 ) ;
  131.       N := Min ;
  132.       Total_Sec := Total_Sec - N*60 ;
  133.       Sec := INT( Total_Sec ) ;
  134.       IF Hr > 12 THEN Hr := Hr - 12 ;
  135.       IF Hr = 0 THEN Hr := 12 ;
  136.       Hr_10 := Hr DIV 10 ;
  137.       Hr_1 :=  Hr MOD 10 ;
  138.       IF Sec = 0 THEN
  139.       BEGIN
  140.          Sec_1 := 0;
  141.          Sec_10 := 0;
  142.       END
  143.       ELSE BEGIN
  144.          Sec_10 := Sec DIV 10 ;
  145.          Sec_1 := Sec MOD 10 ;
  146.       END;
  147.       IF Min = 0 THEN
  148.       BEGIN
  149.          Min_1 := 0;
  150.          Min_10 := 0;
  151.       END
  152.       ELSE BEGIN
  153.          Min_10 := Min DIV 10 ;
  154.          Min_1 := Min MOD 10 ;
  155.       END;
  156.                          { If digits have change Draw New Digit on the screen }
  157.       IF Sec_1 <> Old_Sec_1 THEN
  158.       BEGIN
  159.          DX := 260 ;
  160.          D_Digit( Sec_1 ) ;
  161.       END;
  162.       IF Sec_10 <> Old_Sec_10 THEN
  163.       BEGIN
  164.          DX := 212 ;
  165.          D_Digit( Sec_10 ) ;
  166.       END;
  167.       IF Min_1 <> Old_Min_1 THEN
  168.       BEGIN
  169.          DX := 148 ;
  170.          D_Digit( Min_1 ) ;
  171.       END;
  172.       IF Min_10 <> Old_Min_10 THEN
  173.       BEGIN
  174.          DX := 100 ;
  175.          D_Digit( Min_10 ) ;
  176.       END;
  177.       IF Hr_1 <> Old_Hr_1 THEN
  178.       BEGIN
  179.          DX := 36 ;
  180.          D_Digit( Hr_1 ) ;
  181.       END;
  182.       IF Hr_10 <> Old_Hr_10 THEN  D_Hr_10 ;
  183.       Text_Color( 2 );
  184.       IF PM_Flag THEN Draw_String( 272,119,'PM' )
  185.                  ELSE Draw_String( 272,119,'AM' );
  186.       Old_Hr_10:=Hr_10; Old_Hr_1:=Hr_1;
  187.       Old_Min_10:=Min_10; Old_Min_1:=Min_1;
  188.       Old_Sec_10:=Sec_10; Old_Sec_1:=Sec_1;
  189.    UNTIL which<34;
  190.    Show_Mouse ;
  191. END;  { of Keep_Time }
  192.  
  193.  
  194. PROCEDURE Change_Time;
  195. BEGIN
  196.    Hide_Mouse ;
  197.    Old_Hr_10:=Hr_10; Old_Hr_1:=Hr_1;
  198.    Old_Min_10:=Min_10; Old_Min_1:=Min_1;
  199.    Old_Sec_10:=Sec_10; Old_Sec_1:=Sec_1;
  200.    IF ( X>30 ) AND ( X<52 ) THEN  Original_Sec := Original_Sec + 3600;
  201.    IF ( X>52 ) AND ( X<73 ) THEN  Original_Sec := Original_Sec - 3600;
  202.    IF ( X>122 ) AND ( X<144 ) THEN Original_Sec := Original_Sec + 60;
  203.    IF ( X>144 ) AND ( X<165 ) THEN Original_Sec := Original_Sec - 60;
  204.    IF ( X>211 ) AND ( X<232 ) THEN Original_Sec := Original_Sec + 1;
  205.    IF ( X>232 ) AND ( X<254 ) THEN Original_Sec := Original_Sec - 1;
  206.                    { ** if greater than 24 hrs start counting over ** }
  207.    IF Original_Sec > 86399 THEN  Original_Sec := 0 ;
  208.    IF Original_Sec < 0  THEN  Original_Sec := 86399 ;
  209.    Total_Sec := Original_Sec ; { new original time }
  210.                    { check for pm or am time in seconds and set our flag }
  211.    PM_Flag := False ;
  212.    IF Total_Sec > 43199 THEN PM_Flag := True ;
  213.                    { now break down Total_Sec into hours, minutes and seconds }
  214.    Hr := INT( Total_Sec DIV 3600 ) ;
  215.    N := Hr ;
  216.    Total_Sec := Total_Sec - N*3600 ;
  217.    Min := INT( Total_Sec DIV 60 ) ;
  218.    N := Min ;
  219.    Total_Sec := Total_Sec - N*60 ;
  220.    Sec := INT( Total_Sec ) ;
  221.    IF Hr > 12 THEN Hr := Hr - 12 ;
  222.    IF Hr = 0 THEN Hr := 12 ;
  223.    Hr_10 := Hr DIV 10 ;
  224.    Hr_1 :=  Hr MOD 10 ;
  225.    IF Sec = 0 THEN
  226.    BEGIN
  227.       Sec_1 := 0;
  228.       Sec_10 := 0;
  229.    END
  230.    ELSE BEGIN
  231.       Sec_10 := Sec DIV 10 ;
  232.       Sec_1 := Sec MOD 10 ;
  233.    END;
  234.    IF Min = 0 THEN
  235.    BEGIN
  236.       Min_1 := 0;
  237.       Min_10 := 0;
  238.    END
  239.    ELSE BEGIN
  240.       Min_10 := Min DIV 10 ;
  241.       Min_1 := Min MOD 10 ;
  242.    END;
  243.                        { If digits have change Draw New Digit on the screen }
  244.    IF Sec_1 <> Old_Sec_1 THEN
  245.    BEGIN
  246.       DX := 260 ;
  247.       D_Digit( Sec_1 ) ;
  248.    END;
  249.    IF Sec_10 <> Old_Sec_10 THEN
  250.    BEGIN
  251.       DX := 212 ;
  252.       D_Digit( Sec_10 ) ;
  253.    END;
  254.    IF Min_1 <> Old_Min_1 THEN
  255.    BEGIN
  256.       DX := 148 ;
  257.       D_Digit( Min_1 ) ;
  258.    END;
  259.    IF Min_10 <> Old_Min_10 THEN
  260.    BEGIN
  261.       DX := 100 ;
  262.       D_Digit( Min_10 ) ;
  263.    END;
  264.    IF Hr_1 <> Old_Hr_1 THEN
  265.    BEGIN
  266.       DX := 36 ;
  267.       D_Digit( Hr_1 ) ;
  268.    END;
  269.    IF Hr_10 <> Old_Hr_10 THEN  D_Hr_10 ;
  270.    Text_Color( 2 );
  271.    IF PM_Flag THEN Draw_String( 272,119,'PM' )
  272.               ELSE Draw_String( 272,119,'AM' );
  273.    Old_Hr_10:=Hr_10; Old_Hr_1:=Hr_1;
  274.    Old_Min_10:=Min_10; Old_Min_1:=Min_1;
  275.    Old_Sec_10:=Sec_10; Old_Sec_1:=Sec_1;
  276.    Show_Mouse ;
  277. END;  { of Change_Time }
  278.  
  279.  
  280. PROCEDURE Change_Date;
  281. BEGIN
  282.    Hide_Mouse ;
  283.    { Change Month, Day or Year }
  284.    IF ( X>30 ) AND ( X<52 ) THEN  { Up_Mon }
  285.    BEGIN
  286.       Mon := Mon + 1 ;
  287.       IF Mon > 12 THEN Mon := 1 ;
  288.    END ;
  289.    IF ( X>52 ) AND ( X<73 ) THEN   { Down_Mon }
  290.    BEGIN
  291.       Mon := Mon - 1 ;
  292.       IF Mon < 1 THEN Mon := 12 ;
  293.    END ;
  294.    IF ( X>122 ) AND ( X<144 ) THEN  { Up_Day }
  295.    BEGIN
  296.       Day := Day + 1 ;
  297.       IF Day > 31 THEN Day := 1 ;
  298.    END ;
  299.    IF ( X>144 ) AND ( X<165 ) THEN  { Down_Day }
  300.    BEGIN
  301.       Day := Day - 1 ;
  302.       IF Day < 1 THEN Day := 31 ;
  303.    END;
  304.    IF ( X>211 ) AND ( X<232 ) THEN  { Up_Yr }
  305.    BEGIN
  306.       Yr := Yr + 1 ;
  307.    END ;
  308.    IF ( X>232 ) AND ( X<254 ) THEN  { Down_Yr }
  309.    BEGIN
  310.       Yr := Yr - 1 ;
  311.       IF Yr < 80 Then Yr := 80
  312.    END ;
  313.  
  314.    Day_10 := Day DIV 10 ;
  315.    Day_1  := Day MOD 10 ;
  316.    Mon_10 := Mon DIV 10 ;
  317.    Mon_1  := Mon MOD 10 ;
  318.    Yr_10 := Yr DIV 10 ;
  319.    IF Yr_10 > 9 THEN Yr_10 := Yr_10 - 10 ;
  320.    Yr_1  := Yr MOD 10 ;
  321.  
  322.    {  Draw Digit that have changed on the screen }
  323.    IF Mon <> Old_Mon THEN
  324.    BEGIN
  325.       D_Mon_10 ;
  326.       DX := 36 ;
  327.       D_Digit( Mon_1 ) ;
  328.    END ;
  329.    IF Day <> Old_Day THEN
  330.    BEGIN
  331.       DX := 100 ;
  332.       D_Digit( Day_10 ) ;
  333.       DX := 148 ;
  334.       D_Digit( Day_1 ) ;
  335.    END ;
  336.    IF Yr <> Old_Yr THEN
  337.    BEGIN
  338.       DX := 212 ;
  339.       D_Digit( Yr_10 ) ;
  340.       DX := 260 ;
  341.       D_Digit( Yr_1 ) ;
  342.    END ;
  343.  
  344.    Old_Mon := Mon ;
  345.    Old_Day := Day ;
  346.    Old_Yr  := Yr  ;
  347.  
  348.    Show_Mouse ;
  349. END ;  { of Change_Date }
  350.  
  351.  
  352. PROCEDURE Time_Set;
  353. VAR
  354.    Gt, Dummy    :integer;
  355. BEGIN
  356.    { now break down Total_Sec into hours, minutes and seconds }
  357.    Temp_Sec := Original_Sec ;
  358.    Hr := INT( Temp_Sec DIV 3600 ) ;
  359.    N := Hr ;
  360.    Temp_Sec := Temp_Sec - N*3600 ;
  361.    Min := INT( Temp_Sec DIV 60 ) ;
  362.    N := Min ;
  363.    Temp_Sec := Temp_Sec - N*60 ;
  364.    Sec := INT( Temp_Sec DIV 2 ) ;
  365.    Gt := ( Hr * 2048 ) + ( Min * 32 ) + ( Sec ) ;
  366.    Dummy := T_Settime( Gt ) ;
  367.    Start := Ticks ;
  368. END ;  { of Time_Set }
  369.  
  370.  
  371. PROCEDURE Date_Set;
  372. VAR
  373.    Gt, Dummy    :integer;
  374. BEGIN
  375.    { now break down Total_Sec into hours, minutes and seconds }
  376.    Gt := ( (Yr-80) * 512 ) + ( Mon * 32 ) + ( Day ) ;
  377.    Dummy := T_Setdate( Gt ) ;
  378. END ;  { of Date_Set }
  379.  
  380.  
  381. PROCEDURE Option_Loop;
  382. VAR
  383.    Off          : Boolean ;
  384.    Time_Flag    : Boolean ;
  385.    which,
  386.    dummy,
  387.    key_state, W_key  : Integer ;
  388.    msg : Message_Buffer ;
  389. BEGIN
  390.    Off := False ;
  391.    Time_Flag := True ;
  392.    REPEAT
  393.       { Get a left mouse button event. }
  394.       REPEAT
  395.          which := Get_Event( E_Timer | E_Button, $0001, 0, 0,
  396.                   0, { time count of zero - quik return }
  397.                   false, 0, 0, 0, 0, false, 0, 0, 0, 0, { no rect's }
  398.                   msg, W_Key,   { what key }
  399.                   dummy, dummy, x, y, key_state ) ;
  400.       UNTIL which>33;
  401.       REPEAT
  402.          which := Get_Event( E_Timer | E_Button, $0001, 0, 0,
  403.                   0, { time count of zero - quik return }
  404.                   false, 0, 0, 0, 0, false, 0, 0, 0, 0, { no rect's }
  405.                   msg, W_Key,   { what key }
  406.                   dummy, dummy, x, y, key_state ) ;
  407.       UNTIL which<34;
  408.  
  409.       IF X > 319 THEN X := X - 320 ;  { correct for running prg. from med.rez }
  410.  
  411.       IF ( Y>110 ) AND ( Y< 122 ) THEN { up/down arrow keys }
  412.       BEGIN
  413.          IF Time_Flag = True THEN  Change_Time
  414.          ELSE Change_Date ;
  415.       END;
  416.  
  417.       IF ( Y>163 ) AND ( Y< 176 ) THEN { near option buttons }
  418.       BEGIN
  419.          IF ( X>14 ) AND ( X<63 ) THEN { S/W option picked }
  420.          BEGIN
  421.             IF Time_Flag THEN
  422.             BEGIN
  423.                Original_Sec := 0 ;
  424.                Start := Ticks ;
  425.                Stop_Watch ;
  426.                Event_Loop ;
  427.                Time ;
  428.             END ;
  429.          END;
  430.          IF ( X>63 ) AND ( X<96 ) THEN            { RUN option picked }
  431.          BEGIN
  432.             IF ( Time_Flag ) THEN           { If time display  then run clock }
  433.             BEGIN
  434.                Keep_Time ;
  435.             END;
  436.          END;
  437.          IF ( X>117 ) AND ( X<160 ) THEN        { DATE }
  438.          BEGIN
  439.             Time_Flag := False ;
  440.             Date ;
  441.          END;
  442.          IF ( X>160 ) AND ( X<202 ) THEN        { TIME }
  443.          BEGIN
  444.             Time_Flag := True ;
  445.             Time ;
  446.          END;
  447.          IF ( X>222 ) AND ( X<256 ) THEN        { SET date or time }
  448.          BEGIN
  449.             Hide_Mouse ;
  450.             IF Time_Flag = True THEN  Time_Set
  451.             ELSE  Date_Set ;
  452.             FOR Dummy := 1 TO 1000 DO    { slight delay }
  453.             BEGIN
  454.                Dummy := Dummy ;
  455.             END ;
  456.             Show_Mouse ;
  457.          END;
  458.          IF ( X>256 ) AND ( X<289 ) THEN        { OFF }
  459.          BEGIN
  460.             Off := True ;
  461.          END;
  462.       END;
  463.    UNTIL  Off ;
  464. END ;  { of Option_Loop }
  465.  
  466.  
  467. BEGIN      { main program }
  468.    IF Init_Gem >= 0 THEN
  469.       BEGIN
  470.          Set_Mouse( M_Bee );
  471.          Save_Kolors ;                { reads color registers }
  472.          Starting_Kolor_Reg := Kolor_Reg ; { back-up of starting colors }
  473.          Starting_Rez := Screen_Rez ; { gets rez that program was run from }
  474.          X_Screen := Logical_Screen;  { gets visible/logical screen address }
  475.          Pic_Rez := 0 ; { low rez }
  476.          Set_Screen( X_Screen, X_Screen, Pic_Rez ); { change picture rez }
  477.  
  478.          F_Name := 'DCLOCK.RSC' ;
  479.          S_Load;                   { load raw data in buffer }
  480.          Un_Tiny ;                 { uncompress data and store in buffer }
  481.          Restore_Kolors ;          { sets new picture colors }
  482.          Hide_Mouse;
  483.          Rest_Scn;                 { move picture buffer to visible screen }
  484.          Temp_Date := T_Getdate ;       { get current date from system }
  485.          Day := ( Temp_Date & 31 ) ;
  486.          Mon := SHR( ( Temp_Date & 480 ),5 ) ;
  487.          Yr  := SHR( ( Temp_Date ),9 ) ;
  488.          Yr  := Yr + 80 ;
  489.          Old_Yr := 0 ; Old_Mon := 0 ; Old_Day := 0 ; { init these variables }
  490.          Time ;
  491.          Show_Mouse ;
  492.          Set_Mouse( M_Point_Hand );
  493.          Option_Loop ;
  494.          Set_Mouse( M_Arrow );
  495.          Kolor_Reg := Starting_Kolor_Reg ;
  496.          Set_Screen( X_Screen, X_Screen, Starting_Rez ); { restore rez }
  497.          Restore_Kolors ;          { restore desk top kolors }
  498.          Exit_Gem ;
  499.    END ;
  500. END.
  501.