Reorganized files. Modernized documentation.
[qbasicapps.git] / misc / timer.bas
diff --git a/misc/timer.bas b/misc/timer.bas
new file mode 100644 (file)
index 0000000..74d6238
--- /dev/null
@@ -0,0 +1,855 @@
+CHDIR ".\qbasicapps\unsorted"\r
+\r
+\r
+DECLARE SUB bar ()\r
+DECLARE SUB help (a!)\r
+DECLARE SUB alarm (a!)\r
+DECLARE SUB gtw (y!, m!, t!, r!)\r
+DECLARE SUB daysm (y!, m!, d!)\r
+DECLARE SUB daysy (y!, d!)\r
+DECLARE SUB chdat ()\r
+DECLARE SUB entcla ()\r
+DECLARE SUB entcl ()\r
+DECLARE SUB clrc (a!)\r
+DECLARE SUB scroll ()\r
+DECLARE SUB ps (x!, y!, c!, s$)\r
+DECLARE SUB vbox (x1!, y1!, x2!, y2!, c!)\r
+DECLARE SUB quit ()\r
+DECLARE SUB start ()\r
+DECLARE SUB cns (a!, s$)\r
+DECLARE SUB getkey (a$)\r
+DECLARE SUB chkey (a$)\r
+DECLARE SUB entquit ()\r
+DECLARE SUB ented ()\r
+DECLARE SUB ed (p!)\r
+DECLARE SUB inpu (x!, y!, xl!, c!, a$)\r
+DECLARE SUB box (x!, y!, xl!, yl!, a$)\r
+DECLARE SUB sh ()\r
+\r
+DIM SHARED celh(1 TO 20)\r
+DIM SHARED celm(1 TO 20)\r
+DIM SHARED cels(1 TO 20)\r
+\r
+DIM SHARED celm1$(1 TO 20)\r
+DIM SHARED celm2$(1 TO 20)\r
+DIM SHARED celc$(1 TO 20)\r
+\r
+DIM SHARED celt(1 TO 20)' 0 - empty  1 - onece  2 - every day  3 - specified days\r
+DIM SHARED celw(1 TO 20, 1 TO 7)\r
+DIM SHARED celx(1 TO 20)\r
+\r
+DIM SHARED virt(1 TO 80, 1 TO 25)\r
+DIM SHARED tmr\r
+DIM SHARED slp(1 TO 20)\r
+DIM SHARED alq(1 TO 20)\r
+DIM SHARED alarmo\r
+\r
+DIM SHARED alqm\r
+DIM SHARED br$\r
+\r
+start\r
+\r
+sh\r
+1\r
+br$ = "Press F1 for help"\r
+getkey a$\r
+\r
+IF a$ = "q" THEN entquit\r
+IF a$ = "e" THEN ented\r
+IF a$ = "c" THEN entcl\r
+IF a$ = "d" THEN entcla\r
+IF a$ = CHR$(0) + CHR$(59) THEN help 1: getkey a$: sh\r
+GOTO 1\r
+\r
+SUB alarm (a)\r
+alq(a) = 1\r
+alarmo = 1\r
+'DIM SHARED celm1$(1 TO 20)\r
+'DIM SHARED celm2$(1 TO 20)\r
+'DIM SHARED celc$(1 TO 20)\r
+\r
+IF celc$(a) <> "" THEN\r
+SHELL celc$(a)\r
+END IF\r
+\r
+IF celm1$(a) <> "" OR celm2$(a) <> "" THEN\r
+OPEN "note.txt" FOR OUTPUT AS #1\r
+PRINT #1, celm1$(a)\r
+PRINT #1, celm2$(a)\r
+CLOSE #1\r
+SHELL "notepad note.txt"\r
+END IF\r
+\r
+\r
+FOR b = 100 TO 1000 STEP 20\r
+SOUND b, .1\r
+NEXT b\r
+END SUB\r
+\r
+SUB bar\r
+COLOR 0, 3\r
+LOCATE 22, 72\r
+PRINT CHR$(179) + TIME$\r
+\r
+br$ = br$ + SPACE$(80)\r
+br$ = LEFT$(br$, 70)\r
+LOCATE 22, 1\r
+PRINT " " + br$\r
+\r
+COLOR 7, 0\r
+END SUB\r
+\r
+SUB box (x, y, xl, yl, e$)\r
+vbox x, y, xl, yl, 1\r
+' 201 205 187\r
+COLOR 11\r
+\r
+a$ = ""\r
+d$ = ""\r
+FOR a = 1 TO xl - 2\r
+a$ = a$ + CHR$(205)\r
+d$ = d$ + " "\r
+NEXT a\r
+b$ = CHR$(201) + a$ + CHR$(187)\r
+c$ = CHR$(200) + a$ + CHR$(188)\r
+d$ = CHR$(186) + d$ + CHR$(186)\r
+\r
+LOCATE y, x\r
+PRINT b$\r
+LOCATE y + yl - 1, x\r
+PRINT c$\r
+\r
+FOR a = 1 TO yl - 2\r
+LOCATE y + a, x\r
+PRINT d$\r
+NEXT a\r
+\r
+xt = INT(x + (xl / 2) - (LEN(e$) / 2) - 2)\r
+LOCATE y, xt\r
+PRINT "[ "\r
+xt = xt + 2\r
+\r
+COLOR 10\r
+LOCATE y, xt\r
+PRINT e$\r
+\r
+xt = xt + LEN(e$)\r
+\r
+COLOR 11\r
+LOCATE y, xt\r
+PRINT " ]"\r
+\r
+COLOR 7, 0\r
+END SUB\r
+\r
+SUB chdat\r
+a$ = DATE$\r
+qwy = VAL(RIGHT$(a$, 4))\r
+qwm = VAL(LEFT$(a$, 2))\r
+qwd = VAL(RIGHT$(LEFT$(a$, 5), 2))\r
+gtw qwy, qwm, qwd, w\r
+\r
+a$ = TIME$\r
+qes = VAL(RIGHT$(a$, 4))\r
+qeh = VAL(LEFT$(a$, 2))\r
+qem = VAL(RIGHT$(LEFT$(a$, 5), 2))\r
+\r
+IF alqm <> qem THEN\r
+alqm = qem\r
+\r
+FOR b = 1 TO 20\r
+alq(b) = 0\r
+NEXT b\r
+END IF\r
+\r
+\r
+'DIM SHARED celh(1 TO 20)\r
+'DIM SHARED celm(1 TO 20)\r
+'DIM SHARED cels(1 TO 20)\r
+\r
+\r
+FOR a = 1 TO 20\r
+IF celt(a) = 0 THEN GOTO 19\r
+IF celt(a) = 3 THEN IF celw(a, w) = 0 THEN GOTO 19\r
+IF alq(a) = 1 THEN GOTO 19\r
+IF celh(a) <> qeh THEN GOTO 19\r
+IF celm(a) <> qem THEN GOTO 19\r
+alarm a\r
+IF celt(a) = 1 THEN clrc a\r
+19\r
+NEXT a\r
+END SUB\r
+\r
+SUB chkey (a$)\r
+a$ = INKEY$\r
+\r
+IF a$ = "" THEN\r
+IF tmr > 4 THEN scroll: tmr = 1\r
+SOUND 0, 1\r
+IF alarmo = 1 THEN SOUND 2000, 1\r
+tmr = tmr + 1\r
+chdat\r
+bar\r
+ELSE\r
+IF alarmo = 1 THEN alarmo = 0: a$ = ""\r
+END IF\r
+END SUB\r
+\r
+SUB clrc (a)\r
+\r
+celh(a) = 0\r
+celm(a) = 0\r
+cels(a) = 0\r
+celt(a) = 0\r
+\r
+celm1$(a) = ""\r
+celm2$(a) = ""\r
+celc$(a) = ""\r
+\r
+FOR b = 1 TO 7\r
+celw(a, b) = 0\r
+NEXT b\r
+\r
+END SUB\r
+\r
+SUB cns (a, s$)\r
+s$ = STR$(a)\r
+IF LEFT$(s$, 1) = " " THEN s$ = RIGHT$(s$, LEN(s$) - 1)\r
+IF LEN(s$) = 1 THEN s$ = "0" + s$\r
+END SUB\r
+\r
+SUB daysm (y, m, d)\r
+SELECT CASE m\r
+CASE 1\r
+d = 31\r
+\r
+CASE 2\r
+IF y / 4 = y \ 4 THEN d = 29 ELSE d = 28\r
+\r
+CASE 3\r
+d = 31\r
+\r
+CASE 4\r
+d = 30\r
+\r
+CASE 5\r
+d = 31\r
+\r
+CASE 6\r
+d = 30\r
+\r
+CASE 7\r
+d = 31\r
+\r
+CASE 8\r
+d = 31\r
+\r
+CASE 9\r
+d = 30\r
+\r
+CASE 10\r
+d = 31\r
+\r
+CASE 11\r
+d = 30\r
+\r
+CASE 12\r
+d = 31\r
+END SELECT\r
+\r
+END SUB\r
+\r
+SUB daysy (y, d)\r
+d = 365\r
+IF y / 4 = y \ 4 THEN d = 366\r
+END SUB\r
+\r
+SUB ed (p)\r
+br$ = "Press F1 for help, ESC to close window, CTRL + ENTER accept"\r
+cns celh(p), s$\r
+tth$ = s$\r
+cns celm(p), s$\r
+ttm$ = s$\r
+cns cels(p), s$\r
+tts$ = s$\r
+\r
+ms1$ = celm1$(p)\r
+ms2$ = celm2$(p)\r
+cm1$ = celc$(p)\r
+\r
+DIM wks(1 TO 7)\r
+FOR a = 1 TO 7\r
+wks(a) = celw(p, a)\r
+NEXT a\r
+typ = celt(p)\r
+IF typ = 0 THEN typ = 1\r
+\r
+box 5, 5, 70, 11, "Edit entrie"\r
+LOCATE 7, 7\r
+PRINT "Enter time   (HH:MM:SS)"\r
+LOCATE 8, 23\r
+PRINT ":"\r
+LOCATE 8, 26\r
+PRINT ":"\r
+inpu 21, 8, 2, 1, tth$\r
+inpu 24, 8, 2, 1, ttm$\r
+inpu 27, 8, 2, 1, tts$\r
+\r
+LOCATE 10, 7\r
+PRINT "Enter message"\r
+inpu 21, 10, 52, 1, ms1$\r
+inpu 21, 11, 52, 1, ms2$\r
+\r
+LOCATE 13, 7\r
+PRINT "Enter command"\r
+inpu 21, 13, 52, 1, cm1$\r
+\r
+x = 1\r
+y = 1\r
+11\r
+\r
+IF typ = 1 THEN COLOR 14, 4 ELSE COLOR 14, 0\r
+LOCATE 7, 32\r
+PRINT "O";\r
+COLOR 7\r
+PRINT "nce"\r
+\r
+IF typ = 2 THEN COLOR 14, 4 ELSE COLOR 14, 0\r
+LOCATE 7, 38\r
+PRINT "D";\r
+COLOR 7\r
+PRINT "aily"\r
+\r
+IF typ = 3 THEN COLOR 14, 4 ELSE COLOR 14, 0\r
+LOCATE 7, 45\r
+PRINT "S";\r
+COLOR 7\r
+PRINT "pecified weekdays"\r
+\r
+FOR a = 1 TO 7\r
+IF wks(a) = 1 THEN COLOR 10, 0 ELSE COLOR 8, 0\r
+LOCATE 8, 44 + (a * 2)\r
+PRINT a\r
+NEXT a\r
+\r
+\r
+c = 0\r
+\r
+IF y = 1 THEN\r
+IF x = 1 THEN inpu 21, 8, 2, c, tth$\r
+IF x = 2 THEN inpu 24, 8, 2, c, ttm$\r
+IF x = 3 THEN inpu 27, 8, 2, c, tts$\r
+END IF\r
+\r
+IF y = 2 THEN inpu 21, 10, 52, c, ms1$\r
+IF y = 3 THEN inpu 21, 11, 52, c, ms2$\r
+IF y = 4 THEN inpu 21, 13, 52, c, cm1$\r
+\r
+IF c = 100 THEN GOTO 13\r
+IF c = 102 THEN x = x + 1\r
+IF c = 103 THEN x = x - 1\r
+IF c = 104 THEN y = y - 1\r
+IF c = 105 THEN y = y + 1\r
+IF c = 106 THEN GOTO 12\r
+\r
+tg = 0\r
+IF c = 107 THEN tg = 1\r
+IF c = 108 THEN tg = 2\r
+IF c = 109 THEN tg = 3\r
+IF c = 110 THEN tg = 4\r
+IF c = 111 THEN tg = 5\r
+IF c = 112 THEN tg = 6\r
+IF c = 113 THEN tg = 7\r
+\r
+IF c = 114 THEN typ = 1\r
+IF c = 115 THEN typ = 2\r
+IF c = 116 THEN typ = 3\r
+\r
+IF c = 117 THEN help 2\r
+\r
+IF tg > 0 THEN\r
+IF wks(tg) = 0 THEN wks(tg) = 1 ELSE wks(tg) = 0\r
+END IF\r
+\r
+IF c = 101 THEN\r
+IF y = 1 THEN x = x + 1 ELSE y = y + 1\r
+END IF\r
+\r
+\r
+IF y > 4 THEN y = 4\r
+IF y < 1 THEN y = 1\r
+IF x > 3 THEN x = 1: y = y + 1\r
+IF x < 1 THEN x = 1\r
+\r
+\r
+GOTO 11\r
+12\r
+celh(p) = VAL(tth$)\r
+celm(p) = VAL(ttm$)\r
+cels(p) = VAL(tts$)\r
+\r
+celm1$(p) = ms1$\r
+celm2$(p) = ms2$\r
+celc$(p) = cm1$\r
+celt(p) = typ\r
+\r
+\r
+FOR a = 1 TO 7\r
+celw(p, a) = wks(a)\r
+NEXT a\r
+13\r
+\r
+END SUB\r
+\r
+SUB entcl\r
+a$ = "01"\r
+box 20, 10, 40, 5, "Clear entrie"\r
+\r
+LOCATE 12, 23\r
+PRINT "Which cell do you need to clear?"\r
+\r
+15\r
+inpu 55, 12, 2, c, a$\r
+IF c = 100 THEN GOTO 16\r
+IF c = 101 THEN\r
+clrc VAL(a$)\r
+GOTO 16\r
+END IF\r
+GOTO 15\r
+\r
+16\r
+sh\r
+END SUB\r
+\r
+SUB entcla\r
+\r
+box 15, 10, 50, 6, "Clearing"\r
+\r
+18\r
+LOCATE 12, 21\r
+PRINT "Are you sure you want to clear all cells?"\r
+LOCATE 13, 36\r
+PRINT "[ Y / N ]"\r
+\r
+\r
+getkey a$\r
+IF a$ = "y" OR a$ = "Y" THEN\r
+FOR a = 1 TO 20\r
+clrc a\r
+NEXT a\r
+GOTO 17\r
+END IF\r
+IF a$ = "n" OR a$ = "N" THEN GOTO 17\r
+box 15, 10, 50, 8, "Clearing"\r
+LOCATE 15, 30\r
+COLOR 28\r
+PRINT "Use keys 'Y' or 'N'"\r
+COLOR 7\r
+GOTO 18\r
+\r
+17\r
+sh\r
+\r
+\r
+END SUB\r
+\r
+SUB ented\r
+br$ = "Enter cell number in range of 1 to 20"\r
+a$ = "01"\r
+box 20, 10, 40, 5, "Edit entrie"\r
+\r
+9\r
+LOCATE 12, 23\r
+PRINT "Which cell do you need to edit?"\r
+'SUB inpu (x, y, xl, c, a$)\r
+\r
+6\r
+c = 0\r
+inpu 55, 12, 2, c, a$\r
+IF c = 100 THEN GOTO 7\r
+IF c = 101 THEN\r
+b = VAL(a$)\r
+\r
+IF b = 0 THEN\r
+IF a$ = " 0" OR a$ = "0 " OR a$ = "00" OR a$ = "-0" THEN GOTO 10\r
+box 20, 10, 40, 9, "Edit entrie"\r
+COLOR 12, 0\r
+LOCATE 14, 23\r
+PRINT "    Letters aren't allowed"\r
+LOCATE 15, 23\r
+PRINT "  enter number, or press ESC "\r
+COLOR 7\r
+GOTO 9\r
+END IF\r
+\r
+IF b < 1 OR b > 20 THEN\r
+10\r
+box 20, 10, 40, 9, "Edit entrie"\r
+COLOR 12, 0\r
+LOCATE 14, 23\r
+PRINT "   The entered number must be in"\r
+LOCATE 15, 23\r
+PRINT "    the range between 1 and 20"\r
+LOCATE 16, 23\r
+PRINT "enter correct number, or press ESC"\r
+COLOR 7\r
+GOTO 9\r
+END IF\r
+\r
+IF (b > 0) AND (b < 21) THEN sh: ed b: GOTO 7\r
+\r
+END IF\r
+GOTO 6\r
+7\r
+\r
+sh\r
+END SUB\r
+\r
+SUB entquit\r
+\r
+box 15, 10, 50, 6, "Quitting"\r
+\r
+5\r
+LOCATE 12, 21\r
+PRINT "Are you really sure you want to quit?"\r
+LOCATE 13, 36\r
+PRINT "[ Y / N ]"\r
+\r
+\r
+getkey a$\r
+IF a$ = "y" OR a$ = "Y" THEN quit\r
+IF a$ = "n" OR a$ = "N" THEN GOTO 4\r
+box 15, 10, 50, 8, "Quitting"\r
+LOCATE 15, 30\r
+COLOR 28\r
+PRINT "Use keys 'Y' or 'N'"\r
+COLOR 7\r
+GOTO 5\r
+\r
+4\r
+sh\r
+\r
+END SUB\r
+\r
+SUB getkey (a$)\r
+3\r
+chkey a$\r
+IF a$ = "" THEN GOTO 3\r
+\r
+END SUB\r
+\r
+SUB gtw (y, m, t, r)\r
+d = 0\r
+FOR a = 1500 TO y - 1\r
+daysy a, b\r
+d = d + b\r
+NEXT a\r
+\r
+FOR a = 1 TO m - 1\r
+daysm y, a, b\r
+d = d + b\r
+NEXT a\r
+\r
+d = d + t + 2\r
+r = (d MOD 7) + 1\r
+\r
+END SUB\r
+\r
+SUB help (a)\r
+SELECT CASE a\r
+CASE 1\r
+box 20, 3, 41, 17, "Help"\r
+\r
+LOCATE 5, 24\r
+PRINT "q - quit program"\r
+LOCATE 6, 24\r
+PRINT "c - clear cell"\r
+LOCATE 7, 24\r
+PRINT "d - clear all cells"\r
+LOCATE 8, 24\r
+PRINT "e - edit cell"\r
+\r
+COLOR 14\r
+LOCATE 10, 24\r
+PRINT "This program allows you to"\r
+LOCATE 11, 24\r
+PRINT "shedle messages and commands"\r
+LOCATE 12, 24\r
+PRINT "to specified time: once, daily"\r
+LOCATE 13, 24\r
+PRINT "and specified weekdays."\r
+\r
+LOCATE 15, 24\r
+PRINT "   Copyright"\r
+LOCATE 16, 24\r
+PRINT "Vladimir German &"\r
+LOCATE 17, 24\r
+PRINT "Svjatoslav Agejenko"\r
+br$ = "Press any key to close this window"\r
+\r
+CASE 2\r
+box 3, 16, 76, 5, "Help: allowed keys"\r
+LOCATE 17, 5\r
+PRINT "CTRL + F1..F7  - toggle weekdays     CTRL + O/D/S - toggle modes"\r
+LOCATE 18, 5\r
+PRINT "Arrow keys - to move around          CTRL + ENTER - Accept"\r
+LOCATE 19, 5\r
+PRINT "ESC - close window"\r
+br$ = "You can continue editing ..."\r
+\r
+\r
+END SELECT\r
+\r
+\r
+\r
+END SUB\r
+\r
+SUB inpu (x, y, xl, c, a$)\r
+\r
+x1 = 1\r
+\r
+2\r
+a$ = a$ + SPACE$(100)\r
+a$ = LEFT$(a$, xl)\r
+\r
+COLOR 11, 1\r
+LOCATE y, x\r
+PRINT a$\r
+\r
+IF c = 1 THEN GOTO 8\r
+COLOR 30, 2\r
+LOCATE y, x + x1 - 1\r
+PRINT RIGHT$(LEFT$(a$, x1), 1)\r
+\r
+getkey b$\r
+\r
+IF b$ = CHR$(27) THEN c = 100: GOTO 8\r
+IF b$ = CHR$(13) THEN c = 101: GOTO 8\r
+\r
+IF (ASC(b$) > 31) AND (ASC(b$) < 122) AND (LEN(b$) = 1) THEN\r
+a$ = LEFT$(a$, x1 - 1) + b$ + (RIGHT$(a$, xl - x1 + 1))\r
+x1 = x1 + 1\r
+END IF\r
+\r
+IF b$ = CHR$(8) THEN\r
+IF x1 > 1 THEN\r
+a$ = LEFT$(a$, x1 - 2) + RIGHT$(a$, xl - x1 + 1)\r
+x1 = x1 - 1\r
+END IF\r
+END IF\r
+\r
+IF b$ = CHR$(0) + "M" THEN x1 = x1 + 1\r
+IF b$ = CHR$(0) + "K" THEN x1 = x1 - 1\r
+IF b$ = CHR$(0) + CHR$(94) THEN c = 107: GOTO 8\r
+IF b$ = CHR$(0) + CHR$(95) THEN c = 108: GOTO 8\r
+IF b$ = CHR$(0) + CHR$(96) THEN c = 109: GOTO 8\r
+IF b$ = CHR$(0) + CHR$(97) THEN c = 110: GOTO 8\r
+IF b$ = CHR$(0) + CHR$(98) THEN c = 111: GOTO 8\r
+IF b$ = CHR$(0) + CHR$(99) THEN c = 112: GOTO 8\r
+IF b$ = CHR$(0) + CHR$(100) THEN c = 113: GOTO 8\r
+IF b$ = CHR$(0) + CHR$(59) THEN c = 117: GOTO 8\r
+\r
+IF b$ = CHR$(0) + "S" THEN a$ = LEFT$(a$, x1 - 1) + RIGHT$(a$, xl - x1)\r
+IF x1 < 1 THEN x1 = 1: c = 103: GOTO 8\r
+IF x1 > xl THEN x1 = xl: c = 102: GOTO 8\r
+IF b$ = CHR$(0) + "H" THEN c = 104: GOTO 8\r
+IF b$ = CHR$(0) + "P" THEN c = 105: GOTO 8\r
+\r
+IF b$ = CHR$(10) THEN c = 106: GOTO 8\r
+IF b$ = CHR$(15) THEN c = 114: GOTO 8\r
+IF b$ = CHR$(4) THEN c = 115: GOTO 8\r
+IF b$ = CHR$(19) THEN c = 116: GOTO 8\r
+\r
+\r
+GOTO 2\r
+8\r
+\r
+a$ = a$ + SPACE$(100)\r
+a$ = LEFT$(a$, xl)\r
+COLOR 11, 1\r
+LOCATE y, x\r
+PRINT a$\r
+\r
+IF a$ = SPACE$(LEN(a$)) THEN\r
+a$ = ""\r
+ELSE\r
+14\r
+IF RIGHT$(a$, 1) = " " THEN a$ = LEFT$(a$, LEN(a$) - 1): GOTO 14\r
+END IF\r
+\r
+COLOR 7, 0\r
+END SUB\r
+\r
+SUB ps (x, y, c, s$)\r
+COLOR c\r
+FOR a = 1 TO LEN(s$)\r
+x1 = x + a - 1\r
+IF (x1 > 21) AND (x1 < 81) THEN\r
+IF virt(x1, y) = 0 THEN\r
+LOCATE y, x1\r
+PRINT RIGHT$(LEFT$(s$, a), 1)\r
+END IF\r
+END IF\r
+NEXT a\r
+END SUB\r
+\r
+SUB quit\r
+'DIM SHARED celh(1 TO 20)\r
+'DIM SHARED celm(1 TO 20)\r
+'DIM SHARED cels(1 TO 20)\r
+\r
+'DIM SHARED celm1$(1 TO 20)\r
+'DIM SHARED celm2$(1 TO 20)\r
+'DIM SHARED celc$(1 TO 20)\r
+\r
+'DIM SHARED celt(1 TO 20)' 0 - empty  1 - onece  2 - every day  3 - specified days\r
+'DIM SHARED celw(1 TO 20, 1 TO 7)\r
+\r
+\r
+OPEN "tim.dat" FOR OUTPUT AS #1\r
+FOR a = 1 TO 20\r
+PRINT #1, celh(a); celm(a); cels(a); celt(a)\r
+FOR b = 1 TO 6\r
+PRINT #1, celw(a, b);\r
+NEXT b\r
+PRINT #1, celw(a, 7)\r
+\r
+PRINT #1, celm1$(a)\r
+PRINT #1, celm2$(a)\r
+PRINT #1, celc$(a)\r
+NEXT a\r
+CLOSE #1\r
+SYSTEM\r
+END SUB\r
+\r
+SUB scroll\r
+'ps RND * 60 + 1, RND * 20 + 1, RND * 13 + 1, "asi"\r
+\r
+'DIM SHARED celm1$(1 TO 20)\r
+'DIM SHARED celm2$(1 TO 20)\r
+'DIM SHARED celc$(1 TO 20)\r
+'DIM SHARED celx(1 TO 20)\r
+COLOR 7, 0\r
+\r
+FOR a = 1 TO 20\r
+le = LEN(celm1$(a) + celm2$(a) + celc$(a)) + 2\r
+IF le > 59 THEN\r
+  x = 22 - celx(a)\r
+  IF slp(a) > 0 THEN\r
+    slp(a) = slp(a) - 1\r
+  ELSE\r
+    celx(a) = celx(a) + 1\r
+    IF x + le < 83 THEN slp(a) = 10\r
+    IF x + le < 82 THEN slp(a) = 10: celx(a) = 0\r
+  END IF\r
+ELSE\r
+  x = 22\r
+END IF\r
+\r
+ps x, a + 1, 10, celc$(a) + " "\r
+x = x + LEN(celc$(a)) + 1\r
+ps x, a + 1, 14, celm1$(a) + " "\r
+x = x + LEN(celm1$(a)) + 1\r
+ps x, a + 1, 14, celm2$(a) + " "\r
+\r
+NEXT a\r
+\r
+END SUB\r
+\r
+SUB sh\r
+vbox 1, 1, 80, 25, 0\r
+CLS\r
+LOCATE 1, 1\r
+COLOR 0, 3\r
+PRINT "Num|  Time  | When? | Command & Message                                         "\r
+COLOR 7, 0\r
+\r
+FOR a = 1 TO 20\r
+COLOR 14\r
+IF a < 10 THEN LOCATE a + 1, 2 ELSE LOCATE a + 1, 1\r
+PRINT a\r
+\r
+COLOR 3\r
+LOCATE a + 1, 4\r
+PRINT "|"\r
+\r
+\r
+LOCATE a + 1, 5\r
+COLOR 14\r
+IF celt(a) = 0 THEN\r
+PRINT "-- -- --"\r
+ELSE\r
+COLOR 14\r
+cns celh(a), s$\r
+PRINT s$\r
+LOCATE a + 1, 8\r
+cns celm(a), s$\r
+PRINT s$\r
+LOCATE a + 1, 11\r
+cns cels(a), s$\r
+PRINT s$\r
+END IF\r
+COLOR 30\r
+LOCATE a + 1, 7\r
+PRINT ":"\r
+LOCATE a + 1, 10\r
+PRINT ":"\r
+\r
+COLOR 3\r
+LOCATE a + 1, 13\r
+PRINT "|"\r
+LOCATE a + 1, 14\r
+\r
+IF celt(a) = 1 THEN\r
+COLOR 14\r
+PRINT " Once"\r
+END IF\r
+\r
+IF celt(a) = 2 THEN\r
+COLOR 14\r
+PRINT " Daily"\r
+END IF\r
+\r
+IF celt(a) = 3 THEN\r
+COLOR 10\r
+FOR b = 1 TO 7\r
+'DIM SHARED celw(1 TO 20, 1 TO 7)\r
+LOCATE a + 1, 13 + b\r
+IF celw(a, b) = 1 THEN PRINT RIGHT$(STR$(b), 1)\r
+NEXT b\r
+END IF\r
+\r
+COLOR 3\r
+LOCATE a + 1, 21\r
+PRINT "|"\r
+\r
+NEXT a\r
+\r
+END SUB\r
+\r
+SUB start\r
+\r
+OPEN "tim.dat" FOR INPUT AS #1\r
+FOR a = 1 TO 20\r
+INPUT #1, celh(a), celm(a), cels(a), celt(a)\r
+FOR b = 1 TO 7\r
+INPUT #1, celw(a, b)\r
+NEXT b\r
+\r
+LINE INPUT #1, celm1$(a)\r
+LINE INPUT #1, celm2$(a)\r
+LINE INPUT #1, celc$(a)\r
+NEXT a\r
+CLOSE #1\r
+\r
+alarmo = 0\r
+END SUB\r
+\r
+SUB vbox (x1, y1, x2, y2, c)\r
+FOR y = y1 TO y1 + y2 - 1\r
+FOR x = x1 TO x1 + x2 - 1\r
+virt(x, y) = c\r
+NEXT x\r
+NEXT y\r
+END SUB\r
+\r