From 060f240646501946d23eb43fbfacdead3daa06e1 Mon Sep 17 00:00:00 2001 From: Svjatoslav Agejenko Date: Tue, 15 Oct 2024 22:10:32 +0300 Subject: [PATCH] Refactoring code for better readability --- Automation/School clock/kell/kk.bas | 1396 ++++++++++++++------------- 1 file changed, 699 insertions(+), 697 deletions(-) diff --git a/Automation/School clock/kell/kk.bas b/Automation/School clock/kell/kk.bas index ef33829..14883f8 100755 --- a/Automation/School clock/kell/kk.bas +++ b/Automation/School clock/kell/kk.bas @@ -1,697 +1,699 @@ -' 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 "n„dalap„ev:", 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 "p„evaplaan:", 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) - -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 - -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 - -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 -LOCATE 7, 1 -PRINT TIME$ -LOCATE 8, 1 -PRINT DATE$ -GOTO 1 -4 - - -hist(1) = 10000 -hist(2) = 10000 -hist(3) = 10000 - -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) - -IF k = 3 THEN c = 3 ELSE c = 1 -IF k = 6 THEN c = 14 -LOCATE 5, 6 -COLOR 7, c -PRINT "" -COLOR 7, 0 - -IF k = 1 THEN c = 3 ELSE c = 1 -IF k = 4 THEN c = 14 -LOCATE 4, 1 -COLOR 7, c -PRINT "" -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 "" -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) = "esmasp„ev" -pn$(2) = "teisip„ev" -pn$(3) = "kolmap„ev" -pn$(4) = "neljap„ev" -pn$(5) = "reede" -pn$(6) = "laup„ev" -pn$(7) = "phap„ev" - -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 +' 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 "" +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 "" +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 "" +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 -- 2.20.1