home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / BIGCLOCK.ZIP / BIGCLOCK.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1987-07-05  |  4.0 KB  |  136 lines

  1. Program BigClock;
  2. {$R+}
  3. {
  4.                           Big Clock On Screen
  5.  
  6. This program is exactly what the name emplies.  It is a large clock that ticks
  7. away only seconds on the screen.  The purpose of this program is to provide
  8. a base for developement of other programs.  For example is one wanted to
  9. write a program that could time certain tasks and display the passage of time
  10. visually.  Other applications might be graphics programs.  The basis for many
  11. functions and patterns on the screen are provided here.
  12. }
  13.  
  14. const
  15.     MemorySize = 100;
  16.     One   : Array[0..7]   of Byte     = ($3E,$08,$08,$08,$08,$08,$0A,$0C);
  17.     Two   : Array[0..7]   of Byte     = ($3C,$24,$04,$3C,$20,$20,$24,$3C);
  18.     Three : Array[0..7]   of Byte     = ($1C,$22,$20,$38,$20,$20,$22,$1C);
  19.     Four  : Array[0..7]   of Byte     = ($38,$10,$10,$10,$3E,$14,$18,$10);
  20.     Five  : Array[0..7]   of Byte     = ($1C,$22,$20,$20,$3E,$02,$02,$3E);
  21.     Six   : Array[0..7]   of Byte     = ($18,$24,$24,$24,$1C,$08,$10,$20);
  22.     Seven : Array[0..7]   of Byte     = ($08,$08,$08,$08,$10,$20,$24,$3C);
  23.     Eight : Array[0..7]   of Byte     = ($18,$24,$24,$24,$18,$24,$24,$18);
  24.     Nine  : Array[0..7]   of Byte     = ($04,$08,$10,$38,$24,$24,$24,$18);
  25.     Zero  : Array[0..7]   of Byte     = ($38,$44,$44,$44,$44,$44,$44,$38);
  26.     Hands : Array[0..119]  of Integer  = (160,12,170,15,180,18,190,21,
  27.            200,24,211,29,216,35,221,41,226,47,231,53,238,59,240,67,
  28.            242,75,244,83,246,91,250,100,247,108,244,116,241,124,238,132,
  29.            234,142,229,149,224,156,219,163,214,170,209,176,199,179,189,182,
  30.            179,185,169,188,160,190,151,187,142,184,133,181,123,178,113,175,
  31.            107,169,101,163,95,156,89,149,83,142,81,134,79,126,76,118,
  32.            73,110,70,100,73,92,76,84,79,75,82,66,85,59,90,53,
  33.            95,47,100,41,105,35,112,28,121,25,130,22,139,19,149,16);
  34.  
  35. type RegPack = record
  36.                  AX,BX,CX,DX,BP,DI,SI,DS,ES,Flags: Integer;
  37.                end;
  38.  
  39. var
  40.   X1, X2, Y1, Y2,
  41.   ClockPosition,Pnum : Integer;
  42.   I, Color, HoldSec  : Integer;
  43.   Ch                 : Char;
  44.   Hour,Min,Sec,Fract : Integer;
  45.   Regs               : RegPack;
  46.   Xpos,Ypos,Comp2    : Integer;
  47.   Comp1              : Real;
  48.  
  49. {$I GRAPH.P }
  50.  
  51. procedure Init;
  52. begin
  53.   Pnum := 0;
  54.   Xpos := 161;
  55.   Ypos := 101;
  56.   Ch := ' ';
  57.   GraphColorMode;
  58.   Palette(3);
  59. end;
  60.  
  61. procedure ClockFace;
  62. begin
  63.   Circle(160,100,99,2);
  64.   Pattern(One);
  65.   FillPattern (155,04,162,11,1);     { First digit of '12'  }
  66.   FillPattern (210,20,217,27,1);     { Number '1'           }
  67.   FillPattern (106,20,113,27,1);     { First digit of '11'  }
  68.   FillPattern (113,20,120,27,1);     { Next digit of '11'   }
  69.   FillPattern (77,51,84,58,1);       { First digit of '10'  }
  70.   Pattern(Two);
  71.   FillPattern (162,04,169,11,1);
  72.   FillPattern (237,51,244,58,1);
  73.   Pattern(Three);
  74.   FillPattern (251,97,258,104,1);
  75.   Pattern(Four);
  76.   FillPattern (235,141,242,148,1);
  77.   Pattern(Five);
  78.   FillPattern (210,174,217,181,1);
  79.   Pattern(Six);
  80.   FillPattern (157,190,164,197,1);
  81.   Pattern(Seven);
  82.   FillPattern (106,174,113,181,1);
  83.   Pattern(Eight);
  84.   FillPattern (77,141,84,148,1);
  85.   Pattern(Nine);
  86.   FillPattern (63,97,70,104,1);
  87.   Pattern(Zero);
  88.   FillPattern (83,51,90,58,1);       { Last digit of '10'  }
  89. end;
  90.  
  91. procedure GetTime;
  92. begin
  93.   with Regs do
  94.   begin
  95.     AX := $2C00;
  96.     MsDos(Regs);
  97.     Hour := hi(CX);
  98.     Min  := lo(CX);
  99.     Sec  := hi(DX);
  100.     Fract := lo(DX);
  101.   end;
  102. end;
  103.  
  104. procedure ClockTick;
  105. begin
  106.    GetTime;
  107.    If HoldSec <> Sec
  108.    then Begin
  109.      Sound(20);
  110.      Delay(5);
  111.      NoSound;
  112.      HoldSec := Sec;
  113.      ClockPosition := Sec * 2;
  114.      Draw(160,100,Xpos,Ypos,0);
  115.      Xpos := Hands[ClockPosition];
  116.      Ypos := Hands[ClockPosition + 1];
  117.      Draw(160,100,Xpos,Ypos,2);
  118.      Pnum := Pnum + 1;
  119.      If Pnum = 5
  120.      then Pnum := 0;
  121.      Palette(Pnum);
  122.         End;
  123. End;
  124.  
  125. begin
  126.   ClrScr;
  127.   Init;
  128.   ClockFace;
  129.   Repeat
  130.   ClockTick;
  131.   Until Keypressed;
  132.   TextMode;
  133. end.
  134.  
  135.  
  136.