games/worm/worm.bas

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