games/worm/worm.bas

   1 ' Worm game\r
   2 ' by Svjatoslav Agejenko 2002\r
   3 ' E-mail: svjatoslavagejenko@gmail.com\r
   4 \r
   5 DECLARE FUNCTION cnum$ (a%)\r
   6 DECLARE SUB putworm (a%)\r
   7 DECLARE SUB level (a%)\r
   8 DECLARE SUB showb ()\r
   9 DECLARE SUB sc2 (x%, y%)\r
  10 DECLARE SUB ai (a%)\r
  11 DECLARE SUB autop (a%)\r
  12 DECLARE SUB stat ()\r
  13 DECLARE SUB prc (a%)\r
  14 DECLARE SUB stuff ()\r
  15 DECLARE SUB dead (a%)\r
  16 DECLARE SUB add (a%)\r
  17 DECLARE SUB tkt ()\r
  18 DECLARE SUB subt (b%)\r
  19 DECLARE SUB show ()\r
  20 DECLARE SUB start ()\r
  21 DECLARE SUB init ()\r
  22 DECLARE SUB sc (x%, y%)\r
  23 DEFINT A-Z\r
  24 \r
  25 DIM SHARED buf(0 TO 36, 0 TO 36)\r
  26 DIM SHARED buf2(0 TO 36, 0 TO 36)\r
  27 DIM SHARED ussx(1 TO 2000, 1 TO 5)\r
  28 DIM SHARED ussy(1 TO 2000, 1 TO 5)\r
  29 DIM SHARED ussp(1 TO 5)\r
  30 DIM SHARED ussl(1 TO 5)\r
  31 DIM SHARED usss(1 TO 5)\r
  32 DIM SHARED ussk(1 TO 2000, 1 TO 5)\r
  33 DIM SHARED usskp(1 TO 5)\r
  34 \r
  35 DIM SHARED ux(1 TO 5), uy(1 TO 5), uxp(1 TO 5), uyp(1 TO 5)\r
  36 DIM SHARED mtm\r
  37 DIM SHARED ussm\r
  38 DIM SHARED elud(1 TO 5)\r
  39 DIM SHARED auto(1 TO 5)\r
  40 DIM SHARED ail, lvl, wai\r
  41 DIM SHARED elum\r
  42 DIM SHARED spd\r
  43 \r
  44 ussm = 1\r
  45 ail = 10\r
  46 lvl = 1\r
  47 wai = 0\r
  48 wai = 20\r
  49 \r
  50 \r
  51 auto(1) = 0\r
  52 auto(2) = 0\r
  53 auto(3) = 0\r
  54 auto(4) = 0\r
  55 auto(5) = 0\r
  56 CLS\r
  57 \r
  58 INPUT "How mutch players 1 - 5:", ussm\r
  59 INPUT "How mutch of them is computers:", a\r
  60 FOR b = ussm TO ussm - a + 1 STEP -1\r
  61 auto(b) = 1\r
  62 NEXT b\r
  63 \r
  64 INPUT "How mutch lives:", elum\r
  65 INPUT "Speed: (1-slow 3-ok 10-very fast)", spd\r
  66 \r
  67 \r
  68 start\r
  69 \r
  70 level lvl\r
  71 1\r
  72 tkt\r
  73 SOUND 0, 5 / spd\r
  74 IF mtm >= 15 THEN\r
  75 mtm = 1\r
  76 lvl = lvl + 1\r
  77 level lvl\r
  78 END IF\r
  79 GOTO 1\r
  80 \r
  81 SUB ai (a)\r
  82 \r
  83 \r
  84 FOR y = 0 TO 36\r
  85 FOR x = 0 TO 36\r
  86 buf2(x, y) = 32000\r
  87 IF buf(x, y) = 2 THEN buf2(x, y) = 0\r
  88 IF buf(x, y) > 9 OR buf(x, y) = 1 THEN buf2(x, y) = -1\r
  89 NEXT x\r
  90 NEXT y\r
  91 \r
  92 IF buf2(16, 16) = 32000 THEN buf2(16, 16) = 15000\r
  93 \r
  94 \r
  95 6\r
  96 b = 0\r
  97 FOR y = 1 TO 35\r
  98 FOR x = 1 TO 34\r
  99 IF (buf2(x + 1, y) > buf2(x, y) + 1) AND (buf2(x, y) >= 0) THEN buf2(x + 1, y) = buf2(x, y) + 1: b = 1\r
 100 NEXT x\r
 101 FOR x = 35 TO 2 STEP -1\r
 102 IF (buf2(x - 1, y) > buf2(x, y) + 1) AND (buf2(x, y) >= 0) THEN buf2(x - 1, y) = buf2(x, y) + 1: b = 1\r
 103 NEXT x\r
 104 \r
 105 IF (buf2(1, y) > buf2(35, y) + 1) AND (buf2(35, y) >= 0) THEN buf2(1, y) = buf2(35, y) + 1: b = 1\r
 106 IF (buf2(35, y) > buf2(1, y) + 1) AND (buf2(1, y) >= 0) THEN buf2(35, y) = buf2(1, y) + 1: b = 1\r
 107 NEXT y\r
 108 \r
 109 FOR x = 1 TO 35\r
 110 FOR y = 1 TO 34\r
 111 IF (buf2(x, y + 1) > buf2(x, y) + 1) AND (buf2(x, y) >= 0) THEN buf2(x, y + 1) = buf2(x, y) + 1: b = 1\r
 112 NEXT y\r
 113 FOR y = 35 TO 2 STEP -1\r
 114 IF (buf2(x, y - 1) > buf2(x, y) + 1) AND (buf2(x, y) >= 0) THEN buf2(x, y - 1) = buf2(x, y) + 1: b = 1\r
 115 NEXT y\r
 116 \r
 117 \r
 118 IF (buf2(x, 1) > buf2(x, 35) + 1) AND (buf2(x, 35) >= 0) THEN buf2(x, 1) = buf2(x, 35) + 1: b = 1\r
 119 IF (buf2(x, 35) > buf2(x, 1) + 1) AND (buf2(x, 1) >= 0) THEN buf2(x, 35) = buf2(x, 1) + 1: b = 1\r
 120 NEXT x\r
 121 \r
 122 IF b = 1 THEN GOTO 6\r
 123 \r
 124 tx = ux(a)\r
 125 ty = uy(a)\r
 126 'sc2 tx, ty\r
 127 \r
 128 d = 0\r
 129 7\r
 130 b = 32001\r
 131 tmpxp = 0\r
 132 tmpyp = 0\r
 133 IF (buf2(tx - 1, ty) < b) AND (buf2(tx - 1, ty) >= 0) THEN b = buf2(tx - 1, ty): tmpxp = -1: tmpyp = 0: c = 1\r
 134 IF (buf2(tx, ty - 1) < b) AND (buf2(tx, ty - 1) >= 0) THEN b = buf2(tx, ty - 1): tmpxp = 0: tmpyp = -1: c = 2\r
 135 IF (buf2(tx + 1, ty) < b) AND (buf2(tx + 1, ty) >= 0) THEN b = buf2(tx + 1, ty): tmpxp = 1: tmpyp = 0: c = 3\r
 136 IF (buf2(tx, ty + 1) < b) AND (buf2(tx, ty + 1) >= 0) THEN b = buf2(tx, ty + 1): tmpxp = 0: tmpyp = 1: c = 4\r
 137 \r
 138 IF b = 32001 THEN\r
 139 'SOUND 3000, 1\r
 140 tmpxp = -1\r
 141 tmpyp = 0\r
 142 c = 1\r
 143 b = -1\r
 144 END IF\r
 145 \r
 146 buf2(tx, ty) = -1\r
 147 d = d + 1\r
 148 ussk(d, a) = c\r
 149 tx = tx + tmpxp\r
 150 ty = ty + tmpyp\r
 151 IF tx = 1 THEN tx = 34\r
 152 IF ty = 1 THEN ty = 34\r
 153 IF tx = 35 THEN tx = 2\r
 154 IF ty = 35 THEN ty = 2\r
 155 e = buf2(tx, ty)\r
 156 buf2(tx, ty) = -1\r
 157 \r
 158 sc2 tx, ty\r
 159 IF d > ail THEN GOTO 8\r
 160 IF (e > 0) AND (b > -1) THEN GOTO 7\r
 161 8\r
 162 d = d + 1\r
 163 ussk(d, a) = 5\r
 164 usskp(a) = 1\r
 165 \r
 166 'DIM SHARED ussk(1 TO 2000, 1 TO 5)\r
 167 'DIM SHARED usskp(1 TO 5)\r
 168 \r
 169 \r
 170 showb\r
 171 \r
 172 END SUB\r
 173 \r
 174 SUB autop (a)\r
 175 c = 0\r
 176 5\r
 177 IF usskp(a) > 0 THEN\r
 178 b = ussk(usskp(a), a)\r
 179 IF b = 1 THEN uxp(a) = -1: uyp(a) = 0\r
 180 IF b = 2 THEN uxp(a) = 0: uyp(a) = -1\r
 181 IF b = 3 THEN uxp(a) = 1: uyp(a) = 0\r
 182 IF b = 4 THEN uxp(a) = 0: uyp(a) = 1\r
 183 IF b = 5 THEN ai a: GOTO 5\r
 184 usskp(a) = usskp(a) + 1\r
 185 END IF\r
 186 \r
 187 nx = ux(a) + uxp(a)\r
 188 ny = uy(a) + uyp(a)\r
 189 b = buf(INT(nx), INT(ny))\r
 190 IF (b = 1 OR b > 9) AND (c = 0) THEN ai a: c = 1: GOTO 5\r
 191 \r
 192 \r
 193 END SUB\r
 194 \r
 195 FUNCTION cnum$ (a)\r
 196 \r
 197 b$ = STR$(a)\r
 198 IF LEFT$(b$, 1) = " " THEN b$ = RIGHT$(b$, LEN(b$) - 1)\r
 199 cnum$ = b$\r
 200 \r
 201 END FUNCTION\r
 202 \r
 203 SUB dead (a)\r
 204 elud(a) = elud(a) - 1\r
 205 putworm a\r
 206 END SUB\r
 207 \r
 208 SUB init\r
 209 level 1\r
 210 END SUB\r
 211 \r
 212 SUB level (a)\r
 213 LOCATE 5, 5\r
 214 PRINT "G E T   R E A D Y"\r
 215 LOCATE 7, 5\r
 216 PRINT "L E V E L :"; a\r
 217 \r
 218 FOR b = 1 TO wai\r
 219 SOUND 0, 1\r
 220 NEXT b\r
 221 CLS\r
 222 \r
 223 \r
 224 FOR y = 0 TO 36\r
 225 FOR x = 0 TO 36\r
 226 buf(x, y) = 0\r
 227 NEXT x\r
 228 NEXT y\r
 229 \r
 230 FOR x = 0 TO 36\r
 231 buf(x, 0) = 1\r
 232 buf(x, 36) = 1\r
 233 buf(0, x) = 1\r
 234 buf(36, x) = 1\r
 235 NEXT x\r
 236 \r
 237 \r
 238 \r
 239 b$ = cnum(a) + ".lvl"\r
 240 OPEN b$ FOR INPUT AS #1\r
 241 d = 0\r
 242 10\r
 243 IF EOF(1) <> 0 THEN GOTO 11\r
 244 LINE INPUT #1, c$\r
 245 IF LEFT$(c$, 1) = "/" THEN\r
 246 d = d + 1\r
 247 IF d > 35 THEN GOTO 12\r
 248 g = LEN(c$)\r
 249 IF g > 36 THEN g = 36\r
 250 FOR e = 2 TO g\r
 251 f$ = RIGHT$(LEFT$(c$, e), 1)\r
 252 IF f$ = "#" OR f$ = "m" THEN buf(e - 1, d) = 1 ELSE buf(e - 1, d) = 0\r
 253 NEXT e\r
 254 END IF\r
 255 12\r
 256 \r
 257 GOTO 10\r
 258 11\r
 259 \r
 260 CLOSE #1\r
 261 \r
 262 \r
 263 stuff\r
 264 show\r
 265 \r
 266 \r
 267 FOR b = 1 TO ussm\r
 268 ussl(b) = 0\r
 269 putworm b\r
 270 NEXT b\r
 271 stat\r
 272 END SUB\r
 273 \r
 274 SUB prc (a)\r
 275 \r
 276 subt a\r
 277 ussp(a) = ussp(a) + 1\r
 278 \r
 279 IF elud(a) = 0 THEN GOTO 4\r
 280 \r
 281 IF auto(a) = 1 THEN autop a\r
 282 \r
 283 \r
 284 \r
 285 ux(a) = ux(a) + uxp(a)\r
 286 uy(a) = uy(a) + uyp(a)\r
 287 IF ux(a) = 35 THEN ux(a) = 2\r
 288 IF uy(a) = 35 THEN uy(a) = 2\r
 289 IF ux(a) = 1 THEN ux(a) = 34\r
 290 IF uy(a) = 1 THEN uy(a) = 34\r
 291 \r
 292 \r
 293 x = ux(a)\r
 294 y = uy(a)\r
 295 \r
 296 3\r
 297 IF buf(x, y) = 2 THEN\r
 298 buf(x, y) = 0\r
 299 sc x, y\r
 300 stuff\r
 301 ussl(a) = ussl(a) + mtm\r
 302 usss(a) = usss(a) + mtm\r
 303 FOR b = 1 TO ussm\r
 304 IF (elud(b) > 0) AND (auto(b) = 1) THEN ai b\r
 305 NEXT b\r
 306 stat\r
 307 GOTO 3\r
 308 END IF\r
 309 \r
 310 IF buf(x, y) > 0 THEN dead a: GOTO 4\r
 311 IF a = 1 THEN buf(x, y) = 10\r
 312 IF a = 2 THEN buf(x, y) = 11\r
 313 IF a = 3 THEN buf(x, y) = 12\r
 314 IF a = 4 THEN buf(x, y) = 13\r
 315 IF a = 5 THEN buf(x, y) = 14\r
 316 sc x, y\r
 317 IF ussp(a) > 2000 THEN ussp(a) = ussp(a) - 2000\r
 318 ussx(ussp(a), a) = x\r
 319 ussy(ussp(a), a) = y\r
 320 \r
 321 4\r
 322 \r
 323 END SUB\r
 324 \r
 325 SUB putworm (a)\r
 326 b = ussl(a)\r
 327 FOR c = b TO 1 STEP -1\r
 328 ussl(a) = c\r
 329 subt a\r
 330 NEXT c\r
 331 \r
 332 9\r
 333 uy(a) = INT(RND * 30 + 2)\r
 334 ux(a) = INT(RND * 10 + 5)\r
 335 FOR b = ux(a) TO ux(a) + 10\r
 336 IF buf(b, uy(a)) <> 0 THEN GOTO 9\r
 337 NEXT b\r
 338 \r
 339 uxp(a) = 1\r
 340 uyp(a) = 0\r
 341 ussl(a) = 3\r
 342 stat\r
 343 \r
 344 END SUB\r
 345 \r
 346 SUB sc (x, y)\r
 347 x1 = x * 5\r
 348 y1 = y * 5\r
 349 \r
 350 LINE (x1, y1)-(x1 + 3, y1 + 3), 0, BF\r
 351 \r
 352 SELECT CASE buf(x, y)\r
 353 CASE 0\r
 354 LINE (x1, y1)-(x1 + 3, y1 + 3), 1, BF\r
 355 CASE 1\r
 356 LINE (x1, y1)-(x1 + 3, y1 + 3), 7, BF\r
 357 LINE (x1, y1)-(x1 + 3, y1 + 3), 8, B\r
 358 CASE 2\r
 359 LINE (x1, y1)-(x1 + 3, y1 + 3), 14, BF\r
 360 CASE 10\r
 361 LINE (x1, y1)-(x1 + 3, y1 + 3), 10, BF\r
 362 PSET (x1, y1), 0\r
 363 PSET (x1 + 3, y1), 0\r
 364 PSET (x1, y1 + 3), 0\r
 365 PSET (x1 + 3, y1 + 3), 0\r
 366 \r
 367 CASE 11\r
 368 LINE (x1, y1)-(x1 + 3, y1 + 3), 12, BF\r
 369 PSET (x1, y1), 0\r
 370 PSET (x1 + 3, y1), 0\r
 371 PSET (x1, y1 + 3), 0\r
 372 PSET (x1 + 3, y1 + 3), 0\r
 373 \r
 374 CASE 12\r
 375 LINE (x1, y1)-(x1 + 3, y1 + 3), 13, BF\r
 376 PSET (x1, y1), 0\r
 377 PSET (x1 + 3, y1), 0\r
 378 PSET (x1, y1 + 3), 0\r
 379 PSET (x1 + 3, y1 + 3), 0\r
 380 \r
 381 CASE 13\r
 382 LINE (x1, y1)-(x1 + 3, y1 + 3), 15, BF\r
 383 PSET (x1, y1), 0\r
 384 PSET (x1 + 3, y1), 0\r
 385 PSET (x1, y1 + 3), 0\r
 386 PSET (x1 + 3, y1 + 3), 0\r
 387 \r
 388 CASE 14\r
 389 LINE (x1, y1)-(x1 + 3, y1 + 3), 9, BF\r
 390 PSET (x1, y1), 0\r
 391 PSET (x1 + 3, y1), 0\r
 392 PSET (x1, y1 + 3), 0\r
 393 PSET (x1 + 3, y1 + 3), 0\r
 394 \r
 395 \r
 396 END SELECT\r
 397 \r
 398 END SUB\r
 399 \r
 400 SUB sc2 (x, y)\r
 401 'LOCATE 1, 1\r
 402 'PRINT x, y\r
 403 'x1 = x * 5 + 2\r
 404 'y1 = y * 5 + 2\r
 405 'PSET (x1, y1), 15\r
 406 \r
 407 \r
 408 'a$ = INPUT$(1)\r
 409 \r
 410 END SUB\r
 411 \r
 412 SUB show\r
 413 FOR y = 1 TO 35\r
 414 FOR x = 1 TO 35\r
 415 sc x, y\r
 416 \r
 417 NEXT x\r
 418 NEXT y\r
 419 \r
 420 END SUB\r
 421 \r
 422 SUB showb\r
 423 GOTO 15\r
 424 FOR x = 1 TO 35\r
 425 FOR y = 1 TO 35\r
 426 \r
 427 LINE (x * 2 + 200, y * 2 + 100)-(x * 2 + 201, y * 2 + 101), buf2(x, y) MOD 255, BF\r
 428 NEXT y\r
 429 NEXT x\r
 430 15\r
 431 'a$ = INPUT$(1)\r
 432 END SUB\r
 433 \r
 434 SUB start\r
 435 SCREEN 13\r
 436 RANDOMIZE TIMER\r
 437 \r
 438 uy(1) = 5\r
 439 uy(2) = 10\r
 440 uy(3) = 15\r
 441 uy(4) = 20\r
 442 uy(5) = 25\r
 443 \r
 444 \r
 445 FOR a = 1 TO ussm\r
 446 ux(a) = 15\r
 447 uxp(a) = 1\r
 448 uyp(a) = 0\r
 449 ussp(a) = 0\r
 450 ussl(a) = 3\r
 451 elud(a) = elum\r
 452 usss(a) = 0\r
 453 usskp(a) = 1\r
 454 ussk(1, a) = 5\r
 455 NEXT a\r
 456 mtm = 0\r
 457 END SUB\r
 458 \r
 459 SUB stat\r
 460 LOCATE 1, 25\r
 461 PRINT mtm\r
 462 \r
 463 \r
 464 FOR a = 1 TO 5\r
 465 COLOR 15\r
 466 LOCATE 2 + a, 24\r
 467 PRINT RIGHT$(STR$(a), 1)\r
 468 \r
 469 COLOR 10\r
 470 LOCATE 2 + a, 26\r
 471 IF auto(a) = 1 THEN PRINT "*" ELSE PRINT "-"\r
 472 \r
 473 COLOR 12\r
 474 LOCATE 2 + a, 27\r
 475 b$ = STR$(usss(a))\r
 476 PRINT RIGHT$(b$, LEN(b$) - 1)\r
 477 \r
 478 COLOR 13\r
 479 LOCATE 2 + a, 30\r
 480 b$ = STR$(elud(a))\r
 481 PRINT RIGHT$(b$, LEN(b$) - 1)\r
 482 NEXT a\r
 483 \r
 484 COLOR 10\r
 485 LOCATE 8, 26\r
 486 PRINT "Auto"\r
 487 \r
 488 COLOR 12\r
 489 LOCATE 2, 27\r
 490 PRINT "Score"\r
 491 \r
 492 COLOR 13\r
 493 LOCATE 8, 30\r
 494 PRINT "Lives"\r
 495 \r
 496 LOCATE 1, 30\r
 497 PRINT "Level:"; lvl\r
 498 \r
 499 \r
 500 END SUB\r
 501 \r
 502 SUB stuff\r
 503 2\r
 504 x = INT(RND * 33 + 2)\r
 505 y = INT(RND * 33 + 2)\r
 506 IF buf(x, y) = 0 THEN\r
 507 buf(x, y) = 2\r
 508 sc x, y\r
 509 ELSE\r
 510 GOTO 2\r
 511 END IF\r
 512 mtm = mtm + 1\r
 513 stat\r
 514 END SUB\r
 515 \r
 516 SUB subt (b)\r
 517 a = ussp(b) - ussl(b)\r
 518 IF a < 1 THEN a = a + 2000\r
 519 IF ussx(a, b) > 0 THEN\r
 520 \r
 521 buf(ussx(a, b), ussy(a, b)) = 0\r
 522 sc ussx(a, b), ussy(a, b)\r
 523 ussx(a, b) = 0\r
 524 END IF\r
 525 END SUB\r
 526 \r
 527 SUB tkt\r
 528 a$ = INKEY$\r
 529 IF a$ = CHR$(27) THEN SYSTEM\r
 530 IF (a$ = CHR$(0) + "M") AND (uxp(1) <> -1) THEN uxp(1) = 1: uyp(1) = 0\r
 531 IF (a$ = CHR$(0) + "K") AND (uxp(1) <> 1) THEN uxp(1) = -1: uyp(1) = 0\r
 532 IF (a$ = CHR$(0) + "P") AND (uyp(1) <> -1) THEN uxp(1) = 0: uyp(1) = 1\r
 533 IF (a$ = CHR$(0) + "H") AND (uyp(1) <> 1) THEN uxp(1) = 0: uyp(1) = -1\r
 534 \r
 535 IF (a$ = "d") AND (uxp(2) <> -1) THEN uxp(2) = 1: uyp(2) = 0\r
 536 IF (a$ = "a") AND (uxp(2) <> 1) THEN uxp(2) = -1: uyp(2) = 0\r
 537 IF (a$ = "s") AND (uyp(2) <> -1) THEN uxp(2) = 0: uyp(2) = 1\r
 538 IF (a$ = "w") AND (uyp(2) <> 1) THEN uxp(2) = 0: uyp(2) = -1\r
 539 \r
 540 b = VAL(a$)\r
 541 IF b > 0 THEN\r
 542 IF auto(b) = 1 THEN auto(b) = 0 ELSE auto(b) = 1\r
 543 stat\r
 544 END IF\r
 545 \r
 546 FOR a = 1 TO ussm\r
 547 prc a\r
 548 NEXT a\r
 549 \r
 550 END SUB\r
 551 \r