home *** CD-ROM | disk | FTP | other *** search
/ RBBS in a Box Volume 1 #3.1 / RBBSIABOX31.cdr / colo / clock1.bas < prev    next >
BASIC Source File  |  1985-09-29  |  13KB  |  273 lines
  1. 100 REM This program was written by :
  2. 110 REM 
  3. 120 REM 
  4. 130 REM                               DAVID JOHNSON
  5. 140 REM                               551 Willlow st
  6. 150 REM                               S. Hempstead, N.Y. 11550
  7. 160 REM                               (516) 489-5894
  8. 170 REM 
  9. 180 REM 
  10. 190 REM IF YOU MODIFY THIS PROGRAM, PLEASE DO NOT DISTRIBUTE IT IN MODIFIED
  11. 200 REM FORM!             SUPPORT THE FREEWARE CONCEPT!
  12. 210 REM
  13. 220 REM
  14. 230 REM setting att to true assumes an AT&T PC6300 computer with 640x400
  15. 240 REM resolution. If an error occurs when opening mode 100 then resume
  16. 250 REM and set att to false (0), also turn off all the keys to clear the
  17. 260 REM screen of all the clutter.
  18. 270 ATT=-1
  19. 280 KEY 1,CHR$(26):KEY 2,"":KEY 3,"":KEY 4,"":KEY 5,"":REM turn off all
  20. 290 KEY 6,"":KEY 7,"":KEY 8,"":KEY 9,"":KEY 10,""     :REM of the keys
  21. 300 ON ERROR GOTO 330:IF ATT THEN DISPV=400:DISPH=640:RAT=6/5:CLS
  22. 310 GOTO 340
  23. 320 REM Error opening mode 100, it must be an IBM type computer (640x200)
  24. 330 ATT=0:RESUME 340
  25. 340 IF NOT ATT THEN DISPV=200:DISPH=640:RAT=12/5:CLS
  26. 350 DIM HOUR$(12):OLDX$="00:00:00":X$="00:00:00":NEWTIME$="12:00:00":OLDALM$="12:00:00"
  27. 360 REM read in the hour and half hour chime sound
  28. 370 READ CHIME$
  29. 380 REM make hour contain the sound string for each hour
  30. 390 FOR X=1 TO 12:HOUR$(X)=CHIME$+STRING$(X,67):NEXT
  31. 400 REM go into graphics mode 100 (640x400) if it exists otherwise 
  32. 410 REM enter mode 2 (640x200)
  33. 420 IF DISPV=400 THEN SCREEN 100,0 ELSE SCREEN 2,0
  34. 430 REM set up default settings incase disk file does not exist
  35. 440 CLS:KEY OFF:PI=3.1415:BELL=-1:ALARM$="12:00":TICK=-1:MODE=-1:TMP=-1:GOSUB 2430:LOCATE 1,20:PRINT"hit S to enter setup screen or <esc> to exit"
  36. 450 REM
  37. 460 REM MAIN CLOCK SCREEN
  38. 470 REM
  39. 480 GOSUB 610:LOCATE 1,20:PRINT "                                            "
  40. 490 X$=TIME$:I$=INKEY$:IF I$=CHR$(27) THEN GOSUB 2580:CLS:GOTO 420
  41. 500 IF I$="B" OR I$="b" THEN BELL=0-ABS(BELL+1)
  42. 510 LOCATE 25,1:IF BELL THEN PRINT"BELL ON "; ELSE PRINT"BELL OFF";
  43. 520 IF I$="A" OR I$="a" THEN ALARM=0-ABS(ALARM+1)
  44. 530 LOCATE 25,72:IF NOT ALARM THEN PRINT"ALARM OFF";:LOCATE 24,73:PRINT"      ";
  45. 540 IF I$="s" OR I$="S" THEN GOSUB 1710:CLS:GOTO 480
  46. 550 LOCATE 25,72:IF ALARM THEN PRINT"ALARM ON "; ELSE PRINT"ALARM OFF";
  47. 560 IF OLDX$<>X$ THEN OLDTIME$=X$:TMP=-1:GOSUB 720:OLDX$=OLDTIME$:GOTO 490
  48. 570 GOTO 490
  49. 580 REM 
  50. 590 REM Draw the clock out line and dial
  51. 600 REM 
  52. 610 R=160:HSM=R:VSM=R/RAT:CTH=DISPH/2:CTV=DISPV/2
  53. 620 HSH=HSM*.5:HSV=VSM*.5:MSH=HSM*.8:MSV=VSM*.8:SSH=HSM*.9:SSV=VSM*.9
  54. 630 CIRCLE (CTH,CTV),INT(HSM*1.2)
  55. 640 FOR T=0 TO 59
  56. 650 HI=2*PI/60*(T):X=CTH+INT(SIN(HI)*HSM+.5):Y=CTV-INT(COS(HI)*VSM+.5)
  57. 660 IF T/5=INT(T/5)AND T/15<>INT(T/15) THEN CIRCLE(X,Y),INT(HSM/180*4)
  58. 670 PSET(X,Y)
  59. 680 IF T/15=INT(T/15) THEN LINE(X-INT(HSM/180*3),Y-INT(HSM/180*3))-(X+INT(HSM/180*3),Y+INT(HSM/180*3)),7,BF
  60. 690 NEXT T
  61. 700 RETURN
  62. 710 REM 
  63. 720 REM update clock
  64. 730 REM first erase the hands that move, then redraw all hands!
  65. 740 REM 
  66. 750 IF NOT ((MID$(X$,4,2)="00" OR MID$(X$,4,2)="30") AND VAL(MID$(X$,7,2))<15) AND TICK THEN PLAY "MBMST255L64N1"
  67. 760 H=VAL(MID$(X$,1,2)):M=VAL(MID$(X$,4,2)):S=VAL(MID$(X$,7,2))
  68. 770 OLDH=VAL(MID$(OLDX$,1,2)):OLDM=VAL(MID$(OLDX$,4,2)):OLDS=VAL(MID$(OLDX$,7,2))
  69. 780 IF H<12 THEN AM=-1 ELSE AM=0:IF H>12 THEN H=H-12
  70. 790 IF OLDH>12 THEN  OLDH=OLDH-12
  71. 800 IF H<1 THEN H=H+12
  72. 810 IF OLDH<1 THEN OLDH=OLDH+12
  73. 820 IF NOT MODE THEN MID$(X$,1,2)=CHR$(48+INT(H/10))+CHR$(48+(H-INT(H/10)*10))
  74. 830 IF NOT MODE THEN MID$(OLDX$,1,2)=CHR$(48+INT(OLDH/10))+CHR$(48+(OLDH-INT(OLDH/10)*10))
  75. 840 REM dont forget 12/24 hour modes loop to zero not 1 O'clock
  76. 850 IF H=12 THEN H=0
  77. 860 IF OLDH=12 THEN OLDH=0
  78. 870 H=H+(INT(M/5)*5)/60
  79. 880 OLDH=OLDH+(INT(OLDM/5)*5)/60
  80. 890 M=M+(INT(S/10)*10)/60
  81. 900 OLDM=OLDM+(INT(OLDS/10)*10)/60
  82. 910 LOCATE 25,36:PRINT X$;:IF NOT MODE THEN IF AM THEN PRINT " AM   "; ELSE PRINT " PM   ";
  83. 920 IF MODE THEN PRINT "      ";
  84. 930 GOSUB 950:GOSUB 1170
  85. 940 RETURN
  86. 950 REM remove old hands
  87. 960 IF H=OLDH THEN 1040
  88. 970 REM calculate position of old hour hand and remove it only if it moved
  89. 980 HI=2*PI/12*(OLDH):X=CTH+INT(SIN(HI)*HSH+.5):Y=CTV-INT(COS(HI)*HSV+.5)
  90. 990 LINE (CTH,CTV)-(X,Y),0
  91. 1000 LINE (CTH+3,CTV+3)-(X,Y),0
  92. 1010 LINE (CTH-3,CTV-3)-(X,Y),0
  93. 1020 LINE (CTH-3,CTV+3)-(X,Y),0
  94. 1030 LINE (CTH+3,CTV-3)-(X,Y),0
  95. 1040 IF M=OLDM THEN 1120
  96. 1050 REM calculate position of old min hand and remove it
  97. 1060 MI=2*PI/60*OLDM:X=CTH+INT(SIN(MI)*MSH+.5):Y=CTV-INT(COS(MI)*MSV+.5)
  98. 1070 LINE (CTH,CTV)-(X,Y),0
  99. 1080 LINE (CTH+2,CTV+2)-(X,Y),0
  100. 1090 LINE (CTH-2,CTV-2)-(X,Y),0
  101. 1100 LINE (CTH-2,CTV+2)-(X,Y),0
  102. 1110 LINE (CTH+2,CTV-2)-(X,Y),0
  103. 1120 REM remove old sec hand
  104. 1130 SI=2*PI/60*OLDS:X=CTH+INT(SIN(SI)*SSH+.5):Y=CTV-INT(COS(SI)*SSV+.5)
  105. 1140 LINE (CTH,CTV)-(X,Y),0
  106. 1150 OLDH=H:OLDM=M:OLDS=S
  107. 1160 RETURN
  108. 1170 REM draw new hands
  109. 1180 REM draw second hand
  110. 1190 SI=2*PI/60*S:X=CTH+INT(SIN(SI)*SSH+.5):Y=CTV-INT(COS(SI)*SSV+.5)
  111. 1200 CIRCLE(CTH,CTV),(HSM/180)*5
  112. 1210 LINE (CTH,CTV)-(X,Y),7,,&H5555
  113. 1220 REM draw min hand
  114. 1230 MI=2*PI/60*M:X=CTH+INT(SIN(MI)*MSH+.5):Y=CTV-INT(COS(MI)*MSV+.5)
  115. 1240 LINE (CTH,CTV)-(X,Y),7
  116. 1250 LINE (CTH+2,CTV-2)-(X,Y),7
  117. 1260 LINE (CTH-2,CTV+2)-(X,Y),7
  118. 1270 LINE (CTH-2,CTV-2)-(X,Y),7
  119. 1280 LINE (CTH+2,CTV+2)-(X,Y),7
  120. 1290 REM draw hour hand
  121. 1300 HI=2*PI/12*H:X=CTH+INT(SIN(HI)*HSH+.5):Y=CTV-INT(COS(HI)*HSV+.5)
  122. 1310 IF TMP AND (LEFT$(ALARM$,5)=LEFT$(TIME$,5) AND ALARM) THEN BEEP
  123. 1320 IF TMP AND (MID$(X$,3,5)="30:00") THEN PLAY CHIME$
  124. 1330 IF TMP AND (MID$(X$,4,5)="00:00") THEN H=VAL(MID$(X$,1,2)):H=H+((H>12)*12):PLAY HOUR$(H)
  125. 1340 LINE (CTH,CTV)-(X,Y),7
  126. 1350 LINE (CTH+3,CTV-3)-(X,Y),7
  127. 1360 LINE (CTH-3,CTV+3)-(X,Y),7
  128. 1370 LINE (CTH-3,CTV-3)-(X,Y),7
  129. 1380 LINE (CTH+3,CTV+3)-(X,Y),7
  130. 1390 RETURN
  131. 1400 REM
  132. 1410 REM initialize small setup clock on left
  133. 1420 REM
  134. 1430 R=80:HSM=R:VSM=R/RAT:IF ATT THEN CTH=R*2:CTV=CTH
  135. 1440 IF NOT ATT THEN CTH=R*2:CTV=R
  136. 1450 HSH=HSM*.5:HSV=VSM*.5:MSH=HSM*.8:MSV=VSM*.8:SSH=HSM*.9:SSV=VSM*.9
  137. 1460 CIRCLE (CTH,CTV),INT(HSM*1.2)
  138. 1470 FOR T=0 TO 59 STEP 5
  139. 1480 HI=2*PI/60*(T):X=CTH+INT(SIN(HI)*HSM+.5):Y=CTV-INT(COS(HI)*VSM+.5)
  140. 1490 IF T/5=INT(T/5)AND T/15<>INT(T/15) THEN CIRCLE(X,Y),INT(HSM/180*4)
  141. 1500 PSET(X,Y)
  142. 1510 IF T/15=INT(T/15) THEN LINE(X-INT(HSM/180*3),Y-INT(HSM/180*3))-(X+INT(HSM/180*3),Y+INT(HSM/180*3)),7,BF
  143. 1520 NEXT T
  144. 1530 RETURN
  145. 1540 REM
  146. 1550 REM initialize small alarm dial on right
  147. 1560 REM
  148. 1570 R=80:HSM=R:VSM=R/RAT:IF ATT THEN CTH=640-(R*2):CTV=R*2
  149. 1580 IF NOT ATT THEN CTH=640-(R*2):CTV=R
  150. 1590 HSH=HSM*.5:HSV=VSM*.5:MSH=HSM*.8:MSV=VSM*.8:SSH=HSM*.9:SSV=VSM*.9
  151. 1600 CIRCLE (CTH,CTV),INT(HSM*1.2)
  152. 1610 FOR T=0 TO 59 STEP 5
  153. 1620 HI=2*PI/60*(T):X=CTH+INT(SIN(HI)*HSM+.5):Y=CTV-INT(COS(HI)*VSM+.5)
  154. 1630 IF T/5=INT(T/5)AND T/15<>INT(T/15) THEN CIRCLE(X,Y),INT(HSM/180*4)
  155. 1640 PSET(X,Y)
  156. 1650 IF T/15=INT(T/15) THEN LINE(X-INT(HSM/180*3),Y-INT(HSM/180*3))-(X+INT(HSM/180*3),Y+INT(HSM/180*3)),7,BF
  157. 1660 NEXT T
  158. 1670 RETURN
  159. 1680 REM 
  160. 1690 REM enter setup screen
  161. 1700 REM 
  162. 1710 CLS:LC=1:LOCATE 1,26:PRINT"WRITTEN BY  -- DAVID JOHNSON"
  163. 1720 GOSUB 2270
  164. 1730 LOCATE 4,15:PRINT"CURRENT TIME":LOCATE 4,56:PRINT"ALARM TIME";
  165. 1740 GOSUB 1430:X$=TIME$:OLDTIME$=X$
  166. 1750 GOSUB 1570:X$=ALARM$:OLDX$=OLDALM$:GOSUB 720:OLDALM$=ALARM$
  167. 1760 I$=INKEY$:IF I$=CHR$(27) THEN I$="":RETURN
  168. 1770 IF I$=CHR$(26) THEN GOSUB 2500:I$="":GOTO 1760
  169. 1780 LOCATE 19,16:PRINT TIME$
  170. 1790 X$=TIME$:CTH=2*R:CTV=CTH:IF NOT ATT THEN CTV=R
  171. 1800 IF X$<>OLDTIME$ THEN OLDX$=OLDTIME$:OLDTIME$=X$:GOSUB 720
  172. 1810 IF I$<>"" THEN GOSUB 1830
  173. 1820 GOTO 1760
  174. 1830 IF LEN(I$)>1 THEN I$=RIGHT$(I$,1):IF I$=CHR$(72) THEN I$="-" ELSE IF I$=CHR$(80) THEN I$=CHR$(13)
  175. 1840 IF I$<>CHR$(13) THEN 1880
  176. 1850 LC=LC+1:IF LC>6 THEN LC=1
  177. 1860 IF LC<1 THEN LC=6
  178. 1870 GOSUB 2270:RETURN
  179. 1880 IF I$="-" THEN LC=LC-1:GOTO 1860
  180. 1890 ON LC GOSUB 1900,1910,1920,2070,2080,2090,2210:GOSUB 2270:RETURN
  181. 1900 IF I$<>" " THEN RETURN ELSE TICK=0-ABS(TICK+1):RETURN
  182. 1910 IF I$<>" " THEN RETURN ELSE BELL=0-ABS(BELL+1):RETURN
  183. 1920 IF I$<"0" OR I$>"9" THEN RETURN
  184. 1930 NEWTIME$="":IF I$>="0" OR I$<="9" THEN 1950 ELSE LOCATE 19,16:PRINT"              ";
  185. 1940 I$=INKEY$
  186. 1950 X$=TIME$:CTH=2*R:CTV=CTH:IF NOT ATT THEN CTV=R
  187. 1960 X$=TIME$:IF X$<>OLDTIME$ THEN OLDX$=OLDTIME$:OLDTIME$=X$:GOSUB 720
  188. 1970 IF I$="" THEN 1940
  189. 1980 IF (I$>="0" AND I$<="9") OR I$=":" THEN NEWTIME$=NEWTIME$+I$:LOCATE 19,16:PRINT NEWTIME$;"             ";
  190. 1990 IF I$=CHR$(27) THEN I$="":LOCATE 23,1:PRINT SPACE$(79);:RETURN
  191. 2000 IF I$<>CHR$(13) THEN 1940
  192. 2010 IF NEWTIME$="" THEN RETURN
  193. 2020 IF LEN(NEWTIME$)=4 AND MID$(NEWTIME$,2,1)=":" THEN NEWTIME$="0"+NEWTIME$
  194. 2030 IF LEN(NEWTIME$)>5 THEN NEWTIME$=LEFT$(NEWTIME$,5)
  195. 2040 IF MID$(NEWTIME$,3,1)<>":" OR LEN(NEWTIME$)>5 THEN BEEP:LOCATE 23,1:PRINT"Invalid time format (##:##). Try again or hit return to leave time unchanged";:GOTO 1920
  196. 2050 TIME$=NEWTIME$
  197. 2060 IF LEFT$(NEWTIME$,2)<="12" THEN AM=-1 ELSE AM=0
  198. 2070 IF I$<>" " THEN RETURN ELSE MODE=0-ABS(MODE+1):RETURN
  199. 2080 IF I$<>" " THEN RETURN ELSE ALARM=0-ABS(ALARM+1):RETURN
  200. 2090 IF I$<"0" OR I$>"9" THEN RETURN
  201. 2100 NEWALARM$="":IF I$>="0" OR I$<="9" THEN 2120 ELSE LOCATE 18,58:PRINT "         ";
  202. 2110 I$=INKEY$
  203. 2120 X$=TIME$:CTH=2*R:CTV=CTH:IF NOT ATT THEN CTV=R
  204. 2130 X$=TIME$:IF X$<>OLDTIME$ THEN OLDX$=OLDTIME$:OLDTIME$=X$:GOSUB 720
  205. 2140 IF I$="" THEN 2110
  206. 2150 IF (I$>="0" AND I$<="9") OR I$=":" THEN NEWALARM$=NEWALARM$+I$:LOCATE 18,58:PRINT NEWALARM$;"        ";
  207. 2160 IF I$=CHR$(27) THEN I$="":LOCATE 23,1:PRINT SPACE$(79);:RETURN
  208. 2170 IF I$<>CHR$(13) THEN 2110
  209. 2180 IF NEWALARM$="" THEN RETURN
  210. 2190 IF LEN(NEWALARM$)=4 AND MID$(NEWALARM$,2,1)=":" THEN NEWALARM$="0"+NEWALARM$
  211. 2200 IF LEN(NEWALARM$)>5 THEN NEWALARM$=LEFT$(NEWALARM$,5)
  212. 2210 IF MID$(NEWALARM$,3,1)<>":" THEN BEEP:LOCATE 23,1:PRINT"Invalid time format (##:##). Try again or hit return to leave time unchanged";:GOTO 2090
  213. 2220 TMP=0:X$=NEWALARM$+":00":OLDX$=OLDALM$+":00":CTH=640-(R*2):CTV=R*2:IF NOT ATT THEN CTV=R
  214. 2230 GOSUB 720:ALARM$=NEWALARM$:OLDALM$=ALARM$:TMP=-1
  215. 2240 RETURN
  216. 2250 RETURN
  217. 2260 RETURN
  218. 2270 REM display settings
  219. 2280 REM for setup screens
  220. 2290 LOCATE 23,1:PRINT SPACE$(79);
  221. 2300 LOCATE 22,20:PRINT "PRESS F1 TO SAVE THE NEW CONFIGURATION";
  222. 2310 LOCATE 21,20:PRINT "PRESS SPACE BAR TO TOGGLE ON/OFF THEN";
  223. 2320 LOCATE 17,8:PRINT"  TICK= ";:IF TICK THEN PRINT "ON " ELSE PRINT "OFF"
  224. 2330 LOCATE 18,8:PRINT"  BELL= ";:IF BELL THEN PRINT "ON " ELSE PRINT "OFF"
  225. 2340 LOCATE 19,8:PRINT"  TIME= ";X$;:IF NOT MODE THEN IF AM THEN PRINT" AM " ELSE PRINT" PM "
  226. 2350 IF MODE THEN PRINT"    "
  227. 2360 LOCATE 20,8:PRINT"  MODE= ";:IF MODE THEN PRINT "24 " ELSE PRINT "12 "
  228. 2370 LOCATE 17,48:PRINT"  ALARM = ";:IF ALARM THEN PRINT "ON " ELSE PRINT "OFF"
  229. 2380 LOCATE 18,48:PRINT"  TIME  = ";ALARM$;:IF NOT MODE THEN IF LEFT$(ALARM$,2)<"12" THEN PRINT" AM " ELSE PRINT" PM "
  230. 2390 IF MODE THEN PRINT"    "
  231. 2400 IF LC<=4 THEN LOCATE 16+LC,8:PRINT CHR$(15);
  232. 2410 IF LC>4 THEN LOCATE 16+LC-4,48:PRINT CHR$(15);
  233. 2420 RETURN
  234. 2430 ON ERROR GOTO 2490
  235. 2440 REM look for default data file
  236. 2450 OPEN "data.dat" FOR INPUT AS #1
  237. 2460 INPUT #1,TICK:INPUT #1,BELL:INPUT #1,MODE:INPUT #1,ALARM:INPUT #1,ALARM$:INPUT #1,TMP
  238. 2470 CLOSE #1:ON ERROR GOTO 0
  239. 2480 RETURN
  240. 2490 RESUME 2470:REM ERROR -- no default file use standard defaults
  241. 2500 ON ERROR GOTO 2570
  242. 2510 REM save default settings
  243. 2520 OPEN "data.dat" FOR OUTPUT AS #1
  244. 2530 PRINT #1,TICK:PRINT #1,BELL:PRINT #1,MODE:PRINT #1,ALARM:PRINT #1,ALARM$:PRINT #1,TMP
  245. 2540 LOCATE 23,25:PRINT"CURRENT CONFIGURATION SAVED";
  246. 2550 CLOSE #1:ON ERROR GOTO 0
  247. 2560 RETURN
  248. 2570 RESUME 2550
  249. 2580 SCREEN 0:CLS
  250. 2590 LOCATE 1,10:PRINT "PROGRAM WRITTEN BY:"
  251. 2600 LOCATE 1,40:PRINT "DAVID JOHNSON     "
  252. 2610 LOCATE 2,40:PRINT "551 Willow st.    "
  253. 2620 LOCATE 3,40:PRINT "S. Hempstead, N.Y."
  254. 2630 LOCATE 4,40:PRINT "             11550"
  255. 2640 LOCATE  7,20:PRINT "***************************************"
  256. 2650 LOCATE 11,20:PRINT "***************************************"
  257. 2660 LOCATE  8,20:PRINT "* If you have found this program to   *"
  258. 2670 LOCATE  9,20:PRINT "* be of any value, your controbution  *"
  259. 2680 LOCATE 10,20:PRINT "* ($5 suggested) will be appreciated. *"
  260. 2700 LOCATE 16,18:PRINT "     You are encouraged to copy and share"
  261. 2710 LOCATE 17,18:PRINT "this program with others, on the conditions"
  262. 2720 LOCATE 18,18:PRINT "that the program is not distributed in"
  263. 2730 LOCATE 19,18:PRINT "modified form, that no fee or consideration"
  264. 2740 LOCATE 20,18:PRINT "is charged, and this notice is not bypassed."
  265. 2750 LOCATE 24,1:PRINT"Hit any ket to exit,";
  266. 2760 LOCATE 25,1:PRINT"or hit <esc> to return to clock";
  267. 2770 X$=INKEY$:IF X$="" THEN 2770
  268. 2780 IF X$=CHR$(27) THEN RETURN
  269. 2790 SCREEN 2,0:SCREEN 0
  270. 2800 END
  271. 2810 REM data for hour chimes
  272. 2820 DATA "MBT80MNO2L4ecd<L2g>L4cdeL2cP2T100"
  273.