home *** CD-ROM | disk | FTP | other *** search
/ PDA Software Library / pdasoftwarelib.iso / PSION / GAMES / NIBBLES / NIBBLES.OPL next >
Encoding:
Text File  |  1994-10-15  |  13.0 KB  |  691 lines
  1. PROC Nibbles:
  2. rem
  3. rem Original game design and program by Microsoft
  4. rem Ported to psion by Luke Gilbert
  5. rem Comments/Complaints welcome!
  6. rem email: lgilbert@prairienet.com
  7. rem
  8. rem Obligatory Disclaimer: Use this program at
  9. rem your own risk. I am not responsible for any
  10. rem damage or loss caused by this program. 
  11. rem
  12. global speed%     rem speed
  13. global diff$(1)    rem difficulty
  14. global snd$(1)    rem sound effects
  15. global gspeed$(1)    rem GameSpeed
  16. global CurLvl%
  17. global SstrRow%
  18.  
  19. global ColrTbl%(10)
  20.  
  21. global realRow%(2040)        REM Maps the 80x50 point into the real 80x25
  22. global acolor%(2040)        REM Stores the current color of the point
  23. global sister%(2040)        REM Each char has 2 points in it.  .SISTER is
  24.                                         REM -1 if sister point is above, +1 if below
  25.  
  26.  
  27. Rem CONSTANTS
  28. global TRUE%
  29. global FALSE%
  30. global MAXLEN%    rem max snake length
  31. global STRTOVR%    REM  Parameters to 'Level' SUB
  32. global SAMELVL%
  33. global NEXTLVL%
  34.  
  35. TRUE% = -1
  36. FALSE% = NOT TRUE%
  37. MAXLEN% = 1000
  38. STRTOVR% = 1             REM  Parameters to 'Level' SUB
  39. SAMELVL% = 2
  40. NEXTLVL% = 3
  41.  
  42. RANDOMIZE SECOND
  43. DO
  44.     AT 15, 16
  45.     PRINT "Sound effects (Y or N)"; 
  46.     snd$ = Upper$(get$)
  47. UNTIL snd$ = "Y" OR snd$ = "N"
  48. Intro:
  49. GetInp:
  50. SetColr:
  51. DrawScr:
  52. InitClr:
  53.  
  54. DO
  55.     Play:(diff$)
  56. UNTIL NOT PlayAgn:
  57.  
  58. CLS
  59. ENDP
  60.  
  61. PROC    Intro:
  62. REM   Displays game introduction
  63.  
  64. CLS
  65. center:( 4, "Q B a s i c   N i b b l e s")
  66. center:( 6, "Copyright (C) Microsoft Corporation 1990")
  67. center:( 8, "Nibbles is a game for one player.  Navigate your snake")
  68. center:( 9, "around the screen trying to eat up numbers while avoiding")
  69. center:( 10, "running into walls.  The more numbers you eat up,")
  70. center:( 11, "the more points you gain and the longer your snake grows.")
  71. center:( 14, "Press any key to continue")
  72. if snd$="Y"
  73.     beep 5, 600
  74.     beep 5, 650
  75.     beep 5, 700
  76.     beep 5, 750
  77.     beep 5, 800
  78.     beep 5, 750
  79.     beep 5, 700
  80.     beep 5, 650
  81.     beep 5, 600
  82. endif
  83. SprkPse:
  84.  
  85. CLS
  86. center:( 5, " GAME CONTROLS ")
  87. center:( 7, "                             (Up)                  ")
  88. center:( 8, "       P - Pause                 " + CHR$(24) + "                     ")
  89. center:( 9, "              (Left) " + CHR$(27) + "   " + CHR$(26) + " (Right)")
  90. center:( 10, "                                 " + CHR$(25) + "                    ")
  91. center:( 11, "                             (Down)                 ")
  92. center:( 14, "Press any key to continue")
  93. SprkPse:
  94. ENDP
  95.  
  96. PROC    GetInp:
  97. REM Gets player inputs
  98. local StrtTim%, StopTim%
  99. local i%
  100. CLS
  101.  
  102. AT 22,9 : PRINT "1 = Novice"
  103. AT 22,10 : PRINT "8 = Expert"
  104. AT 22,11 : PRINT "9 = Twiddle Fingers"
  105. AT 15,12 : PRINT "(Computer speed may affect your skill level)"
  106. DO
  107.     AT 22,8 : PRINT "Skill level (1 to 9)";
  108.     gspeed$=GET$
  109. UNTIL ASC(gspeed$) > ASC("0") AND ASC(gspeed$) <= ASC("9")
  110. speed% = VAL(gspeed$)
  111.   
  112. speed% = 10 - speed%
  113.  
  114. DO
  115.     AT 15, 14
  116.     PRINT "Increase game speed during play (Y or N)"; 
  117.     diff$=get$
  118.     diff$ = Upper$(diff$)
  119. UNTIL diff$ = "Y" OR diff$ = "N"
  120.  
  121. ENDP
  122.  
  123. PROC    SetColr:
  124.     ColrTbl%(1)=7        rem snake
  125.     ColrTbl%(3)=7        rem walls
  126.     ColrTbl%(4)=0        rem bkgrd
  127. ENDP
  128.  
  129. PROC    DrawScr:
  130. REM   Draws playing field
  131. local r%, c%
  132. local rr%, ss%
  133. local rowcol%
  134.  
  135. REM initialize screen
  136. CLS
  137.  
  138. REM Print title & message
  139. center:( 1, "Nibbles!")
  140. center:( 11, "Initializing Playing Field...")
  141.     
  142. REM Initialize arena array
  143. r%=0
  144. do
  145.     r%=r%+1
  146.     rr% = INT((r% + 1) / 2)
  147.     ss% = mod:(r%, 2) * 2 - 1
  148.     c%=0
  149.     do
  150.         c%=c%+1
  151.         rowcol%=r%*60+c%-60
  152.         realRow%(rowcol%) = rr%
  153.         sister%(rowcol%) = ss%
  154.     until c%=60
  155. until r%=34
  156. ENDP
  157.  
  158. PROC Play:(diff$)    REM   Main routine that controls game play
  159. local rowcol%
  160. local k%
  161. local i%
  162. global tail%
  163.  
  164. rem TYPE snakeBody
  165. global bodyrow%(1000)
  166. global bodycol%(1000)
  167.  
  168. rem TYPE snaketype
  169. global head%
  170. global length%
  171. global row%
  172. global col%
  173. global dir%
  174. global lives%
  175. global score%
  176. global scolor%
  177. global alive%
  178.  
  179. global CurSpd%
  180. global GameOvr%
  181. global Numbr%
  182. global nonum%
  183. global Died%
  184. global NumRow%
  185. global NumCol%
  186.  
  187. REM Initialize Snake
  188. lives% = 5
  189. score% = 0
  190. scolor% = ColrTbl%(1)
  191.                  
  192. Level:(STRTOVR%, ColrTbl%(3))
  193.  
  194. CurSpd% = speed%
  195.  
  196. REM play Nibbles until finished
  197. SpcPse:( "Level " + NUM$(CurLvl%,2) + ". Push Space.")
  198.  
  199. GameOvr% = FALSE%
  200. DO
  201.     Numbr% = 1          REM Current number that snake is trying to run into
  202.     NoNum% = TRUE%        REM nonum = TRUE if a number is not on the screen
  203.  
  204.     Died% = FALSE%
  205.     PrtScor: (score%, lives%)
  206.     if snd$="Y"
  207.         beep 5, 650
  208.         pause 7
  209.         beep 5, 600
  210.         beep 20, 570
  211.     endif
  212.     DO                                    REM  Print number if no number exists
  213.         IF NoNum% = TRUE%
  214.             DO
  215.                 NumRow% = INT(RND * 29 + 3)
  216.                 NumCol% = INT(RND * 58 + 2)
  217.                 rowcol%=NumRow%*60+NumCol%-60
  218.                 SstrRow% = NumRow% + Sister%(Rowcol%)
  219.             UNTIL NOT PtsTher:(NumRow%, NumCol%, ColrTbl%(4)) AND NOT PtsTher:(SstrRow%, NumCol%, ColrTbl%(4))
  220.             NumRow% = RealRow%(Rowcol%)
  221.             NoNum% = FALSE%
  222.  
  223.             AT NumCol%, NumRow%
  224.             PRINT NUM$(Numbr%, 2);
  225.         ENDIF
  226.  
  227.         REM Delay game
  228.         i%=0
  229.         do
  230.                 i%=i%+1
  231.         until i%=CurSpd%*CurSpd%*CurSpd%
  232.  
  233.         REM Get keyboard input & Change direction accordingly
  234.         k%=key
  235.         if k%
  236.             if k%=256 and dir%<>2
  237.                 dir%=1                                 rem up
  238.             elseif k%=257 and dir%<>1
  239.                 dir%=2                                 rem down
  240.             elseif k%=258 and dir%<>3
  241.                 dir%=4                                 rem right
  242.             elseif k%=259 and dir%<>4
  243.                 dir%=3                                 rem left
  244.             elseif k%=%p
  245.                 SpcPse:( "Paused. Push Space.")
  246.             elseif k%=%x and kmod=8
  247.                 stop
  248.             endif
  249.         endif
  250.  
  251.         if dir%=1
  252.             row% = row% - 1
  253.         elseif dir%=2
  254.             row% = row% + 1
  255.         elseif dir%=3
  256.             col% = col% - 1
  257.         elseif dir%=4
  258.             col% = col% + 1
  259.         endif
  260.  
  261.         REM If snake hits number, respond accordingly
  262.         IF NumRow% = INT((row% + 1) / 2) AND NumCol% = col%
  263.             if snd$="Y"
  264.                 beep 4, 550
  265.                 beep 4, 450
  266.             endif
  267.             IF length% < (MAXLEN% - 30)
  268.                 rem Need a challenge? Try: length% = length% + Numbr% * 7
  269.                 length% = length% + Numbr% * 5
  270.             ENDIF
  271.             score% = Score% + Numbr%
  272.             PrtScor: (score%, lives%)
  273.             Numbr% = Numbr% + 1
  274.             IF Numbr% = 10
  275.                 AT NumCol%, NumRow%
  276.                 PRINT " "
  277.                 Erase:
  278.                 Level:( SAMELVL%, ColrTbl%(4))
  279.                 Level:( NEXTLVL%, ColrTbl%(3))
  280.                 PrtScor: (score%, lives%)
  281.                 SpcPse: ("Level " + num$(CurLvl%,2) + ". Push Space.")
  282.                 Numbr% = 1
  283.                 IF diff$ = "Y"
  284.                     speed%=speed%-1
  285.                         IF speed% < 1 
  286.                             Speed% = 1
  287.                         ENDIF
  288.                     CurSpd% = speed%
  289.                 ENDIF
  290.             ENDIF
  291.             NoNum% = TRUE%
  292.         ENDIF
  293.  
  294.         REM If player runs into any point, or the head of the other snake, it dies.
  295.         IF PtsTher:(row%, col%, ColrTbl%(4))
  296.             if snd$="Y"
  297.                 beep 10,700
  298.                 beep 10, 850
  299.                 beep 10, 1100
  300.             endif
  301.             AT NumCol%, NumRow%
  302.             PRINT " "
  303.             Died% = TRUE%
  304.             alive% = FALSE%
  305.             lives% = lives% - 1
  306.         ELSE    REM Otherwise, move the snake, and erase the tail
  307.             Head% = MOD:(Head% + 1, MAXLEN%)
  308.             BodyRow%(Head%) = row%
  309.             BodyCol%(Head%) = col%
  310.             tail% = MOD:(Head% + MAXLEN% - length%, MAXLEN%)+1
  311.             Set:(BodyRow%(tail%), BodyCol%(tail%), ColrTbl%(4))
  312.             BodyRow%(tail%) = 0
  313.             Set:(row%, col%, scolor%)
  314.         ENDIF
  315.     UNTIL Died%
  316.  
  317.     CurSpd% = speed%                REM  reset speed to initial value
  318.        
  319.     REM If dead, then erase snake in really cool way
  320.     Erase:
  321.  
  322.     IF alive% = FALSE%
  323.         REM Update score
  324.         Score% = Score% - 10
  325.         PrtScor: (score%, lives%)
  326.         SpcPse: ("Died! Push Space.")
  327.     ENDIF
  328.  
  329.     Level:( SAMELVL%, ColrTbl%(3))
  330.     PrtScor: (score%, lives%)
  331.      
  332. UNTIL lives% = 0    REM Play next round until lives have run out.
  333. Level:( SAMELVL%, ColrTbl%(4))
  334. ENDP
  335.  
  336. PROC    InitClr:
  337. REM Initializes playing field colors
  338. local row%
  339. local col%
  340.  
  341. row%=0
  342. do
  343.     row%=row%+1
  344.     col%=0
  345.     do
  346.         col%=col%+1
  347.         acolor%(row%*60+col%-60) = ColrTbl%(4)
  348.     until col%=60
  349. until row%=34
  350.  
  351. CLS
  352.    
  353. col%=0
  354. do
  355.     col%=col%+1
  356.     Set:( 3, col%, ColrTbl%(3))
  357.     Set:( 34, col%, ColrTbl%(3))
  358. until col%=60
  359.  
  360.  
  361. row%=3
  362. do
  363.     row%=row%+1
  364.     Set:( row%, 1, ColrTbl%(3))
  365.     Set:( row%, 60, ColrTbl%(3))
  366. until row%=34
  367. ENDP
  368.  
  369. PROC    Level: (DoThis%, Colr%)
  370. REM Sets game level
  371. local i%
  372.  
  373. if DoThis%=STRTOVR%
  374.     CurLvl% = 1
  375. elseif DoThis%=NEXTLVL%
  376.     CurLvl% = CurLvl% + 1
  377. endif
  378.  
  379. REM Initialize Snake
  380. head% = 1
  381. length% = 3
  382. alive% = TRUE%
  383.  
  384. VECTOR CurLvL%
  385. case1, case2, case3, case4, case5, case6, case7, case8, case9
  386. ENDV
  387.  
  388. REM If CurrentLevel > 9 then do this
  389. i%=2
  390. do
  391.     i%=i%+2
  392.     Set:( i%, 10, Colr%)
  393.     Set:( i% + 1, 20, Colr%)
  394.     Set:( i%, 30, Colr%)
  395.     Set:( i% + 1, 40, Colr%)
  396.     Set:( i%, 50, Colr%)
  397. until i%=32
  398. row% = 7
  399. col% = 58
  400. dir% = 2
  401. RETURN
  402.  
  403. CASE1::
  404.     row% = 25
  405.     col% = 50
  406.     dir% = 3
  407. RETURN
  408.  
  409. CASE2::
  410.     i%=9
  411.     do
  412.         i%=i%+1
  413.         set:(19, i%, Colr%)
  414.     until i%=50 
  415.     row% = 7
  416.     col% = 50
  417.     dir% = 3
  418. RETURN
  419.  
  420. CASE3::
  421. i%=7
  422. do
  423.     i%=i%+1
  424.     set:(i%, 15, Colr%)
  425.     set:(i%, 45, Colr%)
  426. until i%=29
  427. row% = 25
  428. col% = 50
  429. dir% = 1
  430. RETURN
  431.  
  432. CASE4::
  433. i%=3
  434. do
  435.     i%=i%+1
  436.     set:(i%, 20, Colr%)
  437.     set:(37-i%, 40, Colr%)
  438. until i%=20
  439. i%=1
  440. do
  441.     i%=i%+1
  442.     set:(25, i%, Colr%)
  443.     set:(12, 61-i%, Colr%)
  444. until i%=36
  445. row% = 7
  446. col% = 55
  447. dir% = 3
  448. RETURN
  449.    
  450. CASE5::
  451. i%=13
  452. do
  453.     i%=i%+1
  454.     set:(i%, 19, Colr%)
  455.     set:(i%, 47, Colr%)
  456. until i%=23
  457. i%=20
  458. do
  459.     i%=i%+1
  460.     set:(12, i%, Colr%)
  461.     set:(25, i%, Colr%)
  462. until i%=45
  463. row% = 25
  464. col% = 50
  465. dir% = 1
  466. RETURN
  467.  
  468. CASE6::
  469. i% = 3
  470. do
  471.     i%=i%+1
  472.     IF i% > 21 OR i% < 17
  473.         Set: (i%, 10, Colr%)
  474.         Set: (i%, 20, Colr%)
  475.         Set: (i%, 30, Colr%)
  476.         Set: (i%, 40, Colr%)
  477.         Set: (i%, 50, Colr%)
  478.     ENDIF
  479. until i%=33
  480. row% = 7
  481. col% = 55
  482. dir% = 2
  483. RETURN
  484.  
  485. CASE7::
  486. i%=3
  487. do
  488.     i%=i%+2
  489.     Set:( i%, 30, Colr%)
  490. until i%=33
  491. row% = 7
  492. col% = 55
  493. dir% = 2
  494. RETURN
  495.  
  496. CASE8::
  497. i%=3
  498. do
  499.     i%=i%+1
  500.     Set:( i%, 10, Colr%)
  501.     Set:( 37 - i%, 20, Colr%)
  502.     Set:( i%, 30, Colr%)
  503.     Set:( 37 - i%, 40, Colr%)
  504.     Set:( i%, 50, Colr%)
  505. until i%=28
  506. row% = 7
  507. col% = 55
  508. dir% = 2
  509. RETURN
  510.  
  511. CASE9::
  512. i%=5
  513. do
  514.     i%=i%+1
  515.     Set:( i%, i%, Colr%)
  516.     Set:( i%, i% + 24, Colr%)
  517. until i%=31
  518. row% = 32
  519. col% = 58
  520. dir% = 1
  521. RETURN
  522.    
  523. ENDP
  524.  
  525. PROC    PrtScor: (score1%,  lives1%)
  526. REM Prints scores and number of lives remaining
  527. AT 10,1
  528. PRINT "SAMMY-->  Lives:"+num$(lives1%,3)+"      "+num$(score1%,7)
  529. ENDP
  530.  
  531. PROC    Erase:    REM   Erases snake after its died
  532. local c%, b%
  533. c%=0
  534. do
  535.     b%=length%-c%
  536.     do
  537.         tail% = ((Head%+MAXLEN%-b%)-(Head%+MAXLEN%-b%)/MAXLEN%*MAXLEN%)+1
  538.         Set:(BodyRow%(tail%), BodyCol%(tail%), ColrTbl%(4))
  539.         b%=b%-10
  540.     until b%<=0
  541.     c%=c%+1
  542. until c%=10
  543. ENDP
  544.  
  545. PROC    PlayAgn:
  546. REM   Determines if users want to play game again.
  547. local k$(2)
  548.  
  549. center:( 10, "█▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀█")
  550. center:( 11, "█       G A M E   O V E R       █")
  551. center:( 12, "█                               █")
  552. center:( 13, "█      Play Again?   (Y/N)      █")
  553. center:( 14, "█▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄█")
  554.  
  555. DO
  556.          k$ = UPPER$(KEY$)
  557. UNTIL k$ = "Y" OR k$ = "N"
  558.  
  559. center:( 10, "                                 ")
  560. center:( 11, "                                 ")
  561. center:( 12, "                                 ")
  562. center:( 13, "                                 ")
  563. center:( 14, "                                 ") 
  564.  
  565. IF k$ = "Y"
  566.     RETURN TRUE%
  567. ELSE
  568.     RETURN FALSE%
  569.     CLS
  570. ENDIF
  571.  
  572. ENDP
  573.  
  574. PROC SprkPse:
  575. REM   Creates flashing border for intro screen
  576. local a$(90)
  577. local k%
  578. local i%, j%, c%
  579.  
  580. a$ = "*   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   *   "
  581. do
  582.     i%=1
  583.     REM print horizontal sparkles
  584.     do
  585.         AT 1, 1 :PRINT MID$(a$, i%, 60);
  586.         AT 1,17 :PRINT MID$(a$, 5 - i%, 60);
  587.         j%=2
  588.         REM Print Vertical sparkles
  589.         do
  590.             k%=key
  591.             c% = mod:(i% + j%, 4)
  592.             IF c% = 1
  593.                 AT 60,j%
  594.                 PRINT "*";
  595.                 AT 1, 17 - j%
  596.                 PRINT "*";
  597.             ELSE
  598.                 AT 60,j%
  599.                 PRINT " ";
  600.                 AT 1, 17 - j%
  601.                 PRINT " ";
  602.             ENDIF
  603.             j%=j%+1
  604.         until j%=17 or k%
  605.         i%=i%+1
  606.     until i%=5 or k%
  607. until k%
  608. ENDP
  609.  
  610. PROC Center: (row%, text$)
  611. REM   Centers text on given row
  612. IF LEN(text$) >60
  613.     giprint "Line skipped"
  614.     get
  615. ELSE
  616.     AT 31 - int(LEN(text$) / 2.0), row%
  617.     PRINT text$;
  618. ENDIF
  619. ENDP
  620.  
  621. PROC SpcPse:(text$)
  622. REM   Pauses game play and waits for space bar to be pressed before continuing
  623. local k$(1)
  624.  
  625. busy left$(text$,19),1
  626. do
  627.     k$=key$
  628. until k$=" "
  629. busy off
  630. ENDP
  631.  
  632. PROC PtsTher: (r%, c%, color%)
  633. REM   Checks the global  arena array to see if the boolean flag is set
  634. IF r% <> 0
  635.     IF acolor%(r%*60+c%-60) <> color%
  636.         RETURN TRUE%
  637.     ELSE
  638.         RETURN FALSE%
  639.     ENDIF
  640. ENDIF
  641. ENDP
  642.  
  643. PROC Set: (r%, c%, color%)
  644. REM   Sets row and column on playing field to given color to facilitate moving
  645. REM   of snake around the field.
  646. local rowcol%
  647. local TopFlag%
  648. local SstrClr%
  649. local rrow%
  650.  
  651. IF r% <> 0
  652.     rowcol%=r%*60+c%-60
  653.     acolor%(rowcol%) = color%            REM assign color to arena
  654.     RRow% = RealRow%(rowcol%)            REM Get real row of pixel
  655.     TopFlag% = sister%(rowcol%) + 1    REM Deduce whether pixel
  656.                                                             REM is on top▀, or bottom▄
  657.     SstrRow% = r% + sister%(rowcol%)    REM Get row of sister point
  658.     SstrClr% =acolor%(SstrRow%*60+c%-60)  REM Determine sister's color
  659.  
  660.     AT c%, Rrow%
  661.  
  662.     IF color% = SstrClr%                REM If both points are same
  663.         if color% > 6
  664.             PRINT CHR$(219);
  665.         else
  666.             PRINT " ";
  667.         endif
  668.     ELSE
  669.         IF TopFlag%
  670.             IF color% > 6
  671.                 PRINT CHR$(223);
  672.             ELSE
  673.                 PRINT CHR$(220);
  674.             ENDIF
  675.         ELSE
  676.             IF color% > 6
  677.                 PRINT CHR$(220);
  678.             ELSE
  679.                 PRINT CHR$(223);
  680.             ENDIF
  681.         ENDIF
  682.     ENDIF
  683. ENDIF
  684. ENDP
  685.  
  686. PROC Mod:(x%, y%)
  687. return x% - x% / y% * y%
  688. ENDP
  689.  
  690.  
  691.