unsorted/timer.bas

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