-' Program allows scheduling school clock ringing.\r
-' Timetables are stored in separate files.\r
-' Also it drives numerical 2 digit led display through parallel LPT printer port.\r
-' Program is driven by special 3 button keyboard that is also attached to LPT port.\r
-\r
-DECLARE SUB num (a%)\r
-DECLARE SUB mntime ()\r
-DECLARE SUB showit ()\r
-DECLARE SUB ekrf (a%)\r
-DECLARE SUB ekr ()\r
-DECLARE SUB rese ()\r
-DECLARE SUB start ()\r
-DECLARE SUB boot ()\r
-DECLARE SUB getnad (g%, n%, d%, k%)\r
-DECLARE SUB initp (b$)\r
-DECLARE SUB getmd (a$, m%, d%)\r
-DECLARE SUB son (a$)\r
-DEFINT A-Z\r
-\r
-DECLARE SUB inita ()\r
-DECLARE SUB chm ()\r
-DECLARE SUB chd ()\r
-DECLARE SUB kell (a%)\r
-DECLARE SUB sync2 ()\r
-DECLARE SUB sync ()\r
-DECLARE SUB mnmain ()\r
-DECLARE SUB main ()\r
-DECLARE SUB getkey (kla%)\r
-DECLARE SUB klnait (k%)\r
-DECLARE SUB heli (a%)\r
-DECLARE SUB keys ()\r
-DECLARE SUB disp ()\r
-DIM SHARED bit(0 TO 7)\r
-DIM SHARED kl\r
-DIM SHARED hist(1 TO 3)\r
-DIM SHARED ap$(1 TO 500)\r
-DIM SHARED apl\r
-DIM SHARED pp$(1 TO 500)\r
-DIM SHARED ppl\r
-DIM SHARED prt, prt2\r
-DIM SHARED timo$\r
-DIM SHARED dato$\r
-DIM SHARED sona$(1 TO 50)\r
-DIM SHARED mitus\r
-DIM SHARED lp$\r
-DIM SHARED ndlp\r
-DIM SHARED pn$(1 TO 7)\r
-DIM SHARED bitt(1 TO 16)\r
-DIM SHARED modee, vilgu\r
-DIM SHARED tul(1 TO 2)\r
-\r
-start\r
-heli 4\r
-\r
-\r
-disp\r
-mnmain\r
-\r
-SUB chd\r
-b$ = "tuhi"\r
-IF apl = 0 THEN inita\r
-\r
-a$ = DATE$\r
-n1 = VAL(RIGHT$(a$, 4))\r
-n2 = VAL(LEFT$(a$, 2))\r
-a$ = LEFT$(a$, 5)\r
-n3 = VAL(RIGHT$(a$, 2))\r
-getnad n1, n2, n3, ndlp\r
-LOCATE 10, 1\r
-PRINT "n\84dalap\84ev:", pn$(ndlp)\r
-FOR a = 1 TO apl\r
-son ap$(a)\r
-SELECT CASE sona$(1)\r
-CASE "v"\r
-getmd sona$(2), m1, d1\r
-getmd sona$(3), m2, d2\r
-getmd DATE$, m3, d3\r
-IF m3 < m1 THEN GOTO 9\r
-IF m3 > m2 THEN GOTO 9\r
-IF m3 = m1 THEN IF d3 < d1 THEN GOTO 9\r
-IF m3 = m2 THEN IF d3 > d2 THEN GOTO 9\r
-b$ = sona$(4)\r
-CASE "n"\r
-getmd sona$(2), m1, d1\r
-getmd sona$(3), m2, d2\r
-getmd DATE$, m3, d3\r
-IF m3 < m1 THEN GOTO 9\r
-IF m3 > m2 THEN GOTO 9\r
-IF m3 = m1 THEN IF d3 < d1 THEN GOTO 9\r
-IF m3 = m2 THEN IF d3 > d2 THEN GOTO 9\r
-IF ndlp <> VAL(sona$(4)) THEN GOTO 9\r
-b$ = sona$(5)\r
-CASE "e"\r
-getmd sona$(2), m1, d1\r
-getmd DATE$, m2, d2\r
-IF (m1 = m2) AND (d1 = d2) THEN b$ = sona$(3)\r
-END SELECT\r
-9\r
-NEXT a\r
-\r
-IF b$ <> lp$ THEN initp b$\r
-lp$ = b$\r
-LOCATE 9, 1\r
-PRINT "p\84evaplaan:", lp$\r
-END SUB\r
-\r
-SUB chm\r
-showit\r
-a$ = DATE$\r
-IF a$ <> dato$ THEN chd\r
-dato$ = a$\r
-b = 0\r
-FOR a = 1 TO ppl\r
-son pp$(a)\r
-SELECT CASE sona$(1)\r
-CASE "#"\r
-getmd sona$(2), h1, m1\r
-getmd TIME$, h2, m2\r
-' PRINT h1, m1, h2, m2\r
-IF (h2 = h1) AND (m2 = m1) THEN\r
-IF sona$(3) = "sis" THEN b = 1\r
-IF sona$(3) = "val" THEN b = 2\r
-END IF\r
-END SELECT\r
-NEXT a\r
-\r
-IF b > 0 THEN kell b\r
-\r
-END SUB\r
-\r
-SUB disp\r
-CLS\r
-PRINT "Kooli Kell v 1.2 2002.10.10"\r
-PRINT "Programmi autor Svjatoslav Agejenko"\r
-\r
-END SUB\r
-\r
-SUB ekr\r
-FOR e = 1 TO 10\r
-c = 1\r
-c = c + 16 * bitt(1)\r
-c = c + 32 * bitt(2)\r
-c = c + 64 * bitt(3)\r
-c = c + 128 * bitt(4)\r
-OUT prt2, c\r
-\r
-c = 2\r
-c = c + 16 * bitt(5)\r
-c = c + 32 * bitt(6)\r
-c = c + 64 * bitt(7)\r
-c = c + 128 * bitt(8)\r
-OUT prt2, c\r
-\r
-c = 4\r
-c = c + 16 * bitt(9)\r
-c = c + 32 * bitt(10)\r
-c = c + 64 * bitt(11)\r
-c = c + 128 * bitt(12)\r
-OUT prt2, c\r
-\r
-c = 8\r
-c = c + 16 * bitt(13)\r
-c = c + 32 * bitt(14)\r
-c = c + 64 * bitt(15)\r
-c = c + 128 * bitt(16)\r
-OUT prt2, c\r
-\r
-\r
-NEXT e\r
-END SUB\r
-\r
-SUB ekrf (a)\r
-SELECT CASE (a)\r
-CASE 0\r
-bitt(1) = 0\r
-bitt(2) = 0\r
-bitt(3) = 0\r
-bitt(7) = 0\r
-bitt(5) = 0\r
-bitt(6) = 0\r
-bitt(8) = 1\r
-CASE 1\r
-bitt(2) = 0\r
-bitt(7) = 0\r
-CASE 2\r
-bitt(1) = 0\r
-bitt(3) = 0\r
-bitt(5) = 0\r
-bitt(7) = 0\r
-bitt(8) = 0\r
-CASE 3\r
-bitt(1) = 0\r
-bitt(2) = 0\r
-bitt(5) = 0\r
-bitt(8) = 0\r
-bitt(7) = 0\r
-CASE 4\r
-bitt(2) = 0\r
-bitt(6) = 0\r
-bitt(7) = 0\r
-bitt(8) = 0\r
-CASE 5\r
-bitt(1) = 0\r
-bitt(2) = 0\r
-bitt(5) = 0\r
-bitt(6) = 0\r
-bitt(8) = 0\r
-CASE 6\r
-bitt(1) = 0\r
-bitt(2) = 0\r
-bitt(3) = 0\r
-bitt(5) = 0\r
-bitt(6) = 0\r
-bitt(8) = 0\r
-CASE 7\r
-bitt(2) = 0\r
-bitt(7) = 0\r
-bitt(5) = 0\r
-CASE 8\r
-bitt(1) = 0\r
-bitt(2) = 0\r
-bitt(3) = 0\r
-bitt(7) = 0\r
-bitt(5) = 0\r
-bitt(6) = 0\r
-bitt(8) = 0\r
-CASE 9\r
-bitt(1) = 0\r
-bitt(2) = 0\r
-bitt(7) = 0\r
-bitt(5) = 0\r
-bitt(6) = 0\r
-bitt(8) = 0\r
-CASE 10\r
-bitt(15) = 0\r
-bitt(16) = 0\r
-bitt(12) = 0\r
-bitt(10) = 0\r
-bitt(9) = 0\r
-bitt(4) = 0\r
-CASE 11\r
-bitt(15) = 0\r
-bitt(4) = 0\r
-CASE 12\r
-bitt(15) = 0\r
-bitt(16) = 0\r
-bitt(9) = 0\r
-bitt(10) = 0\r
-bitt(11) = 0\r
-CASE 13\r
-bitt(15) = 0\r
-bitt(4) = 0\r
-bitt(16) = 0\r
-bitt(11) = 0\r
-bitt(9) = 0\r
-CASE 14\r
-bitt(15) = 0\r
-bitt(4) = 0\r
-bitt(12) = 0\r
-bitt(11) = 0\r
-CASE 15\r
-bitt(9) = 0\r
-bitt(4) = 0\r
-bitt(11) = 0\r
-bitt(12) = 0\r
-bitt(16) = 0\r
-CASE 16\r
-bitt(9) = 0\r
-bitt(4) = 0\r
-bitt(11) = 0\r
-bitt(12) = 0\r
-bitt(16) = 0\r
-bitt(10) = 0\r
-CASE 17\r
-bitt(4) = 0\r
-bitt(15) = 0\r
-bitt(16) = 0\r
-CASE 18\r
-bitt(4) = 0\r
-bitt(15) = 0\r
-bitt(16) = 0\r
-bitt(12) = 0\r
-bitt(11) = 0\r
-bitt(10) = 0\r
-bitt(9) = 0\r
-CASE 19\r
-bitt(4) = 0\r
-bitt(15) = 0\r
-bitt(16) = 0\r
-bitt(12) = 0\r
-bitt(11) = 0\r
-bitt(9) = 0\r
-END SELECT\r
-\r
-END SUB\r
-\r
-SUB getkey (kla)\r
-\r
-1\r
-IF vilgu = 1 THEN\r
-tmr = tmr + 1\r
-IF tmr > 5 THEN bitt(13) = tul(1): bitt(14) = tul(2) ELSE bitt(13) = 1: bitt(14) = 1\r
-IF tmr > 10 THEN\r
-tmr = 0\r
-END IF\r
-ELSE\r
-bitt(13) = tul(1)\r
-bitt(14) = tul(2)\r
-END IF\r
-\r
-b$ = LEFT$(TIME$, 5)\r
-IF b$ <> timo$ THEN chm\r
-timo$ = b$\r
-hist(1) = hist(1) + 1\r
-IF hist(1) > 20000 THEN hist(1) = 15000\r
-hist(2) = hist(2) + 1\r
-IF hist(2) > 20000 THEN hist(2) = 15000\r
-hist(3) = hist(3) + 1\r
-IF hist(3) > 20000 THEN hist(3) = 15000\r
-\r
-keys\r
-IF kl > 0 THEN\r
- IF hist(kl) > 1 AND hist(kl) < 9 THEN\r
- klnait kl + 3\r
- kla = kl + 3\r
- GOTO 4\r
- ELSE\r
- hist(kl) = 0\r
- END IF\r
-END IF\r
-IF hist(1) = 10 THEN klnait 1: kla = 1: GOTO 4\r
-IF hist(2) = 10 THEN klnait 2: kla = 2: GOTO 4\r
-IF hist(3) = 10 THEN klnait 3: kla = 3: GOTO 4\r
-\r
-IF hist(1) > 11 AND hist(2) > 11 AND hist(3) > 11 THEN klnait 0\r
-LOCATE 7, 1\r
-PRINT TIME$\r
-LOCATE 8, 1\r
-PRINT DATE$\r
-GOTO 1\r
-4\r
-\r
-\r
-hist(1) = 10000\r
-hist(2) = 10000\r
-hist(3) = 10000\r
-\r
-FOR b = 1 TO 100\r
-SOUND 0, .1\r
-NEXT b\r
-IF kla > 3 THEN SOUND 4000, .1 ELSE SOUND 3000, .1\r
-\r
-\r
-\r
-END SUB\r
-\r
-SUB getmd (a$, m, d)\r
-b$ = LEFT$(a$, 5)\r
-m = VAL(LEFT$(b$, 2))\r
-d = VAL(RIGHT$(b$, 2))\r
-\r
-END SUB\r
-\r
-SUB getnad (g, n, d, k)\r
-LOCATE 11, 1\r
-PRINT g, n, d\r
-p = g\r
-m = n - 2\r
-IF n > 2 GOTO 120\r
-p = p - 1: m = m + 12\r
-120\r
-c = INT(p / 100)\r
-y = p - c * 100\r
-w = d + INT((13 * m - 1) / 5) + y + INT(y / 4) + INT(c / 4) - 2 * c\r
-k = w - 7 * INT(w / 7)\r
-IF k = 0 THEN k = 7\r
-END SUB\r
-\r
-SUB heli (a)\r
-'GOTO 10\r
-SELECT CASE a\r
-CASE 1\r
-FOR c = 1 TO 5\r
-SOUND 3000, 1\r
-SOUND 0, 1\r
-NEXT c\r
-\r
-CASE 2\r
-FOR c = 1 TO 5\r
-SOUND 2500, 1\r
-SOUND 0, 2\r
-NEXT c\r
-SOUND 2500, 10\r
-\r
-CASE 3\r
-FOR a = 1 TO 10\r
-SOUND 500, .5\r
-SOUND 1500, .5\r
-SOUND 2000, .5\r
-SOUND 1520, .5\r
-NEXT a\r
-\r
-\r
-CASE 4\r
-FOR a = 800 TO 1000 STEP 10\r
-SOUND a, .1\r
-SOUND a * 3, .1\r
-SOUND 0, 1\r
-NEXT a\r
-10\r
-\r
-END SELECT\r
-\r
-\r
-END SUB\r
-\r
-SUB inita\r
-apl = 0\r
-OPEN "aasta.ap" FOR INPUT AS #1\r
-5\r
-IF EOF(1) <> 0 THEN GOTO 3\r
-LINE INPUT #1, a$\r
-apl = apl + 1\r
-ap$(apl) = a$\r
-GOTO 5\r
-3\r
-CLOSE #1\r
-END SUB\r
-\r
-SUB initp (b$)\r
-ppl = 0\r
-OPEN b$ + ".pp" FOR INPUT AS #1\r
-6\r
-IF EOF(1) <> 0 THEN GOTO 7\r
-LINE INPUT #1, a$\r
-ppl = ppl + 1\r
-pp$(ppl) = a$\r
-GOTO 6\r
-7\r
-CLOSE #1\r
-END SUB\r
-\r
-SUB kell (a)\r
-heli 3\r
-\r
-SELECT CASE a\r
-CASE 1\r
-OUT prt, 255\r
-FOR b = 1 TO 80\r
-SOUND 0, 1\r
-NEXT b\r
-OUT prt, 0\r
-FOR b = 1 TO 15\r
-SOUND 0, 1\r
-NEXT b\r
-OUT prt, 255\r
-FOR b = 1 TO 15\r
-SOUND 0, 1\r
-NEXT b\r
-OUT prt, 0\r
-\r
-CASE 2\r
-OUT prt, 255\r
-FOR b = 1 TO 80\r
-SOUND 0, 1\r
-NEXT b\r
-OUT prt, 0\r
-\r
-END SELECT\r
-END SUB\r
-\r
-SUB keys\r
-kl = 0\r
-OUT prt, 0\r
-8\r
-a = INP(prt)\r
-b = INP(prt)\r
-IF a <> b THEN GOTO 8\r
-\r
-b = 128\r
-FOR c = 0 TO 7\r
-d = INT(a / b)\r
-bit(c) = d\r
-a = a - (b * d)\r
-b = b / 2\r
-NEXT c\r
-\r
-IF bit(4) = 1 AND bit(6) = 1 THEN bit(4) = 0: bit(6) = 0: kl = 3\r
-IF bit(6) = 1 THEN kl = 2\r
-IF bit(4) = 1 THEN kl = 1\r
-\r
-a$ = INKEY$\r
-IF a$ = CHR$(0) + "K" THEN kl = 1\r
-IF a$ = CHR$(0) + "M" THEN kl = 2\r
-IF a$ = CHR$(0) + "P" THEN kl = 3\r
-ekr\r
-END SUB\r
-\r
-SUB klnait (k)\r
-\r
-IF k = 3 THEN c = 3 ELSE c = 1\r
-IF k = 6 THEN c = 14\r
-LOCATE 5, 6\r
-COLOR 7, c\r
-PRINT "<kesk>"\r
-COLOR 7, 0\r
-\r
-IF k = 1 THEN c = 3 ELSE c = 1\r
-IF k = 4 THEN c = 14\r
-LOCATE 4, 1\r
-COLOR 7, c\r
-PRINT "<vasak>"\r
-COLOR 7, 0\r
-\r
-IF k = 2 THEN c = 3 ELSE c = 1\r
-IF k = 5 THEN c = 14\r
-LOCATE 4, 10\r
-COLOR 7, c\r
-PRINT "<parem>"\r
-COLOR 7, 0\r
-\r
-END SUB\r
-\r
-SUB mnmain\r
-2\r
-getkey a\r
-IF a = 6 THEN sync\r
-IF a = 3 THEN sync2\r
-\r
-IF a = 1 THEN kell 1\r
-IF a = 4 THEN kell 2\r
-\r
-IF a = 2 THEN mntime\r
-IF a = 5 THEN rese\r
-GOTO 2\r
-\r
-END SUB\r
-\r
-SUB mntime\r
-vilgu = 1\r
-11\r
-showit\r
-getkey a\r
-\r
-IF modee = 1 THEN\r
- b = VAL(LEFT$(TIME$, 2))\r
- c = 0\r
- IF a = 1 THEN c = 1: b = b - 1\r
- IF a = 2 THEN c = 1: b = b + 1\r
- IF b < 0 THEN b = 0\r
- IF b > 23 THEN b = 23\r
- d$ = STR$(b)\r
- IF LEFT$(d$, 1) = " " THEN d$ = RIGHT$(d$, LEN(d$) - 1)\r
- IF LEN(d$) < 2 THEN d$ = "0" + d$\r
- e$ = d$ + RIGHT$(TIME$, 6)\r
- IF c = 1 THEN TIME$ = e$\r
-ELSE\r
- b = VAL(RIGHT$(LEFT$(TIME$, 5), 2))\r
- c = 0\r
- IF a = 1 THEN c = 1: b = b - 1\r
- IF a = 2 THEN c = 1: b = b + 1\r
- IF b < 0 THEN b = 0\r
- IF b > 59 THEN b = 59\r
- d$ = STR$(b)\r
- IF LEFT$(d$, 1) = " " THEN d$ = RIGHT$(d$, LEN(d$) - 1)\r
- IF LEN(d$) < 2 THEN d$ = "0" + d$\r
- e$ = LEFT$(TIME$, 3) + d$ + RIGHT$(TIME$, 3)\r
- IF c = 1 THEN TIME$ = e$\r
-END IF\r
-\r
-IF a = 3 THEN\r
-IF modee = 1 THEN modee = 2 ELSE modee = 1\r
-END IF\r
-\r
-IF a = 6 THEN GOTO 12\r
-GOTO 11\r
-12\r
-vilgu = 0\r
-modee = 2\r
-END SUB\r
-\r
-SUB num (a)\r
-\r
-FOR b = 1 TO 12\r
-bitt(b) = 1\r
-NEXT b\r
-bitt(15) = 1\r
-bitt(16) = 1\r
-\r
-b = INT(a / 10)\r
-c = a - (10 * b)\r
-ekrf b\r
-ekrf c + 10\r
-END SUB\r
-\r
-SUB rese\r
-heli 4\r
-timo$ = ""\r
-dato$ = ""\r
-apl = 0\r
-END SUB\r
-\r
-SUB showit\r
-a$ = LEFT$(TIME$, 5)\r
-IF modee = 1 THEN\r
-b = VAL(LEFT$(a$, 2))\r
-tul(1) = 1\r
-tul(2) = 0\r
-ELSE\r
-b = VAL(RIGHT$(a$, 2))\r
-tul(1) = 0\r
-tul(2) = 1\r
-END IF\r
-LOCATE 15, 1\r
-PRINT b\r
-num b\r
-\r
-\r
-END SUB\r
-\r
-SUB son (a$)\r
-\r
-FOR b = 1 TO 50\r
-sona$(b) = ""\r
-NEXT b\r
-mitus = 0\r
-\r
-b = 1\r
-FOR c = 1 TO LEN(a$)\r
-d$ = RIGHT$(LEFT$(a$, c), 1)\r
-IF d$ = " " OR d$ = CHR$(9) THEN\r
-b = 1\r
-ELSE\r
-IF b = 1 THEN b = 0: mitus = mitus + 1\r
-sona$(mitus) = sona$(mitus) + d$\r
-END IF\r
-NEXT c\r
-\r
-\r
-END SUB\r
-\r
-SUB start\r
-pn$(1) = "esmasp\84ev"\r
-pn$(2) = "teisip\84ev"\r
-pn$(3) = "kolmap\84ev"\r
-pn$(4) = "neljap\84ev"\r
-pn$(5) = "reede"\r
-pn$(6) = "laup\84ev"\r
-pn$(7) = "p\81hap\84ev"\r
-\r
-prt = &H37A\r
-prt2 = &H378\r
-hist(1) = 10000\r
-hist(2) = 10000\r
-hist(3) = 10000\r
-\r
-FOR a = 1 TO 16\r
-bitt(a) = 1\r
-NEXT a\r
-modee = 2\r
-vilgu = 0\r
-tul(1) = 1\r
-tul(2) = 1\r
-END SUB\r
-\r
-SUB sync\r
-OPEN "sync.txt" FOR INPUT AS #1\r
-LINE INPUT #1, a$\r
-DATE$ = a$\r
-LINE INPUT #1, a$\r
-TIME$ = a$\r
-CLOSE #1\r
-\r
-heli 2\r
-END SUB\r
-\r
-SUB sync2\r
-a$ = TIME$\r
-a$ = LEFT$(a$, 5)\r
-b = VAL(RIGHT$(a$, 2))\r
-c = VAL(LEFT$(a$, 2))\r
-IF b >= 30 THEN c = c + 1\r
-b = 0\r
-IF c > 23 THEN c = c - 24\r
-a$ = RIGHT$(STR$(c), LEN(STR$(c)) - 1)\r
-b$ = RIGHT$(STR$(b), LEN(STR$(b)) - 1)\r
-IF LEN(a$) < 2 THEN a$ = "0" + a$\r
-IF LEN(b$) < 2 THEN b$ = "0" + b$\r
-a$ = a$ + ":" + b$\r
-\r
-'LOCATE 10, 1\r
-'PRINT a$\r
-\r
-TIME$ = a$\r
-\r
-heli 1\r
-END SUB\r
+' Program allows scheduling school clock ringing.
+' Timetables are stored in separate files.
+' Also it drives numerical 2 digit led display through parallel LPT printer port.
+' Program is driven by special 3 button keyboard that is also attached to LPT port.
+
+DECLARE SUB num (a%)
+DECLARE SUB mntime ()
+DECLARE SUB showit ()
+DECLARE SUB ekrf (a%)
+DECLARE SUB ekr ()
+DECLARE SUB rese ()
+DECLARE SUB start ()
+DECLARE SUB boot ()
+DECLARE SUB getnad (g%, n%, d%, k%)
+DECLARE SUB initp (b$)
+DECLARE SUB getmd (a$, m, d)
+DECLARE SUB son (a$)
+DEFINT A-Z
+
+DECLARE SUB inita ()
+DECLARE SUB chm ()
+DECLARE SUB chd ()
+DECLARE SUB kell (a%)
+DECLARE SUB sync2 ()
+DECLARE SUB sync ()
+DECLARE SUB mnmain ()
+DECLARE SUB main ()
+DECLARE SUB getkey (kla%)
+DECLARE SUB klnait (k%)
+DECLARE SUB heli (a%)
+DECLARE SUB keys ()
+DECLARE SUB disp ()
+DIM SHARED bit(0 TO 7)
+DIM SHARED kl
+DIM SHARED hist(1 TO 3)
+DIM SHARED ap$(1 TO 500)
+DIM SHARED apl
+DIM SHARED pp$(1 TO 500)
+DIM SHARED ppl
+DIM SHARED prt, prt2
+DIM SHARED timo$
+DIM SHARED dato$
+DIM SHARED sona$(1 TO 50)
+DIM SHARED mitus
+DIM SHARED lp$
+DIM SHARED ndlp
+DIM SHARED pn$(1 TO 7)
+DIM SHARED bitt(1 TO 16)
+DIM SHARED modee, vilgu
+DIM SHARED tul(1 TO 2)
+
+start
+heli 4
+
+disp
+mnmain
+
+SUB chd
+b$ = "tuhi"
+IF apl = 0 THEN inita
+
+a$ = DATE$
+n1 = VAL(RIGHT$(a$, 4))
+n2 = VAL(LEFT$(a$, 2))
+a$ = LEFT$(a$, 5)
+n3 = VAL(RIGHT$(a$, 2))
+getnad n1, n2, n3, ndlp
+LOCATE 10, 1
+PRINT "Week plan:", pn$(ndlp)
+FOR a = 1 TO apl
+son ap$(a)
+SELECT CASE sona$(1)
+CASE "v"
+getmd sona$(2), m1, d1
+getmd sona$(3), m2, d2
+getmd DATE$, m3, d3
+IF m3 < m1 THEN GOTO 9
+IF m3 > m2 THEN GOTO 9
+IF m3 = m1 THEN IF d3 < d1 THEN GOTO 9
+IF m3 = m2 THEN IF d3 > d2 THEN GOTO 9
+b$ = sona$(4)
+CASE "n"
+getmd sona$(2), m1, d1
+getmd sona$(3), m2, d2
+getmd DATE$, m3, d3
+IF m3 < m1 THEN GOTO 9
+IF m3 > m2 THEN GOTO 9
+IF m3 = m1 THEN IF d3 < d1 THEN GOTO 9
+IF m3 = m2 THEN IF d3 > d2 THEN GOTO 9
+IF ndlp <> VAL(sona$(4)) THEN GOTO 9
+b$ = sona$(5)
+CASE "e"
+getmd sona$(2), m1, d1
+getmd DATE$, m2, d2
+IF (m1 = m2) AND (d1 = d2) THEN b$ = sona$(3)
+END SELECT
+9
+NEXT a
+
+IF b$ <> lp$ THEN initp b$
+lp$ = b$
+LOCATE 9, 1
+PRINT "Day plan:", lp$
+END SUB
+
+SUB chm
+showit
+a$ = DATE$
+IF a$ <> dato$ THEN chd
+dato$ = a$
+b = 0
+FOR a = 1 TO ppl
+son pp$(a)
+SELECT CASE sona$(1)
+CASE "#"
+getmd sona$(2), h1, m1
+getmd TIME$, h2, m2
+' PRINT h1, m1, h2, m2
+IF (h2 = h1) AND (m2 = m1) THEN
+IF sona$(3) = "sis" THEN b = 1
+IF sona$(3) = "val" THEN b = 2
+END IF
+END SELECT
+NEXT a
+
+IF b > 0 THEN kell b
+
+END SUB
+
+SUB disp
+CLS
+PRINT "Kooli Kell v 1.2 2002.10.10"
+PRINT "Programmi autor Svjatoslav Agejenko"
+
+END SUB
+
+SUB ekr
+FOR e = 1 TO 10
+c = 1
+c = c + 16 * bitt(1)
+c = c + 32 * bitt(2)
+c = c + 64 * bitt(3)
+c = c + 128 * bitt(4)
+OUT prt2, c
+
+c = 2
+c = c + 16 * bitt(5)
+c = c + 32 * bitt(6)
+c = c + 64 * bitt(7)
+c = c + 128 * bitt(8)
+OUT prt2, c
+
+c = 4
+c = c + 16 * bitt(9)
+c = c + 32 * bitt(10)
+c = c + 64 * bitt(11)
+c = c + 128 * bitt(12)
+OUT prt2, c
+
+c = 8
+c = c + 16 * bitt(13)
+c = c + 32 * bitt(14)
+c = c + 64 * bitt(15)
+c = c + 128 * bitt(16)
+OUT prt2, c
+
+NEXT e
+END SUB
+
+SUB ekrf (a)
+SELECT CASE (a)
+CASE 0
+bitt(1) = 0
+bitt(2) = 0
+bitt(3) = 0
+bitt(7) = 0
+bitt(5) = 0
+bitt(6) = 0
+bitt(8) = 1
+CASE 1
+bitt(2) = 0
+bitt(7) = 0
+CASE 2
+bitt(1) = 0
+bitt(3) = 0
+bitt(5) = 0
+bitt(7) = 0
+bitt(8) = 0
+CASE 3
+bitt(1) = 0
+bitt(2) = 0
+bitt(5) = 0
+bitt(8) = 0
+bitt(7) = 0
+CASE 4
+bitt(2) = 0
+bitt(6) = 0
+bitt(7) = 0
+bitt(8) = 0
+CASE 5
+bitt(1) = 0
+bitt(2) = 0
+bitt(5) = 0
+bitt(6) = 0
+bitt(8) = 0
+CASE 6
+bitt(1) = 0
+bitt(2) = 0
+bitt(3) = 0
+bitt(5) = 0
+bitt(6) = 0
+bitt(8) = 0
+CASE 7
+bitt(2) = 0
+bitt(7) = 0
+bitt(5) = 0
+CASE 8
+bitt(1) = 0
+bitt(2) = 0
+bitt(3) = 0
+bitt(7) = 0
+bitt(5) = 0
+bitt(6) = 0
+bitt(8) = 0
+CASE 9
+bitt(1) = 0
+bitt(2) = 0
+bitt(7) = 0
+bitt(5) = 0
+bitt(6) = 0
+bitt(8) = 0
+CASE 10
+bitt(15) = 0
+bitt(16) = 0
+bitt(12) = 0
+bitt(10) = 0
+bitt(9) = 0
+bitt(4) = 0
+CASE 11
+bitt(15) = 0
+bitt(4) = 0
+CASE 12
+bitt(15) = 0
+bitt(16) = 0
+bitt(9) = 0
+bitt(10) = 0
+bitt(11) = 0
+CASE 13
+bitt(15) = 0
+bitt(4) = 0
+bitt(16) = 0
+bitt(11) = 0
+bitt(9) = 0
+CASE 14
+bitt(15) = 0
+bitt(4) = 0
+bitt(12) = 0
+bitt(11) = 0
+CASE 15
+bitt(9) = 0
+bitt(4) = 0
+bitt(11) = 0
+bitt(12) = 0
+bitt(16) = 0
+CASE 16
+bitt(9) = 0
+bitt(4) = 0
+bitt(11) = 0
+bitt(12) = 0
+bitt(16) = 0
+bitt(10) = 0
+CASE 17
+bitt(4) = 0
+bitt(15) = 0
+bitt(16) = 0
+CASE 18
+bitt(4) = 0
+bitt(15) = 0
+bitt(16) = 0
+bitt(12) = 0
+bitt(11) = 0
+bitt(10) = 0
+bitt(9) = 0
+CASE 19
+bitt(4) = 0
+bitt(15) = 0
+bitt(16) = 0
+bitt(12) = 0
+bitt(11) = 0
+bitt(9) = 0
+END SELECT
+
+END SUB
+
+SUB getkey (kla)
+
+' Read the state of the buttons on the keyboard
+1
+IF vilgu = 1 THEN
+tmr = tmr + 1
+IF tmr > 5 THEN bitt(13) = tul(1): bitt(14) = tul(2) ELSE bitt(13) = 1: bitt(14) = 1
+IF tmr > 10 THEN
+tmr = 0
+END IF
+ELSE
+bitt(13) = tul(1)
+bitt(14) = tul(2)
+END IF
+
+' Get the current time
+b$ = LEFT$(TIME$, 5)
+IF b$ <> timo$ THEN chm
+timo$ = b$
+hist(1) = hist(1) + 1
+IF hist(1) > 20000 THEN hist(1) = 15000
+hist(2) = hist(2) + 1
+IF hist(2) > 20000 THEN hist(2) = 15000
+hist(3) = hist(3) + 1
+IF hist(3) > 20000 THEN hist(3) = 15000
+
+' Read the state of the buttons on the keyboard
+keys
+IF kl > 0 THEN
+ IF hist(kl) > 1 AND hist(kl) < 9 THEN
+ klnait kl + 3
+ kla = kl + 3
+ GOTO 4
+ ELSE
+ hist(kl) = 0
+ END IF
+END IF
+IF hist(1) = 10 THEN klnait 1: kla = 1: GOTO 4
+IF hist(2) = 10 THEN klnait 2: kla = 2: GOTO 4
+IF hist(3) = 10 THEN klnait 3: kla = 3: GOTO 4
+
+IF hist(1) > 11 AND hist(2) > 11 AND hist(3) > 11 THEN klnait 0
+
+' Display current time and date
+LOCATE 7, 1
+PRINT TIME$
+LOCATE 8, 1
+PRINT DATE$
+GOTO 1
+4
+
+' Reset the button press count
+hist(1) = 10000
+hist(2) = 10000
+hist(3) = 10000
+
+' Play a sound to indicate button press
+FOR b = 1 TO 100
+SOUND 0, .1
+NEXT b
+IF kla > 3 THEN SOUND 4000, .1 ELSE SOUND 3000, .1
+
+END SUB
+
+SUB getmd (a$, m, d)
+b$ = LEFT$(a$, 5)
+m = VAL(LEFT$(b$, 2))
+d = VAL(RIGHT$(b$, 2))
+
+END SUB
+
+SUB getnad (g, n, d, k)
+LOCATE 11, 1
+PRINT g, n, d
+p = g
+m = n - 2
+IF n > 2 GOTO 120
+p = p - 1: m = m + 12
+120
+c = INT(p / 100)
+y = p - c * 100
+w = d + INT((13 * m - 1) / 5) + y + INT(y / 4) + INT(c / 4) - 2 * c
+k = w - 7 * INT(w / 7)
+IF k = 0 THEN k = 7
+END SUB
+
+SUB heli (a)
+'GOTO 10
+SELECT CASE a
+CASE 1
+FOR c = 1 TO 5
+SOUND 3000, 1
+SOUND 0, 1
+NEXT c
+
+CASE 2
+FOR c = 1 TO 5
+SOUND 2500, 1
+SOUND 0, 2
+NEXT c
+SOUND 2500, 10
+
+CASE 3
+FOR a = 1 TO 10
+SOUND 500, .5
+SOUND 1500, .5
+SOUND 2000, .5
+SOUND 1520, .5
+NEXT a
+
+CASE 4
+FOR a = 800 TO 1000 STEP 10
+SOUND a, .1
+SOUND a * 3, .1
+SOUND 0, 1
+NEXT a
+10
+
+END SELECT
+
+END SUB
+
+SUB inita
+apl = 0
+OPEN "aasta.ap" FOR INPUT AS #1
+5
+IF EOF(1) <> 0 THEN GOTO 3
+LINE INPUT #1, a$
+apl = apl + 1
+ap$(apl) = a$
+GOTO 5
+3
+CLOSE #1
+END SUB
+
+SUB initp (b$)
+ppl = 0
+OPEN b$ + ".pp" FOR INPUT AS #1
+6
+IF EOF(1) <> 0 THEN GOTO 7
+LINE INPUT #1, a$
+ppl = ppl + 1
+pp$(ppl) = a$
+GOTO 6
+7
+CLOSE #1
+END SUB
+
+SUB kell (a)
+heli 3
+
+SELECT CASE a
+CASE 1
+OUT prt, 255
+FOR b = 1 TO 80
+SOUND 0, 1
+NEXT b
+OUT prt, 0
+FOR b = 1 TO 15
+SOUND 0, 1
+NEXT b
+OUT prt, 255
+FOR b = 1 TO 15
+SOUND 0, 1
+NEXT b
+OUT prt, 0
+
+CASE 2
+OUT prt, 255
+FOR b = 1 TO 80
+SOUND 0, 1
+NEXT b
+OUT prt, 0
+
+END SELECT
+END SUB
+
+SUB keys
+kl = 0
+OUT prt, 0
+8
+a = INP(prt)
+b = INP(prt)
+IF a <> b THEN GOTO 8
+
+b = 128
+FOR c = 0 TO 7
+d = INT(a / b)
+bit(c) = d
+a = a - (b * d)
+b = b / 2
+NEXT c
+
+IF bit(4) = 1 AND bit(6) = 1 THEN bit(4) = 0: bit(6) = 0: kl = 3
+IF bit(6) = 1 THEN kl = 2
+IF bit(4) = 1 THEN kl = 1
+
+a$ = INKEY$
+IF a$ = CHR$(0) + "K" THEN kl = 1
+IF a$ = CHR$(0) + "M" THEN kl = 2
+IF a$ = CHR$(0) + "P" THEN kl = 3
+ekr
+END SUB
+
+SUB klnait (k)
+
+' Highlight the pressed button on the display
+IF k = 3 THEN c = 3 ELSE c = 1
+IF k = 6 THEN c = 14
+LOCATE 5, 6
+COLOR 7, c
+PRINT "<kesk>"
+COLOR 7, 0
+
+' Highlight the pressed button on the display
+IF k = 1 THEN c = 3 ELSE c = 1
+IF k = 4 THEN c = 14
+LOCATE 4, 1
+COLOR 7, c
+PRINT "<vasak>"
+COLOR 7, 0
+
+IF k = 2 THEN c = 3 ELSE c = 1
+IF k = 5 THEN c = 14
+LOCATE 4, 10
+COLOR 7, c
+PRINT "<parem>"
+COLOR 7, 0
+
+END SUB
+
+SUB mnmain
+2
+getkey a
+IF a = 6 THEN sync
+IF a = 3 THEN sync2
+
+IF a = 1 THEN kell 1
+IF a = 4 THEN kell 2
+
+IF a = 2 THEN mntime
+IF a = 5 THEN rese
+GOTO 2
+
+END SUB
+
+SUB mntime
+vilgu = 1
+11
+showit
+getkey a
+
+IF modee = 1 THEN
+ b = VAL(LEFT$(TIME$, 2))
+ c = 0
+ IF a = 1 THEN c = 1: b = b - 1
+ IF a = 2 THEN c = 1: b = b + 1
+ IF b < 0 THEN b = 0
+ IF b > 23 THEN b = 23
+ d$ = STR$(b)
+ IF LEFT$(d$, 1) = " " THEN d$ = RIGHT$(d$, LEN(d$) - 1)
+ IF LEN(d$) < 2 THEN d$ = "0" + d$
+ e$ = d$ + RIGHT$(TIME$, 6)
+ IF c = 1 THEN TIME$ = e$
+ELSE
+ b = VAL(RIGHT$(LEFT$(TIME$, 5), 2))
+ c = 0
+ IF a = 1 THEN c = 1: b = b - 1
+ IF a = 2 THEN c = 1: b = b + 1
+ IF b < 0 THEN b = 0
+ IF b > 59 THEN b = 59
+ d$ = STR$(b)
+ IF LEFT$(d$, 1) = " " THEN d$ = RIGHT$(d$, LEN(d$) - 1)
+ IF LEN(d$) < 2 THEN d$ = "0" + d$
+ e$ = LEFT$(TIME$, 3) + d$ + RIGHT$(TIME$, 3)
+ IF c = 1 THEN TIME$ = e$
+END IF
+
+IF a = 3 THEN
+IF modee = 1 THEN modee = 2 ELSE modee = 1
+END IF
+
+IF a = 6 THEN GOTO 12
+GOTO 11
+12
+vilgu = 0
+modee = 2
+END SUB
+
+SUB num (a)
+
+FOR b = 1 TO 12
+bitt(b) = 1
+NEXT b
+bitt(15) = 1
+bitt(16) = 1
+
+b = INT(a / 10)
+c = a - (10 * b)
+ekrf b
+ekrf c + 10
+END SUB
+
+SUB rese
+heli 4
+timo$ = ""
+dato$ = ""
+apl = 0
+END SUB
+
+SUB showit
+a$ = LEFT$(TIME$, 5)
+IF modee = 1 THEN
+b = VAL(LEFT$(a$, 2))
+tul(1) = 1
+tul(2) = 0
+ELSE
+b = VAL(RIGHT$(a$, 2))
+tul(1) = 0
+tul(2) = 1
+END IF
+LOCATE 15, 1
+PRINT b
+num b
+
+
+END SUB
+
+SUB son (a$)
+
+FOR b = 1 TO 50
+sona$(b) = ""
+NEXT b
+mitus = 0
+
+b = 1
+FOR c = 1 TO LEN(a$)
+d$ = RIGHT$(LEFT$(a$, c), 1)
+IF d$ = " " OR d$ = CHR$(9) THEN
+b = 1
+ELSE
+IF b = 1 THEN b = 0: mitus = mitus + 1
+sona$(mitus) = sona$(mitus) + d$
+END IF
+NEXT c
+
+
+END SUB
+
+SUB start
+pn$(1) = "Monday"
+pn$(2) = "Tuesday"
+pn$(3) = "Wednesday"
+pn$(4) = "Thursday"
+pn$(5) = "Friday"
+pn$(6) = "Saturday"
+pn$(7) = "Sunday"
+
+prt = &H37A
+prt2 = &H378
+hist(1) = 10000
+hist(2) = 10000
+hist(3) = 10000
+
+FOR a = 1 TO 16
+bitt(a) = 1
+NEXT a
+modee = 2
+vilgu = 0
+tul(1) = 1
+tul(2) = 1
+END SUB
+
+SUB sync
+OPEN "sync.txt" FOR INPUT AS #1
+LINE INPUT #1, a$
+DATE$ = a$
+LINE INPUT #1, a$
+TIME$ = a$
+CLOSE #1
+
+heli 2
+END SUB
+
+SUB sync2
+a$ = TIME$
+a$ = LEFT$(a$, 5)
+b = VAL(RIGHT$(a$, 2))
+c = VAL(LEFT$(a$, 2))
+IF b >= 30 THEN c = c + 1
+b = 0
+IF c > 23 THEN c = c - 24
+a$ = RIGHT$(STR$(c), LEN(STR$(c)) - 1)
+b$ = RIGHT$(STR$(b), LEN(STR$(b)) - 1)
+IF LEN(a$) < 2 THEN a$ = "0" + a$
+IF LEN(b$) < 2 THEN b$ = "0" + b$
+a$ = a$ + ":" + b$
+
+'LOCATE 10, 1
+'PRINT a$
+
+TIME$ = a$
+
+heli 1
+END SUB
projects / qbasicapps.git / commitdiff