Author Topic: Trip down memory lane (modern style)  (Read 2986 times)

0 Members and 1 Guest are viewing this topic.

Offline xra7en

  • Seasoned Forum Regular
  • Posts: 284
    • View Profile
Trip down memory lane (modern style)
« on: June 03, 2019, 04:12:53 pm »
I plan on making a book like David Ahl used to to. What worked then can still work today. To learn to program, I used to always refer back to these books and either copy the code, or translate it to a new language in order to better understand.

I think I will call it "QB64 COMPUTER GAMES" Yes?
The book will not be just a direct copy or style of DAVID H AHL, but more of a compliment. Something that teaches modular programing and sterring way from the spaghetti code.  All of the games will circle around some type of algebra, trig or calculus to make games fun. All will be short to code in a few hours to a day or two at best.

If you guys have any suggestions for SIMPLE games... post here.

This one is not done, but definitely playable. Sadly there is not formula for computing x,y. So it's more of a guessing game. There are some cosmetic touches left, and a few bugs.

INCLUDE FILE (REQUIRED)
Code: QB64: [Select]
  1. '// DEC(X) -1 TO X
  2. '// INC(X) +1 TO X
  3. '// DISTANCE: DISTANCE BETWEEN 2 X,Y COORDS
  4.  
  5.     '============================================================================
  6.     '--- PASCAL FUNCTION: DECREASES X BY 1)
  7.     '============================================================================
  8.     DEC = X - 1
  9.  
  10.     '============================================================================
  11.     '--- PASCAL FUNCTION: INCREASE X BY 1)
  12.     '============================================================================
  13.     INC = X + 1
  14.  
  15. FUNCTION DISTANCE (X1, Y1, X2, Y2 AS INTEGER)
  16.     '============================================================================
  17.     '--- DIST BETWEEN 2 POINTS
  18.     '============================================================================
  19.     DISTANCE = SQR((X1 - X2) ^ 2 + (Y1 - Y2) ^ 2)
  20.  
  21.  
  22. FUNCTION yesNo (default AS STRING)
  23.     '// @default = when ENTER is pressed what will be the default answer
  24.  
  25.     DIM ans AS STRING
  26.  
  27.     DO
  28.         ans = INKEY$
  29.         ans = LCASE$(ans)
  30.     LOOP UNTIL ans = "y" OR ans = "n" OR ans = CHR$(13)
  31.     IF ans = CHR$(13) THEN ans = default
  32.  
  33.     IF ans = "y" THEN
  34.         yesNo = 1
  35.     ELSE
  36.         yesNo = 0
  37.     END IF
  38.  
  39.  
  40. FUNCTION COUNT_TAGS (TEXT AS STRING)
  41.     '//
  42.     '// RETURNS THE NUMBER OF LORD TAGS IN A STRING
  43.     '//
  44.     DIM I AS INTEGER
  45.     IF LEN(TEXT) = 0 THEN COUNT_TAGS = 0
  46.     DIM COUNT AS INTEGER
  47.     DIM LENGTH AS INTEGER
  48.     LENGTH = LEN(TEXT)
  49.     COUNT = 0
  50.  
  51.     FOR I = 1 TO LENGTH
  52.         IF MID$(TEXT, I, 1) = "`" THEN COUNT = COUNT + 1
  53.  
  54.     NEXT
  55.     COUNT_TAGS = COUNT
  56.  
  57.  
  58.  
  59.  
  60. SUB CENTER (text AS STRING, row AS INTEGER)
  61.     '//
  62.     '// CENTER TEXT AS A SPECIFIED ROW
  63.     '//
  64.     DIM textLen, col AS INTEGER
  65.     DIM TAGS AS INTEGER
  66.  
  67.     IF INSTR(text, "`") >= 1 THEN ' There is a tag
  68.  
  69.         TAGS = COUNT_TAGS(text) * 2
  70.         textLen = INT((LEN(text) - TAGS) / 2)
  71.     ELSE
  72.         textLen = INT(LEN(text) / 2)
  73.  
  74.     END IF
  75.  
  76.     col = 40 - textLen
  77.     LOCATE row, col
  78.     IF TAGS > 0 THEN
  79.         LWRITE text
  80.     ELSE
  81.         PRINT text
  82.     END IF
  83.  
  84.  
  85.  
  86. SUB LWRITE (TXT AS STRING)
  87.     DIM i AS INTEGER
  88.     '======================================================
  89.     '--- THIS IS A POPULAR COLOR ROUTINE BASED ON THE
  90.     '--- SETH ABLE L.O.R.D. BBS GAME COLOR FORMATTING
  91.     '=====================================================
  92.     COLOR 7 ' DEFAULT COLOR
  93.     FOR i = 1 TO LEN(TXT$)
  94.         ' CHECK FOR A COLOR CHANGE
  95.         IF MID$(TXT$, i, 1) = "`" THEN
  96.             i = i + 1
  97.             SELECT CASE MID$(TXT, i, 1)
  98.                 CASE "0": COLOR 10
  99.                 CASE "1": COLOR 1
  100.                 CASE "2": COLOR 2
  101.                 CASE "3": COLOR 3
  102.                 CASE "4": COLOR 4
  103.                 CASE "5": COLOR 5
  104.                 CASE "6": COLOR 6
  105.                 CASE "7": COLOR 7
  106.                 CASE "8": COLOR 8
  107.                 CASE "9": COLOR 9
  108.                 CASE "!": COLOR 11
  109.                 CASE "@": COLOR 12
  110.                 CASE "#": COLOR 13
  111.                 CASE "$": COLOR 14
  112.                 CASE "%": COLOR 15
  113.                 CASE "n": PRINT '           new line
  114.                 CASE "t": PRINT , ; '       TAB
  115.             END SELECT
  116.             i = i + 1
  117.  
  118.         END IF
  119.         PRINT MID$(TXT$, i, 1);
  120.     NEXT
  121.     PRINT ;
  122.  
  123. SUB LWRITELN (TXT AS STRING)
  124.     LWRITE (TXT$)
  125.     PRINT
  126.  


ACTUAL GAME
Code: QB64: [Select]
  1.  
  2. '// MINE: SENTRY DRONE
  3. '// DESC: USE DRONES TO DETONATE TOXIC ROX TO PREP SECTOR FOR MINING
  4. '//
  5.  
  6. DIM SHARED TURN AS INTEGER '                    TURN COUNTER. STARTING 3 TURNS PER ROX*
  7. DIM SHARED ROX_CNT AS INTEGER '                 TOTAL ROX IN THIS SECTOR
  8. DIM SHARED ROX_TOTAL AS INTEGER '               TOTAL NUMBER OF ROX TO FIND
  9. DIM SHARED I, J AS INTEGER '                    LOOP COUNTERS
  10. DIM SHARED GAMEOVER AS INTEGER
  11. DIM SHARED SECTOR(20, 20) AS INTEGER '           AREA WHERE ROX ARE HIDDEN
  12. DIM SHARED ROX_TIMER(20, 20) AS INTEGER '        IF PLAYER IS WITHIN 3 SQUARES, ROX CAN EXPLODE AFTER 3 TURNS*
  13.  
  14. CONST TRUE = 1
  15. CONST FALSE = 0
  16.  
  17. TITLE
  18. INSTRUCTIONS
  19.  
  20.     GAME_INIT
  21.     GAME_RUN
  22.  
  23. LOOP UNTIL GAMEOVER = TRUE
  24.  
  25. '$include: 'utils.bi'
  26.  
  27.  
  28. SUB GAME_INIT
  29.     GAMEOVER = FALSE
  30.     ROX_TOTAL = 15
  31.     DIM X, Y AS INTEGER
  32.  
  33.     TURN = 0
  34.     FOR I = 1 TO ROX_TOTAL: FOR J = 1 TO 2: SECTOR(I, J) = 0: ROX_TIMER(I, J) = 0: NEXT: NEXT
  35.     FOR I = 1 TO ROX_TOTAL
  36.         FOR J = 1 TO 2
  37.             SECTOR(I, J) = INT(RND * ROX_TOTAL) + 1
  38.         NEXT J
  39.     NEXT I
  40.  
  41.  
  42.  
  43. SUB GAME_RUN
  44.     DIM M, N AS INTEGER
  45.     DIM D AS DOUBLE '                                                       DISTANCE VAR
  46.     DIM ACTIVE AS INTEGER '                                                 IS A ROX STILL ACTIVE
  47.  
  48.  
  49.     DO
  50.         LWRITELN ("`7TURN `$" + STR$(TURN)) '                               DISPLAY TURN
  51.         LWRITELN ("`% 99,0 `8= `7Quit,  `%99,1 = `7Help") '                 OTHER PLAYER OPTIONS
  52.         LWRITE ("`7Guess X,Y location: `#") '                               ASK FOR GUESS
  53.         INPUT M, N '                                                        X,Y = M,N
  54.  
  55.         IF M = 99 AND N = 0 THEN
  56.             GAME_END
  57.             EXIT SUB
  58.         END IF
  59.  
  60.         '//TODO ADD HELP HERE
  61.         FOR I = 1 TO ROX_TOTAL '                                                   START LOOP OF #OF ROX
  62.             IF SECTOR(I, 1) <> -1 THEN '                                    ROX NOT DESTROYED?
  63.                 IF M = SECTOR(I, 1) AND N = SECTOR(I, 2) THEN '             M & n = X,Y?
  64.                     LWRITELN ("`2TARGET `4" + STR$(I) + " `0MARKED FOR DESTRUCTION!") '        YES!!
  65.                     SECTOR(I, 1) = -1 '                                     MARK IT AS DESTROYED (-1)
  66.  
  67.                 ELSE '                                                      OTHERWISE.....
  68.                     D = DISTANCE(SECTOR(I, 1), SECTOR(I, 2), M, N) '        CALC DISTANCE FROM 0,0
  69.                     LWRITELN ("`7TARGET `$" + STR$(I) + " `7DISTANCE: `$" + STR$((INT(D * 10) / 10))) ' DISPLAY TO PLAYER
  70.  
  71.                 END IF
  72.             END IF '                                                        CHECK DONE PLAYER GUESS=ROX X,Y
  73.         NEXT I '                                                            LOOP TO NEXT ROX LOCATION
  74.  
  75.         '//
  76.         '// CHECK TO SEE IF THEY ALL HAVE BEEN FOUND (-1)
  77.         '//
  78.         ACTIVE = FALSE '                                                    DEFAULT CHECK TO FALSE
  79.  
  80.         FOR I = 1 TO ROX_TOTAL '                                                   GO THROUGH ALL ROX LOCATIONS
  81.             IF SECTOR(I, 1) > 0 THEN ACTIVE = TRUE '                        IF ANY ARE NOT -1 ACTIVE = TRUE
  82.         NEXT
  83.  
  84.         IF ACTIVE = FALSE THEN GAME_END_WIN '                               IF ALL FOUND, END GAME
  85.  
  86.         TURN = INC(TURN) '                                                  INC TURN (CONT.. GAME)
  87.  
  88.  
  89.         IF TURN > 40 THEN GAME_END_LOSE '                                   DID THEY RUN OUT OF TIME?
  90.     LOOP UNTIL ACTIVE = FALSE '                                             CONT.. UNTIL ALL ACTIVE ARE FALSE
  91.  
  92.  
  93.  
  94. SUB GAME_END
  95.     DIM ANS AS INTEGER
  96.     COLOR 3
  97.     PRINT
  98.     PRINT "SINCE YOU ARE THE ONLY 'QUALIFIED' PERSON OUT HERE,"
  99.     PRINT "WOULD YOU LIKE TO WORK ON ANOTHER SECTOR? Y/n: ";
  100.     COLOR 13
  101.     ANS = yesNo("N")
  102.     GAMEOVER = FALSE
  103.     IF ANS = FALSE THEN GAMEOVER = TRUE
  104.  
  105. SUB GAME_END_WIN
  106.     CLS
  107.     PRINT "YOU FOUND THEM ALL!"
  108.     PRINT "CONT.. END GAME STORY"
  109.     ACCURACY
  110.  
  111.     PRINT
  112.     GAME_END
  113.  
  114. SUB ACCURACY
  115.     PRINT "Your accuracy = ";
  116.     PRINT USING "###.##"; ABS(100 - ((ROX_TOTAL / TURN) * 100)); "% !"
  117.  
  118.  
  119. SUB GAME_END_LOSE
  120.     CLS
  121.     COLOR 4
  122.     PRINT "TIMES UP. YOU WERE NOT ABLE TO GET THEM ALL :"
  123.     PRINT
  124.     PRINT "AFTER THE MASSIVE EXPLOSIONS, THE SATILITE WAS ABLE TO RESOLVE"
  125.     PRINT "THE REMAINING LOCATIONS:"
  126.     PRINT
  127.     COLOR 7
  128.     FOR I = 1 TO ROX_TOTAL
  129.         IF SECTOR(I, 1) <> -1 THEN PRINT "ROX "; I; " LOCATED AT "; SECTOR(I, 1); ","; SECTOR(I, 2)
  130.     NEXT I
  131.     PRINT
  132.     ACCURACY
  133.     PRINT
  134.  
  135.     GAME_END
  136.  
  137.  
  138. SUB TITLE
  139.     CLS
  140.     CALL CENTER("`#ROX SENTRY", 2)
  141.  
  142.     CALL CENTER("`8Press `7ENTER `8 to start", 20)
  143.  
  144.     I = yesNo("y")
  145.     CLS
  146.  
  147.  
  148. SUB INSTRUCTIONS
  149.     DIM ans AS INTEGER
  150.  
  151.     COLOR 7
  152.     PRINT "A mining company wants to mine a new planet. However  toxic and explosive"
  153.     PRINT "pockets line the surface. Your job: Find these pockets and mark them for"
  154.     PRINT "drones to hone in and safely destroy them. Problem: The satilites are"
  155.     PRINT "malfunctioning, and therefore cannot relay their information to the drones.!"
  156.     PRINT "This is where you come in, guess x,y coords and in return the satilite will"
  157.     PRINT "tell you how far you are off. Why the satilites cannot inform you directly is"
  158.     PRINT "another 'bug' in the system"
  159.     PRINT
  160.     LWRITELN ("`7When asked, input and x,y coord like: `#X`8,`#Y `7include the 'comma'")
  161.     PRINT "in your answer"
  162.     PRINT
  163.     PRINT "Good Luck (Note: You have 40 tries to eliminate all the ROX pockets)"
  164.     PRINT
  165.     PRINT
  166.     PRINT "Press ENTER to continue...."
  167.     ans = yesNo("Y")
  168.  
  169.  

I just like re-writing old DOS book games into modern QB64 code - weird hobby, I know!

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Trip down memory lane (modern style)
« Reply #1 on: June 04, 2019, 04:54:40 pm »
I made a few modifications:

Code: QB64: [Select]
  1. _TITLE "Rox Proximity" '  by bplus started 2019-06-04"
  2.  
  3. CONST xmax = 800
  4. CONST ymax = 600
  5. CONST nSquaresPerSide = 10
  6. CONST squareSize = 40
  7. CONST nRox = 15
  8.  
  9. SCREEN _NEWIMAGE(xmax, ymax, 32)
  10. _SCREENMOVE 360, 60
  11.  
  12. DIM SHARED xOffSet AS INTEGER, yOffSet AS INTEGER, escape AS INTEGER, missionComplete AS INTEGER
  13. DIM SHARED turn AS INTEGER, ClickedCol AS INTEGER, clickedRow AS INTEGER
  14. xOffSet = (xmax - squareSize * nSquaresPerSide) / 2
  15. yOffSet = (ymax - squareSize * nSquaresPerSide) / 2
  16. DIM SHARED board(1 TO nSquaresPerSide, 1 TO nSquaresPerSide) AS INTEGER
  17. DIM SHARED report(1 TO nRox) AS STRING
  18.  
  19. help
  20. initGame
  21. ClickedCol = 1: clickedRow = 1
  22.     updateScreen
  23.     getClick
  24.     IF escape THEN CLS: END
  25.     SELECT CASE board(ClickedCol, clickedRow)
  26.         CASE 0: board(ClickedCol, clickedRow) = 1 'now explored no Rox
  27.         CASE -1: board(ClickedCol, clickedRow) = -10 'Rox now marked
  28.     END SELECT
  29.     _LIMIT 60
  30. LOOP UNTIL missionComplete
  31.  
  32. SUB initGame 'assign rox positions  on board
  33.     DIM i AS INTEGER, rx AS INTEGER, ry AS INTEGER
  34.     FOR i = 1 TO nRox
  35.         rx = INT(RND * nSquaresPerSide) + 1
  36.         ry = INT(RND * nSquaresPerSide) + 1
  37.         WHILE board(rx, ry) = -1
  38.             rx = INT(RND * nSquaresPerSide) + 1
  39.             ry = INT(RND * nSquaresPerSide) + 1
  40.         WEND
  41.         board(rx, ry) = -1
  42.     NEXT
  43.  
  44. SUB getClick
  45.     DIM test AS STRING
  46.     DIM m AS INTEGER, mb AS INTEGER, mx AS INTEGER, my AS INTEGER, row AS SINGLE, col AS SINGLE
  47.     ClickedCol = 0: clickedRow = 0
  48.     WHILE 1
  49.         test$ = INKEY$
  50.         IF LEN(test$) THEN
  51.             IF ASC(test$) = 27 THEN escape = -1: EXIT SUB
  52.         END IF
  53.         m = _MOUSEINPUT: mb = _MOUSEBUTTON(1): mx = _MOUSEX: my = _MOUSEY
  54.         IF mb THEN 'get last place mouse button was down
  55.             mb = _MOUSEBUTTON(1): mx = _MOUSEX: my = _MOUSEY
  56.             WHILE mb 'left button down, wait for mouse button release before doing anything as a "click"
  57.                 m = _MOUSEINPUT: mb = _MOUSEBUTTON(1): mx = _MOUSEX: my = _MOUSEY
  58.             WEND
  59.             row = (my - yOffSet) / squareSize
  60.             IF row > 0 AND row < nSquaresPerSide THEN
  61.                 clickedRow = INT(row) + 1
  62.                 col = (mx - xOffSet) / squareSize
  63.                 IF col > 0 AND col < nSquaresPerSide THEN
  64.                     ClickedCol = INT(col) + 1
  65.                     EXIT WHILE
  66.                 ELSE
  67.                     IF mx <> -1 AND my <> -1 THEN BEEP
  68.                 END IF
  69.             ELSE
  70.                 IF mx <> -1 AND my <> -1 THEN BEEP
  71.             END IF
  72.         END IF
  73.         _LIMIT 1000 'STOP THE FAN !
  74.     WEND
  75.     turn = turn + 1
  76.  
  77. SUB updateScreen
  78.     DIM r AS INTEGER, c AS INTEGER, reportI AS INTEGER, marked AS INTEGER
  79.     DIM s AS STRING
  80.     DIM colr AS _UNSIGNED LONG
  81.     CLS
  82.     'LOCATE 1, 1: PRINT ClickedCol, clickedRow
  83.     LOCATE 2, 60: PRINT "Red for Rox"
  84.     LOCATE 3, 60: PRINT "Green for clear"
  85.     FOR r = 1 TO nSquaresPerSide
  86.         FOR c = 1 TO nSquaresPerSide
  87.             SELECT CASE board(c, r)
  88.                 CASE -1, 0
  89.                     s = _TRIM$(STR$(ABS(ClickedCol - c) + ABS(clickedRow - r)))
  90.                     colr = &HFF888888
  91.                     IF board(c, r) = -1 THEN
  92.                         reportI = reportI + 1
  93.                         report(reportI) = s
  94.                     END IF
  95.                 CASE 1
  96.                     s = ""
  97.                     colr = &HFF008800
  98.                 CASE -10 'mark Rox
  99.                     s = ""
  100.                     colr = &HFFFF0000
  101.                     reportI = reportI + 1
  102.                     report(reportI) = "Marked"
  103.                     marked = marked + 1
  104.             END SELECT
  105.             LINE (xOffSet + (c - 1) * squareSize, yOffSet + (r - 1) * squareSize)-STEP(squareSize, squareSize), colr, BF
  106.             IF s <> "" THEN
  107.                 COLOR &HFFFFFFFF, colr
  108.                 _PRINTSTRING (xOffSet + (c - 1) * squareSize + (squareSize - LEN(s) * 8) / 2, yOffSet + (r - 1) * squareSize + (squareSize - 16) / 2), s
  109.                 COLOR &HFFFFFFFF, &HFF000000
  110.             END IF
  111.         NEXT
  112.     NEXT
  113.  
  114.     LOCATE 2, 5: PRINT "Satellite Report for turn #"; turn; " location ("; RTRIM$(STR$(ClickedCol)); ","; RTRIM$(STR$(clickedRow)); ")"
  115.     LOCATE 3, 5: PRINT "Rox #", "Prox:"
  116.     FOR r = 1 TO 15
  117.         LOCATE r + 3, 5: PRINT r, report$(r)
  118.     NEXT
  119.     IF marked = nRox THEN
  120.         missionComplete = -1
  121.         s = "Congratulations! All Rox are marked."
  122.         LOCATE 34, (xmax / 8 - LEN(s)) \ 2: PRINT s
  123.     END IF
  124.  
  125. SUB help
  126.     PRINT
  127.     PRINT "        A mining company wants to mine a new planet. However toxic and explosive"
  128.     PRINT "   pockets line the surface."
  129.     PRINT
  130.     PRINT "        Your job: Find these pockets and mark them for drones to safely destroy."
  131.     PRINT
  132.     PRINT "        Problem: The satellites are malfunctioning, and therefore cannot relay"
  133.     PRINT "   their information to the drones!"
  134.     PRINT
  135.     PRINT "        This is where you come in, click an x, y coordinate and the satilite will"
  136.     PRINT "   tell you how far off you are."
  137.     PRINT
  138.     PRINT "        Why the satilites cannot do this directly is another 'bug' in the system."
  139.     PRINT
  140.     PRINT "        You will start the survey at the top left corner of the map."
  141.     PRINT
  142.     PRINT "        Proximity units are the number of squares away from your last click."
  143.     PRINT
  144.     PRINT "                                                       Press any to continue... "
  145.     SLEEP
  146.  
  147.  

 
Rox Proximity.PNG
« Last Edit: June 04, 2019, 05:02:11 pm by bplus »

Offline xra7en

  • Seasoned Forum Regular
  • Posts: 284
    • View Profile
Re: Trip down memory lane (modern style)
« Reply #2 on: June 04, 2019, 04:58:07 pm »
very nice!!!
I just like re-writing old DOS book games into modern QB64 code - weird hobby, I know!

Offline xra7en

  • Seasoned Forum Regular
  • Posts: 284
    • View Profile
Re: Trip down memory lane (modern style)
« Reply #3 on: June 04, 2019, 06:05:55 pm »
OK, I played the modified version, doesn't seem to work for solving. My original (a HURKLE remake) base is 0,0. The distances shown is computed from that point. Using a compass you can get close to find the ROX.
The version seems like a minesweep version. How do you find a location?
I just like re-writing old DOS book games into modern QB64 code - weird hobby, I know!

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Trip down memory lane (modern style)
« Reply #4 on: June 04, 2019, 06:11:36 pm »
OK, I played the modified version, doesn't seem to work for solving. My original (a HURKLE remake) base is 0,0. The distances shown is computed from that point. Using a compass you can get close to find the ROX.
The version seems like a minesweep version. How do you find a location?


Yes I skipped the distance formula, you just count the x and y squares away. The satellite reports says the same thing, say 3, look on the map for all the 3's around the last clicked item, look for a 3 following the click point on the map, as the Rox are counted from top top bottom, left to right. A diagonal will count as 2 = 1 x move + 1 y move.
« Last Edit: June 04, 2019, 06:15:40 pm by bplus »

Offline xra7en

  • Seasoned Forum Regular
  • Posts: 284
    • View Profile
Re: Trip down memory lane (modern style)
« Reply #5 on: June 04, 2019, 06:55:38 pm »
ahhh, I kinda thought that was how it worked. I had fun playing it. Much easier than mine hahaha

The easiest way to solve SENTRY DRONE, is to either get fancy calculus, or cheat and use a compass LOL.

There are several favs of mine from that BASIC COMPUTER GAMES trilogy that D.A. created that I will be remaking

and of course - can't remake it without a WUMPUS game LOL!!

I have a few other mods to the SENTRY DONE that I want to clean up. Mostly the display.
I just like re-writing old DOS book games into modern QB64 code - weird hobby, I know!

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Trip down memory lane (modern style)
« Reply #6 on: June 04, 2019, 07:08:49 pm »
Very simple to modify it with the distance formula, but it makes it really easy to decide what to click next:
Code: QB64: [Select]
  1. _TITLE "Rox Proximity" '  by bplus started 2019-06-04 modified for distance formula
  2.  
  3. CONST xmax = 800
  4. CONST ymax = 600
  5. CONST nSquaresPerSide = 10
  6. CONST squareSize = 40
  7. CONST nRox = 15
  8.  
  9. SCREEN _NEWIMAGE(xmax, ymax, 32)
  10. _SCREENMOVE 360, 60
  11.  
  12. DIM SHARED xOffSet AS INTEGER, yOffSet AS INTEGER, escape AS INTEGER, missionComplete AS INTEGER
  13. DIM SHARED turn AS INTEGER, ClickedCol AS INTEGER, clickedRow AS INTEGER
  14. xOffSet = (xmax - squareSize * nSquaresPerSide) / 2
  15. yOffSet = (ymax - squareSize * nSquaresPerSide) / 2
  16. DIM SHARED board(1 TO nSquaresPerSide, 1 TO nSquaresPerSide) AS INTEGER
  17. DIM SHARED report(1 TO nRox) AS STRING
  18.  
  19. help
  20. initGame
  21. ClickedCol = 1: clickedRow = 1
  22.     updateScreen
  23.     getClick
  24.     IF escape THEN CLS: END
  25.     SELECT CASE board(ClickedCol, clickedRow)
  26.         CASE 0: board(ClickedCol, clickedRow) = 1 'now explored no Rox
  27.         CASE -1: board(ClickedCol, clickedRow) = -10 'Rox now marked
  28.     END SELECT
  29.     _LIMIT 60
  30. LOOP UNTIL missionComplete
  31.  
  32. SUB initGame 'assign rox positions  on board
  33.     DIM i AS INTEGER, rx AS INTEGER, ry AS INTEGER
  34.     FOR i = 1 TO nRox
  35.         rx = INT(RND * nSquaresPerSide) + 1
  36.         ry = INT(RND * nSquaresPerSide) + 1
  37.         WHILE board(rx, ry) = -1
  38.             rx = INT(RND * nSquaresPerSide) + 1
  39.             ry = INT(RND * nSquaresPerSide) + 1
  40.         WEND
  41.         board(rx, ry) = -1
  42.     NEXT
  43.  
  44. SUB getClick
  45.     DIM test AS STRING
  46.     DIM m AS INTEGER, mb AS INTEGER, mx AS INTEGER, my AS INTEGER, row AS SINGLE, col AS SINGLE
  47.     ClickedCol = 0: clickedRow = 0
  48.     WHILE 1
  49.         test$ = INKEY$
  50.         IF LEN(test$) THEN
  51.             IF ASC(test$) = 27 THEN escape = -1: EXIT SUB
  52.         END IF
  53.         m = _MOUSEINPUT: mb = _MOUSEBUTTON(1): mx = _MOUSEX: my = _MOUSEY
  54.         IF mb THEN 'get last place mouse button was down
  55.             mb = _MOUSEBUTTON(1): mx = _MOUSEX: my = _MOUSEY
  56.             WHILE mb 'left button down, wait for mouse button release before doing anything as a "click"
  57.                 m = _MOUSEINPUT: mb = _MOUSEBUTTON(1): mx = _MOUSEX: my = _MOUSEY
  58.             WEND
  59.             row = (my - yOffSet) / squareSize
  60.             IF row > 0 AND row < nSquaresPerSide THEN
  61.                 clickedRow = INT(row) + 1
  62.                 col = (mx - xOffSet) / squareSize
  63.                 IF col > 0 AND col < nSquaresPerSide THEN
  64.                     ClickedCol = INT(col) + 1
  65.                     EXIT WHILE
  66.                 ELSE
  67.                     IF mx <> -1 AND my <> -1 THEN BEEP
  68.                 END IF
  69.             ELSE
  70.                 IF mx <> -1 AND my <> -1 THEN BEEP
  71.             END IF
  72.         END IF
  73.         _LIMIT 1000 'STOP THE FAN !
  74.     WEND
  75.     turn = turn + 1
  76.  
  77. SUB updateScreen
  78.     DIM r AS INTEGER, c AS INTEGER, reportI AS INTEGER, marked AS INTEGER
  79.     DIM d AS SINGLE
  80.     DIM s AS STRING
  81.     DIM colr AS _UNSIGNED LONG
  82.     CLS
  83.     'LOCATE 1, 1: PRINT ClickedCol, clickedRow
  84.     LOCATE 2, 60: PRINT "Red for Rox"
  85.     LOCATE 3, 60: PRINT "Green for clear"
  86.     FOR r = 1 TO nSquaresPerSide
  87.         FOR c = 1 TO nSquaresPerSide
  88.             SELECT CASE board(c, r)
  89.                 CASE -1, 0
  90.                     d = INT(10 * SQR((ClickedCol - c) ^ 2 + (clickedRow - r) ^ 2))
  91.                     s = _TRIM$(STR$(d / 10))
  92.                     colr = &HFF888888
  93.                     IF board(c, r) = -1 THEN
  94.                         reportI = reportI + 1
  95.                         report(reportI) = s
  96.                     END IF
  97.                 CASE 1
  98.                     s = ""
  99.                     colr = &HFF008800
  100.                 CASE -10 'mark Rox
  101.                     s = ""
  102.                     colr = &HFFFF0000
  103.                     reportI = reportI + 1
  104.                     report(reportI) = "Marked"
  105.                     marked = marked + 1
  106.             END SELECT
  107.             LINE (xOffSet + (c - 1) * squareSize, yOffSet + (r - 1) * squareSize)-STEP(squareSize, squareSize), colr, BF
  108.             IF s <> "" THEN
  109.                 COLOR &HFFFFFFFF, colr
  110.                 _PRINTSTRING (xOffSet + (c - 1) * squareSize + (squareSize - LEN(s) * 8) / 2, yOffSet + (r - 1) * squareSize + (squareSize - 16) / 2), s
  111.                 COLOR &HFFFFFFFF, &HFF000000
  112.             END IF
  113.         NEXT
  114.     NEXT
  115.  
  116.     LOCATE 2, 5: PRINT "Satellite Report for turn #"; turn; " location ("; RTRIM$(STR$(ClickedCol)); ","; RTRIM$(STR$(clickedRow)); ")"
  117.     LOCATE 3, 5: PRINT "Rox #", "Prox:"
  118.     FOR r = 1 TO 15
  119.         LOCATE r + 3, 5: PRINT r, report$(r)
  120.     NEXT
  121.     IF marked = nRox THEN
  122.         missionComplete = -1
  123.         s = "Congratulations! All Rox are marked."
  124.         LOCATE 34, (xmax / 8 - LEN(s)) \ 2: PRINT s
  125.     END IF
  126.  
  127. SUB help
  128.     PRINT
  129.     PRINT "        A mining company wants to mine a new planet. However toxic and explosive"
  130.     PRINT "   pockets line the surface."
  131.     PRINT
  132.     PRINT "        Your job: Find these pockets and mark them for drones to safely destroy."
  133.     PRINT
  134.     PRINT "        Problem: The satellites are malfunctioning, and therefore cannot relay"
  135.     PRINT "   their information to the drones!"
  136.     PRINT
  137.     PRINT "        This is where you come in, click an x, y coordinate and the satilite will"
  138.     PRINT "   tell you how far off you are."
  139.     PRINT
  140.     PRINT "        Why the satilites cannot do this directly is another 'bug' in the system."
  141.     PRINT
  142.     PRINT "        You will start the survey at the top left corner of the map."
  143.     PRINT
  144.     PRINT "        Proximity units are the number of squares away from your last click."
  145.     PRINT
  146.     PRINT "                                                       Press any to continue... "
  147.     SLEEP
  148.  
  149.  
Rox Proxi distance.PNG
« Last Edit: June 04, 2019, 07:11:25 pm by bplus »

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Trip down memory lane (modern style)
« Reply #7 on: June 05, 2019, 09:07:16 am »
ahhh, I kinda thought that was how it worked. I had fun playing it. Much easier than mine hahaha

The easiest way to solve SENTRY DRONE, is to either get fancy calculus, or cheat and use a compass LOL.

There are several favs of mine from that BASIC COMPUTER GAMES trilogy that D.A. created that I will be remaking

and of course - can't remake it without a WUMPUS game LOL!!

I have a few other mods to the SENTRY DONE that I want to clean up. Mostly the display.

I found WUMPUS in the QB64 samples.

Offline xra7en

  • Seasoned Forum Regular
  • Posts: 284
    • View Profile
Re: Trip down memory lane (modern style)
« Reply #8 on: June 05, 2019, 12:26:10 pm »
Interesting, the game does not appear in the search results. The only search results with the word WUMPUS  is in fact just my post recently

Can you shoot me a link please, I'd be interested in seeing what the code looks like.
I just like re-writing old DOS book games into modern QB64 code - weird hobby, I know!

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Trip down memory lane (modern style)
« Reply #9 on: June 05, 2019, 02:09:31 pm »
From your downloaded QB64 folder > programs\samples\misc\wumpus.bas

In case you still can't find it :)
Code: QB64: [Select]
  1. REM *** HUNT THE WUMPUS **
  2. DIM p(5)
  3. PRINT "INSTRUCTIONS (Y-N)";
  4. i$ = UCASE$(i$)
  5. IF (i$ = "Y") OR (i$ = "YES") THEN GOSUB 375
  6. REM *** SET UP CAVE (DODECAHEDRAL NODE LIST) ***
  7. DIM s(20, 3)
  8. FOR j = 1 TO 20
  9.     FOR k = 1 TO 3
  10.         READ s(j, k)
  11.     NEXT k
  12. DATA 2,5,8,1,3,10,2,4,12,3,5,14,1,4,6
  13. DATA 5,7,15,6,8,17,1,7,9,8,10,18,2,9,11
  14. DATA 10,12,19,3,11,13,12,14,20,4,13,15,6,14,16
  15. DATA 15,17,20,7,16,18,9,17,19,11,18,20,13,16,19
  16. REM *** LOCATE L ARRAY ITEMS ***
  17. REM *** 1-YOU, 2-WUMPUS, 3&4-PITS, 5&6-BATS ***
  18. DIM l(6)
  19. DIM m(6)
  20. 170 FOR j = 1 TO 6
  21.     l(j) = INT(20 * RND(1)) + 1
  22.     m(j) = l(j)
  23. REM *** CHECK FOR CROSSOVERS (IE l(1)=l(2), ETC) ***
  24. FOR j = 1 TO 6
  25.     FOR k = 1 TO 6
  26.         IF j = k THEN GOTO 215
  27.         IF l(j) = l(k) THEN GOTO 170
  28.    215 NEXT k
  29. REM *** SET NO. OF ARROWS ***
  30. 230 a = 5
  31. l = l(1)
  32. REM *** RUN THE GAME ***
  33. PRINT "HUNT THE WUMPUS"
  34. REM *** HAZARD WARNING AND LOCATION ***
  35. 255 GOSUB 585
  36. REM *** MOVE OR SHOOT ***
  37. GOSUB 670
  38. IF o = 1 THEN GOTO 280
  39. IF o = 2 THEN GOTO 300
  40. REM *** SHOOT ***
  41. 280 GOSUB 715
  42. IF f = 0 THEN GOTO 255
  43. GOTO 310
  44. REM *** MOVE ***
  45. 300 GOSUB 975
  46. IF f = 0 THEN GOTO 255
  47. 310 IF f > 0 THEN GOTO 335
  48. REM *** LOSE ***
  49. PRINT "HA HA HA - YOU LOSE!"
  50. GOTO 340
  51. REM *** WIN ***
  52. 335 PRINT "HEE HEE HEE - THE WUMPUS'LL GET YOU NEXT TIME!!"
  53. 340 FOR j = 1 TO 6
  54.     l(j) = m(j)
  55. PRINT "SAME SETUP (Y-N)";
  56. IF (i$ <> "Y") AND (i$ <> "y") THEN GOTO 170
  57. GOTO 230
  58. 375 REM *** INSTRUCTIONS ***
  59. PRINT "WELCOME TO 'HUNT THE WUMPUS'"
  60. PRINT " THE WUMPUS LIVES IN A CAVE OF 20 ROOMS. EACH ROOM"
  61. PRINT "HAS 3 TUNNELS LEADING TO OTHER ROOMS. (LOOK AT A"
  62. PRINT "DODECAHEDRON TO SEE HOW THIS WORKS-IF YOU DON'T KNOW"
  63. PRINT "WHAT A DODECAHEDRON IS, ASK SOMEONE)"
  64. PRINT " HAZARDS:"
  65. PRINT " BOTTOMLESS PITS - TWO ROOMS HAVE BOTTOMLESS PITS IN THEM"
  66. PRINT " IF YOU GO THERE, YOU FALL INTO THE PIT (& LOSE!)"
  67. PRINT " SUPER BATS - TWO OTHER ROOMS HAVE SUPER BATS. IF YOU"
  68. PRINT " GO THERE, A BAT GRABS YOU AND TAKES YOU TO SOME OTHER"
  69. PRINT " ROOM AT RANDOM. (WHICH MAY BE TROUBLESOME)"
  70. INPUT "HIT RETURN TO CONTINUE"; a$
  71. PRINT " WUMPUS:"
  72. PRINT " THE WUMPUS IS NOT BOTHERED BY HAZARDS (HE HAS SUCKER"
  73. PRINT " FEET AND IS TOO BIG FOR A BAT TO LIFT). USUALLY"
  74. PRINT " HE IS ASLEEP. TWO THINGS WAKE HIM UP: YOU SHOOTING AN"
  75. PRINT "ARROW OR YOU ENTERING HIS ROOM."
  76. PRINT " IF THE WUMPUS WAKES HE MOVES (P=.75) ONE ROOM"
  77. PRINT " OR STAYS STILL (P=.25). AFTER THAT, IF HE IS WHERE YOU"
  78. PRINT " ARE, HE EATS YOU UP AND YOU LOSE!"
  79. PRINT " YOU:"
  80. PRINT " EACH TURN YOU MAY MOVE OR SHOOT A CROOKED ARROW"
  81. PRINT " MOVING: YOU CAN MOVE ONE ROOM (THRU ONE TUNNEL)"
  82. PRINT " ARROWS: YOU HAVE 5 ARROWS. YOU LOSE WHEN YOU RUN OUT"
  83. PRINT " EACH ARROW CAN GO FROM 1 TO 5 ROOMS. YOU AIM BY TELLING"
  84. PRINT " THE COMPUTER THE ROOM#S YOU WANT THE ARROW TO GO TO."
  85. PRINT " IF THE ARROW CAN'T GO THAT WAY (IF NO TUNNEL) IT MOVES"
  86. PRINT " AT RANDOM TO THE NEXT ROOM."
  87. PRINT " IF THE ARROW HITS THE WUMPUS, YOU WIN."
  88. PRINT " IF THE ARROW HITS YOU, YOU LOSE."
  89. INPUT "HIT RETURN TO CONTINUE"; a$
  90. PRINT " WARNINGS:"
  91. PRINT " WHEN YOU ARE ONE ROOM AWAY FROM A WUMPUS OR HAZARD,"
  92. PRINT " THE COMPUTER SAYS:"
  93. PRINT " WUMPUS: 'I SMELL A WUMPUS'"
  94. PRINT " BAT : 'BATS NEARBY'"
  95. PRINT " PIT : 'I FEEL A DRAFT'"
  96. 585 REM *** PRINT LOCATION & HAZARD WARNINGS ***
  97. FOR j = 2 TO 6
  98.     FOR k = 1 TO 3
  99.         IF s(l(1), k) <> l(j) THEN GOTO 640
  100.         SELECT CASE j - 1
  101.             CASE 1
  102.                 GOTO 615
  103.             CASE 2
  104.                 GOTO 625
  105.             CASE 3
  106.                 GOTO 625
  107.             CASE 4
  108.                 GOTO 635
  109.             CASE 5
  110.                 GOTO 635
  111.         END SELECT
  112.        615 PRINT "I SMELL A WUMPUS!"
  113.         GOTO 640
  114.        625 PRINT "I FEEL A DRAFT"
  115.         GOTO 640
  116.        635 PRINT "BATS NEARBY!"
  117.    640 NEXT k
  118. PRINT "YOU ARE IN ROOM "; l(1)
  119. PRINT "TUNNELS LEAD TO "; s(l, 1); " "; s(l, 2); " "; s(l, 3)
  120. 670 REM *** CHOOSE OPTION ***
  121. 675 PRINT "SHOOT OR MOVE (S-M)";
  122. IF (i$ <> "S") AND (i$ <> "s") THEN GOTO 700
  123. o = 1
  124. 700 IF (i$ <> "M") AND (i$ <> "m") THEN GOTO 675
  125. o = 2
  126. 715 REM *** ARROW ROUTINE ***
  127. f = 0
  128. REM *** PATH OF ARROW ***
  129. 735 PRINT "NO. OF ROOMS (1-5)";
  130. IF j9 < 1 THEN GOTO 735
  131. IF j9 > 5 THEN GOTO 735
  132. FOR k = 1 TO j9
  133.    760 PRINT "ROOM #";
  134.     INPUT p(k)
  135.     IF k <= 2 THEN 790
  136.     IF p(k) <> p(k - 2) THEN GOTO 790
  137.     PRINT "ARROWS AREN'T THAT CROOKED - TRY ANOTHER ROOM"
  138.     GOTO 760
  139. 790 NEXT k
  140. REM *** SHOOT ARROW ***
  141. l = l(1)
  142. FOR k = 1 TO j9
  143.     FOR k1 = 1 TO 3
  144.         IF s(l, k1) = p(k) THEN GOTO 895
  145.     NEXT k1
  146.     REM *** NO TUNNEL FOR ARROW ***
  147.     l = s(l, INT(3 * RND(1)) + 1)
  148.     GOTO 900
  149. 840 NEXT k
  150. PRINT "MISSED"
  151. l = l(1)
  152. REM *** MOVE WUMPUS ***
  153. GOSUB 935
  154. REM *** AMMO CHECK ***
  155. a = a - 1
  156. IF a > 0 THEN 885
  157. 880 f = -1
  158. 885 RETURN
  159. REM *** SEE IF ARROW IS AT l(1) OR AT l(2)
  160. 895 l = p(k)
  161. 900 IF l <> l(2) THEN 920
  162. PRINT "AHA! YOU GOT THE WUMPUS!"
  163. f = 1
  164. 920 IF l <> l(1) THEN GOTO 840
  165. PRINT "OUCH! ARROW GOT YOU!"
  166. GOTO 880
  167. 935 REM *** MOVE WUMPUS ROUTINE ***
  168. 940 k = INT(4 * RND(1)) + 1
  169. IF k = 4 THEN GOTO 955
  170. l(2) = s(l(2), k)
  171. 955 IF l(2) <> l THEN GOTO 970
  172. PRINT "TSK TSK TSK - WUMPUS GOT YOU!"
  173. f = -1
  174. 970 RETURN
  175. 975 REM *** MOVE ROUTINE ***
  176. f = 0
  177. 985 PRINT "WHERE TO";
  178. IF l < 1 THEN GOTO 985
  179. IF l > 20 THEN GOTO 985
  180. FOR k = 1 TO 3
  181.     REM *** CHECK IF LEGAL MOVE ***
  182.     IF s(l(1), k) = l THEN GOTO 1045
  183. IF l = l(1) THEN GOTO 1045
  184. PRINT "NOT POSSIBLE -";
  185. GOTO 985
  186. REM *** CHECK FOR HAZARDS ***
  187. 1045 l(1) = l
  188. REM *** WUMPUS ***
  189. IF l <> l(2) THEN GOTO 1090
  190. PRINT "... OOPS! BUMPED A WUMPUS!"
  191. REM *** MOVE WUMPUS ***
  192. GOSUB 940
  193. IF f = 0 THEN GOTO 1090
  194. REM *** PIT ***
  195. 1090 IF l = l(3) THEN GOTO 1100
  196. IF l <> l(4) THEN GOTO 1120
  197. 1100 PRINT "YYYYIIIIEEEE . . . FELL IN PIT"
  198. f = -1
  199. REM *** BATS ***
  200. 1120 IF l = l(5) THEN GOTO 1130
  201. IF l <> l(6) THEN GOTO 1145
  202. 1130 PRINT "ZAP--SUPER BAT SNATCH! ELSEWHEREVILLE FOR YOU!"
  203. l = INT(20 * RND(1)) + 1
  204. GOTO 1045
  205. 1145 RETURN
  206.  

There are lot's of \programs begging to be updated.
1100 PRINT "YYYYIIIIEEEE . . . FEeL the lines numbers"
« Last Edit: June 05, 2019, 02:12:58 pm by bplus »