unsorted/timer.bas

   1 CHDIR ".\qbasicapps\unsorted"\r
   2 \r
   3 \r
   4 DECLARE SUB bar ()\r
   5 DECLARE SUB help (a!)\r
   6 DECLARE SUB alarm (a!)\r
   7 DECLARE SUB gtw (y!, m!, t!, r!)\r
   8 DECLARE SUB daysm (y!, m!, d!)\r
   9 DECLARE SUB daysy (y!, d!)\r
  10 DECLARE SUB chdat ()\r
  11 DECLARE SUB entcla ()\r
  12 DECLARE SUB entcl ()\r
  13 DECLARE SUB clrc (a!)\r
  14 DECLARE SUB scroll ()\r
  15 DECLARE SUB ps (x!, y!, c!, s$)\r
  16 DECLARE SUB vbox (x1!, y1!, x2!, y2!, c!)\r
  17 DECLARE SUB quit ()\r
  18 DECLARE SUB start ()\r
  19 DECLARE SUB cns (a!, s$)\r
  20 DECLARE SUB getkey (a$)\r
  21 DECLARE SUB chkey (a$)\r
  22 DECLARE SUB entquit ()\r
  23 DECLARE SUB ented ()\r
  24 DECLARE SUB ed (p!)\r
  25 DECLARE SUB inpu (x!, y!, xl!, c!, a$)\r
  26 DECLARE SUB box (x!, y!, xl!, yl!, a$)\r
  27 DECLARE SUB sh ()\r
  28 \r
  29 DIM SHARED celh(1 TO 20)\r
  30 DIM SHARED celm(1 TO 20)\r
  31 DIM SHARED cels(1 TO 20)\r
  32 \r
  33 DIM SHARED celm1$(1 TO 20)\r
  34 DIM SHARED celm2$(1 TO 20)\r
  35 DIM SHARED celc$(1 TO 20)\r
  36 \r
  37 DIM SHARED celt(1 TO 20)' 0 - empty  1 - onece  2 - every day  3 - specified days\r
  38 DIM SHARED celw(1 TO 20, 1 TO 7)\r
  39 DIM SHARED celx(1 TO 20)\r
  40 \r
  41 DIM SHARED virt(1 TO 80, 1 TO 25)\r
  42 DIM SHARED tmr\r
  43 DIM SHARED slp(1 TO 20)\r
  44 DIM SHARED alq(1 TO 20)\r
  45 DIM SHARED alarmo\r
  46 \r
  47 DIM SHARED alqm\r
  48 DIM SHARED br$\r
  49 \r
  50 start\r
  51 \r
  52 sh\r
  53 1\r
  54 br$ = "Press F1 for help"\r
  55 getkey a$\r
  56 \r
  57 IF a$ = "q" THEN entquit\r
  58 IF a$ = "e" THEN ented\r
  59 IF a$ = "c" THEN entcl\r
  60 IF a$ = "d" THEN entcla\r
  61 IF a$ = CHR$(0) + CHR$(59) THEN help 1: getkey a$: sh\r
  62 GOTO 1\r
  63 \r
  64 SUB alarm (a)\r
  65 alq(a) = 1\r
  66 alarmo = 1\r
  67 'DIM SHARED celm1$(1 TO 20)\r
  68 'DIM SHARED celm2$(1 TO 20)\r
  69 'DIM SHARED celc$(1 TO 20)\r
  70 \r
  71 IF celc$(a) <> "" THEN\r
  72 SHELL celc$(a)\r
  73 END IF\r
  74 \r
  75 IF celm1$(a) <> "" OR celm2$(a) <> "" THEN\r
  76 OPEN "note.txt" FOR OUTPUT AS #1\r
  77 PRINT #1, celm1$(a)\r
  78 PRINT #1, celm2$(a)\r
  79 CLOSE #1\r
  80 SHELL "notepad note.txt"\r
  81 END IF\r
  82 \r
  83 \r
  84 FOR b = 100 TO 1000 STEP 20\r
  85 SOUND b, .1\r
  86 NEXT b\r
  87 END SUB\r
  88 \r
  89 SUB bar\r
  90 COLOR 0, 3\r
  91 LOCATE 22, 72\r
  92 PRINT CHR$(179) + TIME$\r
  93 \r
  94 br$ = br$ + SPACE$(80)\r
  95 br$ = LEFT$(br$, 70)\r
  96 LOCATE 22, 1\r
  97 PRINT " " + br$\r
  98 \r
  99 COLOR 7, 0\r
 100 END SUB\r
 101 \r
 102 SUB box (x, y, xl, yl, e$)\r
 103 vbox x, y, xl, yl, 1\r
 104 ' 201 205 187\r
 105 COLOR 11\r
 106 \r
 107 a$ = ""\r
 108 d$ = ""\r
 109 FOR a = 1 TO xl - 2\r
 110 a$ = a$ + CHR$(205)\r
 111 d$ = d$ + " "\r
 112 NEXT a\r
 113 b$ = CHR$(201) + a$ + CHR$(187)\r
 114 c$ = CHR$(200) + a$ + CHR$(188)\r
 115 d$ = CHR$(186) + d$ + CHR$(186)\r
 116 \r
 117 LOCATE y, x\r
 118 PRINT b$\r
 119 LOCATE y + yl - 1, x\r
 120 PRINT c$\r
 121 \r
 122 FOR a = 1 TO yl - 2\r
 123 LOCATE y + a, x\r
 124 PRINT d$\r
 125 NEXT a\r
 126 \r
 127 xt = INT(x + (xl / 2) - (LEN(e$) / 2) - 2)\r
 128 LOCATE y, xt\r
 129 PRINT "[ "\r
 130 xt = xt + 2\r
 131 \r
 132 COLOR 10\r
 133 LOCATE y, xt\r
 134 PRINT e$\r
 135 \r
 136 xt = xt + LEN(e$)\r
 137 \r
 138 COLOR 11\r
 139 LOCATE y, xt\r
 140 PRINT " ]"\r
 141 \r
 142 COLOR 7, 0\r
 143 END SUB\r
 144 \r
 145 SUB chdat\r
 146 a$ = DATE$\r
 147 qwy = VAL(RIGHT$(a$, 4))\r
 148 qwm = VAL(LEFT$(a$, 2))\r
 149 qwd = VAL(RIGHT$(LEFT$(a$, 5), 2))\r
 150 gtw qwy, qwm, qwd, w\r
 151 \r
 152 a$ = TIME$\r
 153 qes = VAL(RIGHT$(a$, 4))\r
 154 qeh = VAL(LEFT$(a$, 2))\r
 155 qem = VAL(RIGHT$(LEFT$(a$, 5), 2))\r
 156 \r
 157 IF alqm <> qem THEN\r
 158 alqm = qem\r
 159 \r
 160 FOR b = 1 TO 20\r
 161 alq(b) = 0\r
 162 NEXT b\r
 163 END IF\r
 164 \r
 165 \r
 166 'DIM SHARED celh(1 TO 20)\r
 167 'DIM SHARED celm(1 TO 20)\r
 168 'DIM SHARED cels(1 TO 20)\r
 169 \r
 170 \r
 171 FOR a = 1 TO 20\r
 172 IF celt(a) = 0 THEN GOTO 19\r
 173 IF celt(a) = 3 THEN IF celw(a, w) = 0 THEN GOTO 19\r
 174 IF alq(a) = 1 THEN GOTO 19\r
 175 IF celh(a) <> qeh THEN GOTO 19\r
 176 IF celm(a) <> qem THEN GOTO 19\r
 177 alarm a\r
 178 IF celt(a) = 1 THEN clrc a\r
 179 19\r
 180 NEXT a\r
 181 END SUB\r
 182 \r
 183 SUB chkey (a$)\r
 184 a$ = INKEY$\r
 185 \r
 186 IF a$ = "" THEN\r
 187 IF tmr > 4 THEN scroll: tmr = 1\r
 188 SOUND 0, 1\r
 189 IF alarmo = 1 THEN SOUND 2000, 1\r
 190 tmr = tmr + 1\r
 191 chdat\r
 192 bar\r
 193 ELSE\r
 194 IF alarmo = 1 THEN alarmo = 0: a$ = ""\r
 195 END IF\r
 196 END SUB\r
 197 \r
 198 SUB clrc (a)\r
 199 \r
 200 celh(a) = 0\r
 201 celm(a) = 0\r
 202 cels(a) = 0\r
 203 celt(a) = 0\r
 204 \r
 205 celm1$(a) = ""\r
 206 celm2$(a) = ""\r
 207 celc$(a) = ""\r
 208 \r
 209 FOR b = 1 TO 7\r
 210 celw(a, b) = 0\r
 211 NEXT b\r
 212 \r
 213 END SUB\r
 214 \r
 215 SUB cns (a, s$)\r
 216 s$ = STR$(a)\r
 217 IF LEFT$(s$, 1) = " " THEN s$ = RIGHT$(s$, LEN(s$) - 1)\r
 218 IF LEN(s$) = 1 THEN s$ = "0" + s$\r
 219 END SUB\r
 220 \r
 221 SUB daysm (y, m, d)\r
 222 SELECT CASE m\r
 223 CASE 1\r
 224 d = 31\r
 225 \r
 226 CASE 2\r
 227 IF y / 4 = y \ 4 THEN d = 29 ELSE d = 28\r
 228 \r
 229 CASE 3\r
 230 d = 31\r
 231 \r
 232 CASE 4\r
 233 d = 30\r
 234 \r
 235 CASE 5\r
 236 d = 31\r
 237 \r
 238 CASE 6\r
 239 d = 30\r
 240 \r
 241 CASE 7\r
 242 d = 31\r
 243 \r
 244 CASE 8\r
 245 d = 31\r
 246 \r
 247 CASE 9\r
 248 d = 30\r
 249 \r
 250 CASE 10\r
 251 d = 31\r
 252 \r
 253 CASE 11\r
 254 d = 30\r
 255 \r
 256 CASE 12\r
 257 d = 31\r
 258 END SELECT\r
 259 \r
 260 END SUB\r
 261 \r
 262 SUB daysy (y, d)\r
 263 d = 365\r
 264 IF y / 4 = y \ 4 THEN d = 366\r
 265 END SUB\r
 266 \r
 267 SUB ed (p)\r
 268 br$ = "Press F1 for help, ESC to close window, CTRL + ENTER accept"\r
 269 cns celh(p), s$\r
 270 tth$ = s$\r
 271 cns celm(p), s$\r
 272 ttm$ = s$\r
 273 cns cels(p), s$\r
 274 tts$ = s$\r
 275 \r
 276 ms1$ = celm1$(p)\r
 277 ms2$ = celm2$(p)\r
 278 cm1$ = celc$(p)\r
 279 \r
 280 DIM wks(1 TO 7)\r
 281 FOR a = 1 TO 7\r
 282 wks(a) = celw(p, a)\r
 283 NEXT a\r
 284 typ = celt(p)\r
 285 IF typ = 0 THEN typ = 1\r
 286 \r
 287 box 5, 5, 70, 11, "Edit entrie"\r
 288 LOCATE 7, 7\r
 289 PRINT "Enter time   (HH:MM:SS)"\r
 290 LOCATE 8, 23\r
 291 PRINT ":"\r
 292 LOCATE 8, 26\r
 293 PRINT ":"\r
 294 inpu 21, 8, 2, 1, tth$\r
 295 inpu 24, 8, 2, 1, ttm$\r
 296 inpu 27, 8, 2, 1, tts$\r
 297 \r
 298 LOCATE 10, 7\r
 299 PRINT "Enter message"\r
 300 inpu 21, 10, 52, 1, ms1$\r
 301 inpu 21, 11, 52, 1, ms2$\r
 302 \r
 303 LOCATE 13, 7\r
 304 PRINT "Enter command"\r
 305 inpu 21, 13, 52, 1, cm1$\r
 306 \r
 307 x = 1\r
 308 y = 1\r
 309 11\r
 310 \r
 311 IF typ = 1 THEN COLOR 14, 4 ELSE COLOR 14, 0\r
 312 LOCATE 7, 32\r
 313 PRINT "O";\r
 314 COLOR 7\r
 315 PRINT "nce"\r
 316 \r
 317 IF typ = 2 THEN COLOR 14, 4 ELSE COLOR 14, 0\r
 318 LOCATE 7, 38\r
 319 PRINT "D";\r
 320 COLOR 7\r
 321 PRINT "aily"\r
 322 \r
 323 IF typ = 3 THEN COLOR 14, 4 ELSE COLOR 14, 0\r
 324 LOCATE 7, 45\r
 325 PRINT "S";\r
 326 COLOR 7\r
 327 PRINT "pecified weekdays"\r
 328 \r
 329 FOR a = 1 TO 7\r
 330 IF wks(a) = 1 THEN COLOR 10, 0 ELSE COLOR 8, 0\r
 331 LOCATE 8, 44 + (a * 2)\r
 332 PRINT a\r
 333 NEXT a\r
 334 \r
 335 \r
 336 c = 0\r
 337 \r
 338 IF y = 1 THEN\r
 339 IF x = 1 THEN inpu 21, 8, 2, c, tth$\r
 340 IF x = 2 THEN inpu 24, 8, 2, c, ttm$\r
 341 IF x = 3 THEN inpu 27, 8, 2, c, tts$\r
 342 END IF\r
 343 \r
 344 IF y = 2 THEN inpu 21, 10, 52, c, ms1$\r
 345 IF y = 3 THEN inpu 21, 11, 52, c, ms2$\r
 346 IF y = 4 THEN inpu 21, 13, 52, c, cm1$\r
 347 \r
 348 IF c = 100 THEN GOTO 13\r
 349 IF c = 102 THEN x = x + 1\r
 350 IF c = 103 THEN x = x - 1\r
 351 IF c = 104 THEN y = y - 1\r
 352 IF c = 105 THEN y = y + 1\r
 353 IF c = 106 THEN GOTO 12\r
 354 \r
 355 tg = 0\r
 356 IF c = 107 THEN tg = 1\r
 357 IF c = 108 THEN tg = 2\r
 358 IF c = 109 THEN tg = 3\r
 359 IF c = 110 THEN tg = 4\r
 360 IF c = 111 THEN tg = 5\r
 361 IF c = 112 THEN tg = 6\r
 362 IF c = 113 THEN tg = 7\r
 363 \r
 364 IF c = 114 THEN typ = 1\r
 365 IF c = 115 THEN typ = 2\r
 366 IF c = 116 THEN typ = 3\r
 367 \r
 368 IF c = 117 THEN help 2\r
 369 \r
 370 IF tg > 0 THEN\r
 371 IF wks(tg) = 0 THEN wks(tg) = 1 ELSE wks(tg) = 0\r
 372 END IF\r
 373 \r
 374 IF c = 101 THEN\r
 375 IF y = 1 THEN x = x + 1 ELSE y = y + 1\r
 376 END IF\r
 377 \r
 378 \r
 379 IF y > 4 THEN y = 4\r
 380 IF y < 1 THEN y = 1\r
 381 IF x > 3 THEN x = 1: y = y + 1\r
 382 IF x < 1 THEN x = 1\r
 383 \r
 384 \r
 385 GOTO 11\r
 386 12\r
 387 celh(p) = VAL(tth$)\r
 388 celm(p) = VAL(ttm$)\r
 389 cels(p) = VAL(tts$)\r
 390 \r
 391 celm1$(p) = ms1$\r
 392 celm2$(p) = ms2$\r
 393 celc$(p) = cm1$\r
 394 celt(p) = typ\r
 395 \r
 396 \r
 397 FOR a = 1 TO 7\r
 398 celw(p, a) = wks(a)\r
 399 NEXT a\r
 400 13\r
 401 \r
 402 END SUB\r
 403 \r
 404 SUB entcl\r
 405 a$ = "01"\r
 406 box 20, 10, 40, 5, "Clear entrie"\r
 407 \r
 408 LOCATE 12, 23\r
 409 PRINT "Which cell do you need to clear?"\r
 410 \r
 411 15\r
 412 inpu 55, 12, 2, c, a$\r
 413 IF c = 100 THEN GOTO 16\r
 414 IF c = 101 THEN\r
 415 clrc VAL(a$)\r
 416 GOTO 16\r
 417 END IF\r
 418 GOTO 15\r
 419 \r
 420 16\r
 421 sh\r
 422 END SUB\r
 423 \r
 424 SUB entcla\r
 425 \r
 426 box 15, 10, 50, 6, "Clearing"\r
 427 \r
 428 18\r
 429 LOCATE 12, 21\r
 430 PRINT "Are you sure you want to clear all cells?"\r
 431 LOCATE 13, 36\r
 432 PRINT "[ Y / N ]"\r
 433 \r
 434 \r
 435 getkey a$\r
 436 IF a$ = "y" OR a$ = "Y" THEN\r
 437 FOR a = 1 TO 20\r
 438 clrc a\r
 439 NEXT a\r
 440 GOTO 17\r
 441 END IF\r
 442 IF a$ = "n" OR a$ = "N" THEN GOTO 17\r
 443 box 15, 10, 50, 8, "Clearing"\r
 444 LOCATE 15, 30\r
 445 COLOR 28\r
 446 PRINT "Use keys 'Y' or 'N'"\r
 447 COLOR 7\r
 448 GOTO 18\r
 449 \r
 450 17\r
 451 sh\r
 452 \r
 453 \r
 454 END SUB\r
 455 \r
 456 SUB ented\r
 457 br$ = "Enter cell number in range of 1 to 20"\r
 458 a$ = "01"\r
 459 box 20, 10, 40, 5, "Edit entrie"\r
 460 \r
 461 9\r
 462 LOCATE 12, 23\r
 463 PRINT "Which cell do you need to edit?"\r
 464 'SUB inpu (x, y, xl, c, a$)\r
 465 \r
 466 6\r
 467 c = 0\r
 468 inpu 55, 12, 2, c, a$\r
 469 IF c = 100 THEN GOTO 7\r
 470 IF c = 101 THEN\r
 471 b = VAL(a$)\r
 472 \r
 473 IF b = 0 THEN\r
 474 IF a$ = " 0" OR a$ = "0 " OR a$ = "00" OR a$ = "-0" THEN GOTO 10\r
 475 box 20, 10, 40, 9, "Edit entrie"\r
 476 COLOR 12, 0\r
 477 LOCATE 14, 23\r
 478 PRINT "    Letters aren't allowed"\r
 479 LOCATE 15, 23\r
 480 PRINT "  enter number, or press ESC "\r
 481 COLOR 7\r
 482 GOTO 9\r
 483 END IF\r
 484 \r
 485 IF b < 1 OR b > 20 THEN\r
 486 10\r
 487 box 20, 10, 40, 9, "Edit entrie"\r
 488 COLOR 12, 0\r
 489 LOCATE 14, 23\r
 490 PRINT "   The entered number must be in"\r
 491 LOCATE 15, 23\r
 492 PRINT "    the range between 1 and 20"\r
 493 LOCATE 16, 23\r
 494 PRINT "enter correct number, or press ESC"\r
 495 COLOR 7\r
 496 GOTO 9\r
 497 END IF\r
 498 \r
 499 IF (b > 0) AND (b < 21) THEN sh: ed b: GOTO 7\r
 500 \r
 501 END IF\r
 502 GOTO 6\r
 503 7\r
 504 \r
 505 sh\r
 506 END SUB\r
 507 \r
 508 SUB entquit\r
 509 \r
 510 box 15, 10, 50, 6, "Quitting"\r
 511 \r
 512 5\r
 513 LOCATE 12, 21\r
 514 PRINT "Are you really sure you want to quit?"\r
 515 LOCATE 13, 36\r
 516 PRINT "[ Y / N ]"\r
 517 \r
 518 \r
 519 getkey a$\r
 520 IF a$ = "y" OR a$ = "Y" THEN quit\r
 521 IF a$ = "n" OR a$ = "N" THEN GOTO 4\r
 522 box 15, 10, 50, 8, "Quitting"\r
 523 LOCATE 15, 30\r
 524 COLOR 28\r
 525 PRINT "Use keys 'Y' or 'N'"\r
 526 COLOR 7\r
 527 GOTO 5\r
 528 \r
 529 4\r
 530 sh\r
 531 \r
 532 END SUB\r
 533 \r
 534 SUB getkey (a$)\r
 535 3\r
 536 chkey a$\r
 537 IF a$ = "" THEN GOTO 3\r
 538 \r
 539 END SUB\r
 540 \r
 541 SUB gtw (y, m, t, r)\r
 542 d = 0\r
 543 FOR a = 1500 TO y - 1\r
 544 daysy a, b\r
 545 d = d + b\r
 546 NEXT a\r
 547 \r
 548 FOR a = 1 TO m - 1\r
 549 daysm y, a, b\r
 550 d = d + b\r
 551 NEXT a\r
 552 \r
 553 d = d + t + 2\r
 554 r = (d MOD 7) + 1\r
 555 \r
 556 END SUB\r
 557 \r
 558 SUB help (a)\r
 559 SELECT CASE a\r
 560 CASE 1\r
 561 box 20, 3, 41, 17, "Help"\r
 562 \r
 563 LOCATE 5, 24\r
 564 PRINT "q - quit program"\r
 565 LOCATE 6, 24\r
 566 PRINT "c - clear cell"\r
 567 LOCATE 7, 24\r
 568 PRINT "d - clear all cells"\r
 569 LOCATE 8, 24\r
 570 PRINT "e - edit cell"\r
 571 \r
 572 COLOR 14\r
 573 LOCATE 10, 24\r
 574 PRINT "This program allows you to"\r
 575 LOCATE 11, 24\r
 576 PRINT "shedle messages and commands"\r
 577 LOCATE 12, 24\r
 578 PRINT "to specified time: once, daily"\r
 579 LOCATE 13, 24\r
 580 PRINT "and specified weekdays."\r
 581 \r
 582 LOCATE 15, 24\r
 583 PRINT "   Copyright"\r
 584 LOCATE 16, 24\r
 585 PRINT "Vladimir German &"\r
 586 LOCATE 17, 24\r
 587 PRINT "Svjatoslav Agejenko"\r
 588 br$ = "Press any key to close this window"\r
 589 \r
 590 CASE 2\r
 591 box 3, 16, 76, 5, "Help: allowed keys"\r
 592 LOCATE 17, 5\r
 593 PRINT "CTRL + F1..F7  - toggle weekdays     CTRL + O/D/S - toggle modes"\r
 594 LOCATE 18, 5\r
 595 PRINT "Arrow keys - to move around          CTRL + ENTER - Accept"\r
 596 LOCATE 19, 5\r
 597 PRINT "ESC - close window"\r
 598 br$ = "You can continue editing ..."\r
 599 \r
 600 \r
 601 END SELECT\r
 602 \r
 603 \r
 604 \r
 605 END SUB\r
 606 \r
 607 SUB inpu (x, y, xl, c, a$)\r
 608 \r
 609 x1 = 1\r
 610 \r
 611 2\r
 612 a$ = a$ + SPACE$(100)\r
 613 a$ = LEFT$(a$, xl)\r
 614 \r
 615 COLOR 11, 1\r
 616 LOCATE y, x\r
 617 PRINT a$\r
 618 \r
 619 IF c = 1 THEN GOTO 8\r
 620 COLOR 30, 2\r
 621 LOCATE y, x + x1 - 1\r
 622 PRINT RIGHT$(LEFT$(a$, x1), 1)\r
 623 \r
 624 getkey b$\r
 625 \r
 626 IF b$ = CHR$(27) THEN c = 100: GOTO 8\r
 627 IF b$ = CHR$(13) THEN c = 101: GOTO 8\r
 628 \r
 629 IF (ASC(b$) > 31) AND (ASC(b$) < 122) AND (LEN(b$) = 1) THEN\r
 630 a$ = LEFT$(a$, x1 - 1) + b$ + (RIGHT$(a$, xl - x1 + 1))\r
 631 x1 = x1 + 1\r
 632 END IF\r
 633 \r
 634 IF b$ = CHR$(8) THEN\r
 635 IF x1 > 1 THEN\r
 636 a$ = LEFT$(a$, x1 - 2) + RIGHT$(a$, xl - x1 + 1)\r
 637 x1 = x1 - 1\r
 638 END IF\r
 639 END IF\r
 640 \r
 641 IF b$ = CHR$(0) + "M" THEN x1 = x1 + 1\r
 642 IF b$ = CHR$(0) + "K" THEN x1 = x1 - 1\r
 643 IF b$ = CHR$(0) + CHR$(94) THEN c = 107: GOTO 8\r
 644 IF b$ = CHR$(0) + CHR$(95) THEN c = 108: GOTO 8\r
 645 IF b$ = CHR$(0) + CHR$(96) THEN c = 109: GOTO 8\r
 646 IF b$ = CHR$(0) + CHR$(97) THEN c = 110: GOTO 8\r
 647 IF b$ = CHR$(0) + CHR$(98) THEN c = 111: GOTO 8\r
 648 IF b$ = CHR$(0) + CHR$(99) THEN c = 112: GOTO 8\r
 649 IF b$ = CHR$(0) + CHR$(100) THEN c = 113: GOTO 8\r
 650 IF b$ = CHR$(0) + CHR$(59) THEN c = 117: GOTO 8\r
 651 \r
 652 IF b$ = CHR$(0) + "S" THEN a$ = LEFT$(a$, x1 - 1) + RIGHT$(a$, xl - x1)\r
 653 IF x1 < 1 THEN x1 = 1: c = 103: GOTO 8\r
 654 IF x1 > xl THEN x1 = xl: c = 102: GOTO 8\r
 655 IF b$ = CHR$(0) + "H" THEN c = 104: GOTO 8\r
 656 IF b$ = CHR$(0) + "P" THEN c = 105: GOTO 8\r
 657 \r
 658 IF b$ = CHR$(10) THEN c = 106: GOTO 8\r
 659 IF b$ = CHR$(15) THEN c = 114: GOTO 8\r
 660 IF b$ = CHR$(4) THEN c = 115: GOTO 8\r
 661 IF b$ = CHR$(19) THEN c = 116: GOTO 8\r
 662 \r
 663 \r
 664 GOTO 2\r
 665 8\r
 666 \r
 667 a$ = a$ + SPACE$(100)\r
 668 a$ = LEFT$(a$, xl)\r
 669 COLOR 11, 1\r
 670 LOCATE y, x\r
 671 PRINT a$\r
 672 \r
 673 IF a$ = SPACE$(LEN(a$)) THEN\r
 674 a$ = ""\r
 675 ELSE\r
 676 14\r
 677 IF RIGHT$(a$, 1) = " " THEN a$ = LEFT$(a$, LEN(a$) - 1): GOTO 14\r
 678 END IF\r
 679 \r
 680 COLOR 7, 0\r
 681 END SUB\r
 682 \r
 683 SUB ps (x, y, c, s$)\r
 684 COLOR c\r
 685 FOR a = 1 TO LEN(s$)\r
 686 x1 = x + a - 1\r
 687 IF (x1 > 21) AND (x1 < 81) THEN\r
 688 IF virt(x1, y) = 0 THEN\r
 689 LOCATE y, x1\r
 690 PRINT RIGHT$(LEFT$(s$, a), 1)\r
 691 END IF\r
 692 END IF\r
 693 NEXT a\r
 694 END SUB\r
 695 \r
 696 SUB quit\r
 697 'DIM SHARED celh(1 TO 20)\r
 698 'DIM SHARED celm(1 TO 20)\r
 699 'DIM SHARED cels(1 TO 20)\r
 700 \r
 701 'DIM SHARED celm1$(1 TO 20)\r
 702 'DIM SHARED celm2$(1 TO 20)\r
 703 'DIM SHARED celc$(1 TO 20)\r
 704 \r
 705 'DIM SHARED celt(1 TO 20)' 0 - empty  1 - onece  2 - every day  3 - specified days\r
 706 'DIM SHARED celw(1 TO 20, 1 TO 7)\r
 707 \r
 708 \r
 709 OPEN "tim.dat" FOR OUTPUT AS #1\r
 710 FOR a = 1 TO 20\r
 711 PRINT #1, celh(a); celm(a); cels(a); celt(a)\r
 712 FOR b = 1 TO 6\r
 713 PRINT #1, celw(a, b);\r
 714 NEXT b\r
 715 PRINT #1, celw(a, 7)\r
 716 \r
 717 PRINT #1, celm1$(a)\r
 718 PRINT #1, celm2$(a)\r
 719 PRINT #1, celc$(a)\r
 720 NEXT a\r
 721 CLOSE #1\r
 722 SYSTEM\r
 723 END SUB\r
 724 \r
 725 SUB scroll\r
 726 'ps RND * 60 + 1, RND * 20 + 1, RND * 13 + 1, "asi"\r
 727 \r
 728 'DIM SHARED celm1$(1 TO 20)\r
 729 'DIM SHARED celm2$(1 TO 20)\r
 730 'DIM SHARED celc$(1 TO 20)\r
 731 'DIM SHARED celx(1 TO 20)\r
 732 COLOR 7, 0\r
 733 \r
 734 FOR a = 1 TO 20\r
 735 le = LEN(celm1$(a) + celm2$(a) + celc$(a)) + 2\r
 736 IF le > 59 THEN\r
 737   x = 22 - celx(a)\r
 738   IF slp(a) > 0 THEN\r
 739     slp(a) = slp(a) - 1\r
 740   ELSE\r
 741     celx(a) = celx(a) + 1\r
 742     IF x + le < 83 THEN slp(a) = 10\r
 743     IF x + le < 82 THEN slp(a) = 10: celx(a) = 0\r
 744   END IF\r
 745 ELSE\r
 746   x = 22\r
 747 END IF\r
 748 \r
 749 ps x, a + 1, 10, celc$(a) + " "\r
 750 x = x + LEN(celc$(a)) + 1\r
 751 ps x, a + 1, 14, celm1$(a) + " "\r
 752 x = x + LEN(celm1$(a)) + 1\r
 753 ps x, a + 1, 14, celm2$(a) + " "\r
 754 \r
 755 NEXT a\r
 756 \r
 757 END SUB\r
 758 \r
 759 SUB sh\r
 760 vbox 1, 1, 80, 25, 0\r
 761 CLS\r
 762 LOCATE 1, 1\r
 763 COLOR 0, 3\r
 764 PRINT "Num|  Time  | When? | Command & Message                                         "\r
 765 COLOR 7, 0\r
 766 \r
 767 FOR a = 1 TO 20\r
 768 COLOR 14\r
 769 IF a < 10 THEN LOCATE a + 1, 2 ELSE LOCATE a + 1, 1\r
 770 PRINT a\r
 771 \r
 772 COLOR 3\r
 773 LOCATE a + 1, 4\r
 774 PRINT "|"\r
 775 \r
 776 \r
 777 LOCATE a + 1, 5\r
 778 COLOR 14\r
 779 IF celt(a) = 0 THEN\r
 780 PRINT "-- -- --"\r
 781 ELSE\r
 782 COLOR 14\r
 783 cns celh(a), s$\r
 784 PRINT s$\r
 785 LOCATE a + 1, 8\r
 786 cns celm(a), s$\r
 787 PRINT s$\r
 788 LOCATE a + 1, 11\r
 789 cns cels(a), s$\r
 790 PRINT s$\r
 791 END IF\r
 792 COLOR 30\r
 793 LOCATE a + 1, 7\r
 794 PRINT ":"\r
 795 LOCATE a + 1, 10\r
 796 PRINT ":"\r
 797 \r
 798 COLOR 3\r
 799 LOCATE a + 1, 13\r
 800 PRINT "|"\r
 801 LOCATE a + 1, 14\r
 802 \r
 803 IF celt(a) = 1 THEN\r
 804 COLOR 14\r
 805 PRINT " Once"\r
 806 END IF\r
 807 \r
 808 IF celt(a) = 2 THEN\r
 809 COLOR 14\r
 810 PRINT " Daily"\r
 811 END IF\r
 812 \r
 813 IF celt(a) = 3 THEN\r
 814 COLOR 10\r
 815 FOR b = 1 TO 7\r
 816 'DIM SHARED celw(1 TO 20, 1 TO 7)\r
 817 LOCATE a + 1, 13 + b\r
 818 IF celw(a, b) = 1 THEN PRINT RIGHT$(STR$(b), 1)\r
 819 NEXT b\r
 820 END IF\r
 821 \r
 822 COLOR 3\r
 823 LOCATE a + 1, 21\r
 824 PRINT "|"\r
 825 \r
 826 NEXT a\r
 827 \r
 828 END SUB\r
 829 \r
 830 SUB start\r
 831 \r
 832 OPEN "tim.dat" FOR INPUT AS #1\r
 833 FOR a = 1 TO 20\r
 834 INPUT #1, celh(a), celm(a), cels(a), celt(a)\r
 835 FOR b = 1 TO 7\r
 836 INPUT #1, celw(a, b)\r
 837 NEXT b\r
 838 \r
 839 LINE INPUT #1, celm1$(a)\r
 840 LINE INPUT #1, celm2$(a)\r
 841 LINE INPUT #1, celc$(a)\r
 842 NEXT a\r
 843 CLOSE #1\r
 844 \r
 845 alarmo = 0\r
 846 END SUB\r
 847 \r
 848 SUB vbox (x1, y1, x2, y2, c)\r
 849 FOR y = y1 TO y1 + y2 - 1\r
 850 FOR x = x1 TO x1 + x2 - 1\r
 851 virt(x, y) = c\r
 852 NEXT x\r
 853 NEXT y\r
 854 END SUB\r
 855 \r