THE PAST MASTER CLUB
CLOCK & CALENDAR.HTM
' ** NICK K. VAN VLIET AUG/98 CLOCK.bas VERS2.7 CALENDAR (C) 1964/81 ' ** ' ** HOME PAGE: http://www.geocities.com/klaus_vanv/index.html ' ** ' ** LOOK FOR MORE BAS FILES; AS WELL AS, OTHER PERHAPS MORE INTERESTING ' ** PROGRAM FILES. ' ** DEFDBL A-Z DECLARE SUB MASK () DECLARE SUB DIAL () 'face DECLARE SUB DrawCircles (T, scale, radius, X0, Y0, clr, size) 'dots DECLARE SUB HALO (scale, X0, Y0, clr) 'circle DECLARE SUB CALENDAR () 'calendar CONST true = -1 CONST false = NOT true CONST pi = 3.141592654# 'PI /7 = 0.44880 4 * ATN(1#) CONST maxx = 319 - 3 'half of 640x480 CONST maxy = 239 'half screen CONST RADIUS0 = 220 CONST radius1 = 200 CONST radius2 = 190 CONST radius3 = 140 CONST BRDR = 10 CONST CLRH = 0 ' 12 COMMON SHARED xx, yy, RW, CL, IY, ID, DD, CLK, RWK, K$, DI, KD COMMON SHARED X0, Y0, h, K, A$, G, R, S, T, U, C, clr, LTR$, radius SCREEN 12 '640x480 w/256 colors DIM SHARED B(6 * 6): DIM SHARED C(18 * 18): DIM SHARED D(18 * 18) DrawCircles T, 3, 0, 3, 3, 12, 7.5 '15 MINS RD12 GET (0, 0)-(9, 9), B CLS DrawCircles T, 9, 0, 9, 9, 14, 30 'HOURS YEL14 GET (0, 0)-(18, 18), C CLS DrawCircles T, 9, 0, 9, 9, 4, 30 'HOUR HAND BK0 GET (0, 0)-(18, 18), D DD = 0: SCK = VAL(MID$(TIME$, 7, 2)) CLS PAINT (1, 1), 9 '7=lgrey 9=lblue x1 = RADIUS0 + 15 + maxx y1 = maxy FOR II = 0 TO 360 X2 = (RADIUS0 + 15) * COS((II + 0) / 180 * pi) + maxx Y2 = (RADIUS0 + 15) * SIN((II + 0) / 180 * pi) + maxy LINE (x1, y1)-(X2, Y2), 4 'CLCK OUTLINE x1 = X2: y1 = Y2 NEXT II DIAL 'FACE CALENDAR 'CALENDAR MASK 'RESTORE CORNERS alarm = false: salarm = false LOCATE 27, 68: PRINT "S=Set Alarm" LOCATE 28, 68: PRINT "A=Alarm Off" LOCATE 28, 3: PRINT "cntrl pause=exit" DO ' <<<<<<< MAIN LOOP <<<<<<<< IF ID <> VAL(MID$(DATE$, 4, 2)) THEN RUN: ' start over at midnight! y$ = TIME$ LOCATE RW, CL + 14 - KD: COLOR BRDR: PRINT y$ hr = CDBL(VAL(MID$(y$, 1, 2))): 'PRINT hr MN = CDBL(VAL(MID$(y$, 4, 2))): 'PRINT mn sc = CDBL(VAL(MID$(y$, 7, 2))): 'PRINT sc: INPUT u$ MN = CDBL(MN + sc / 60#) hr = CDBL(hr + MN / 60#) 'HOUR HAND x1 = radius1 * COS((90 - (hr * 30)) / 180 * pi) '360/12=30 y1 = -radius1 * SIN((90 - (hr * 30)) / 180 * pi) X2 = (radius1 - 30) * COS((90 - (hr * 30)) / 180 * pi) Y2 = -(radius1 - 30) * SIN((90 - (hr * 30)) / 180 * pi) 'MINUTE HAND x3 = radius2 * COS((90 - (MN * 6)) / 180 * pi) '360/60=6 y3 = -radius2 * SIN((90 - (MN * 6)) / 180 * pi) X4 = (radius2 - 30) * COS((90 - (MN * 6)) / 180 * pi) Y4 = -(radius2 - 30) * SIN((90 - (MN * 6)) / 180 * pi) 'SECOND HAND x5 = radius2 * COS((90 - (sc * 6)) / 180 * pi) '360/60/60=.1 y5 = -radius2 * SIN((90 - (sc * 6)) / 180 * pi) '@MIN x6 = (radius2 - 30) * COS((90 - (sc * 6)) / 180 * pi) y6 = -(radius2 - 30) * SIN((90 - (sc * 6)) / 180 * pi) LINE (maxx + (x3 + X4) / 2 - 10, maxy + (y3 + Y4) / 2 - 10)-(maxx + (x3 + X4) / 2 + 10, maxy + (y3 + Y4) / 2 + 10), 9, BF 'MN ERR PUT (maxx + (x3 + X4) / 2 - 3, maxy + (y3 + Y4) / 2 - 3), B(0), OR 'MN PAINT (maxx + (x3 + X4) / 2, maxy + (y3 + Y4) / 2), CLRH, 9 LINE (maxx + x1, maxy + y1)-(maxx + X2, maxy + Y2), CLRH 'HR HAND LINE (maxx + x3, maxy + y3)-(maxx + X4, maxy + Y4), CLRH 'MN HAND LINE (maxx + x5, maxy + y5)-(maxx + x6, maxy + y6), CLRH 'SC HAND PUT (maxx + (x1 + X2) / 2 - 9, maxy + (y1 + Y2) / 2 - 9), D(0), OR 'HR PAINT (maxx + (x1 + X2) / 2, maxy + (y1 + Y2) / 2), CLRH, 9 HALO 4, maxx + (x3 + X4) / 2, maxy + (y3 + Y4) / 2, 9 'erase circle MN HALO 10, maxx + (x1 + X2) / 2, maxy + (y1 + Y2) / 2, 9 'erase circle HR ND = ((sc MOD 6) + 8): IF ND = 9 OR ND = 11 OR ND = 8 THEN ND = 14 COLOR ND: LOCATE RWK, CLK: PRINT K$: COLOR 15 'CHAR CLR LINE (maxx + x1, maxy + y1)-(maxx + X2, maxy + Y2), 9 'ERASE LINES HR LINE (maxx + x3, maxy + y3)-(maxx + X4, maxy + Y4), 9 'MN LINE (maxx + x5, maxy + y5)-(maxx + x6, maxy + y6), 9 'SC Key$ = INKEY$ 'get any keystrokes IF LEN(Key$) THEN keyval = ASC(Key$) 'convert to an integer IF keyval = 64 OR keyval = 97 THEN 'set alarm IF NOT alarm THEN zzz$ = "On ": alarm = true ELSE zzz$ = "Off": alarm = false FOR zzz = 0 TO 100: LOCATE 28, 76: PRINT zzz$ NEXT zzz keyval = 0 END IF IF keyval = 83 OR keyval = 115 THEN 'set time alarm alarm = true loopsalarm: LOCATE 27, 68: PRINT "EnterTimeDc" LOCATE 28, 68: PRINT " " LOCATE 28, 68: INPUT zzzs IF NOT (zzzs >= 0 AND zzzs <= 24) THEN GOTO loopsalarm IF zzzs >= 12! THEN szzs = zzzs - 12 ELSE szzs = zzzs LOCATE 27, 68: PRINT USING " ##.##"; szzs; IF zzzs >= 12! THEN PRINT " pm " ELSE PRINT " am " 'PRINT USING " ##"; FIX(dys); : PRINT " dys "; 'PRINT USING " ##"; CINT((thr - .5) MOD 12); : PRINT ":"; 'PRINT USING " ##"; CINT((tmn + .5) MOD 60); : PRINT ":"; 'PRINT USING " ##"; CINT((sc + .5) MOD 60); : PRINT " "; : 'IF am THEN PRINT " am "; ELSE PRINT " pm " LOCATE 28, 68: COLOR 10: PRINT "A=Alarm "; : COLOR 15: PRINT "On " FOR zzz = 0 TO 100: LOCATE 28, 76: PRINT zzz$ NEXT zzz keyval = 0 END IF 'off IF VAL(TIME$) >= zzzs AND VAL(TIME$) <= (zzzs + 1) AND alarm THEN FOR h = 0 TO 10 '12RED TURN THIS LINE INTO 1000 TO CHECK YOUT AIM FOR T = 0 TO 2 SOUND T * 100, 1.3 'noise LONGER SOUND T * 100, .2 'noise NEXT T ' SOUND h * 100, .3 'noise SHORT ' SOUND h * 100, .2 'noise NEXT h 'ELSE ' alarm = false END IF LOOP WHILE keyval <> 27 'keep going until escape is pressed END SUB CALENDAR 10 REM NICK K. VAN VLIET CALENDAR VERS2.1 COPYRIGHTED 1981 AND EARLIER 20 REM CONVERTED DIRECTLY FROM GWBASIC PROGRAM C:\N\NIC4\BAS\CAL.BAS 40 IM = VAL(MID$(DATE$, 1, 2)) 50 ID = VAL(MID$(DATE$, 4, 2)) 60 IY = VAL(MID$(DATE$, 7, 4)) 62 REM IM = 9: ID = 27: IY = 1943 TEST '12RD-OK '13PINK 70 RW = 11: CL = 26: DI = ID '2GRN '7GRY '0 '9BLU '10lgrn-OK 150 GOSUB 630 160 KD = 0: FOR I = 1 TO 8 170 IF MID$(U$, I, 1) = " " THEN KD = FIX(9 - I) / 2: I = 90 180 NEXT I 230 COLOR 15: PRINT : LOCATE RW, CL: PRINT DI; U$; TAB(23 + CL); IY 234 LOCATE RW, CL + 14 - KD: PRINT TIME$: LOCATE RW + 1, CL: COLOR BRDR 240 PRINT CHR$(201); : FOR I = 1 TO 6: FOR J = 1 TO 3: PRINT CHR$(205); 250 NEXT J: PRINT CHR$(203); : NEXT I: FOR J = 1 TO 3: PRINT CHR$(205); 260 NEXT J: PRINT CHR$(187); : LOCATE RW + 2, CL: PRINT CHR$(186); 262 COLOR 11: PRINT "SUN"; 270 COLOR BRDR: PRINT CHR$(186); : COLOR 15: PRINT "MON"; 'DAYS 272 COLOR BRDR: PRINT CHR$(186); : COLOR 15: PRINT "TUE"; : 280 COLOR BRDR: PRINT CHR$(186); : COLOR 15: PRINT "WED"; 290 COLOR BRDR: PRINT CHR$(186); : COLOR 15: PRINT "THU"; : COLOR BRDR 300 PRINT CHR$(186); : COLOR 15: PRINT "FRI"; : COLOR BRDR: PRINT CHR$(186); 310 COLOR 11: PRINT "SAT"; : COLOR BRDR: PRINT CHR$(186); 320 LOCATE RW + 3, CL: PRINT CHR$(204); : FOR I = 1 TO 6: FOR J = 1 TO 3 330 PRINT CHR$(205); : NEXT J: PRINT CHR$(202); : NEXT I 'BAR 340 FOR J = 1 TO 3: PRINT CHR$(205); : NEXT J: PRINT CHR$(185); 350 G = -(IM = 1 OR IM = 10) - 2 * (IM = 5) - 3 * (IM = 8) 360 G = G - 4 * (IM = 2 OR IM = 3 OR IM = 11) - 5 * (IM = 6) 370 G = G - 6 * (IM = 9 OR IM = 12) - 7 * (IM = 4 OR IM = 7) 380 U$ = MID$("MABCKFGAIDEFNBCDLGABJEFGHCDE", Z + 1, 1) 390 G = G - 2 + (Z = IZ AND (IM = 1 OR IM = 2)) - (U$ = "A" OR U$ = "N") 400 G = G - 2 * (U$ = "B" OR U$ = "H") - 3 * (U$ = "C" OR U$ = "I") 410 G = G - 4 * (U$ = "D" OR U$ = "J") - 5 * (U$ = "E" OR U$ = "K") 420 G = G - 6 * (U$ = "F" OR U$ = "L") - 7 * (U$ = "G" OR U$ = "M") + 7 * 7 430 G = G - 7 * INT(G / 7 + .1) + 1: 432 REM 'PRINT " G= "; G; "U$ = "; U$ '6+6-2=10-7=3 434 DD = 4: K = 1 440 FOR I = 1 TO 6: LOCATE RW + 3 + I, CL: COLOR BRDR: PRINT CHR$(186); 450 DD = DD + 1: FOR J = 1 TO 7: A = 7 * (I - 1) + J: COLOR 15 460 IF J = 1 OR J = 7 THEN COLOR 11 470 IF K = ID THEN COLOR 14: CLK = (4 * (J - 1) + 2 + (K >= 10) + CL): RWK = RW + I + 3: K$ = STR$(K) 480 IF A >= G AND K <= DL THEN PRINT TAB(4 * (J - 1) + 2 + (K >= 10) + CL); STR$(K); : COLOR 15 490 K = K - (A >= G): NEXT J: COLOR BRDR: PRINT TAB(CL + 28); CHR$(186) 500 IF K > DL THEN I = I + 1: GOTO 512 510 NEXT I 512 LOCATE RW + 3 + I, CL: COLOR BRDR: PRINT CHR$(200); 514 FOR I = 1 TO 27: PRINT CHR$(205); 520 NEXT I: PRINT CHR$(188) 530 GOTO 800 630 REM GOSUB 632 U$ = ">8><><>><><>" 640 IF IY = 1800 THEN IY = 1902 650 IF IY = 1900 THEN IY = 1906 660 IF IY < 1900 THEN IY = IY + 12 670 Z = IY - 28 * FIX(IY / 28): IZ = 4 * FIX(Z / 4) 674 DL = ASC(MID$(U$, IM, 1)) / 2 - (IM = 2 AND Z = IZ) 680 U$ = "JANUARY FEBRUARY MARCH APRIL MAY JUNE JULY AUGU" 690 U$ = U$ + "ST SEPTEMBEROCTOBER NOVEMBER DECEMBER " 700 U$ = MID$(U$, (IM - 1) * 9 + 1, 9) 710 RETURN 800 END SUB SUB DIAL PAINT (1, 1), 7, 4 FOR T = 0 TO 360 STEP 5 x1 = RADIUS0 * COS(T * 1 / 180 * pi) y1 = -RADIUS0 * SIN(T * 1 / 180 * pi) X2 = (RADIUS0 - 15) * COS(T * 1 / 180 * pi) Y2 = -(RADIUS0 - 15) * SIN(T * 1 / 180 * pi) LINE (maxx + x1, maxy + y1)-(maxx + X2, maxy + Y2), 14 'TICS NEXT T FOR T = 1 TO 48 x1 = RADIUS0 * COS((90 - T * 7.5) / 180 * pi) '15 MIN. y1 = -RADIUS0 * SIN((90 - T * 7.5) / 180 * pi) PUT (maxx + x1 - 3, maxy + y1 - 3), B(0), OR PAINT (maxx + x1, maxy + y1), 12, 9 NEXT T FOR T = 1 TO 12 x1 = RADIUS0 * COS((90 - T * 30) / 180 * pi) 'HRLY y1 = -RADIUS0 * SIN((90 - T * 30) / 180 * pi) PUT (maxx + x1 - 9, maxy + y1 - 9), C(0), OR PAINT (maxx + x1, maxy + y1), 14, 9 NEXT T END SUB SUB DrawCircles (T, scale, radius, X0, Y0, clr, size) x1 = radius * COS((90 - T * size) / 180 * pi) y1 = -radius * SIN((90 - T * size) / 180 * pi) FOR II = 0 TO 360 X2 = scale * COS((II + 0) / 180 * pi) Y2 = scale * SIN((II + 0) / 180 * pi) LINE (X0 + x1, Y0 + y1)-(X2 + X0 + x1, Y2 + Y0 + y1), clr NEXT II END SUB SUB HALO (scale, X0, Y0, clr) 'to erase hr hand x1 = scale + X0 y1 = Y0 FOR II = 0 TO 360 X2 = scale * COS((II + 0) / 180 * pi) + X0 Y2 = scale * SIN((II + 0) / 180 * pi) + Y0 LINE (x1, y1)-(X2, Y2), clr, BF x1 = X2: y1 = Y2 NEXT II END SUB SUB MASK LINE (CL * 8 - 8, RW * 16 - 20)-(432, (RW + DD) * 16 - 2), 0, B ' 1 TOP BRDR LINE (CL * 8 - 9, RW * 16 - 21)-(433, (RW + DD) * 16 - 2), 0, B ' 2 TOP BRDR LINE (CL * 8 - 10, RW * 16 - 21)-(434, (RW + DD) * 16 - 2), 0, B ' 3 TOP LINE (CL * 8 - 11, RW * 16 - 21)-(435, (RW + DD) * 16 - 1), 0, B ' 4 TOP LINE (CL * 8 - 8, RW * 16 - 20)-(432, RW * 16 - 17), 0, BF 'LETTERING TOP LOCATE RW + DD + 0, CL: COLOR BRDR: PRINT CHR$(200); CHR$(205); 'CORNERS LOCATE RW + DD + 0, CL + 27: COLOR BRDR: PRINT CHR$(205); CHR$(188); ' END SUB
RETURN TO TOP
RETURN TO PMC MENU
HOME PAGE
You are visitor no.