DECLARE FUNCTION getnam$ (a%) DECLARE FUNCTION getsym$ (a$, b%) DECLARE SUB editor () DECLARE SUB leiaconf () DECLARE SUB clrerr () DECLARE SUB dispt () ' Kooli Kell 3 ' (c) Svjatoslav Agejenko ' All rights reserved. ' E-mail: svjatoslav@svjatoslav.eu ' Homepage: svjatoslav.eu DECLARE SUB dispp () DECLARE SUB displukk () DECLARE SUB kola (a%) DECLARE SUB rese () DECLARE SUB start () DECLARE SUB getnad (g%, n%, d%, k%) DECLARE SUB initp (b$) DECLARE SUB getmd (a$, m%, d%) DECLARE SUB son (a$) DECLARE SUB inita () DECLARE SUB chm () DECLARE SUB chd () DECLARE SUB kell (a%) DECLARE SUB sync2 () DECLARE SUB sync () DECLARE SUB mnmain () DECLARE SUB heli (a%) DECLARE SUB disp () DEFINT A-Z 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 lk$ DIM SHARED ssave DIM SHARED ssavel DIM SHARED timero AS LONG DIM SHARED kblukk DIM SHARED tunnidara DIM SHARED errmsg$ DIM SHARED cnflist$(1 TO 200) 'ON ERROR GOTO 20 start disp mnmain 20 LOCATE 20, 1 COLOR 0, 15 PRINT "Programmi t88s ilmus j2rgnev t6rge:" PRINT errmsg$ PRINT "Programmi t2itmine katkestatud! Abi saamiseks lugege juhendit." SYSTEM 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 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$ tunnidara = 0 dispp disp END SUB SUB chm 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 (tunnidara = 0) AND (b > 0) THEN kell b ssave = ssave + 1 END SUB SUB clrerr errmsg$ = "tundmatu viga. V6ibolla on v2he RAM m2lu?" END SUB SUB disp CLS PRINT "Kooli Kell 3 2003.09" PRINT "autor: Svjatoslav Agejenko " PRINT "" PRINT "s - kell tundi sisse v - kell tunnist v�lja" PRINT "a - sisesta uus aeg d - sisesta uus daatum" PRINT "p - n2itab dokumentatsiooni j - j�tab k�ik tunnid t�na �ra" PRINT "7 - 1 minut tagasi 8 - 1 minut edasi" PRINT "4 - 1 tund tagasi 5 - 1 tund edasi" PRINT "r - programmi restart q - programmist v�lja" PRINT "k - konfiguratsiooni redaktor CTRL+L - klaviatuuri lukk (sees/v2ljas)" dispp LOCATE 12, 15 PRINT "Kuu-P�ev-Aasta (USA standard)" LOCATE 17 FOR a = 1 TO ppl IF pp$(a) <> SPACE$(LEN(pp$(a))) THEN PRINT pp$(a); PRINT SPACE$(15 - LEN(pp$(a))); END IF NEXT a displukk dispt END SUB SUB displukk LOCATE 1, 40 IF kblukk = 1 THEN COLOR 0, 7 PRINT "Klaviatuur lukus! Vajuta CTRL+L" COLOR 15, 0 ELSE PRINT " " END IF END SUB SUB dispp IF ndlp = 0 THEN GOTO 14 LOCATE 14, 1 PRINT "n�dalap�ev:", pn$(ndlp) LOCATE 15, 1 PRINT "p�evaplaan:", lp$ 14 END SUB SUB dispt LOCATE 16, 20 COLOR 12 + 15, 0 IF tunnidara = 1 THEN PRINT "T2na on k6ik tunnid 2ra j2etud" ELSE PRINT " " END IF COLOR 15, 0 END SUB SUB editor 23 leiaconf CLS COLOR 0, 15 LOCATE 1, 1 PRINT SPACE$(80); LOCATE 1, 1 PRINT "Konfiguratsiooni redaktor. Valige v2lja p2eva v6i aasta plaani." LOCATE 2, 1 PRINT SPACE$(80); LOCATE 2, 1 PRINT " nr nimi laiend suurus loomisdaatum" LOCATE 22, 1 PRINT SPACE$(80); LOCATE 22, 1 PRINT "K - valitud faili kustutamine U - uus fail ESC - redaktorist v2lja" p = 0 v = 1 17 FOR a = 3 TO 21 IF a - 2 + p = v THEN COLOR 0, 7 LOCATE a, 1 PRINT cnflist$(a - 2 + p) + SPACE$(55 - LEN(cnflist$(a - 2 + p))) LOCATE a, 56 COLOR 31, 0 PRINT "<=="; IF cnflist$(a - 2 + p) <> SPACE$(LEN(cnflist$(a - 2 + p))) THEN COLOR 15, 0 PRINT " valitud: " + getnam$(v) END IF COLOR 15, 0 ELSE COLOR 15, 0 LOCATE a, 1 PRINT cnflist$(a - 2 + p) + SPACE$(80 - LEN(cnflist$(a - 2 + p))) END IF NEXT a a$ = INKEY$ LOCATE 1, 1 'IF a$ <> "" THEN PRINT ASC(RIGHT$(a$, 1)); ASC(LEFT$(a$, 1)) IF a$ = CHR$(27) THEN GOTO 18 IF a$ = "u" OR a$ = "U" THEN SHELL "EDIT": GOTO 23 IF a$ = CHR$(0) + "P" THEN v = v + 1 IF a$ = CHR$(0) + "H" THEN v = v - 1 IF a$ = CHR$(0) + CHR$(73) THEN v = v - 17 IF a$ = CHR$(0) + CHR$(81) THEN v = v + 17 IF a$ = "K" OR a$ = "k" THEN IF LEN(getnam$(v)) > 2 THEN IF getnam$(v) = "AASTA.AP" THEN SOUND 3000, .1 ELSE KILL getnam$(v) GOTO 23 END IF ELSE SOUND 3000, .1 END IF END IF IF a$ = CHR$(13) THEN IF getnam$(v) = "." THEN SOUND 3000, .1 ELSE SHELL "EDIT " + getnam$(v) GOTO 23 END IF END IF IF v < 1 THEN v = 1: SOUND 3000, .2 IF v > 200 THEN v = 200: : SOUND 3000, .2 21 IF v - p > 19 THEN p = p + 1: GOTO 21 22 IF v - p < 1 THEN p = p - 1: GOTO 22 GOTO 17 18 COLOR 15, 0 disp 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 FUNCTION getnam$ (a) c$ = "" FOR b = 8 TO 40 d$ = getsym(cnflist$(a), b) IF d$ = " " THEN GOTO 19 c$ = c$ + d$ NEXT b 19 getnam$ = c$ + "." + getsym(cnflist$(a), 17) + getsym(cnflist$(a), 18) END FUNCTION FUNCTION getsym$ (a$, b) getsym$ = RIGHT$(LEFT$(a$, b), 1) END FUNCTION 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 errmsg$ = "Ei leia aastaplaani faili! 'aasta.ap'" OPEN "aasta.ap" FOR INPUT AS #1 clrerr 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 errmsg$ = "Ei leia aastaplaanis mainitud '" + b$ + ".pp' p2evaplaani!" OPEN b$ + ".pp" FOR INPUT AS #1 clrerr 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) b$ = TIME$ + DATE$ IF b$ <> lk$ THEN lk$ = b$ ELSE GOTO 2 heli 3 SELECT CASE a CASE 1 kola 4 FOR b = 1 TO 15 SOUND 0, 1 NEXT b kola 1 CASE 2 kola 5 END SELECT 2 END SUB SUB kola (a) COLOR 15, 7 s$ = "" FOR b = 1 TO 80 s$ = s$ + CHR$(219) NEXT b FOR b = 1 TO 30 PRINT s$; NEXT b timero = TIMER 11 OUT prt, 255 IF ABS(timero - TIMER) < a THEN GOTO 11 OUT prt, 0 COLOR 15, 0 disp END SUB SUB leiaconf FOR a = 1 TO 200 cnflist$(a) = "" NEXT a c = 1 SHELL "dir >dir.tmp" OPEN "dir.tmp" FOR INPUT AS #1 15 IF EOF(1) <> 0 THEN GOTO 16 LINE INPUT #1, a$ IF LEN(a$) < 30 THEN GOTO 15 IF LEFT$(a$, 1) = " " THEN GOTO 15 IF LEFT$(a$, 1) = "." THEN GOTO 15 b$ = RIGHT$(LEFT$(a$, 12), 3) IF b$ = "PP " OR b$ = "AP " THEN ELSE GOTO 15 d$ = " " + STR$(c) a$ = RIGHT$(d$, 4) + " " + a$ IF LEN(a$) > 50 THEN a$ = LEFT$(a$, 50) cnflist$(c) = a$ c = c + 1 GOTO 15 16 CLOSE #1 KILL "dir.tmp" END SUB SUB mnmain 1 b$ = LEFT$(TIME$, 5) IF b$ <> timo$ THEN chm timo$ = b$ a$ = INKEY$ IF a$ <> "" THEN IF ssave > ssavel THEN disp ssave = 0 END IF IF a$ = CHR$(12) THEN IF kblukk = 1 THEN kblukk = 0 ELSE kblukk = 1 displukk END IF IF kblukk = 1 THEN IF a$ <> "" THEN SOUND 3000, 1 a$ = "" END IF IF a$ = "k" OR a$ = "K" THEN editor IF a$ = "s" OR a$ = "S" THEN kell 1 IF a$ = "v" OR a$ = "V" THEN kell 2 IF a$ = "a" THEN CLS PRINT " vana aeg: " + TIME$ INPUT "sisesta uus aeg (TT:MM:SS): ", b$ IF LEN(b$) <> 8 THEN GOTO 12 TIME$ = b$ timo$ = "" 12 disp END IF IF a$ = "d" OR a$ = "D" THEN CLS PRINT " vana daatum: " + DATE$ INPUT "sisesta uus daatum (KK-PP-AAAA): ", b$ IF LEN(b$) <> 10 THEN GOTO 13 DATE$ = b$ timo$ = "" 13 disp END IF IF a$ = "7" OR a$ = "8" THEN b = VAL(RIGHT$(LEFT$(TIME$, 5), 2)) IF a$ = "7" THEN b = b - 1 IF a$ = "8" THEN 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) TIME$ = e$ END IF IF a$ = "4" OR a$ = "5" THEN b = VAL(LEFT$(TIME$, 2)) IF a$ = "4" THEN b = b - 1 IF a$ = "5" THEN 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) TIME$ = e$ END IF IF a$ = "p" OR a$ = "P" THEN SHELL "EDIT juhend.txt": disp IF a$ = "r" OR a$ = "R" THEN rese IF a$ = "q" OR a$ = "Q" THEN SYSTEM IF a$ = "j" OR a$ = "J" THEN IF tunnidara = 0 THEN tunnidara = 1 ELSE tunnidara = 0 dispt END IF IF ssave <= ssavel THEN LOCATE 11, 1 PRINT TIME$ LOCATE 12, 1 PRINT DATE$ ELSE IF ABS(TIMER - timero) > 10 THEN CLS kblukk = 1 FOR b = 1 TO 20 LOCATE RND * 22 + 1, RND * 79 + 1 IF RND * 100 < 50 THEN PRINT "*" ELSE PRINT "." NEXT b LOCATE RND * 22 + 1, RND * 50 + 1 COLOR 0, 7 PRINT "< " + LEFT$(TIME$, 2); COLOR 16, 7 PRINT ":"; COLOR 0, 7 PRINT RIGHT$(LEFT$(TIME$, 5), 2) + " >" COLOR 15, 0 timero = TIMER END IF END IF GOTO 1 END SUB SUB rese heli 4 timo$ = "" dato$ = "" apl = 0 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 CLS COLOR 15 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 = &H378 ssavel = 2 kblukk = 1 tunnidara = 0 OUT prt, 0 END SUB