6239978a64c60392a6ad580afa3ba1ca0be3b296
[qbasicapps.git] / automation / school clock / kell3 / kell3.bas
1 DECLARE FUNCTION getnam$ (a%)\r
2 DECLARE FUNCTION getsym$ (a$, b%)\r
3 DECLARE SUB editor ()\r
4 DECLARE SUB leiaconf ()\r
5 DECLARE SUB clrerr ()\r
6 DECLARE SUB dispt ()\r
7 \r
8 ' Kooli Kell 3\r
9 \r
10 ' (c) Svjatoslav Agejenko\r
11 ' All rights reserved.\r
12 \r
13 ' E-mail:       svjatoslav@svjatoslav.eu\r
14 ' Homepage:     svjatoslav.eu\r
15 \r
16 DECLARE SUB dispp ()\r
17 DECLARE SUB displukk ()\r
18 DECLARE SUB kola (a%)\r
19 DECLARE SUB rese ()\r
20 DECLARE SUB start ()\r
21 DECLARE SUB getnad (g%, n%, d%, k%)\r
22 DECLARE SUB initp (b$)\r
23 DECLARE SUB getmd (a$, m%, d%)\r
24 DECLARE SUB son (a$)\r
25 DECLARE SUB inita ()\r
26 DECLARE SUB chm ()\r
27 DECLARE SUB chd ()\r
28 DECLARE SUB kell (a%)\r
29 DECLARE SUB sync2 ()\r
30 DECLARE SUB sync ()\r
31 DECLARE SUB mnmain ()\r
32 DECLARE SUB heli (a%)\r
33 DECLARE SUB disp ()\r
34 DEFINT A-Z\r
35 \r
36 DIM SHARED ap$(1 TO 500)\r
37 DIM SHARED apl\r
38 DIM SHARED pp$(1 TO 500)\r
39 DIM SHARED ppl\r
40 DIM SHARED prt, prt2\r
41 DIM SHARED timo$\r
42 DIM SHARED dato$\r
43 DIM SHARED sona$(1 TO 50)\r
44 DIM SHARED mitus\r
45 DIM SHARED lp$\r
46 DIM SHARED ndlp\r
47 DIM SHARED pn$(1 TO 7)\r
48 DIM SHARED lk$\r
49 DIM SHARED ssave\r
50 DIM SHARED ssavel\r
51 DIM SHARED timero AS LONG\r
52 DIM SHARED kblukk\r
53 DIM SHARED tunnidara\r
54 DIM SHARED errmsg$\r
55 DIM SHARED cnflist$(1 TO 200)\r
56 \r
57 'ON ERROR GOTO 20\r
58 \r
59 start\r
60 disp\r
61 mnmain\r
62 \r
63 20\r
64 LOCATE 20, 1\r
65 COLOR 0, 15\r
66 PRINT "Programmi t88s ilmus j2rgnev t6rge:"\r
67 PRINT errmsg$\r
68 PRINT "Programmi t2itmine katkestatud!  Abi saamiseks lugege juhendit."\r
69 SYSTEM\r
70 \r
71 SUB chd\r
72 b$ = "tuhi"\r
73 IF apl = 0 THEN inita\r
74 \r
75 a$ = DATE$\r
76 n1 = VAL(RIGHT$(a$, 4))\r
77 n2 = VAL(LEFT$(a$, 2))\r
78 a$ = LEFT$(a$, 5)\r
79 n3 = VAL(RIGHT$(a$, 2))\r
80 getnad n1, n2, n3, ndlp\r
81 FOR a = 1 TO apl\r
82 son ap$(a)\r
83 SELECT CASE sona$(1)\r
84 CASE "v"\r
85 getmd sona$(2), m1, d1\r
86 getmd sona$(3), m2, d2\r
87 getmd DATE$, m3, d3\r
88 IF m3 < m1 THEN GOTO 9\r
89 IF m3 > m2 THEN GOTO 9\r
90 IF m3 = m1 THEN IF d3 < d1 THEN GOTO 9\r
91 IF m3 = m2 THEN IF d3 > d2 THEN GOTO 9\r
92 b$ = sona$(4)\r
93 CASE "n"\r
94 getmd sona$(2), m1, d1\r
95 getmd sona$(3), m2, d2\r
96 getmd DATE$, m3, d3\r
97 IF m3 < m1 THEN GOTO 9\r
98 IF m3 > m2 THEN GOTO 9\r
99 IF m3 = m1 THEN IF d3 < d1 THEN GOTO 9\r
100 IF m3 = m2 THEN IF d3 > d2 THEN GOTO 9\r
101 IF ndlp <> VAL(sona$(4)) THEN GOTO 9\r
102 b$ = sona$(5)\r
103 CASE "e"\r
104 getmd sona$(2), m1, d1\r
105 getmd DATE$, m2, d2\r
106 IF (m1 = m2) AND (d1 = d2) THEN b$ = sona$(3)\r
107 END SELECT\r
108 9\r
109 NEXT a\r
110 \r
111 IF b$ <> lp$ THEN initp b$\r
112 lp$ = b$\r
113 tunnidara = 0\r
114 dispp\r
115 disp\r
116 END SUB\r
117 \r
118 SUB chm\r
119 a$ = DATE$\r
120 IF a$ <> dato$ THEN chd\r
121 dato$ = a$\r
122 b = 0\r
123 FOR a = 1 TO ppl\r
124 son pp$(a)\r
125 SELECT CASE sona$(1)\r
126 CASE "#"\r
127 getmd sona$(2), h1, m1\r
128 getmd TIME$, h2, m2\r
129 ' PRINT h1, m1, h2, m2\r
130 IF (h2 = h1) AND (m2 = m1) THEN\r
131 IF sona$(3) = "sis" THEN b = 1\r
132 IF sona$(3) = "val" THEN b = 2\r
133 END IF\r
134 END SELECT\r
135 NEXT a\r
136 \r
137 IF (tunnidara = 0) AND (b > 0) THEN kell b\r
138 ssave = ssave + 1\r
139 END SUB\r
140 \r
141 SUB clrerr\r
142 errmsg$ = "tundmatu viga. V6ibolla on v2he RAM m2lu?"\r
143 END SUB\r
144 \r
145 SUB disp\r
146 CLS\r
147 PRINT "Kooli Kell 3     2003.09"\r
148 PRINT "autor: Svjatoslav Agejenko  "\r
149 PRINT ""\r
150 PRINT "s - kell tundi sisse             v - kell tunnist v�lja"\r
151 PRINT "a - sisesta uus aeg              d - sisesta uus daatum"\r
152 PRINT "p - n2itab dokumentatsiooni      j - j�tab k�ik tunnid t�na �ra"\r
153 PRINT "7 - 1 minut tagasi               8 - 1 minut edasi"\r
154 PRINT "4 - 1 tund tagasi                5 - 1 tund edasi"\r
155 PRINT "r - programmi restart            q - programmist v�lja"\r
156 PRINT "k - konfiguratsiooni redaktor    CTRL+L - klaviatuuri lukk (sees/v2ljas)"\r
157 \r
158 dispp\r
159 \r
160 LOCATE 12, 15\r
161 PRINT "Kuu-P�ev-Aasta (USA standard)"\r
162 \r
163 \r
164 LOCATE 17\r
165 \r
166 FOR a = 1 TO ppl\r
167 IF pp$(a) <> SPACE$(LEN(pp$(a))) THEN\r
168   PRINT pp$(a);\r
169   PRINT SPACE$(15 - LEN(pp$(a)));\r
170 END IF\r
171 NEXT a\r
172 \r
173 displukk\r
174 dispt\r
175 END SUB\r
176 \r
177 SUB displukk\r
178 LOCATE 1, 40\r
179 IF kblukk = 1 THEN\r
180   COLOR 0, 7\r
181   PRINT "Klaviatuur lukus! Vajuta CTRL+L"\r
182   COLOR 15, 0\r
183 ELSE\r
184   PRINT "                               "\r
185 END IF\r
186 END SUB\r
187 \r
188 SUB dispp\r
189 IF ndlp = 0 THEN GOTO 14\r
190 LOCATE 14, 1\r
191 PRINT "n�dalap�ev:", pn$(ndlp)\r
192 LOCATE 15, 1\r
193 PRINT "p�evaplaan:", lp$\r
194 14\r
195 END SUB\r
196 \r
197 SUB dispt\r
198 LOCATE 16, 20\r
199 COLOR 12 + 15, 0\r
200 IF tunnidara = 1 THEN\r
201   PRINT "T2na on k6ik tunnid 2ra j2etud"\r
202 ELSE\r
203   PRINT "                              "\r
204 END IF\r
205 COLOR 15, 0\r
206 END SUB\r
207 \r
208 SUB editor\r
209 23\r
210 leiaconf\r
211 CLS\r
212 COLOR 0, 15\r
213 LOCATE 1, 1\r
214 PRINT SPACE$(80);\r
215 LOCATE 1, 1\r
216 PRINT "Konfiguratsiooni redaktor. Valige v2lja p2eva v6i aasta plaani."\r
217 LOCATE 2, 1\r
218 PRINT SPACE$(80);\r
219 LOCATE 2, 1\r
220 PRINT "  nr   nimi     laiend     suurus loomisdaatum"\r
221 \r
222 LOCATE 22, 1\r
223 PRINT SPACE$(80);\r
224 LOCATE 22, 1\r
225 PRINT "K - valitud faili kustutamine   U - uus fail   ESC - redaktorist v2lja"\r
226 p = 0\r
227 v = 1\r
228 17\r
229 FOR a = 3 TO 21\r
230   IF a - 2 + p = v THEN\r
231     COLOR 0, 7\r
232     LOCATE a, 1\r
233     PRINT cnflist$(a - 2 + p) + SPACE$(55 - LEN(cnflist$(a - 2 + p)))\r
234     LOCATE a, 56\r
235     COLOR 31, 0\r
236     PRINT "<==";\r
237     IF cnflist$(a - 2 + p) <> SPACE$(LEN(cnflist$(a - 2 + p))) THEN\r
238       COLOR 15, 0\r
239       PRINT " valitud: " + getnam$(v)\r
240     END IF\r
241     COLOR 15, 0\r
242   ELSE\r
243     COLOR 15, 0\r
244     LOCATE a, 1\r
245     PRINT cnflist$(a - 2 + p) + SPACE$(80 - LEN(cnflist$(a - 2 + p)))\r
246   END IF\r
247 NEXT a\r
248   \r
249 \r
250 a$ = INKEY$\r
251 LOCATE 1, 1\r
252 'IF a$ <> "" THEN PRINT ASC(RIGHT$(a$, 1)); ASC(LEFT$(a$, 1))\r
253 IF a$ = CHR$(27) THEN GOTO 18\r
254 IF a$ = "u" OR a$ = "U" THEN SHELL "EDIT": GOTO 23\r
255 IF a$ = CHR$(0) + "P" THEN v = v + 1\r
256 IF a$ = CHR$(0) + "H" THEN v = v - 1\r
257 IF a$ = CHR$(0) + CHR$(73) THEN v = v - 17\r
258 IF a$ = CHR$(0) + CHR$(81) THEN v = v + 17\r
259 IF a$ = "K" OR a$ = "k" THEN\r
260   IF LEN(getnam$(v)) > 2 THEN\r
261     IF getnam$(v) = "AASTA.AP" THEN\r
262       SOUND 3000, .1\r
263     ELSE\r
264       KILL getnam$(v)\r
265       GOTO 23\r
266     END IF\r
267   ELSE\r
268     SOUND 3000, .1\r
269   END IF\r
270 END IF\r
271 IF a$ = CHR$(13) THEN\r
272   IF getnam$(v) = "." THEN\r
273     SOUND 3000, .1\r
274   ELSE\r
275     SHELL "EDIT " + getnam$(v)\r
276     GOTO 23\r
277   END IF\r
278 END IF\r
279 \r
280 IF v < 1 THEN v = 1: SOUND 3000, .2\r
281 IF v > 200 THEN v = 200: : SOUND 3000, .2\r
282 \r
283 21 IF v - p > 19 THEN p = p + 1: GOTO 21\r
284 22 IF v - p < 1 THEN p = p - 1: GOTO 22\r
285 \r
286 GOTO 17\r
287 18\r
288 COLOR 15, 0\r
289 disp\r
290 END SUB\r
291 \r
292 SUB getmd (a$, m, d)\r
293 b$ = LEFT$(a$, 5)\r
294 m = VAL(LEFT$(b$, 2))\r
295 d = VAL(RIGHT$(b$, 2))\r
296 \r
297 END SUB\r
298 \r
299 SUB getnad (g, n, d, k)\r
300 'LOCATE 11, 1\r
301 'PRINT g, n, d\r
302 p = g\r
303 m = n - 2\r
304 IF n > 2 GOTO 120\r
305 p = p - 1: m = m + 12\r
306 120\r
307 c = INT(p / 100)\r
308 y = p - c * 100\r
309 w = d + INT((13 * m - 1) / 5) + y + INT(y / 4) + INT(c / 4) - 2 * c\r
310 k = w - 7 * INT(w / 7)\r
311 IF k = 0 THEN k = 7\r
312 END SUB\r
313 \r
314 FUNCTION getnam$ (a)\r
315 c$ = ""\r
316 FOR b = 8 TO 40\r
317   d$ = getsym(cnflist$(a), b)\r
318   IF d$ = " " THEN GOTO 19\r
319   c$ = c$ + d$\r
320 NEXT b\r
321 19\r
322 getnam$ = c$ + "." + getsym(cnflist$(a), 17) + getsym(cnflist$(a), 18)\r
323 END FUNCTION\r
324 \r
325 FUNCTION getsym$ (a$, b)\r
326 getsym$ = RIGHT$(LEFT$(a$, b), 1)\r
327 END FUNCTION\r
328 \r
329 SUB heli (a)\r
330 'GOTO 10\r
331 SELECT CASE a\r
332 CASE 1\r
333 FOR c = 1 TO 5\r
334 SOUND 3000, 1\r
335 SOUND 0, 1\r
336 NEXT c\r
337 \r
338 CASE 2\r
339 FOR c = 1 TO 5\r
340 SOUND 2500, 1\r
341 SOUND 0, 2\r
342 NEXT c\r
343 SOUND 2500, 10\r
344 \r
345 CASE 3\r
346 FOR a = 1 TO 10\r
347 SOUND 500, .5\r
348 SOUND 1500, .5\r
349 SOUND 2000, .5\r
350 SOUND 1520, .5\r
351 NEXT a\r
352 \r
353 \r
354 CASE 4\r
355 FOR a = 800 TO 1000 STEP 10\r
356 SOUND a, .1\r
357 SOUND a * 3, .1\r
358 SOUND 0, 1\r
359 NEXT a\r
360 10\r
361 \r
362 END SELECT\r
363 \r
364 \r
365 END SUB\r
366 \r
367 SUB inita\r
368 apl = 0\r
369 errmsg$ = "Ei leia aastaplaani faili! 'aasta.ap'"\r
370 OPEN "aasta.ap" FOR INPUT AS #1\r
371 clrerr\r
372 5\r
373 IF EOF(1) <> 0 THEN GOTO 3\r
374 LINE INPUT #1, a$\r
375 apl = apl + 1\r
376 ap$(apl) = a$\r
377 GOTO 5\r
378 3\r
379 CLOSE #1\r
380 END SUB\r
381 \r
382 SUB initp (b$)\r
383 ppl = 0\r
384 errmsg$ = "Ei leia aastaplaanis mainitud '" + b$ + ".pp' p2evaplaani!"\r
385 OPEN b$ + ".pp" FOR INPUT AS #1\r
386 clrerr\r
387 6\r
388 IF EOF(1) <> 0 THEN GOTO 7\r
389 LINE INPUT #1, a$\r
390 ppl = ppl + 1\r
391 pp$(ppl) = a$\r
392 GOTO 6\r
393 7\r
394 CLOSE #1\r
395 END SUB\r
396 \r
397 SUB kell (a)\r
398 b$ = TIME$ + DATE$\r
399 IF b$ <> lk$ THEN lk$ = b$ ELSE GOTO 2\r
400 \r
401 heli 3\r
402 \r
403 SELECT CASE a\r
404 CASE 1\r
405 kola 4\r
406 FOR b = 1 TO 15\r
407 SOUND 0, 1\r
408 NEXT b\r
409 kola 1\r
410 CASE 2\r
411 kola 5\r
412 END SELECT\r
413 2\r
414 END SUB\r
415 \r
416 SUB kola (a)\r
417 COLOR 15, 7\r
418 s$ = ""\r
419 FOR b = 1 TO 80\r
420   s$ = s$ + CHR$(219)\r
421 NEXT b\r
422 FOR b = 1 TO 30\r
423 PRINT s$;\r
424 NEXT b\r
425 \r
426 timero = TIMER\r
427 11\r
428 OUT prt, 255\r
429 IF ABS(timero - TIMER) < a THEN GOTO 11\r
430 OUT prt, 0\r
431 COLOR 15, 0\r
432 disp\r
433 END SUB\r
434 \r
435 SUB leiaconf\r
436 FOR a = 1 TO 200\r
437   cnflist$(a) = ""\r
438 NEXT a\r
439 c = 1\r
440 \r
441 SHELL "dir >dir.tmp"\r
442 OPEN "dir.tmp" FOR INPUT AS #1\r
443 15\r
444 IF EOF(1) <> 0 THEN GOTO 16\r
445 LINE INPUT #1, a$\r
446 IF LEN(a$) < 30 THEN GOTO 15\r
447 IF LEFT$(a$, 1) = " " THEN GOTO 15\r
448 IF LEFT$(a$, 1) = "." THEN GOTO 15\r
449 b$ = RIGHT$(LEFT$(a$, 12), 3)\r
450 IF b$ = "PP " OR b$ = "AP " THEN  ELSE GOTO 15\r
451 d$ = "    " + STR$(c)\r
452 a$ = RIGHT$(d$, 4) + "   " + a$\r
453 IF LEN(a$) > 50 THEN a$ = LEFT$(a$, 50)\r
454 cnflist$(c) = a$\r
455 c = c + 1\r
456 GOTO 15\r
457 16\r
458 CLOSE #1\r
459 KILL "dir.tmp"\r
460 END SUB\r
461 \r
462 SUB mnmain\r
463 1\r
464 b$ = LEFT$(TIME$, 5)\r
465 IF b$ <> timo$ THEN chm\r
466 timo$ = b$\r
467 \r
468 a$ = INKEY$\r
469 \r
470 IF a$ <> "" THEN\r
471 IF ssave > ssavel THEN disp\r
472 ssave = 0\r
473 END IF\r
474 \r
475 IF a$ = CHR$(12) THEN\r
476   IF kblukk = 1 THEN kblukk = 0 ELSE kblukk = 1\r
477   displukk\r
478 END IF\r
479 IF kblukk = 1 THEN\r
480   IF a$ <> "" THEN SOUND 3000, 1\r
481   a$ = ""\r
482 END IF\r
483 IF a$ = "k" OR a$ = "K" THEN editor\r
484 \r
485 IF a$ = "s" OR a$ = "S" THEN kell 1\r
486 IF a$ = "v" OR a$ = "V" THEN kell 2\r
487 \r
488 IF a$ = "a" THEN\r
489 CLS\r
490 PRINT "                  vana aeg: " + TIME$\r
491 INPUT "sisesta uus aeg (TT:MM:SS): ", b$\r
492 IF LEN(b$) <> 8 THEN GOTO 12\r
493 TIME$ = b$\r
494 timo$ = ""\r
495 12\r
496 disp\r
497 END IF\r
498 \r
499 IF a$ = "d" OR a$ = "D" THEN\r
500 CLS\r
501 PRINT "                    vana daatum: " + DATE$\r
502 INPUT "sisesta uus daatum (KK-PP-AAAA): ", b$\r
503 IF LEN(b$) <> 10 THEN GOTO 13\r
504 DATE$ = b$\r
505 timo$ = ""\r
506 13\r
507 disp\r
508 END IF\r
509 \r
510 IF a$ = "7" OR a$ = "8" THEN\r
511   b = VAL(RIGHT$(LEFT$(TIME$, 5), 2))\r
512   IF a$ = "7" THEN b = b - 1\r
513   IF a$ = "8" THEN b = b + 1\r
514   IF b < 0 THEN b = 0\r
515   IF b > 59 THEN b = 59\r
516   d$ = STR$(b)\r
517   IF LEFT$(d$, 1) = " " THEN d$ = RIGHT$(d$, LEN(d$) - 1)\r
518   IF LEN(d$) < 2 THEN d$ = "0" + d$\r
519   e$ = LEFT$(TIME$, 3) + d$ + RIGHT$(TIME$, 3)\r
520   TIME$ = e$\r
521 END IF\r
522 \r
523 IF a$ = "4" OR a$ = "5" THEN\r
524   b = VAL(LEFT$(TIME$, 2))\r
525   IF a$ = "4" THEN b = b - 1\r
526   IF a$ = "5" THEN b = b + 1\r
527   IF b < 0 THEN b = 0\r
528   IF b > 23 THEN b = 23\r
529   d$ = STR$(b)\r
530   IF LEFT$(d$, 1) = " " THEN d$ = RIGHT$(d$, LEN(d$) - 1)\r
531   IF LEN(d$) < 2 THEN d$ = "0" + d$\r
532   e$ = d$ + RIGHT$(TIME$, 6)\r
533   TIME$ = e$\r
534 END IF\r
535 \r
536 IF a$ = "p" OR a$ = "P" THEN SHELL "EDIT juhend.txt": disp\r
537 \r
538 IF a$ = "r" OR a$ = "R" THEN rese\r
539 IF a$ = "q" OR a$ = "Q" THEN SYSTEM\r
540 \r
541 IF a$ = "j" OR a$ = "J" THEN\r
542 IF tunnidara = 0 THEN tunnidara = 1 ELSE tunnidara = 0\r
543 dispt\r
544 END IF\r
545 \r
546 IF ssave <= ssavel THEN\r
547   LOCATE 11, 1\r
548   PRINT TIME$\r
549   LOCATE 12, 1\r
550   PRINT DATE$\r
551 ELSE\r
552   IF ABS(TIMER - timero) > 10 THEN\r
553   CLS\r
554   kblukk = 1\r
555   FOR b = 1 TO 20\r
556     LOCATE RND * 22 + 1, RND * 79 + 1\r
557     IF RND * 100 < 50 THEN PRINT "*" ELSE PRINT "."\r
558   NEXT b\r
559   LOCATE RND * 22 + 1, RND * 50 + 1\r
560   COLOR 0, 7\r
561   PRINT "< " + LEFT$(TIME$, 2);\r
562   COLOR 16, 7\r
563   PRINT ":";\r
564   COLOR 0, 7\r
565   PRINT RIGHT$(LEFT$(TIME$, 5), 2) + " >"\r
566   COLOR 15, 0\r
567   timero = TIMER\r
568   END IF\r
569 END IF\r
570 GOTO 1\r
571 \r
572 \r
573 END SUB\r
574 \r
575 SUB rese\r
576 heli 4\r
577 timo$ = ""\r
578 dato$ = ""\r
579 apl = 0\r
580 END SUB\r
581 \r
582 SUB son (a$)\r
583 \r
584 FOR b = 1 TO 50\r
585   sona$(b) = ""\r
586 NEXT b\r
587 mitus = 0\r
588 \r
589 b = 1\r
590 FOR c = 1 TO LEN(a$)\r
591 d$ = RIGHT$(LEFT$(a$, c), 1)\r
592 IF d$ = " " OR d$ = CHR$(9) THEN\r
593 b = 1\r
594 ELSE\r
595 IF b = 1 THEN b = 0: mitus = mitus + 1\r
596 sona$(mitus) = sona$(mitus) + d$\r
597 END IF\r
598 NEXT c\r
599 \r
600 \r
601 END SUB\r
602 \r
603 SUB start\r
604 CLS\r
605 COLOR 15\r
606 pn$(1) = "esmasp�ev"\r
607 pn$(2) = "teisip�ev"\r
608 pn$(3) = "kolmap�ev"\r
609 pn$(4) = "neljap�ev"\r
610 pn$(5) = "reede"\r
611 pn$(6) = "laup�ev"\r
612 pn$(7) = "p�hap�ev"\r
613 \r
614 prt = &H378\r
615 \r
616 ssavel = 2\r
617 kblukk = 1\r
618 tunnidara = 0\r
619 \r
620 OUT prt, 0\r
621 END SUB\r
622 \r