home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / TURBOM2 / M2DSCLK.LBR / M2DSCLK.MZD / M2DSCLK.MOD
Text File  |  2000-06-30  |  7KB  |  314 lines
  1. MODULE DSclock;
  2.  
  3. (*
  4.  
  5. This is a program that simply puts a 7-bar type clock on the screen.
  6. It is  RTC based  that derives its time from Plu*Perfect's DateStamper. 
  7. It uses my DS access MODULE DStime and adapted from my earlier full 
  8. software version.  As DS doesn't pass fractions of a sec, I copped
  9. out and have the colon flashing at a 1 sec on 1 sec off rate rather than
  10. a proper 500mSec on 500mSec off rate.
  11.  
  12. Jim Lill 27 Aug 87
  13.  
  14. *)
  15.  
  16. FROM Terminal IMPORT BusyRead, ClearScreen, GotoXY;
  17. FROM DStime IMPORT CLOCK,HOUR,MIN,SEC;
  18.  
  19. CONST
  20.       bar1 ='///';
  21.       bar2 ='////';
  22.       bar3 ='/////////';
  23.       bar4 ='///////////';
  24.       bar5 ='/////////////';
  25.       bar6 ='///////////////';
  26.       bar7 ='///       ///';
  27.       bar8 ='///         ///';
  28.      blank ='                                     ';
  29.  
  30. VAR
  31.     n, lmin, BASE : CARDINAL;
  32.     i,o,x,y,
  33.     hrs,mins,secs,
  34.     tenshrs,unithrs,tensmins,unitmins : INTEGER;
  35.  
  36.     c : CHAR;
  37.  
  38. (*...................................*)
  39.  
  40. PROCEDURE zero(x,y :INTEGER);
  41.  
  42. BEGIN  (*zero*)
  43.   GotoXY(x+11,y);WRITE(bar4);
  44.   GotoXY(x+9,y+1);WRITE(bar5);
  45.   GotoXY(x+7,y+2);WRITE(bar8);
  46.   GotoXY(x+6,y+3);WRITE(bar8);
  47.   GotoXY(x+5,y+4);WRITE(bar8);
  48.   GotoXY(x+4,y+5);WRITE(bar8);
  49.   GotoXY(x+3,y+6);WRITE(bar8);
  50.   GotoXY(x+2,y+7);WRITE(bar8);
  51.   GotoXY(x+2,y+8);WRITE(bar5);
  52.   GotoXY(x+2,y+9);WRITE(bar4)
  53. END zero;
  54.  
  55. (*...................................*)
  56.  
  57. PROCEDURE one(x,y :INTEGER);
  58.  
  59. BEGIN  (*one*)
  60.   GotoXY(x+15,y);WRITE(bar2);
  61.   GotoXY(x+14,y+1);WRITE(bar2);
  62.   GotoXY(x+13,y+2);WRITE(bar2);
  63.   GotoXY(x+12,y+3);WRITE(bar2);
  64.   GotoXY(x+11,y+4);WRITE(bar2);
  65.   GotoXY(x+10,y+5);WRITE(bar2);
  66.   GotoXY(x+9,y+6);WRITE(bar2);
  67.   GotoXY(x+8,y+7);WRITE(bar2);
  68.   GotoXY(x+7,y+8);WRITE(bar2);
  69.   GotoXY(x+6,y+9);WRITE(bar2)
  70. END one;
  71.  
  72. (*..................................*)
  73.  
  74. PROCEDURE two(x,y :INTEGER);
  75.  
  76. BEGIN  (*two*)
  77.   GotoXY(x+11,y);WRITE(bar4);
  78.   GotoXY(x+9,y+1);WRITE(bar5);
  79.   GotoXY(x+7,y+2);WRITE(bar8);
  80.   GotoXY(x+18,y+3);WRITE(bar1);
  81.   GotoXY(x+6,y+4);WRITE(bar5);
  82.   GotoXY(x+5,y+5);WRITE(bar5);
  83.   GotoXY(x+3,y+6);WRITE(bar1);
  84.   GotoXY(x+2,y+7);WRITE(bar1);
  85.   GotoXY(x+1,y+8);WRITE(bar6);
  86.   GotoXY(x,y+9);WRITE(bar6)
  87. END two;
  88.  
  89. (*...................................*)
  90.  
  91. PROCEDURE three(x,y :INTEGER);
  92.  
  93. BEGIN  (*three*)
  94.   GotoXY(x+11,y);WRITE(bar4);
  95.   GotoXY(x+9,y+1);WRITE(bar5);
  96.   GotoXY(x+7,y+2);WRITE(bar8);
  97.   GotoXY(x+18,y+3);WRITE(bar1);
  98.   GotoXY(x+9,y+4);WRITE(bar3);
  99.   GotoXY(x+8,y+5);WRITE(bar3);
  100.   GotoXY(x+15,y+6);WRITE(bar1);
  101.   GotoXY(x+2,y+7);WRITE(bar8);
  102.   GotoXY(x+2,y+8);WRITE(bar5);
  103.   GotoXY(x+2,y+9);WRITE(bar4)
  104. END three;
  105.  
  106. (*...................................*)
  107.  
  108. PROCEDURE four(x,y :INTEGER);
  109.  
  110. BEGIN  (*four*)
  111.   GotoXY(x+10,y);WRITE(bar7);
  112.   GotoXY(x+9,y+1);WRITE(bar7);
  113.   GotoXY(x+8,y+2);WRITE(bar7);
  114.   GotoXY(x+7,y+3);WRITE(bar7);
  115.   GotoXY(x+6,y+4);WRITE(bar6);
  116.   GotoXY(x+5,y+5);WRITE(bar6);
  117.   GotoXY(x+14,y+6);WRITE(bar1);
  118.   GotoXY(x+13,y+7);WRITE(bar1);
  119.   GotoXY(x+12,y+8);WRITE(bar1);
  120.   GotoXY(x+11,y+9);WRITE(bar1)
  121. END four;
  122.  
  123. (*....................................*)
  124.  
  125. PROCEDURE five(x,y :INTEGER);
  126.  
  127. BEGIN  (*five*)
  128.   GotoXY(x+9,y);WRITE(bar6);
  129.   GotoXY(x+8,y+1);WRITE(bar6);
  130.   GotoXY(x+7,y+2);WRITE(bar1);
  131.   GotoXY(x+6,y+3);WRITE(bar1);
  132.   GotoXY(x+5,y+4);WRITE(bar5);
  133.   GotoXY(x+4,y+5);WRITE(bar6);
  134.   GotoXY(x+15,y+6);WRITE(bar1);
  135.   GotoXY(x+2,y+7);WRITE(bar8);
  136.   GotoXY(x+2,y+8);WRITE(bar5);
  137.   GotoXY(x+2,y+9);WRITE(bar4)
  138. END five;
  139.  
  140. (*....................................*)
  141.  
  142. PROCEDURE six(x,y :INTEGER);
  143.  
  144. BEGIN  (*six*)
  145.   GotoXY(x+11,y);WRITE(bar4);
  146.   GotoXY(x+9,y+1);WRITE(bar5);
  147.   GotoXY(x+7,y+2);WRITE(bar8);
  148.   GotoXY(x+6,y+3);WRITE(bar1);
  149.   GotoXY(x+5,y+4);WRITE(bar5);
  150.   GotoXY(x+4,y+5);WRITE(bar6);
  151.   GotoXY(x+3,y+6);WRITE(bar8);
  152.   GotoXY(x+2,y+7);WRITE(bar8);
  153.   GotoXY(x+2,y+8);WRITE(bar5);
  154.   GotoXY(x+2,y+9);WRITE(bar4)
  155. END six;
  156.  
  157. (*....................................*)
  158.  
  159. PROCEDURE seven(x,y :INTEGER);
  160.  
  161. BEGIN  (*seven*)
  162.   GotoXY(x+11,y);WRITE(bar5);
  163.   GotoXY(x+10,y+1);WRITE(bar5);
  164.   GotoXY(x+18,y+2);WRITE(bar2);
  165.   GotoXY(x+17,y+3);WRITE(bar2);
  166.   GotoXY(x+16,y+4);WRITE(bar2);
  167.   GotoXY(x+15,y+5);WRITE(bar2);
  168.   GotoXY(x+14,y+6);WRITE(bar2);
  169.   GotoXY(x+13,y+7);WRITE(bar2);
  170.   GotoXY(x+12,y+8);WRITE(bar2);
  171.   GotoXY(x+11,y+9);WRITE(bar2)
  172. END seven;
  173.  
  174. (*.....................................*)
  175.  
  176. PROCEDURE eight(x,y :INTEGER);
  177.  
  178. BEGIN  (*eight*)
  179.   GotoXY(x+11,y);WRITE(bar4);
  180.   GotoXY(x+9,y+1);WRITE(bar5);
  181.   GotoXY(x+7,y+2);WRITE(bar8);
  182.   GotoXY(x+6,y+3);WRITE(bar8);
  183.   GotoXY(x+6,y+4);WRITE(bar5);
  184.   GotoXY(x+5,y+5);WRITE(bar5);
  185.   GotoXY(x+3,y+6);WRITE(bar8);
  186.   GotoXY(x+2,y+7);WRITE(bar8);
  187.   GotoXY(x+2,y+8);WRITE(bar5);
  188.   GotoXY(x+2,y+9);WRITE(bar4)
  189. END eight;
  190.  
  191. (*......................................*)
  192.  
  193. PROCEDURE nine(x,y :INTEGER);
  194.  
  195. BEGIN  (*nine*)
  196.   GotoXY(x+11,y);WRITE(bar4);
  197.   GotoXY(x+9,y+1);WRITE(bar5);
  198.   GotoXY(x+7,y+2);WRITE(bar8);
  199.   GotoXY(x+6,y+3);WRITE(bar8);
  200.   GotoXY(x+5,y+4);WRITE(bar6);
  201.   GotoXY(x+6,y+5);WRITE(bar5);
  202.   GotoXY(x+15,y+6);WRITE(bar1);
  203.   GotoXY(x+2,y+7);WRITE(bar8);
  204.   GotoXY(x+2,y+8);WRITE(bar5);
  205.   GotoXY(x+2,y+9);WRITE(bar4)
  206. END nine;
  207.  
  208. (*.......................................*)
  209.  
  210. PROCEDURE colon(x,y:INTEGER;c:CHAR);
  211.  
  212. BEGIN;  (*colon*)
  213.   GotoXY(x+5,y); WRITE(c,c,c);
  214.   GotoXY(x+4,y+1); WRITE(c,c,c);
  215.   GotoXY(x+1,y+4); WRITE(c,c,c);
  216.   GotoXY(x,y+5); WRITE(c,c,c)
  217. END colon;
  218.  
  219. (*......................................*)
  220.  
  221. PROCEDURE dispit(x,y,number:INTEGER);
  222.  
  223. BEGIN
  224.   CASE number OF
  225.    | 0 : zero(x,y)
  226.    | 1 : one(x,y)
  227.    | 2 : two(x,y)
  228.    | 3 : three(x,y)
  229.    | 4 : four(x,y)
  230.    | 5 : five(x,y)
  231.    | 6 : six(x,y)
  232.    | 7 : seven(x,y)
  233.    | 8 : eight(x,y)
  234.    | 9 : nine(x,y)
  235.   END
  236. END dispit;
  237.  
  238. (*...................................*)
  239.  
  240. PROCEDURE author;
  241.  
  242. BEGIN (*author*)
  243.   GotoXY(55,22);
  244.   WRITE('by Jim Lill 27 Aug 87')
  245. END author;
  246.  
  247. (*....................................*)
  248.  
  249. PROCEDURE cleardigit(pos:INTEGER);
  250.  
  251. BEGIN  (*cleardigit*)
  252.   FOR i:= 0 TO 9 DO
  253.     GotoXY(pos-i,8+i);
  254.     WRITE(blank)
  255.   END
  256. END cleardigit;
  257.  
  258. (*....................................*)
  259.  
  260. PROCEDURE dispmins(mins:INTEGER);
  261.  
  262. BEGIN  (*dispmins*)
  263.   tensmins:= mins DIV 10;
  264.   cleardigit(48);
  265.   dispit(39,8,tensmins);
  266.   unitmins:= mins MOD 10;
  267.   dispit(56,8,unitmins)
  268. END dispmins;
  269.  
  270. (*.......................................*)
  271.  
  272. PROCEDURE disphrs(hrs:INTEGER);
  273.  
  274. BEGIN  (*disphrs*)
  275.   tenshrs:= hrs DIV 10;
  276.   cleardigit(9);
  277.   dispit(0,8,tenshrs);
  278.   unithrs:= hrs MOD 10;
  279.   dispit(17,8,unithrs)
  280. END disphrs;
  281.  
  282. (*........................................*)
  283.  
  284. PROCEDURE runclock;
  285.  
  286. VAR anykey : CHAR;
  287.  
  288. BEGIN (*runclock*)
  289.   REPEAT
  290.     BusyRead(anykey);
  291.     IF CLOCK() THEN
  292.       IF MIN() # lmin THEN
  293.         disphrs(INT(HOUR()));
  294.         dispmins(INT(MIN()));
  295.         colon(36,10,'/');
  296.         lmin:= MIN();
  297.       END;
  298.       IF (SEC() MOD 2) = 0 THEN colon(36,10,'/')
  299.       ELSE colon(36,10,' ')
  300.       END;
  301.     END;
  302.   GotoXY(78,22);
  303.   UNTIL anykey # 0C
  304. END runclock;
  305.  
  306. (*...................................*)
  307.  
  308. BEGIN (*clock*)
  309.   ClearScreen;
  310.   author;
  311.   runclock;
  312. END DSclock.
  313.  
  314.