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:       svjatoslavagejenko@gmail.com
' 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