Author Topic: platform.bas - an attempted QB64 clone of Mr Jump S  (Read 8516 times)

0 Members and 1 Guest are viewing this topic.

FellippeHeitor

  • Guest
platform.bas - an attempted QB64 clone of Mr Jump S
« on: February 21, 2018, 02:11:23 pm »
Here's the current state of my clone of Mr Jump S. No difference in gameplay, as I've simply restructured the code so it's prettier and easier to follow.

Ah, but now you can now jump with the mouse button (click on the game screen).

ESC resets the random level.

This is taken directly from the latest commit c6521ab.

Code: QB64: [Select]
  1.  
  2. CONST false = 0, true = NOT false
  3.  
  4. SCREEN _NEWIMAGE(800, 450, 32)
  5.  
  6. TYPE newLevel
  7.     landColor AS _UNSIGNED LONG
  8.     grassColor AS _UNSIGNED LONG
  9.     waterColor AS _UNSIGNED LONG
  10.     symbolSpacingX AS LONG
  11.     symbolSpacingY AS LONG
  12.  
  13. TYPE newObject
  14.     id AS LONG
  15.     x AS SINGLE
  16.     xv AS SINGLE
  17.     y AS SINGLE
  18.     yv AS SINGLE
  19.     w AS LONG
  20.     h AS LONG
  21.     img AS LONG
  22.     imgPointer AS _BYTE
  23.     standing AS _BYTE
  24.     alive AS _BYTE
  25.  
  26. CONST idPlatform = 1
  27. CONST idGoal = 2
  28. CONST idAirJump = 3
  29. CONST idInfiniteJumps = 4
  30. CONST idSpike = 5
  31. CONST idCloud = 6
  32. CONST idScene = 7
  33. CONST idSky = 8
  34. CONST idWater = 9
  35.  
  36. DIM SHARED thisLevel AS LONG
  37. DIM SHARED arenaWidth AS LONG, i AS LONG
  38. DIM SHARED totalObjects AS LONG
  39. DIM SHARED drowned AS _BYTE
  40. DIM SHARED restartRequested AS _BYTE
  41. DIM SHARED levelData AS newLevel
  42. DIM SHARED platformDecoration AS STRING
  43. DIM SHARED obj(100) AS newObject
  44. DIM SHARED goalGlyph AS STRING, airJumpGlyph AS STRING
  45. DIM SHARED airJumps AS LONG
  46.  
  47.  
  48. goalGlyph = "C" + STR$(_RGB32(255, 255, 255)) + "e10f10g10 h8e8f6g6 h4 e4f2g1"
  49. airJumpGlyph = "C" + STR$(_RGB32(255, 255, 255)) + "e10f10g10h10"
  50. gravity = .8
  51. thisLevel = 1
  52.  
  53. Restart:
  54. setLevel thisLevel
  55.  
  56.     processInput
  57.     doPhysics
  58.     adjustCamera
  59.     drawObjects
  60.     IF restartRequested THEN restartRequested = false: GOTO Restart
  61.     IF NOT drowned THEN drawHero
  62.  
  63.     _DISPLAY
  64.     _LIMIT 60
  65.  
  66. SUB addWater
  67.     DIM this AS LONG
  68.     this = newObject
  69.     obj(this).id = idWater
  70.     obj(this).img = _NEWIMAGE(_WIDTH, _HEIGHT, 32)
  71.     _DEST obj(this).img
  72.     LINE (0, _HEIGHT - _HEIGHT / 4)-STEP(_WIDTH, _HEIGHT / 4), darken(levelData.waterColor, 55), BF
  73.     LINE (0, _HEIGHT - _HEIGHT / 4)-STEP(_WIDTH, _HEIGHT / 7), darken(levelData.waterColor, 70), BF
  74.     LINE (0, _HEIGHT - _HEIGHT / 4)-STEP(_WIDTH, _HEIGHT / 9), darken(levelData.waterColor, 85), BF
  75.     LINE (0, _HEIGHT - _HEIGHT / 4)-STEP(_WIDTH, _HEIGHT / 11), levelData.waterColor, BF
  76.     _DEST 0
  77.  
  78. SUB drawObjects
  79.     FOR i = 1 TO totalObjects
  80.         SELECT CASE obj(i).id
  81.             CASE idPlatform
  82.                 _PUTIMAGE (obj(i).x + camera, obj(i).y), obj(i).img
  83.             CASE idGoal
  84.                 DRAW "bm" + STR$(obj(goal).x + camera) + "," + STR$(obj(goal).y + obj(goal).h / 2)
  85.                 DRAW goalGlyph
  86.             CASE idAirJump
  87.                 DRAW "bm" + STR$(obj(i).x + camera) + "," + STR$(obj(i).y + obj(i).h / 2)
  88.                 DRAW airJumpGlyph
  89.             CASE idCloud
  90.                 obj(i).x = obj(i).x - obj(i).xv
  91.                 IF obj(i).x + obj(i).w < 0 THEN obj(i).x = arenaWidth
  92.                 LINE (obj(i).x + camera / 2.5, obj(i).y)-STEP(obj(i).w, obj(i).h), _RGBA32(255, 255, 255, 30), BF
  93.             CASE idScene
  94.                 _PUTIMAGE (obj(i).x + camera / obj(i).xv, obj(i).y), obj(i).img
  95.             CASE idSky
  96.                 LINE (0, 0)-(_WIDTH, _HEIGHT), obj(i).color, BF
  97.             CASE idWater
  98.                 _PUTIMAGE , obj(i).img
  99.         END SELECT
  100.     NEXT
  101.  
  102. SUB processInput
  103.     DIM button AS _BYTE
  104.  
  105.     IF _KEYHIT = 27 THEN
  106.         obj(hero).alive = true
  107.         obj(hero).yv = 0
  108.         restartRequested = true
  109.         EXIT SUB
  110.     END IF
  111.  
  112.     IF obj(hero).alive = false THEN EXIT SUB
  113.     IF obj(hero).x + obj(hero).w < arenaWidth + _WIDTH THEN obj(hero).x = obj(hero).x + 5
  114.  
  115.     'IF _KEYDOWN(19712) THEN 'character goes left, screen goes right
  116.     '    obj(hero).x = obj(hero).x + 5
  117.     'END IF
  118.  
  119.     'IF _KEYDOWN(19200) THEN 'character goes right, screen goes left
  120.     '    obj(hero).x = obj(hero).x - 5
  121.     'END IF
  122.  
  123.     STATIC lastJump!, jumpKeyDown AS _BYTE
  124.     CONST jumpFactor = 3
  125.  
  126.     button = _MOUSEBUTTON(1) OR _KEYDOWN(32)
  127.  
  128.     IF button THEN '18432
  129.         IF jumpKeyDown = false AND (obj(hero).standing = true OR airJumps > 0) THEN
  130.             IF airJumps > 0 THEN airJumps = airJumps - 1
  131.             jumpKeyDown = true
  132.             obj(hero).standing = false
  133.             lastJump! = 0
  134.             obj(hero).yv = obj(hero).yv - gravity * jumpFactor
  135.         ELSE
  136.             lastJump! = lastJump! + 1
  137.             IF lastJump! < 7 THEN
  138.                 obj(hero).yv = obj(hero).yv - gravity * jumpFactor
  139.             END IF
  140.         END IF
  141.     ELSE
  142.         jumpKeyDown = false
  143.     END IF
  144.  
  145. SUB adjustCamera
  146.     camera = _WIDTH / 4 - obj(hero).x
  147.     IF camera > 0 THEN camera = 0
  148.     IF camera < -arenaWidth THEN camera = -arenaWidth
  149.  
  150. SUB drawHero
  151.     LINE (obj(hero).x + camera, obj(hero).y)-STEP(obj(hero).w, obj(hero).h), obj(hero).color, BF
  152.  
  153. SUB doPhysics
  154.     DIM this AS newObject
  155.     DIM j AS LONG, shadowCast AS _BYTE
  156.  
  157.     IF NOT obj(hero).alive THEN
  158.         _PRINTSTRING (0, 0), "Dead"
  159.         _PRINTSTRING (0, 20), STR$((obj(hero).x / arenaWidth) * 100) + "%"
  160.         EXIT SUB
  161.     END IF
  162.  
  163.     CONST gravityCap = 15
  164.  
  165.     obj(hero).standing = false
  166.     drowned = false
  167.     IF obj(hero).y + obj(hero).yv + gravity > _HEIGHT - _HEIGHT / 4 + _HEIGHT / 22 THEN drowned = true: obj(hero).alive = false: EXIT SUB
  168.  
  169.     FOR j = 1 TO totalObjects
  170.         IF obj(j).id = idPlatform THEN
  171.             IF obj(hero).x + obj(hero).w > obj(j).x AND obj(hero).x < obj(j).x + obj(j).w THEN
  172.                 shadowCast = true
  173.                 LINE ((obj(hero).x - 3) + camera, obj(j).y + 5)-STEP(obj(hero).w + 6, 2), _RGBA32(0, 0, 0, 30), BF
  174.  
  175.                 IF obj(hero).y + obj(hero).yv + gravity < obj(j).y - (obj(hero).h - 5) THEN
  176.                     EXIT FOR
  177.                 ELSEIF obj(hero).y + obj(hero).yv + gravity <= obj(j).y - (obj(hero).h - 20) THEN
  178.                     obj(hero).standing = true
  179.                     obj(hero).y = obj(j).y - (obj(hero).h - 5)
  180.                     EXIT FOR
  181.                 ELSEIF obj(hero).y >= obj(j).y - (obj(hero).h - 20) THEN
  182.                     obj(hero).alive = false
  183.                     EXIT FOR
  184.                 END IF
  185.             END IF
  186.         END IF
  187.     NEXT
  188.  
  189.     IF NOT obj(hero).standing THEN
  190.         obj(hero).yv = obj(hero).yv + gravity
  191.         IF obj(hero).yv > gravityCap THEN obj(hero).yv = gravityCap
  192.         obj(hero).y = obj(hero).y + obj(hero).yv
  193.         obj(hero).color = _RGB32(255, 255, 255)
  194.     ELSE
  195.         _PRINTSTRING (0, 0), "Standing"
  196.         obj(hero).yv = 0
  197.         obj(hero).color = _RGB32(200, 200, 200)
  198.     END IF
  199.  
  200.     IF hit(obj(hero), obj(goal)) THEN _AUTODISPLAY: _PRINTSTRING (_WIDTH / 2 - _PRINTWIDTH("Level complete!") / 2, _HEIGHT / 2 - _FONTHEIGHT / 2), "Level complete!": obj(hero).alive = false: SLEEP
  201.  
  202.     IF shadowCast = false THEN LINE ((obj(hero).x - 3) + camera, _HEIGHT - _HEIGHT / 4 + _HEIGHT / 22)-STEP(obj(hero).w + 6, 2), _RGBA32(0, 0, 0, 30), BF
  203.  
  204. FUNCTION hit%% (obj1 AS newObject, obj2 AS newObject)
  205.     hit%% = obj1.x + obj1.w > obj2.x AND obj1.x <= obj2.x + obj2.w AND obj1.y + obj1.h > obj2.y AND obj1.y < obj2.y + obj2.h
  206.  
  207. FUNCTION darken~& (WhichColor~&, ByHowMuch%)
  208.     darken~& = _RGB32(_RED32(WhichColor~&) * (ByHowMuch% / 100), _GREEN32(WhichColor~&) * (ByHowMuch% / 100), _BLUE32(WhichColor~&) * (ByHowMuch% / 100))
  209.  
  210.  
  211. SUB setLevel (level AS LONG)
  212.     'the order of creation of objects is also the draw order
  213.  
  214.     DIM totalPlatforms AS LONG
  215.     DIM this AS LONG, firstPlatform AS LONG
  216.  
  217.     resetObjects
  218.     SELECT CASE level
  219.         CASE 1
  220.             arenaWidth = 3200
  221.             totalPlatforms = 30
  222.             levelData.landColor = _RGB32(194, 127, 67)
  223.             levelData.waterColor = _RGB32(33, 166, 188)
  224.             levelData.grassColor = _RGB32(83, 161, 72)
  225.  
  226.             this = newObject
  227.             obj(this).id = idSky
  228.             obj(this).color = _RGB32(67, 200, 205)
  229.  
  230.             addScene level
  231.  
  232.             addWater
  233.  
  234.             addClouds 5
  235.  
  236.             platformDecoration = "c" + STR$(_RGB32(166, 111, 67)) + " bd5 e10r1g10r1e10r1g10r1e10r1g10r1e10r1g10"
  237.             levelData.symbolSpacingX = 11
  238.             levelData.symbolSpacingY = 11
  239.             FOR i = 1 TO totalPlatforms
  240.                 this = newObject
  241.                 obj(this).id = idPlatform
  242.                 obj(this).w = RND * 200 + 50
  243.                 obj(this).w = obj(this).w - (obj(this).w MOD 20)
  244.                 IF i = 1 THEN
  245.                     firstPlatform = this
  246.                     obj(this).h = 200
  247.                     obj(this).x = RND * (arenaWidth / totalPlatforms)
  248.                 ELSE
  249.                     obj(this).h = RND * 50 + 50
  250.                     obj(this).x = obj(this - 1).x + obj(this - 1).w + (RND * (arenaWidth / (totalPlatforms * 1.5)))
  251.                 END IF
  252.                 obj(this).y = (_HEIGHT - _HEIGHT / 4 + (_HEIGHT / 20)) - obj(this).h
  253.                 drawPlatform obj(this)
  254.             NEXT
  255.  
  256.             goal = newObject
  257.             obj(goal).id = idGoal
  258.             obj(goal).x = arenaWidth
  259.             obj(goal).y = _HEIGHT / 2
  260.             obj(goal).h = 20
  261.             obj(goal).w = 20
  262.  
  263.             hero = newObject
  264.             obj(hero).x = obj(firstPlatform).x
  265.             obj(hero).y = obj(firstPlatform).y - 25
  266.             obj(hero).w = 15
  267.             obj(hero).h = 30
  268.             obj(hero).alive = true
  269.             obj(hero).standing = true
  270.     END SELECT
  271.  
  272. FUNCTION newObject&
  273.     totalObjects = totalObjects + 1
  274.     IF totalObjects > UBOUND(obj) THEN
  275.         REDIM _PRESERVE obj(totalObjects + 99) AS newObject
  276.     END IF
  277.     newObject& = totalObjects
  278.  
  279. SUB resetObjects
  280.     DIM emptyObject AS newObject
  281.     FOR i = 1 TO UBOUND(obj)
  282.         IF obj(i).img < -1 AND obj(i).imgPointer = false THEN _FREEIMAGE obj(i).img
  283.         obj(i) = emptyObject
  284.     NEXT
  285.     totalObjects = 0
  286.  
  287. SUB drawPlatform (this AS newObject)
  288.     this.img = _NEWIMAGE(this.w, this.h, 32)
  289.     _DEST this.img
  290.     LINE (0, 10)-STEP(this.w - 1, this.h - 1), levelData.landColor, BF
  291.     FOR x = -10 TO this.w STEP levelData.symbolSpacingX
  292.         FOR y = 15 TO this.h + 10 STEP levelData.symbolSpacingY
  293.             PSET (x, y), levelData.landColor
  294.             DRAW platformDecoration
  295.         NEXT
  296.     NEXT
  297.     LINE (0, 0)-STEP(this.w - 1, 20), levelData.grassColor, BF
  298.     LINE (0, 0)-STEP(this.w - 1, 10), _RGBA32(255, 255, 255, 30), BF
  299.     LINE (0, 10)-STEP(5, this.h), _RGBA32(255, 255, 255, 30), BF
  300.     LINE (this.w - 6, 10)-STEP(5, this.h), _RGBA32(0, 0, 0, 30), BF
  301.  
  302.     LINE (0, 5)-(5, 0), _RGB32(255, 0, 255)
  303.     PAINT (0, 0), _RGB32(255, 0, 255), _RGB32(255, 0, 255)
  304.     LINE (_WIDTH - 1, 5)-(_WIDTH - 6, 0), _RGB32(255, 0, 255)
  305.     PAINT (_WIDTH - 1, 0), _RGB32(255, 0, 255), _RGB32(255, 0, 255)
  306.     LINE (0, this.h - 4)-STEP(this.w, 3), _RGB32(255, 0, 255), BF
  307.     _CLEARCOLOR _RGB32(255, 0, 255)
  308.     LINE (0, this.h - 5)-STEP(this.w - 1, 5), _RGBA32(0, 0, 0, 30), BF
  309.     _DEST 0
  310.  
  311. SUB addClouds (max AS LONG)
  312.     DIM this AS LONG
  313.  
  314.     FOR i = 1 TO max
  315.         this = newObject
  316.         obj(this).id = idCloud
  317.         obj(this).x = RND * arenaWidth
  318.         obj(this).y = RND * (_HEIGHT / 2)
  319.         obj(this).h = 30
  320.         obj(this).w = arenaWidth / max
  321.         obj(this).xv = RND
  322.     NEXT
  323.  
  324. SUB addScene (level AS LONG)
  325.     DIM this AS LONG, firstItem AS LONG
  326.  
  327.     SELECT CASE level
  328.         CASE 1
  329.             'green mountains, 2 layers
  330.  
  331.             'farther range
  332.             FOR i = 1 TO 20
  333.                 this = newObject
  334.                 IF i = 1 THEN
  335.                     firstItem = this
  336.                     obj(this).img = _NEWIMAGE(_WIDTH, _HEIGHT, 32)
  337.                     _DEST obj(this).img
  338.                     LINE (0, _HEIGHT - 1)-(_WIDTH / 2, 0), _RGB32(100, 150, 122)
  339.                     LINE -(_WIDTH - 1, _HEIGHT - 1), _RGB32(100, 150, 122)
  340.                     LINE -(0, _HEIGHT - 1), _RGB32(100, 150, 122)
  341.                     PAINT (_WIDTH / 2, _HEIGHT / 2), _RGB32(100, 150, 122), _RGB32(100, 150, 122)
  342.                     _DEST 0
  343.                 ELSE
  344.                     obj(this).img = obj(firstItem).img
  345.                     obj(this).imgPointer = true
  346.                 END IF
  347.  
  348.                 obj(this).id = idScene
  349.                 obj(this).x = RND * arenaWidth
  350.                 obj(this).y = RND * (_HEIGHT / 2)
  351.                 obj(this).xv = 2.5
  352.             NEXT
  353.  
  354.             'closer range
  355.             FOR i = 1 TO 20
  356.                 this = newObject
  357.                 IF i = 1 THEN
  358.                     firstItem = this
  359.                     obj(this).img = _NEWIMAGE(_WIDTH, _HEIGHT, 32)
  360.                     _DEST obj(this).img
  361.                     LINE (0, _HEIGHT - 1)-(_WIDTH / 2, 0), _RGB32(78, 111, 67)
  362.                     LINE -(_WIDTH - 1, _HEIGHT - 1), _RGB32(78, 111, 67)
  363.                     LINE -(0, _HEIGHT - 1), _RGB32(78, 111, 67)
  364.                     PAINT (_WIDTH / 2, _HEIGHT / 2), _RGB32(78, 111, 67), _RGB32(78, 111, 67)
  365.                     _DEST 0
  366.                 ELSE
  367.                     obj(this).img = obj(firstItem).img
  368.                     obj(this).imgPointer = true
  369.                 END IF
  370.  
  371.                 obj(this).id = idScene
  372.                 obj(this).x = RND * arenaWidth
  373.                 obj(this).y = RND * (_HEIGHT / 2)
  374.                 obj(this).xv = 2
  375.             NEXT
  376.     END SELECT
  377.  

Offline Pete

  • Forum Resident
  • Posts: 2361
  • Cuz I sez so, varmint!
    • View Profile
Re: platform.bas - an attempted QB64 clone of Mr Jump S
« Reply #1 on: February 21, 2018, 04:02:41 pm »
  • Best Answer
  • Cool! Did you code that? It reminds me of Nintendo Mario.

    Pete [:)] Maybe now some time to enable smilies?
    thumbs-up-smiley.jpg
    * thumbs-up-smiley.jpg (Filesize: 8.7 KB, Dimensions: 240x181, Views: 638)
    Want to learn how to write code on cave walls? https://www.tapatalk.com/groups/qbasic/qbasic-f1/

    Offline keybone

    • Forum Regular
    • Posts: 116
    • My name a Nursultan Tulyakbay.
      • View Profile
    Re: platform.bas - an attempted QB64 clone of Mr Jump S
    « Reply #2 on: February 21, 2018, 04:06:15 pm »
  • Best Answer
  • Definately had fun playing that one for a few minutes. :-)
    I am from a Kazakhstan, we follow the hawk.

    Offline Pete

    • Forum Resident
    • Posts: 2361
    • Cuz I sez so, varmint!
      • View Profile
    Re: platform.bas - an attempted QB64 clone of Mr Jump S
    « Reply #3 on: February 21, 2018, 10:49:22 pm »
  • Best Answer
  • See? Keybone wants smilies, too!
    Want to learn how to write code on cave walls? https://www.tapatalk.com/groups/qbasic/qbasic-f1/

    Offline keybone

    • Forum Regular
    • Posts: 116
    • My name a Nursultan Tulyakbay.
      • View Profile
    Re: platform.bas - an attempted QB64 clone of Mr Jump S
    « Reply #4 on: February 22, 2018, 01:13:21 am »
  • Best Answer
  • See? Keybone wants smilies, too!

    irc habits. :D
    I am from a Kazakhstan, we follow the hawk.

    Offline Pete

    • Forum Resident
    • Posts: 2361
    • Cuz I sez so, varmint!
      • View Profile
    Re: platform.bas - an attempted QB64 clone of Mr Jump S
    « Reply #5 on: February 22, 2018, 01:16:19 am »
  • Best Answer
  • 666
    Want to learn how to write code on cave walls? https://www.tapatalk.com/groups/qbasic/qbasic-f1/