CHDIR ".\qbasicapps\unsorted"


DECLARE SUB bar ()
DECLARE SUB help (a!)
DECLARE SUB alarm (a!)
DECLARE SUB gtw (y!, m!, t!, r!)
DECLARE SUB daysm (y!, m!, d!)
DECLARE SUB daysy (y!, d!)
DECLARE SUB chdat ()
DECLARE SUB entcla ()
DECLARE SUB entcl ()
DECLARE SUB clrc (a!)
DECLARE SUB scroll ()
DECLARE SUB ps (x!, y!, c!, s$)
DECLARE SUB vbox (x1!, y1!, x2!, y2!, c!)
DECLARE SUB quit ()
DECLARE SUB start ()
DECLARE SUB cns (a!, s$)
DECLARE SUB getkey (a$)
DECLARE SUB chkey (a$)
DECLARE SUB entquit ()
DECLARE SUB ented ()
DECLARE SUB ed (p!)
DECLARE SUB inpu (x!, y!, xl!, c!, a$)
DECLARE SUB box (x!, y!, xl!, yl!, a$)
DECLARE SUB sh ()

DIM SHARED celh(1 TO 20)
DIM SHARED celm(1 TO 20)
DIM SHARED cels(1 TO 20)

DIM SHARED celm1$(1 TO 20)
DIM SHARED celm2$(1 TO 20)
DIM SHARED celc$(1 TO 20)

DIM SHARED celt(1 TO 20)' 0 - empty  1 - onece  2 - every day  3 - specified days
DIM SHARED celw(1 TO 20, 1 TO 7)
DIM SHARED celx(1 TO 20)

DIM SHARED virt(1 TO 80, 1 TO 25)
DIM SHARED tmr
DIM SHARED slp(1 TO 20)
DIM SHARED alq(1 TO 20)
DIM SHARED alarmo

DIM SHARED alqm
DIM SHARED br$

start

sh
1
br$ = "Press F1 for help"
getkey a$

IF a$ = "q" THEN entquit
IF a$ = "e" THEN ented
IF a$ = "c" THEN entcl
IF a$ = "d" THEN entcla
IF a$ = CHR$(0) + CHR$(59) THEN help 1: getkey a$: sh
GOTO 1

SUB alarm (a)
alq(a) = 1
alarmo = 1
'DIM SHARED celm1$(1 TO 20)
'DIM SHARED celm2$(1 TO 20)
'DIM SHARED celc$(1 TO 20)

IF celc$(a) <> "" THEN
SHELL celc$(a)
END IF

IF celm1$(a) <> "" OR celm2$(a) <> "" THEN
OPEN "note.txt" FOR OUTPUT AS #1
PRINT #1, celm1$(a)
PRINT #1, celm2$(a)
CLOSE #1
SHELL "notepad note.txt"
END IF


FOR b = 100 TO 1000 STEP 20
SOUND b, .1
NEXT b
END SUB

SUB bar
COLOR 0, 3
LOCATE 22, 72
PRINT CHR$(179) + TIME$

br$ = br$ + SPACE$(80)
br$ = LEFT$(br$, 70)
LOCATE 22, 1
PRINT " " + br$

COLOR 7, 0
END SUB

SUB box (x, y, xl, yl, e$)
vbox x, y, xl, yl, 1
' 201 205 187
COLOR 11

a$ = ""
d$ = ""
FOR a = 1 TO xl - 2
a$ = a$ + CHR$(205)
d$ = d$ + " "
NEXT a
b$ = CHR$(201) + a$ + CHR$(187)
c$ = CHR$(200) + a$ + CHR$(188)
d$ = CHR$(186) + d$ + CHR$(186)

LOCATE y, x
PRINT b$
LOCATE y + yl - 1, x
PRINT c$

FOR a = 1 TO yl - 2
LOCATE y + a, x
PRINT d$
NEXT a

xt = INT(x + (xl / 2) - (LEN(e$) / 2) - 2)
LOCATE y, xt
PRINT "[ "
xt = xt + 2

COLOR 10
LOCATE y, xt
PRINT e$

xt = xt + LEN(e$)

COLOR 11
LOCATE y, xt
PRINT " ]"

COLOR 7, 0
END SUB

SUB chdat
a$ = DATE$
qwy = VAL(RIGHT$(a$, 4))
qwm = VAL(LEFT$(a$, 2))
qwd = VAL(RIGHT$(LEFT$(a$, 5), 2))
gtw qwy, qwm, qwd, w

a$ = TIME$
qes = VAL(RIGHT$(a$, 4))
qeh = VAL(LEFT$(a$, 2))
qem = VAL(RIGHT$(LEFT$(a$, 5), 2))

IF alqm <> qem THEN
alqm = qem

FOR b = 1 TO 20
alq(b) = 0
NEXT b
END IF


'DIM SHARED celh(1 TO 20)
'DIM SHARED celm(1 TO 20)
'DIM SHARED cels(1 TO 20)


FOR a = 1 TO 20
IF celt(a) = 0 THEN GOTO 19
IF celt(a) = 3 THEN IF celw(a, w) = 0 THEN GOTO 19
IF alq(a) = 1 THEN GOTO 19
IF celh(a) <> qeh THEN GOTO 19
IF celm(a) <> qem THEN GOTO 19
alarm a
IF celt(a) = 1 THEN clrc a
19
NEXT a
END SUB

SUB chkey (a$)
a$ = INKEY$

IF a$ = "" THEN
IF tmr > 4 THEN scroll: tmr = 1
SOUND 0, 1
IF alarmo = 1 THEN SOUND 2000, 1
tmr = tmr + 1
chdat
bar
ELSE
IF alarmo = 1 THEN alarmo = 0: a$ = ""
END IF
END SUB

SUB clrc (a)

celh(a) = 0
celm(a) = 0
cels(a) = 0
celt(a) = 0

celm1$(a) = ""
celm2$(a) = ""
celc$(a) = ""

FOR b = 1 TO 7
celw(a, b) = 0
NEXT b

END SUB

SUB cns (a, s$)
s$ = STR$(a)
IF LEFT$(s$, 1) = " " THEN s$ = RIGHT$(s$, LEN(s$) - 1)
IF LEN(s$) = 1 THEN s$ = "0" + s$
END SUB

SUB daysm (y, m, d)
SELECT CASE m
CASE 1
d = 31

CASE 2
IF y / 4 = y \ 4 THEN d = 29 ELSE d = 28

CASE 3
d = 31

CASE 4
d = 30

CASE 5
d = 31

CASE 6
d = 30

CASE 7
d = 31

CASE 8
d = 31

CASE 9
d = 30

CASE 10
d = 31

CASE 11
d = 30

CASE 12
d = 31
END SELECT

END SUB

SUB daysy (y, d)
d = 365
IF y / 4 = y \ 4 THEN d = 366
END SUB

SUB ed (p)
br$ = "Press F1 for help, ESC to close window, CTRL + ENTER accept"
cns celh(p), s$
tth$ = s$
cns celm(p), s$
ttm$ = s$
cns cels(p), s$
tts$ = s$

ms1$ = celm1$(p)
ms2$ = celm2$(p)
cm1$ = celc$(p)

DIM wks(1 TO 7)
FOR a = 1 TO 7
wks(a) = celw(p, a)
NEXT a
typ = celt(p)
IF typ = 0 THEN typ = 1

box 5, 5, 70, 11, "Edit entrie"
LOCATE 7, 7
PRINT "Enter time   (HH:MM:SS)"
LOCATE 8, 23
PRINT ":"
LOCATE 8, 26
PRINT ":"
inpu 21, 8, 2, 1, tth$
inpu 24, 8, 2, 1, ttm$
inpu 27, 8, 2, 1, tts$

LOCATE 10, 7
PRINT "Enter message"
inpu 21, 10, 52, 1, ms1$
inpu 21, 11, 52, 1, ms2$

LOCATE 13, 7
PRINT "Enter command"
inpu 21, 13, 52, 1, cm1$

x = 1
y = 1
11

IF typ = 1 THEN COLOR 14, 4 ELSE COLOR 14, 0
LOCATE 7, 32
PRINT "O";
COLOR 7
PRINT "nce"

IF typ = 2 THEN COLOR 14, 4 ELSE COLOR 14, 0
LOCATE 7, 38
PRINT "D";
COLOR 7
PRINT "aily"

IF typ = 3 THEN COLOR 14, 4 ELSE COLOR 14, 0
LOCATE 7, 45
PRINT "S";
COLOR 7
PRINT "pecified weekdays"

FOR a = 1 TO 7
IF wks(a) = 1 THEN COLOR 10, 0 ELSE COLOR 8, 0
LOCATE 8, 44 + (a * 2)
PRINT a
NEXT a


c = 0

IF y = 1 THEN
IF x = 1 THEN inpu 21, 8, 2, c, tth$
IF x = 2 THEN inpu 24, 8, 2, c, ttm$
IF x = 3 THEN inpu 27, 8, 2, c, tts$
END IF

IF y = 2 THEN inpu 21, 10, 52, c, ms1$
IF y = 3 THEN inpu 21, 11, 52, c, ms2$
IF y = 4 THEN inpu 21, 13, 52, c, cm1$

IF c = 100 THEN GOTO 13
IF c = 102 THEN x = x + 1
IF c = 103 THEN x = x - 1
IF c = 104 THEN y = y - 1
IF c = 105 THEN y = y + 1
IF c = 106 THEN GOTO 12

tg = 0
IF c = 107 THEN tg = 1
IF c = 108 THEN tg = 2
IF c = 109 THEN tg = 3
IF c = 110 THEN tg = 4
IF c = 111 THEN tg = 5
IF c = 112 THEN tg = 6
IF c = 113 THEN tg = 7

IF c = 114 THEN typ = 1
IF c = 115 THEN typ = 2
IF c = 116 THEN typ = 3

IF c = 117 THEN help 2

IF tg > 0 THEN
IF wks(tg) = 0 THEN wks(tg) = 1 ELSE wks(tg) = 0
END IF

IF c = 101 THEN
IF y = 1 THEN x = x + 1 ELSE y = y + 1
END IF


IF y > 4 THEN y = 4
IF y < 1 THEN y = 1
IF x > 3 THEN x = 1: y = y + 1
IF x < 1 THEN x = 1


GOTO 11
12
celh(p) = VAL(tth$)
celm(p) = VAL(ttm$)
cels(p) = VAL(tts$)

celm1$(p) = ms1$
celm2$(p) = ms2$
celc$(p) = cm1$
celt(p) = typ


FOR a = 1 TO 7
celw(p, a) = wks(a)
NEXT a
13

END SUB

SUB entcl
a$ = "01"
box 20, 10, 40, 5, "Clear entrie"

LOCATE 12, 23
PRINT "Which cell do you need to clear?"

15
inpu 55, 12, 2, c, a$
IF c = 100 THEN GOTO 16
IF c = 101 THEN
clrc VAL(a$)
GOTO 16
END IF
GOTO 15

16
sh
END SUB

SUB entcla

box 15, 10, 50, 6, "Clearing"

18
LOCATE 12, 21
PRINT "Are you sure you want to clear all cells?"
LOCATE 13, 36
PRINT "[ Y / N ]"


getkey a$
IF a$ = "y" OR a$ = "Y" THEN
FOR a = 1 TO 20
clrc a
NEXT a
GOTO 17
END IF
IF a$ = "n" OR a$ = "N" THEN GOTO 17
box 15, 10, 50, 8, "Clearing"
LOCATE 15, 30
COLOR 28
PRINT "Use keys 'Y' or 'N'"
COLOR 7
GOTO 18

17
sh


END SUB

SUB ented
br$ = "Enter cell number in range of 1 to 20"
a$ = "01"
box 20, 10, 40, 5, "Edit entrie"

9
LOCATE 12, 23
PRINT "Which cell do you need to edit?"
'SUB inpu (x, y, xl, c, a$)

6
c = 0
inpu 55, 12, 2, c, a$
IF c = 100 THEN GOTO 7
IF c = 101 THEN
b = VAL(a$)

IF b = 0 THEN
IF a$ = " 0" OR a$ = "0 " OR a$ = "00" OR a$ = "-0" THEN GOTO 10
box 20, 10, 40, 9, "Edit entrie"
COLOR 12, 0
LOCATE 14, 23
PRINT "    Letters aren't allowed"
LOCATE 15, 23
PRINT "  enter number, or press ESC "
COLOR 7
GOTO 9
END IF

IF b < 1 OR b > 20 THEN
10
box 20, 10, 40, 9, "Edit entrie"
COLOR 12, 0
LOCATE 14, 23
PRINT "   The entered number must be in"
LOCATE 15, 23
PRINT "    the range between 1 and 20"
LOCATE 16, 23
PRINT "enter correct number, or press ESC"
COLOR 7
GOTO 9
END IF

IF (b > 0) AND (b < 21) THEN sh: ed b: GOTO 7

END IF
GOTO 6
7

sh
END SUB

SUB entquit

box 15, 10, 50, 6, "Quitting"

5
LOCATE 12, 21
PRINT "Are you really sure you want to quit?"
LOCATE 13, 36
PRINT "[ Y / N ]"


getkey a$
IF a$ = "y" OR a$ = "Y" THEN quit
IF a$ = "n" OR a$ = "N" THEN GOTO 4
box 15, 10, 50, 8, "Quitting"
LOCATE 15, 30
COLOR 28
PRINT "Use keys 'Y' or 'N'"
COLOR 7
GOTO 5

4
sh

END SUB

SUB getkey (a$)
3
chkey a$
IF a$ = "" THEN GOTO 3

END SUB

SUB gtw (y, m, t, r)
d = 0
FOR a = 1500 TO y - 1
daysy a, b
d = d + b
NEXT a

FOR a = 1 TO m - 1
daysm y, a, b
d = d + b
NEXT a

d = d + t + 2
r = (d MOD 7) + 1

END SUB

SUB help (a)
SELECT CASE a
CASE 1
box 20, 3, 41, 17, "Help"

LOCATE 5, 24
PRINT "q - quit program"
LOCATE 6, 24
PRINT "c - clear cell"
LOCATE 7, 24
PRINT "d - clear all cells"
LOCATE 8, 24
PRINT "e - edit cell"

COLOR 14
LOCATE 10, 24
PRINT "This program allows you to"
LOCATE 11, 24
PRINT "shedle messages and commands"
LOCATE 12, 24
PRINT "to specified time: once, daily"
LOCATE 13, 24
PRINT "and specified weekdays."

LOCATE 15, 24
PRINT "   Copyright"
LOCATE 16, 24
PRINT "Vladimir German &"
LOCATE 17, 24
PRINT "Svjatoslav Agejenko"
br$ = "Press any key to close this window"

CASE 2
box 3, 16, 76, 5, "Help: allowed keys"
LOCATE 17, 5
PRINT "CTRL + F1..F7  - toggle weekdays     CTRL + O/D/S - toggle modes"
LOCATE 18, 5
PRINT "Arrow keys - to move around          CTRL + ENTER - Accept"
LOCATE 19, 5
PRINT "ESC - close window"
br$ = "You can continue editing ..."


END SELECT



END SUB

SUB inpu (x, y, xl, c, a$)

x1 = 1

2
a$ = a$ + SPACE$(100)
a$ = LEFT$(a$, xl)

COLOR 11, 1
LOCATE y, x
PRINT a$

IF c = 1 THEN GOTO 8
COLOR 30, 2
LOCATE y, x + x1 - 1
PRINT RIGHT$(LEFT$(a$, x1), 1)

getkey b$

IF b$ = CHR$(27) THEN c = 100: GOTO 8
IF b$ = CHR$(13) THEN c = 101: GOTO 8

IF (ASC(b$) > 31) AND (ASC(b$) < 122) AND (LEN(b$) = 1) THEN
a$ = LEFT$(a$, x1 - 1) + b$ + (RIGHT$(a$, xl - x1 + 1))
x1 = x1 + 1
END IF

IF b$ = CHR$(8) THEN
IF x1 > 1 THEN
a$ = LEFT$(a$, x1 - 2) + RIGHT$(a$, xl - x1 + 1)
x1 = x1 - 1
END IF
END IF

IF b$ = CHR$(0) + "M" THEN x1 = x1 + 1
IF b$ = CHR$(0) + "K" THEN x1 = x1 - 1
IF b$ = CHR$(0) + CHR$(94) THEN c = 107: GOTO 8
IF b$ = CHR$(0) + CHR$(95) THEN c = 108: GOTO 8
IF b$ = CHR$(0) + CHR$(96) THEN c = 109: GOTO 8
IF b$ = CHR$(0) + CHR$(97) THEN c = 110: GOTO 8
IF b$ = CHR$(0) + CHR$(98) THEN c = 111: GOTO 8
IF b$ = CHR$(0) + CHR$(99) THEN c = 112: GOTO 8
IF b$ = CHR$(0) + CHR$(100) THEN c = 113: GOTO 8
IF b$ = CHR$(0) + CHR$(59) THEN c = 117: GOTO 8

IF b$ = CHR$(0) + "S" THEN a$ = LEFT$(a$, x1 - 1) + RIGHT$(a$, xl - x1)
IF x1 < 1 THEN x1 = 1: c = 103: GOTO 8
IF x1 > xl THEN x1 = xl: c = 102: GOTO 8
IF b$ = CHR$(0) + "H" THEN c = 104: GOTO 8
IF b$ = CHR$(0) + "P" THEN c = 105: GOTO 8

IF b$ = CHR$(10) THEN c = 106: GOTO 8
IF b$ = CHR$(15) THEN c = 114: GOTO 8
IF b$ = CHR$(4) THEN c = 115: GOTO 8
IF b$ = CHR$(19) THEN c = 116: GOTO 8


GOTO 2
8

a$ = a$ + SPACE$(100)
a$ = LEFT$(a$, xl)
COLOR 11, 1
LOCATE y, x
PRINT a$

IF a$ = SPACE$(LEN(a$)) THEN
a$ = ""
ELSE
14
IF RIGHT$(a$, 1) = " " THEN a$ = LEFT$(a$, LEN(a$) - 1): GOTO 14
END IF

COLOR 7, 0
END SUB

SUB ps (x, y, c, s$)
COLOR c
FOR a = 1 TO LEN(s$)
x1 = x + a - 1
IF (x1 > 21) AND (x1 < 81) THEN
IF virt(x1, y) = 0 THEN
LOCATE y, x1
PRINT RIGHT$(LEFT$(s$, a), 1)
END IF
END IF
NEXT a
END SUB

SUB quit
'DIM SHARED celh(1 TO 20)
'DIM SHARED celm(1 TO 20)
'DIM SHARED cels(1 TO 20)

'DIM SHARED celm1$(1 TO 20)
'DIM SHARED celm2$(1 TO 20)
'DIM SHARED celc$(1 TO 20)

'DIM SHARED celt(1 TO 20)' 0 - empty  1 - onece  2 - every day  3 - specified days
'DIM SHARED celw(1 TO 20, 1 TO 7)


OPEN "tim.dat" FOR OUTPUT AS #1
FOR a = 1 TO 20
PRINT #1, celh(a); celm(a); cels(a); celt(a)
FOR b = 1 TO 6
PRINT #1, celw(a, b);
NEXT b
PRINT #1, celw(a, 7)

PRINT #1, celm1$(a)
PRINT #1, celm2$(a)
PRINT #1, celc$(a)
NEXT a
CLOSE #1
SYSTEM
END SUB

SUB scroll
'ps RND * 60 + 1, RND * 20 + 1, RND * 13 + 1, "asi"

'DIM SHARED celm1$(1 TO 20)
'DIM SHARED celm2$(1 TO 20)
'DIM SHARED celc$(1 TO 20)
'DIM SHARED celx(1 TO 20)
COLOR 7, 0

FOR a = 1 TO 20
le = LEN(celm1$(a) + celm2$(a) + celc$(a)) + 2
IF le > 59 THEN
  x = 22 - celx(a)
  IF slp(a) > 0 THEN
    slp(a) = slp(a) - 1
  ELSE
    celx(a) = celx(a) + 1
    IF x + le < 83 THEN slp(a) = 10
    IF x + le < 82 THEN slp(a) = 10: celx(a) = 0
  END IF
ELSE
  x = 22
END IF

ps x, a + 1, 10, celc$(a) + " "
x = x + LEN(celc$(a)) + 1
ps x, a + 1, 14, celm1$(a) + " "
x = x + LEN(celm1$(a)) + 1
ps x, a + 1, 14, celm2$(a) + " "

NEXT a

END SUB

SUB sh
vbox 1, 1, 80, 25, 0
CLS
LOCATE 1, 1
COLOR 0, 3
PRINT "Num|  Time  | When? | Command & Message                                         "
COLOR 7, 0

FOR a = 1 TO 20
COLOR 14
IF a < 10 THEN LOCATE a + 1, 2 ELSE LOCATE a + 1, 1
PRINT a

COLOR 3
LOCATE a + 1, 4
PRINT "|"


LOCATE a + 1, 5
COLOR 14
IF celt(a) = 0 THEN
PRINT "-- -- --"
ELSE
COLOR 14
cns celh(a), s$
PRINT s$
LOCATE a + 1, 8
cns celm(a), s$
PRINT s$
LOCATE a + 1, 11
cns cels(a), s$
PRINT s$
END IF
COLOR 30
LOCATE a + 1, 7
PRINT ":"
LOCATE a + 1, 10
PRINT ":"

COLOR 3
LOCATE a + 1, 13
PRINT "|"
LOCATE a + 1, 14

IF celt(a) = 1 THEN
COLOR 14
PRINT " Once"
END IF

IF celt(a) = 2 THEN
COLOR 14
PRINT " Daily"
END IF

IF celt(a) = 3 THEN
COLOR 10
FOR b = 1 TO 7
'DIM SHARED celw(1 TO 20, 1 TO 7)
LOCATE a + 1, 13 + b
IF celw(a, b) = 1 THEN PRINT RIGHT$(STR$(b), 1)
NEXT b
END IF

COLOR 3
LOCATE a + 1, 21
PRINT "|"

NEXT a

END SUB

SUB start

OPEN "tim.dat" FOR INPUT AS #1
FOR a = 1 TO 20
INPUT #1, celh(a), celm(a), cels(a), celt(a)
FOR b = 1 TO 7
INPUT #1, celw(a, b)
NEXT b

LINE INPUT #1, celm1$(a)
LINE INPUT #1, celm2$(a)
LINE INPUT #1, celc$(a)
NEXT a
CLOSE #1

alarmo = 0
END SUB

SUB vbox (x1, y1, x2, y2, c)
FOR y = y1 TO y1 + y2 - 1
FOR x = x1 TO x1 + x2 - 1
virt(x, y) = c
NEXT x
NEXT y
END SUB