"Fossies" - the Fresh Open Source Software Archive

Member "blassic-0.11.0/deepsea.bas" (15 Feb 2006, 9840 Bytes) of package /linux/privat/blassic-0.11.0.tgz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Visual Basic source code syntax highlighting (style: standard) with prefixed line numbers. Alternatively you can here view or download the uninterpreted source code file. See also the latest Fossies "Diffs" side-by-side code changes report for "deepsea.bas": 0.10.3_vs_0.11.0.

    1 rem         *****************************
    2 rem         **  D E E P S E A . B A S  **
    3 rem         *****************************
    4 
    5 rem ***************************************************************
    6 rem **    A simple game demonstrating Blassic's capabilites.     **
    7 rem     **                                                           **
    8 rem **         (C) 2002-2005 Julian Albo "NotFound"              **
    9 rem **                Revision 21-mar-2005                       **
   10 rem **     Distributable under the terms of the GPL License.     **
   11 rem ***************************************************************
   12 
   13 def int a-z
   14 
   15 ' Set LOCATE style Microsoft
   16 flags1= sysvarptr + 30
   17 n= peek (flags1)
   18 if n mod 2 = 1 then poke flags1, n - 1
   19 
   20 randomize time
   21 
   22 color_sky= 11
   23 color_sea= 1
   24 color_boat= 4
   25 color_sub= 6
   26 
   27 sealevel= 7
   28 boatlevel= sealevel - 1
   29 minysub= sealevel + 1
   30 
   31 maxbomb= 5
   32 dim xbomb (maxbomb), ybomb (maxbomb), counter (maxbomb)
   33 
   34 maxboat= 7
   35 dim xboat (maxboat), incboat (maxboat)
   36 
   37 maxglub= 20
   38 dim xglub (maxglub), countglub (maxglub)
   39 
   40 maxcharge= 40
   41 dim xcharge (maxcharge), ycharge (maxcharge)
   42 
   43 probboat!= 0.15
   44 probcharge!=0.25
   45 
   46 arg= val (programarg$ (1) )
   47 if arg = 0 then arg= 1
   48 
   49 border color_sky
   50 mode 320 * arg, 200 * arg, , arg, arg
   51 
   52 set_title "Deep Sea"
   53 
   54 skywin= 1
   55 window #skywin, 1, 40, 1, boatlevel
   56 paper #skywin, color_sky
   57 
   58 seawin= 2
   59 window #seawin, 1, 40, sealevel, 24
   60 paper #seawin, color_sea
   61 
   62 boatwin= 3
   63 window #boatwin, 1, 40, boatlevel, boatlevel
   64 paper #boatwin, color_sky
   65 
   66 synchronize 1
   67 
   68 gosub defchars
   69 
   70 d= sysvarptr
   71 charset= peek (d+20) + 256 * (peek (d+21) + 256 * (peek (d+22) + 256 * peek (d+23) ) )
   72 
   73 
   74 label startplay
   75 
   76 nbomb= 0
   77 inicount= 2
   78 nboat= 0
   79 inicountglub= 18
   80 
   81 for i= 1 to maxbomb
   82     xbomb (i)= 0
   83 next
   84 for i= 1 to maxboat
   85     xboat (i)= 0
   86 next
   87 for i= 1 to maxglub
   88     xglub (i)= 0
   89 next
   90 for i= 1 to maxcharge - 1
   91     xcharge (i)= 0
   92     ycharge (i)= i + 1
   93 next
   94 xcharge (maxcharge)= 0
   95 ycharge (maxcharge)= 0
   96 freecharge= 1
   97 
   98 points= 0
   99 endnow= 0
  100 quit= 0
  101 killed= 0
  102 
  103 pen 0, 0
  104 gosub clearscreen
  105 
  106 synchronize
  107 
  108 colrot= 0
  109 
  110 g$= "DEEP": posx= 5: posy= sealevel + 1: gosub rotulo
  111 
  112 pause 500
  113 
  114 g$= "SEA": posx= 9: posy= sealevel + 9: gosub rotulo
  115 
  116 pause 750
  117 
  118 xsub= 20: ysub= 20
  119 
  120 pen color_sub: paper color_sea
  121 locate ysub, xsub: print sub$;
  122 synchronize
  123 
  124 pause 500
  125 
  126 gosub clearscreen
  127 
  128 pen color_sub: paper color_sea
  129 
  130 gosub printpoints
  131 
  132 
  133 on #0 gosub handle_keys
  134 
  135 repeat
  136     locate ysub, xsub: print sub$;
  137     synchronize
  138     pause 200
  139 
  140     xmove= max (min (xmove, 3), -3)
  141     ymove= max (min (ymove, 3), -3)
  142     xsub= max (min (xsub + xmove, 38), 1)
  143     ysub= max (min (ysub + ymove, 24), minysub)
  144     xmove= 0: ymove= 0
  145 
  146     gosub moveall
  147     if fire then gosub firebomb: fire= 0
  148 until quit
  149 
  150 if killed then gosub gameover: on #0 gosub 0: goto startplay
  151 
  152 goto finalize
  153 
  154 
  155 label handle_keys
  156 
  157 local a$
  158 
  159 get a$
  160 repeat
  161     a$= upper$ (a$)
  162     if a$ = "P" then get a$: a$= upper$ (a$)
  163     if a$ = "LEFT" then xmove= xmove - 1
  164     if a$ = "RIGHT" then xmove= xmove + 1
  165     if a$ = "UP" then ymove= ymove - 1
  166     if a$ = "DOWN" then ymove= ymove + 1
  167     if a$ = " " then fire= 1
  168     if a$ = "Q" then quit= 1
  169 until (let a$= inkey$) = ""
  170 
  171 return
  172 
  173 label moveall
  174 
  175 gosub moveboats
  176 
  177 pen color_sub, 0: paper color_sea
  178 
  179 cls #seawin
  180 
  181 pen , 1
  182 
  183 gosub movebombs
  184 
  185 gosub movecharges
  186 
  187 pen , 0
  188 
  189 gosub printpoints
  190 
  191 return
  192 
  193 label movebombs
  194 
  195 for i= 1 to maxbomb
  196     if xbomb (i) = 0 then goto nextbomb
  197 
  198     counter (i)= counter (i) - 1
  199     if counter (i) > 0 then goto printbomb
  200     counter (i)= inicount
  201 
  202     ybomb (i)= ybomb (i) - 1
  203     if ybomb (i) >= sealevel then goto printbomb
  204 
  205     killpos= xbomb (i)  
  206     xbomb (i)= 0: nbomb= nbomb - 1
  207 
  208     killboat= 0
  209     for j= 1 to maxboat
  210         if xboat (j) = 0 then goto nextbombboat
  211         touch= killpos - xboat (j)
  212         if touch >= 0 and touch <= 2 then killboat= j: j= maxboat
  213 
  214         label nextbombboat
  215     next
  216     if killboat = 0 then goto nextbomb
  217 
  218     newglub= 0
  219     for j= 1 to maxglub
  220         if xglub (j) = 0 then newglub= j: j= maxglub
  221     next
  222     if newglub <> 0 then xglub (newglub)= xboat (killboat): countglub (newglub)= inicountglub
  223 
  224     xboat (killboat)= 0: nboat= nboat - 1
  225     points= points + 10
  226 
  227     goto nextbomb
  228 
  229     label printbomb
  230     locate ybomb (i), xbomb (i): print bomb$;
  231 
  232     label nextbomb
  233 next
  234 
  235 return
  236 
  237 label movecharges
  238 
  239 for i= 1 to maxcharge
  240     if xcharge (i) = 0 then goto nextcharge
  241     ycharge (i)= ycharge (i) + 1
  242     if ycharge (i) >= 25 then xcharge (i)= 0 : ycharge (i)= freecharge: freecharge= i: goto nextcharge
  243 
  244     label nomovecharge
  245 
  246     locate ycharge (i), xcharge (i): print charge$;
  247 
  248     dist= xcharge (i) - xsub
  249     if ycharge (i) = ysub and dist >= 0 and dist < 3 then killed= 1: quit= 1: locate ycharge (i), xcharge (i) - 2: print "(( ))";
  250 
  251     label nextcharge
  252 next
  253 
  254 return
  255 
  256 label firecharge
  257 
  258 if killed then return
  259 
  260 if xfire < 1 or xfire > 40 then return
  261 
  262 if freecharge = 0 then return
  263 x= freecharge
  264 freecharge= ycharge (x)
  265 
  266 xcharge (x)= xfire
  267 ycharge (x)= sealevel - 1
  268 rem pen color_sub: paper color_sea
  269 rem locate ycharge (x), xcharge (x): print charge$;
  270 rem pen color_boat
  271 
  272 return
  273 
  274 label moveboats
  275 
  276 local i
  277 
  278 pen color_boat, 0: paper color_sky
  279 
  280 cls #boatwin
  281 
  282 pen , 1
  283 
  284 for iboat= 1 to maxboat
  285     if xboat (iboat) = 0 then goto nextboat
  286     xboat (iboat)= xboat (iboat) + incboat (iboat)
  287     if (incboat (iboat) < 0 and xboat (iboat) < 1) or (incboat (iboat) > 0 and xboat (iboat) > 37) then xboat (iboat)= 0: nboat= nboat - 1: goto nextboat
  288 
  289     locate boatlevel, xboat (iboat)
  290     if incboat (iboat) > 0 then print boat$; else print boat2$;
  291 
  292     if rnd > probcharge! then goto nextboat
  293     xfire= xboat (iboat)
  294     if incboat (iboat) > 0 then xfire= xfire + 4: else xfire= xfire - 2
  295     gosub firecharge
  296 
  297     label nextboat
  298 next
  299 
  300 if nboat >= maxboat or rnd > probboat! then goto endmoveboats
  301 
  302 posboat= 0
  303 for i= 1 to maxboat
  304     if xboat (i) = 0 then posboat= i: i= maxboat
  305 next
  306 if posboat= 0 then goto endmoveboats
  307 
  308 nboat= nboat + 1
  309 
  310 if rnd > 0.5 then goto boatfromright
  311 
  312 xboat (posboat)= 1
  313 incboat (posboat)= 1
  314 
  315 goto finishboat
  316 
  317 label boatfromright
  318 
  319 xboat (posboat)= 37
  320 incboat (posboat)= -1
  321 
  322 label finishboat
  323 
  324 locate boatlevel, xboat (posboat): print boat$;
  325 
  326 label endmoveboats
  327 
  328 for i= 1 to maxglub
  329     if xglub (i) = 0 then goto nextglub
  330     countglub (i)= countglub (i) - 1
  331     if countglub (i) = 0 then xglub (i)= 0: goto nextglub
  332     g= int (countglub (i) / 3)
  333     locate boatlevel, xglub (i) : print glub$ (g);
  334 
  335     label nextglub
  336 next
  337 
  338 return
  339 
  340 label firebomb
  341     if nbomb >= maxbomb then return
  342 
  343     posbomb= 0
  344     for i= 1 to maxbomb
  345         if xbomb (i) = 0 then posbomb= i: i= maxbomb
  346     next
  347     if posbomb = 0 then return
  348 
  349     nbomb= nbomb + 1
  350     ybomb (posbomb)= ysub - 1
  351     xbomb (posbomb)= xsub + 2
  352     counter (posbomb)= inicount
  353     locate ybomb (posbomb), xbomb (posbomb): print bomb$;
  354 return
  355 
  356 label printpoints
  357 
  358 locate 25, 1: print using "Points: ######", points;
  359 
  360 return
  361 
  362 
  363 label markend
  364 
  365 get a$
  366 if upper$ (a$) = "P" then playagain= 1
  367 
  368 endnow= not 0
  369 
  370 return
  371 
  372 
  373 label gameover
  374 
  375 synchronize
  376 
  377 set_title "Deep Sea: game over"
  378 
  379 for i= 1 to 2
  380     gosub moveboats
  381     synchronize
  382     pause 200
  383 next
  384 
  385 clear input
  386 
  387 playagain= 0
  388 on #0 gosub markend
  389 
  390 colrot= 0
  391 posx= 5
  392 
  393 while not endnow
  394     g$= "GAME": posy= sealevel + 1: gosub rotulo
  395 
  396     for i= 1 to 3
  397         gosub moveboats
  398         synchronize
  399         pause 200
  400         if endnow then pull for: goto endloopover
  401     next
  402 
  403     if endnow then goto endloopover
  404 
  405     g$= "OVER": posy= sealevel + 9: gosub rotulo
  406 
  407     for i= 1 to 3
  408         gosub moveboats
  409         synchronize
  410         pause 200
  411         if endnow then pull for: goto endloopover
  412     next
  413 
  414     if colrot = 0 then colrot= 15 else colrot= 0
  415 
  416     locate sealevel + 17, 10
  417     pen colrot
  418     print "Press P to play again"
  419 
  420     label endloopover
  421 wend
  422 
  423 if playagain then return
  424 
  425 
  426 label finalize
  427 
  428 on #0 gosub 0
  429 synchronize 0
  430 pen 1, 0
  431 paper color_sky
  432 clear input
  433 scroll
  434 
  435 end
  436 
  437 label rotulo
  438 
  439 l= len (g$)
  440 for i= 0 to 7
  441     pen colrot, 0
  442     for j= 1 to l
  443         posj= (j - 1) * 8
  444         c= asc (mid$ (g$, j, 1) )
  445         n= peek (charset + c * 8 + i)
  446         m= 128
  447         for k= 0 to 7
  448             if n >= m then locate posy + i, posx + k + posj: print black$; : n= n - m
  449             m= m \ 2
  450             if endnow then pull for: pull for: pull for: return
  451         next
  452     next
  453     if killed then checkmove= (checkmove + 1) mod 3: if checkmove = 1 then gosub moveboats
  454     synchronize
  455     pause 50
  456 next
  457 
  458 return
  459 
  460 label clearscreen
  461 
  462 paper color_sea
  463 cls
  464 
  465 cls #skywin
  466 
  467 return
  468 
  469 label defchars
  470 
  471 symbol after 230
  472 
  473 symbol 253,   0,   0,   0,  31, 127, 255, 127,  31
  474 symbol 254, 248, 248, 248, 255, 255, 255, 255, 255
  475 symbol 255,   0,   0,   0, 248, 254, 255, 254, 248
  476 sub$= chr$ (253) + chr$ (254) + chr$ (255)
  477 
  478 symbol 250,   0,   0,   0,   0, 255, 255, 127,  63
  479 symbol 251,   4,   4, 255, 255, 255, 255, 255, 255
  480 symbol 252,   0,   0,   0,   0, 255, 252, 240, 192
  481 boat$= chr$ (250) + chr$ (251) + chr$ (252)
  482 
  483 symbol 232,   0,   0,   0,   0, 255, 255, 254, 248
  484 symbol 231,  32,  32, 255, 255, 255, 255, 255, 255
  485 symbol 230,   0,   0,   0,   0, 255,  63,  15,   3
  486 boat2$= chr$ (230) + chr$ (231) + chr$ (232)
  487 
  488 symbol 249,  16,  56,  56,  56,  56,  56, 124, 214
  489 bomb$= chr$ (249)
  490 
  491 symbol 248,  16,  56, 124, 254, 127,  62,  28,   8
  492 charge$= chr$ (248)
  493 
  494 symbol 247, 255, 255, 255, 255, 255, 255, 255, 255
  495 black$= chr$ (247)
  496 
  497 dim glub$ (6)
  498 symbol 244,   0, 224, 124, 127,  63,  63,  31,  31
  499 symbol 245,   0,   0,   0, 128, 240, 254, 255, 255
  500 symbol 246,   0,   0,   0,   0,   0,   0, 192, 248
  501 glub$ (6)= chr$ (244) + chr$ (245) + chr$ (246)
  502 
  503 symbol 241,   0,   0, 224, 124, 127,  63,  63,  31
  504 symbol 242,   0,   0,   0,   0, 128, 240, 254, 255
  505 symbol 243,   0,   0,   0,   0,   0,   0,   0, 192
  506 glub$ (5)= chr$ (241) + chr$ (242) + chr$ (243)
  507 
  508 symbol 239,   0,   0,   0, 224, 124, 127,  63,  63
  509 symbol 240,   0,   0,   0,   0,   0, 128, 240, 254
  510 glub$ (4)= chr$ (239) + chr$ (240)
  511 
  512 symbol 237,   0,   0,   0,   0, 224, 124, 127,  63
  513 symbol 238,   0,   0,   0,   0,   0,   0, 128, 240
  514 glub$ (3)= chr$ (237) + chr$ (238)
  515 
  516 symbol 235,   0,   0,   0,   0,   0, 224, 124, 127
  517 symbol 236,   0,   0,   0,   0,   0,   0,   0, 128
  518 glub$ (2)= chr$ (235) + chr$ (236)
  519 
  520 symbol 234,   0,   0,   0,   0,   0,   0, 224, 124
  521 glub$ (1)= chr$ (234)
  522 
  523 symbol 233,   0,   0,   0,   0,   0,   0,   0, 224
  524 glub$ (0)= chr$ (233)
  525 
  526 return