automation/school clock/kell2/kkmini.bas

   1 DECLARE SUB dispt ()\r
   2 ' Svjatoslav Agejenko\r
   3 ' E-mail: svjatoslavagejenko@gmail.com\r
   4 ' Homepage: www.hot.ee/n0/\r
   5 \r
   6 DECLARE SUB dispp ()\r
   7 DECLARE SUB displukk ()\r
   8 DECLARE SUB kola (a%)\r
   9 DECLARE SUB rese ()\r
  10 DECLARE SUB start ()\r
  11 DECLARE SUB getnad (g%, n%, d%, k%)\r
  12 DECLARE SUB initp (b$)\r
  13 DECLARE SUB getmd (a$, m%, d%)\r
  14 DECLARE SUB son (a$)\r
  15 DECLARE SUB inita ()\r
  16 DECLARE SUB chm ()\r
  17 DECLARE SUB chd ()\r
  18 DECLARE SUB kell (a%)\r
  19 DECLARE SUB sync2 ()\r
  20 DECLARE SUB sync ()\r
  21 DECLARE SUB mnmain ()\r
  22 DECLARE SUB heli (a%)\r
  23 DECLARE SUB disp ()\r
  24 DEFINT A-Z\r
  25 \r
  26 DIM SHARED ap$(1 TO 500)\r
  27 DIM SHARED apl\r
  28 DIM SHARED pp$(1 TO 500)\r
  29 DIM SHARED ppl\r
  30 DIM SHARED prt, prt2\r
  31 DIM SHARED timo$\r
  32 DIM SHARED dato$\r
  33 DIM SHARED sona$(1 TO 50)\r
  34 DIM SHARED mitus\r
  35 DIM SHARED lp$\r
  36 DIM SHARED ndlp\r
  37 DIM SHARED pn$(1 TO 7)\r
  38 DIM SHARED lk$\r
  39 DIM SHARED ssave\r
  40 DIM SHARED ssavel\r
  41 DIM SHARED timero AS LONG\r
  42 DIM SHARED kblukk\r
  43 DIM SHARED tunnidara\r
  44 \r
  45 start\r
  46 \r
  47 \r
  48 disp\r
  49 mnmain\r
  50 \r
  51 SUB chd\r
  52 b$ = "tuhi"\r
  53 IF apl = 0 THEN inita\r
  54 \r
  55 a$ = DATE$\r
  56 n1 = VAL(RIGHT$(a$, 4))\r
  57 n2 = VAL(LEFT$(a$, 2))\r
  58 a$ = LEFT$(a$, 5)\r
  59 n3 = VAL(RIGHT$(a$, 2))\r
  60 getnad n1, n2, n3, ndlp\r
  61 FOR a = 1 TO apl\r
  62 son ap$(a)\r
  63 SELECT CASE sona$(1)\r
  64 CASE "v"\r
  65 getmd sona$(2), m1, d1\r
  66 getmd sona$(3), m2, d2\r
  67 getmd DATE$, m3, d3\r
  68 IF m3 < m1 THEN GOTO 9\r
  69 IF m3 > m2 THEN GOTO 9\r
  70 IF m3 = m1 THEN IF d3 < d1 THEN GOTO 9\r
  71 IF m3 = m2 THEN IF d3 > d2 THEN GOTO 9\r
  72 b$ = sona$(4)\r
  73 CASE "n"\r
  74 getmd sona$(2), m1, d1\r
  75 getmd sona$(3), m2, d2\r
  76 getmd DATE$, m3, d3\r
  77 IF m3 < m1 THEN GOTO 9\r
  78 IF m3 > m2 THEN GOTO 9\r
  79 IF m3 = m1 THEN IF d3 < d1 THEN GOTO 9\r
  80 IF m3 = m2 THEN IF d3 > d2 THEN GOTO 9\r
  81 IF ndlp <> VAL(sona$(4)) THEN GOTO 9\r
  82 b$ = sona$(5)\r
  83 CASE "e"\r
  84 getmd sona$(2), m1, d1\r
  85 getmd DATE$, m2, d2\r
  86 IF (m1 = m2) AND (d1 = d2) THEN b$ = sona$(3)\r
  87 END SELECT\r
  88 9\r
  89 NEXT a\r
  90 \r
  91 IF b$ <> lp$ THEN initp b$\r
  92 lp$ = b$\r
  93 tunnidara = 0\r
  94 dispp\r
  95 disp\r
  96 END SUB\r
  97 \r
  98 SUB chm\r
  99 a$ = DATE$\r
 100 IF a$ <> dato$ THEN chd\r
 101 dato$ = a$\r
 102 b = 0\r
 103 FOR a = 1 TO ppl\r
 104 son pp$(a)\r
 105 SELECT CASE sona$(1)\r
 106 CASE "#"\r
 107 getmd sona$(2), h1, m1\r
 108 getmd TIME$, h2, m2\r
 109 ' PRINT h1, m1, h2, m2\r
 110 IF (h2 = h1) AND (m2 = m1) THEN\r
 111 IF sona$(3) = "sis" THEN b = 1\r
 112 IF sona$(3) = "val" THEN b = 2\r
 113 END IF\r
 114 END SELECT\r
 115 NEXT a\r
 116 \r
 117 IF (tunnidara = 0) AND (b > 0) THEN kell b\r
 118 ssave = ssave + 1\r
 119 END SUB\r
 120 \r
 121 SUB disp\r
 122 CLS\r
 123 PRINT "Kooli Kell (mini) v 1.1  2003.3"\r
 124 PRINT "Programmi autor Svjatoslav Agejenko   E-mail: n0@hot.ee"\r
 125 PRINT ""\r
 126 PRINT "s - kell tundi sisse             v - kell tunnist v�lja"\r
 127 PRINT "a - sisesta uus aeg              d - sisesta uus daatum"\r
 128 PRINT "u - �mardab aja t�istunnini      l - laeb aja failist SYNC.TXT"\r
 129 PRINT "7 - 1 minut tagasi               8 - 1 minut edasi"\r
 130 PRINT "4 - 1 tund tagasi                5 - 1 tund edasi"\r
 131 PRINT "r - programmi restart            q - programmist v�lja"\r
 132 PRINT "                                 j - j�tab k�ik tunnid t�na �ra"\r
 133 \r
 134 dispp\r
 135 \r
 136 LOCATE 12, 15\r
 137 PRINT "Kuu-P�ev-Aasta (USA standard)"\r
 138 \r
 139 \r
 140 LOCATE 17\r
 141 \r
 142 FOR a = 1 TO ppl\r
 143 IF pp$(a) <> SPACE$(LEN(pp$(a))) THEN\r
 144   PRINT pp$(a);\r
 145   PRINT SPACE$(15 - LEN(pp$(a)));\r
 146 END IF\r
 147 NEXT a\r
 148 \r
 149 displukk\r
 150 dispt\r
 151 END SUB\r
 152 \r
 153 SUB displukk\r
 154 LOCATE 1, 40\r
 155 IF kblukk = 1 THEN\r
 156   COLOR 0, 7\r
 157   PRINT "Klaviatuur lukus! Vajuta CTRL+L"\r
 158   COLOR 7, 0\r
 159 ELSE\r
 160   PRINT "                               "\r
 161 END IF\r
 162 END SUB\r
 163 \r
 164 SUB dispp\r
 165 IF ndlp = 0 THEN GOTO 14\r
 166 LOCATE 14, 1\r
 167 PRINT "n�dalap�ev:", pn$(ndlp)\r
 168 LOCATE 15, 1\r
 169 PRINT "p�evaplaan:", lp$\r
 170 14\r
 171 END SUB\r
 172 \r
 173 SUB dispt\r
 174 LOCATE 16, 20\r
 175 COLOR 12 + 15, 0\r
 176 IF tunnidara = 1 THEN\r
 177   PRINT "T�na on k�ik tunnid �ra j�etud"\r
 178 ELSE\r
 179   PRINT "                              "\r
 180 END IF\r
 181 COLOR 7, 0\r
 182 END SUB\r
 183 \r
 184 SUB getmd (a$, m, d)\r
 185 b$ = LEFT$(a$, 5)\r
 186 m = VAL(LEFT$(b$, 2))\r
 187 d = VAL(RIGHT$(b$, 2))\r
 188 \r
 189 END SUB\r
 190 \r
 191 SUB getnad (g, n, d, k)\r
 192 'LOCATE 11, 1\r
 193 'PRINT g, n, d\r
 194 p = g\r
 195 m = n - 2\r
 196 IF n > 2 GOTO 120\r
 197 p = p - 1: m = m + 12\r
 198 120\r
 199 c = INT(p / 100)\r
 200 y = p - c * 100\r
 201 w = d + INT((13 * m - 1) / 5) + y + INT(y / 4) + INT(c / 4) - 2 * c\r
 202 k = w - 7 * INT(w / 7)\r
 203 IF k = 0 THEN k = 7\r
 204 END SUB\r
 205 \r
 206 SUB heli (a)\r
 207 'GOTO 10\r
 208 SELECT CASE a\r
 209 CASE 1\r
 210 FOR c = 1 TO 5\r
 211 SOUND 3000, 1\r
 212 SOUND 0, 1\r
 213 NEXT c\r
 214 \r
 215 CASE 2\r
 216 FOR c = 1 TO 5\r
 217 SOUND 2500, 1\r
 218 SOUND 0, 2\r
 219 NEXT c\r
 220 SOUND 2500, 10\r
 221 \r
 222 CASE 3\r
 223 FOR a = 1 TO 10\r
 224 SOUND 500, .5\r
 225 SOUND 1500, .5\r
 226 SOUND 2000, .5\r
 227 SOUND 1520, .5\r
 228 NEXT a\r
 229 \r
 230 \r
 231 CASE 4\r
 232 FOR a = 800 TO 1000 STEP 10\r
 233 SOUND a, .1\r
 234 SOUND a * 3, .1\r
 235 SOUND 0, 1\r
 236 NEXT a\r
 237 10\r
 238 \r
 239 END SELECT\r
 240 \r
 241 \r
 242 END SUB\r
 243 \r
 244 SUB inita\r
 245 apl = 0\r
 246 OPEN "aasta.ap" FOR INPUT AS #1\r
 247 5\r
 248 IF EOF(1) <> 0 THEN GOTO 3\r
 249 LINE INPUT #1, a$\r
 250 apl = apl + 1\r
 251 ap$(apl) = a$\r
 252 GOTO 5\r
 253 3\r
 254 CLOSE #1\r
 255 END SUB\r
 256 \r
 257 SUB initp (b$)\r
 258 ppl = 0\r
 259 OPEN b$ + ".pp" FOR INPUT AS #1\r
 260 6\r
 261 IF EOF(1) <> 0 THEN GOTO 7\r
 262 LINE INPUT #1, a$\r
 263 ppl = ppl + 1\r
 264 pp$(ppl) = a$\r
 265 GOTO 6\r
 266 7\r
 267 CLOSE #1\r
 268 END SUB\r
 269 \r
 270 SUB kell (a)\r
 271 b$ = TIME$ + DATE$\r
 272 IF b$ <> lk$ THEN lk$ = b$ ELSE GOTO 2\r
 273 \r
 274 heli 3\r
 275 \r
 276 SELECT CASE a\r
 277 CASE 1\r
 278 kola 4\r
 279 FOR b = 1 TO 15\r
 280 SOUND 0, 1\r
 281 NEXT b\r
 282 kola 1\r
 283 CASE 2\r
 284 kola 5\r
 285 END SELECT\r
 286 2\r
 287 END SUB\r
 288 \r
 289 SUB kola (a)\r
 290 timero = TIMER\r
 291 11\r
 292 FOR b = 1 TO 100\r
 293 OUT prt, 0\r
 294 OUT prt, 255\r
 295 NEXT b\r
 296 IF ABS(timero - TIMER) < a THEN GOTO 11\r
 297 END SUB\r
 298 \r
 299 SUB mnmain\r
 300 1\r
 301 b$ = LEFT$(TIME$, 5)\r
 302 IF b$ <> timo$ THEN chm\r
 303 timo$ = b$\r
 304 \r
 305 a$ = INKEY$\r
 306 \r
 307 IF a$ <> "" THEN\r
 308 IF ssave > ssavel THEN disp\r
 309 ssave = 0\r
 310 END IF\r
 311 \r
 312 IF a$ = CHR$(12) THEN\r
 313   IF kblukk = 1 THEN kblukk = 0 ELSE kblukk = 1\r
 314   displukk\r
 315 END IF\r
 316 IF kblukk = 1 THEN a$ = ""\r
 317 \r
 318 IF a$ = "s" THEN kell 1\r
 319 IF a$ = "v" THEN kell 2\r
 320 \r
 321 IF a$ = "a" THEN\r
 322 CLS\r
 323 PRINT "                  vana aeg: " + TIME$\r
 324 INPUT "sisesta uus aeg (TT:MM:SS): ", b$\r
 325 IF LEN(b$) <> 8 THEN GOTO 12\r
 326 TIME$ = b$\r
 327 timo$ = ""\r
 328 12\r
 329 disp\r
 330 END IF\r
 331 \r
 332 IF a$ = "d" THEN\r
 333 CLS\r
 334 PRINT "                    vana daatum: " + DATE$\r
 335 INPUT "sisesta uus daatum (KK-PP-AAAA): ", b$\r
 336 IF LEN(b$) <> 10 THEN GOTO 13\r
 337 DATE$ = b$\r
 338 timo$ = ""\r
 339 13\r
 340 disp\r
 341 END IF\r
 342 \r
 343 IF a$ = "7" OR a$ = "8" THEN\r
 344   b = VAL(RIGHT$(LEFT$(TIME$, 5), 2))\r
 345   IF a$ = "7" THEN b = b - 1\r
 346   IF a$ = "8" THEN b = b + 1\r
 347   IF b < 0 THEN b = 0\r
 348   IF b > 59 THEN b = 59\r
 349   d$ = STR$(b)\r
 350   IF LEFT$(d$, 1) = " " THEN d$ = RIGHT$(d$, LEN(d$) - 1)\r
 351   IF LEN(d$) < 2 THEN d$ = "0" + d$\r
 352   e$ = LEFT$(TIME$, 3) + d$ + RIGHT$(TIME$, 3)\r
 353   TIME$ = e$\r
 354 END IF\r
 355 \r
 356 IF a$ = "4" OR a$ = "5" THEN\r
 357   b = VAL(LEFT$(TIME$, 2))\r
 358   IF a$ = "4" THEN b = b - 1\r
 359   IF a$ = "5" THEN b = b + 1\r
 360   IF b < 0 THEN b = 0\r
 361   IF b > 23 THEN b = 23\r
 362   d$ = STR$(b)\r
 363   IF LEFT$(d$, 1) = " " THEN d$ = RIGHT$(d$, LEN(d$) - 1)\r
 364   IF LEN(d$) < 2 THEN d$ = "0" + d$\r
 365   e$ = d$ + RIGHT$(TIME$, 6)\r
 366   TIME$ = e$\r
 367 END IF\r
 368 \r
 369 IF a$ = "u" THEN sync2\r
 370 IF a$ = "l" THEN sync\r
 371 \r
 372 IF a$ = "r" THEN rese\r
 373 IF a$ = "q" THEN SYSTEM\r
 374 \r
 375 IF a$ = "j" THEN\r
 376 IF tunnidara = 0 THEN tunnidara = 1 ELSE tunnidara = 0\r
 377 dispt\r
 378 END IF\r
 379 \r
 380 IF ssave <= ssavel THEN\r
 381   LOCATE 11, 1\r
 382   PRINT TIME$\r
 383   LOCATE 12, 1\r
 384   PRINT DATE$\r
 385 ELSE\r
 386   IF ABS(TIMER - timero) > 10 THEN\r
 387   CLS\r
 388   kblukk = 1\r
 389   FOR b = 1 TO 20\r
 390     LOCATE RND * 22 + 1, RND * 79 + 1\r
 391     IF RND * 100 < 50 THEN PRINT "*" ELSE PRINT "."\r
 392   NEXT b\r
 393   LOCATE RND * 22 + 1, RND * 50 + 1\r
 394   COLOR 0, 7\r
 395   PRINT "< " + LEFT$(TIME$, 2);\r
 396   COLOR 16, 7\r
 397   PRINT ":";\r
 398   COLOR 0, 7\r
 399   PRINT RIGHT$(LEFT$(TIME$, 5), 2) + " >"\r
 400   COLOR 7, 0\r
 401   timero = TIMER\r
 402   END IF\r
 403 END IF\r
 404 GOTO 1\r
 405 \r
 406 \r
 407 END SUB\r
 408 \r
 409 SUB rese\r
 410 heli 4\r
 411 timo$ = ""\r
 412 dato$ = ""\r
 413 apl = 0\r
 414 END SUB\r
 415 \r
 416 SUB son (a$)\r
 417 \r
 418 FOR b = 1 TO 50\r
 419 sona$(b) = ""\r
 420 NEXT b\r
 421 mitus = 0\r
 422 \r
 423 b = 1\r
 424 FOR c = 1 TO LEN(a$)\r
 425 d$ = RIGHT$(LEFT$(a$, c), 1)\r
 426 IF d$ = " " OR d$ = CHR$(9) THEN\r
 427 b = 1\r
 428 ELSE\r
 429 IF b = 1 THEN b = 0: mitus = mitus + 1\r
 430 sona$(mitus) = sona$(mitus) + d$\r
 431 END IF\r
 432 NEXT c\r
 433 \r
 434 \r
 435 END SUB\r
 436 \r
 437 SUB start\r
 438 pn$(1) = "esmasp�ev"\r
 439 pn$(2) = "teisip�ev"\r
 440 pn$(3) = "kolmap�ev"\r
 441 pn$(4) = "neljap�ev"\r
 442 pn$(5) = "reede"\r
 443 pn$(6) = "laup�ev"\r
 444 pn$(7) = "p�hap�ev"\r
 445 \r
 446 prt = &H378\r
 447 \r
 448 ssavel = 2\r
 449 kblukk = 1\r
 450 tunnidara = 0\r
 451 END SUB\r
 452 \r
 453 SUB sync\r
 454 OPEN "sync.txt" FOR INPUT AS #1\r
 455 LINE INPUT #1, a$\r
 456 DATE$ = a$\r
 457 LINE INPUT #1, a$\r
 458 TIME$ = a$\r
 459 CLOSE #1\r
 460 \r
 461 heli 2\r
 462 END SUB\r
 463 \r
 464 SUB sync2\r
 465 a$ = TIME$\r
 466 a$ = LEFT$(a$, 5)\r
 467 b = VAL(RIGHT$(a$, 2))\r
 468 c = VAL(LEFT$(a$, 2))\r
 469 IF b >= 30 THEN c = c + 1\r
 470 b = 0\r
 471 IF c > 23 THEN c = c - 24\r
 472 a$ = RIGHT$(STR$(c), LEN(STR$(c)) - 1)\r
 473 b$ = RIGHT$(STR$(b), LEN(STR$(b)) - 1)\r
 474 IF LEN(a$) < 2 THEN a$ = "0" + a$\r
 475 IF LEN(b$) < 2 THEN b$ = "0" + b$\r
 476 a$ = a$ + ":" + b$\r
 477 \r
 478 'LOCATE 10, 1\r
 479 'PRINT a$\r
 480 \r
 481 TIME$ = a$\r
 482 \r
 483 heli 1\r
 484 END SUB\r
 485 \r