Advertisement
Mysoft

Untitled

May 12th, 2022 (edited)
2,768
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
QBasic 10.74 KB | None | 0 0
  1. WIDTH 40, 25
  2. CLS
  3.  
  4. DEFINT A-Z
  5. DEFSTR S
  6. DEFSNG F
  7.  
  8. ' # walls
  9. ' - walls that ghost can pass
  10. ' . edible dots
  11. ' * edible super dots
  12. ' @ player initial position
  13. ' x ghost initial position
  14.  
  15. DIM sMap(25), sM(25)
  16. sM(1) = "7888888888w8888888889"
  17. sM(2) = "4.........5.........6"
  18. sM(3) = "4.789.789.5.789.789.6"
  19. sM(4) = "4*5 5.5 5.5.5 5.5 5*6"
  20. sM(5) = "4.123.123.s.123.123.6"
  21. sM(6) = "4...................6"
  22. sM(7) = "4.789.w.78889.w.789.6"
  23. sM(8) = "4.123.5.12w23.5.123.6"
  24. sM(9) = "4.....5...5...5.....6"
  25. sM(10) = "18889.a88.s.88d.78883"
  26. sM(11) = "    5.5.......5.5    "
  27. sM(12) = "22223.s.7---9.s.12222"
  28. sM(13) = "     ...5 x 5...     "
  29. sM(14) = "88889.w.18883.w.78888"
  30. sM(15) = "    5.5.......5.5    "
  31. sM(16) = "72223.s.22w22.s.12229"
  32. sM(17) = "4.........5.........6"
  33. sM(18) = "4.889.888.5.888.788.6"
  34. sM(19) = "4*..5.....@.....5..*6"
  35. sM(20) = "189.5.w.78889.w.5.783"
  36. sM(21) = "723.s.5.12w23.5.s.129"
  37. sM(22) = "4.....5...5...5.....6"
  38. sM(23) = "4.8888s88.s.88s8888.6"
  39. sM(24) = "4...................6"
  40. sM(25) = "122222222222222222223"
  41.  
  42. DIM iX, iY, iC, M, N, iDots
  43. DIM iPlayerX, iPlayerY, iStartX, iStartY
  44. DIM iSpawnX, iSpawnY, iRand
  45. DIM iScore, iLives
  46. DIM iSuper, iPlayer, iDead
  47. DIM iGhostX(3), iGhostY(3), iGhostSX(3), iGhostSY(3)
  48. DIM iGhostMov(3), iGhostWait(3)
  49.  
  50. iPlayer = 1: iDead = 1: iLives = 3
  51.  
  52.  
  53. 'exibe labirinto inicial conforme os dados no mapa
  54. 'salvando os pontos de teleporte, e os pontos iniciais do jogador/fantasmas
  55. FOR iY = 1 TO 25
  56.   sMap(iY) = sM(iY): LOCATE iY, 1
  57.   FOR iX = 1 TO 21
  58.     COLOR 9
  59.     SELECT CASE MID$(sMap(iY), iX, 1)
  60.       CASE "1": PRINT CHR$(200); : MID$(sMap(iY), iX, 1) = "y"
  61.       CASE "2": PRINT CHR$(205); : MID$(sMap(iY), iX, 1) = "y"
  62.       CASE "3": PRINT CHR$(188); : MID$(sMap(iY), iX, 1) = "y"
  63.       CASE "4", "5", "6": PRINT CHR$(186); : MID$(sMap(iY), iX, 1) = "y"
  64.       CASE "7": PRINT CHR$(201); : MID$(sMap(iY), iX, 1) = "y"
  65.       CASE "8": PRINT CHR$(205); : MID$(sMap(iY), iX, 1) = "y"
  66.       CASE "9": PRINT CHR$(187); : MID$(sMap(iY), iX, 1) = "y"
  67.       CASE "w": PRINT CHR$(203); : MID$(sMap(iY), iX, 1) = "y"
  68.       CASE "s": PRINT CHR$(202); : MID$(sMap(iY), iX, 1) = "y"
  69.       CASE "a": PRINT CHR$(204); : MID$(sMap(iY), iX, 1) = "y"
  70.       CASE "d": PRINT CHR$(185); : MID$(sMap(iY), iX, 1) = "y"
  71.       CASE "-": PRINT "-"; : MID$(sMap(iY), iX, 1) = "z"
  72.       CASE " ": PRINT " ";
  73.       CASE "x": PRINT " "; : iSpawnX = iX: iSpawnY = iY
  74.       CASE ".": COLOR 6: PRINT CHR$(250); : iDots = iDots + 1
  75.       CASE "*": COLOR 14: PRINT CHR$(254); : iDots = iDots + 1
  76.       CASE "@": PRINT " "; : iStartX = iX: iStartY = iY
  77.     END SELECT
  78.   NEXT iX
  79. NEXT iY
  80.  
  81. 'ghost initial position
  82. 'and delay between movements
  83. FOR N = 0 TO 3
  84.   iGhostX(N) = iSpawnX: iGhostY(N) = iSpawnY
  85.   iGhostSX(N) = 1: iGhostSY(N) = 0
  86.   iGhostWait(N) = N * 128 + N + 32
  87. NEXT N
  88. iPlayerX = iStartX: iPlayerY = iStartY
  89.  
  90. DIM sKey
  91.  
  92. ContinueDo:
  93. DO
  94.  
  95.   'adjust "randmoness"
  96.   iRand = iRand + 1
  97.   WHILE iRand > 3
  98.     iRand = iRand - 4
  99.   WEND
  100.  
  101.   'move ghosts
  102.   FOR N = 0 TO 3
  103.    
  104.     iX = iGhostX(N): iY = iGhostY(N)
  105.    
  106.     'delete ghost (put back map character)
  107.     LOCATE iY, iX:
  108.     SELECT CASE MID$(sMap(iY), iX, 1)
  109.       CASE ".": COLOR 6: PRINT CHR$(250);
  110.       CASE "z": COLOR 9: PRINT "-";
  111.       CASE "*": COLOR 14: PRINT CHR$(254);
  112.       CASE ELSE: PRINT " ";
  113.     END SELECT
  114.    
  115.     'if player touch ghost then one of them die
  116.     IF iX = iPlayerX AND iY = iPlayerY THEN
  117.       IF iSuper > 0 THEN 'ghost dies
  118.         iScore = iScore + 150
  119.         FOR M = 0 TO 3
  120.           IF iGhostWait(M) > 8 THEN iScore = iScore + 50
  121.         NEXT M
  122.         iGhostX(N) = iSpawnX: iGhostY(N) = iSpawnY
  123.         iGhostSX(N) = 1: iGhostSY(N) = 0
  124.         iGhostWait(N) = 128 + N
  125.       ELSE 'player dies
  126.         iDead = 1
  127.       END IF
  128.     END IF
  129.    
  130.     IF iGhostWait(N) > 0 THEN
  131.      
  132.       'decrement counter for ghost action
  133.       IF iGhostWait(N) < 9 OR iSuper = 0 THEN iGhostWait(N) = iGhostWait(N) - 1
  134.       IF iGhostWait(N) < 1 THEN
  135.         'fantasmas metade da velocidade enquanto jogador esta super
  136.         IF iSuper > 0 THEN iGhostWait(N) = 8 ELSE iGhostWait(N) = 4
  137.         iC = 0
  138.        
  139.         'which direction ghosts can go?
  140.         '1) cant go trough walls
  141.         '2) cant go back on same path (if possible)
  142.         '3) cant hit another ghost
  143.         DIM iUp, iDn, iLt, iRt
  144.         iUp = 0: iDn = 0: iLt = 0: iRt = 0
  145.        
  146.         'prevent ghosts from moving on top of each other
  147.         FOR M = 0 TO 3
  148.           IF M <> N THEN 'ignora o próprio
  149.             IF (iX + 1) = iGhostX(M) AND (iY) = iGhostY(M) THEN iRt = -1
  150.             IF (iX - 1) = iGhostX(M) AND (iY) = iGhostY(M) THEN iLt = -1
  151.             IF (iX) = iGhostX(M) AND (iY - 1) = iGhostY(M) THEN iUp = -1
  152.             IF (iX) = iGhostX(M) AND (iY + 1) = iGhostY(M) THEN iDn = -1
  153.           END IF
  154.         NEXT M
  155.        
  156.         'if not hit wall and not going back then add as valid direction
  157.         IF iRt = 0 AND iX < 21 THEN
  158.           IF MID$(sMap(iY), iX + 1, 1) < "y" THEN
  159.             IF iGhostSX(N) <> -1 OR iGhostSY(N) <> 0 THEN iC = iC + 1: iRt = 1: iRand = iRand + 1
  160.           END IF
  161.         END IF
  162.         IF iLt = 0 AND iX > 1 THEN
  163.           IF MID$(sMap(iY), iX - 1, 1) < "y" THEN
  164.             IF iGhostSX(N) <> 1 OR iGhostSY(N) <> 0 THEN iC = iC + 2: iLt = 1: iRand = iRand + 1
  165.           END IF
  166.         END IF
  167.         IF iUp = 0 AND MID$(sMap(iY - 1), iX, 1) <> "y" THEN
  168.           IF iGhostSX(N) <> 0 OR iGhostSY(N) <> 1 THEN iC = iC + 4: iUp = 1: iRand = iRand + 1
  169.         END IF
  170.         IF iDn = 0 AND MID$(sMap(iY + 1), iX, 1) < "y" THEN
  171.           IF iGhostSX(N) <> 0 OR iGhostSY(N) <> -1 THEN iC = iC + 8: iDn = 1: iRand = iRand + 1
  172.         END IF
  173.        
  174.         'if theres no other possibility then make it go back
  175.         IF iC = 0 THEN
  176.           IF iGhostSX(N) = -1 AND iGhostSY(N) = 0 THEN iC = iC + 1: iRt = 1: iRand = iRand + 1
  177.           IF iGhostSX(N) = 1 AND iGhostSY(N) = 0 THEN iC = iC + 2: iLt = 1: iRand = iRand + 1
  178.           IF iGhostSX(N) = 0 AND iGhostSY(N) = 1 THEN iC = iC + 4: iUp = 1: iRand = iRand + 1
  179.           IF iGhostSX(N) = 0 AND iGhostSY(N) = -1 THEN iC = iC + 8: iDn = 1: iRand = iRand + 1
  180.         END IF
  181.        
  182.         'choose new direction
  183.         DO WHILE iC > 0 AND iC <> iGhostMov(N)
  184.           iRand = (iRand + 1) AND 3
  185.           IF iRand = 0 AND iRt = 1 THEN iGhostSX(N) = 1: iGhostSY(N) = 0: EXIT DO
  186.           IF iRand = 1 AND iDn = 1 THEN iGhostSX(N) = 0: iGhostSY(N) = 1: EXIT DO
  187.           IF iRand = 2 AND iLt = 1 THEN iGhostSX(N) = -1: iGhostSY(N) = 0: EXIT DO
  188.           IF iRand = 3 AND iUp = 1 THEN iGhostSX(N) = 0: iGhostSY(N) = -1: EXIT DO
  189.         LOOP
  190.        
  191.         'move o fantasma (se puder)
  192.         iGhostMov(N) = iC
  193.         IF iC > 0 THEN
  194.           iGhostX(N) = iGhostX(N) + iGhostSX(N)
  195.           iGhostY(N) = iGhostY(N) + iGhostSY(N)
  196.         END IF
  197.        
  198.       END IF
  199.     END IF
  200.    
  201.     'if dead than put all ghosts on start position and add some delay
  202.     IF iDead THEN
  203.       iGhostX(N) = iSpawnX: iGhostY(N) = iSpawnY
  204.       iGhostWait(N) = N * 128 + N + 32
  205.     END IF
  206.    
  207.     LOCATE iGhostY(N), iGhostX(N)
  208.     IF iSuper > 0 THEN
  209.       'while player is super then ghosts are same color
  210.       'but when super time is running out they blink white
  211.       iC = 3
  212.       FOR M = 4 TO 40 STEP 4
  213.         IF iSuper > M THEN
  214.           IF iC = 3 THEN iC = 15 ELSE iC = 3
  215.         END IF
  216.       NEXT M
  217.       COLOR iC
  218.     ELSE
  219.       COLOR N + 10
  220.     END IF
  221.     PRINT CHR$(15);
  222.    
  223.   NEXT N
  224.  
  225.   'if dead then put player on start position
  226.   'if was not there then decrement a life
  227.   IF iDead THEN
  228.     LOCATE iPlayerY, iPlayerX: PRINT " ";
  229.     IF iPlayerX <> iStartX OR iPlayerY <> iStartY THEN iLives = iLives - 1
  230.     iPlayerX = iStartX: iPlayerY = iStartY
  231.   END IF
  232.  
  233.   'teleport side to side
  234.   IF iPlayerX < 1 THEN iPlayerX = 21: iRand = iRand + 3
  235.   IF iPlayerX > 21 THEN iPlayerX = 1: iRand = iRand + 1
  236.    
  237.   SELECT CASE MID$(sMap(iPlayerY), iPlayerX, 1)
  238.   CASE "."
  239.     'when step on a dot eat it and decrement dot count
  240.     'if theres no more dots then you won!
  241.     iDots = iDots - 1: iRand = iRand + 2
  242.     iScore = iScore + 5: SOUND 8000, 1 / 18
  243.     MID$(sMap(iPlayerY), iPlayerX, 1) = " "
  244.   CASE "*"
  245.     'if it was super dot then become super for 256 frames
  246.     iDots = iDots - 1: iSuper = iSuper + 256
  247.     iRand = iRand + 3: iScore = iScore + 20
  248.     MID$(sMap(iPlayerY), iPlayerX, 1) = " "
  249.   END SELECT
  250.  
  251.   'screen information
  252.   COLOR 15: LOCATE 2, 23: PRINT "Dots.: "; iDots; " ";
  253.   COLOR 14: LOCATE 4, 23: PRINT "Super: "; (iSuper + 19) \ 20; " ";
  254.   COLOR 10: LOCATE 6, 23: PRINT "Score: "; iScore
  255.   COLOR 12: LOCATE 8, 23: PRINT "Vidas: "; iLives
  256.  
  257.   'if player super then swap between chr$(1 and chr$(2) otherwise chr$(1)
  258.   IF iSuper > 0 THEN
  259.     iSuper = iSuper - 1: iRand = iRand + 1
  260.     iPlayer = 3 - iPlayer '2<->1
  261.   ELSE
  262.     iPlayer = 1
  263.   END IF
  264.  
  265.   'if theres no more lives game end without drawing player
  266.   IF iLives < 1 THEN EXIT DO
  267.  
  268.   'draw player
  269.   LOCATE iPlayerY, iPlayerX, 0
  270.   COLOR 14: PRINT CHR$(iPlayer);
  271.  
  272.   'if no more dots to get game ends with player showing
  273.   IF iDots < 1 THEN EXIT DO
  274.  
  275.   'while no key is pressed go back to start
  276.   sKey = INKEY$
  277.   IF sKey = "" THEN
  278.     IF ABS(TIMER-fDelay) > 1 THEN fDelay = TIMER
  279.     WHILE ABS(TIMER-fDelay) < (1/18.2)
  280.       WAIT &H3DA, 8: WAIT &H3DA, 8, 8 'vsync?
  281.     WEND    
  282.     fDelay = fDelay+(1/18.2) : GOTO ContinueDo
  283.   END IF
  284.  
  285.  
  286.   IF sKey = CHR$(27) THEN EXIT DO 'escape quit
  287.  
  288.   'erase player (as it may change position)
  289.   LOCATE iPlayerY, iPlayerX
  290.   PRINT " ";
  291.  
  292.   'one arrow was pressed can the player move to that direction?
  293.   SELECT CASE sKey
  294.   CASE CHR$(0) + "K"
  295.     IF iPlayerX > 1 THEN
  296.       IF MID$(sMap(iPlayerY), iPlayerX - 1, 1) < "y" THEN
  297.         iPlayerX = iPlayerX - 1: iRand = iRand + 1: iDead = 0
  298.       END IF
  299.     ELSE
  300.       iPlayerX = iPlayerX - 1: iRand = iRand + 1: iDead = 0
  301.     END IF
  302.   CASE CHR$(0) + "M"
  303.     IF MID$(sMap(iPlayerY), iPlayerX + 1, 1) < "y" THEN
  304.       iPlayerX = iPlayerX + 1: iRand = iRand + 2: iDead = 0
  305.     END IF
  306.   CASE CHR$(0) + "H"
  307.     IF MID$(sMap(iPlayerY - 1), iPlayerX, 1) < "y" THEN
  308.       iPlayerY = iPlayerY - 1: iRand = iRand + 3: iDead = 0
  309.     END IF
  310.   CASE CHR$(0) + "P"
  311.     IF MID$(sMap(iPlayerY + 1), iPlayerX, 1) < "y" THEN
  312.       iPlayerY = iPlayerY + 1: iRand = iRand + 1: iDead = 0
  313.     END IF
  314.   END SELECT
  315.  
  316. LOOP
  317.  
  318. IF iDots <= 0 THEN
  319.   WHILE INKEY$ <> CHR$(27)
  320.     IF iC = 10 THEN iC = 15 ELSE iC = 10
  321.     LOCATE 16, 27: COLOR iC
  322.     PRINT "Well Done!";
  323.     SOUND 32767, 3
  324.   WEND
  325. ELSE
  326.   IF iLives <= 0 THEN
  327.     WHILE INKEY$ <> CHR$(27)
  328.       IF iC = 12 THEN iC = 9 ELSE iC = 12
  329.       LOCATE 16, 27: COLOR iC
  330.       PRINT "GAME OVER!";
  331.       SOUND 32767, 4
  332.     WEND
  333.   END IF
  334. END IF
  335.  
  336.  
  337.  
  338.  
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement