The QBasic / QB64 Discussion Forum      Other Subforums, Links and Downloads
 

Respond to this messageReturn to Index
Original Message
  • "Start fire with rocks" game "re"creation:
    • (Login ComputerGhost)
      R
      Posted May 15, 2007 7:30 PM

      DECLARE SUB Orig.Main ()
      DECLARE SUB Orig.Draw.Wheel (x%, y%, rot%, c%)
      DECLARE SUB Orig.Explode ()
      DECLARE SUB Orig.Draw.Dail (x%, y%)
      DECLARE SUB Orig.Draw.Level (x%, y%, rot%, c%)
      DECLARE SUB Main.Draw ()
      DECLARE SUB Orig.Draw ()
      DECLARE FUNCTION Main.Menu! ()
      DECLARE SUB DrawBox (x1%, y1%, x2%, y2%)

      DIM SHARED Main.Menu.Selected
      DIM SHARED Highlight(496)

      'Now for the main part of the program
      RANDOMIZE TIMER \ 3
      SCREEN 12
      WIDTH 80, 30

      Main.Draw
      r1.x% = 364: r1.xd% = 18
      r1.y% = 228: r1.yd% = 21
      r2.x% = 526: r2.xd% = -18
      r2.y% = 228: r2.yd% = 21
      DO
      optn = Main.Menu
      s = TIMER + .1
      IF optn = 0 THEN
      Orig.Main
      Main.Draw
      ELSEIF optn <> 1 THEN
      LINE (r1.x%, r1.y%)-(r1.x% + 18, r1.y% + 21), 0, BF
      LINE (r2.x%, r2.y%)-(r2.x% + 18, r2.y% + 21), 0, BF

      r1.x% = r1.x% + r1.xd%: r1.y% = r1.y% + r1.yd%
      r2.x% = r2.x% + r2.xd%: r2.y% = r2.y% + r2.yd%
      IF r1.x% >= 580 THEN r1.xd% = -18
      IF r1.y% >= 406 THEN r1.yd% = -21
      IF r1.x% <= 364 THEN r1.xd% = 18
      IF r1.y% <= 228 THEN r1.yd% = 21
      IF r2.x% >= 580 THEN r2.xd% = -18
      IF r2.y% >= 406 THEN r2.yd% = -21
      IF r2.x% <= 364 THEN r2.xd% = 18
      IF r2.y% <= 228 THEN r2.yd% = 21

      LINE (r1.x%, r1.y%)-(r1.x% + 18, r1.y% + 21), 15, BF
      LINE (r2.x%, r2.y%)-(r2.x% + 18, r2.y% + 21), 15, BF

      IF (ABS(r1.x% - r2.x%) = 18 AND r1.y% = r2.y%) OR (ABS(r1.y% - r2.y%) = 21 AND r1.x% = r2.x%) THEN
      LINE (364, 228)-(598, 438), 15, BF
      s = TIMER + .01: WHILE s > TIMER: WEND
      LINE (364, 228)-(598, 438), 0, BF
      END IF

      WHILE s > TIMER: WEND
      END IF
      LOOP WHILE optn <> 1

      SCREEN 0
      SYSTEM
      'END

      SUB DrawBox (x1%, y1%, x2%, y2%)
      FOR i% = 0 TO 2
      LINE (x1% + i%, y1% + i%)-(x2% - i%, y2% - i%), 8 - (i% MOD 2), B
      NEXT i%
      LINE (x1% + i%, y1% + i%)-(x2% - i%, y2% - i%), 0, BF
      END SUB

      SUB Main.Draw
      CLS
      DrawBox 0, 0, 639, 479
      LOCATE 2, 26: PRINT "SMASHING ROCKS TO MAKE FIRE"
      PRINT
      COLOR 7
      LOCATE , 2: PRINT " This game is basically a remake of "
      LOCATE , 2: PRINT "someone else's long lost game. I have "
      LOCATE , 2: PRINT "used specifications given by a friend "
      LOCATE , 2: PRINT "of the original creator to recreate the"
      LOCATE , 2: PRINT "original, and I have drawn and coded a "
      LOCATE , 2: PRINT "virtual computer like the steam-powered"
      LOCATE , 2: PRINT "one that the original game ran on. "
      PRINT
      LOCATE , 2: PRINT " Use the menu to the right to choose"
      LOCATE , 2: PRINT "whether to play the game or to exit."
      LOCATE , 2: PRINT "The arrow keys the WASD keys can be "
      LOCATE , 2: PRINT "used to navigate the menu. Press Enter"
      LOCATE , 2: PRINT "or Space to make your selection."
      PRINT
      LOCATE , 2: PRINT " I give credit to mennonite for "
      LOCATE , 2: PRINT "telling me about the original program. "
      LOCATE , 2: PRINT "The creator of the original program is "
      LOCATE , 2: PRINT "to be temporarily kept secret. I want "
      LOCATE , 2: PRINT "to see if you can guess who he is."
      PRINT
      LOCATE , 2: PRINT " Oh, yea... I can't forget to give "
      LOCATE , 2: PRINT "credit to myself for doing this! I go "
      LOCATE , 2: PRINT "by the alias ComputerGhost on the 'net "
      LOCATE , 2: PRINT "(email: ComputerGhost@hotmail.com)."

      DrawBox 45 * 8, 5 * 16, 76 * 8, 5 * 16 + 4 * 16
      COLOR 15
      LOCATE 5, 58: PRINT "Menu"
      PRINT
      COLOR 7
      LOCATE , 48: PRINT "Play"
      LOCATE , 48: PRINT "Exit"

      LINE (45 * 8 + 4, 15 * 16)-(76 * 8 - 4, 15 * 16 + 15), 7, B
      LINE (45 * 8 + 5, 15 * 16 + 1)-(76 * 8 - 5, 15 * 16 + 14), 8, BF
      GET (45 * 8 + 4, 15 * 16)-(76 * 8 - 4, 15 * 16 + 15), Highlight
      PUT (45 * 8 + 4, (Main.Menu.Selected + 6) * 16), Highlight
      Main.Menu.Selected = 0

      COLOR 15
      LOCATE 14, 54: PRINT "Original Demo"
      DrawBox 360, 224, 602, 442
      LINE (603, 224)-(604, 442), 0, B
      END SUB

      'Main.Menu.Selected
      FUNCTION Main.Menu
      k$ = UCASE$(INKEY$)
      WHILE INKEY$ <> "": WEND
      newSel = Main.Menu.Selected
      IF k$ = CHR$(0) + "H" OR k$ = "W" THEN
      newSel = (Main.Menu.Selected + 1) MOD 2
      ELSEIF k$ = CHR$(0) + "P" OR k$ = "S" THEN
      newSel = (Main.Menu.Selected + 1) MOD 2
      ELSEIF k$ = CHR$(27) THEN
      newSel = 1
      ELSEIF k$ = CHR$(13) OR k$ = CHR$(32) THEN
      Main.Menu = Main.Menu.Selected
      EXIT FUNCTION
      END IF

      IF newSel <> Main.Menu.Selected THEN
      'De-highlight old selection
      PUT (45 * 8 + 4, (Main.Menu.Selected + 6) * 16), Highlight
      'Set variables
      Main.Menu.Selected = newSel
      'highlight new selection
      PUT (45 * 8 + 4, (Main.Menu.Selected + 6) * 16), Highlight
      END IF
      Main.Menu = -1
      END FUNCTION

      SUB Orig.Draw
      LOCATE 2, 26: PRINT "SMASHING ROCKS TO MAKE FIRE"

      'LINE (160, 110)-(460, 350), 7, BF
      DrawBox 156, 106, 464, 354
      LINE (155, 105)-(465, 355), 7, B
      LINE (154, 104)-(466, 356), 7, B

      'steam mechanical thingey
      LINE (468, 90)-(473, 356), 8, BF
      LINE (474, 90)-(482, 356), 7, BF
      LINE (483, 90)-(488, 356), 15, BF
      LINE (489, 300)-(600, 356), 8, BF
      CIRCLE (520, 329), 20, 7
      CIRCLE (520, 329), 21, 15
      CIRCLE (520, 329), 22, 7

      'smoke
      FOR x% = 468 TO 600
      CIRCLE (x%, 80 - RND * 30), 10, INT(RND * 2) + 7
      NEXT x%

      'Draw dails
      Orig.Draw.Dail 64, 112
      LOCATE 10, 8: PRINT "psi"
      Orig.Draw.Dail 64, 240
      LOCATE 18, 7: PRINT "temp"
      Orig.Draw.Dail 64, 368
      LOCATE 26, 7: PRINT "water"

      DrawBox 19 * 8, 23 * 16, 75 * 8, 29 * 16
      LOCATE 25, 21: PRINT " Smash the rocks together to make a fire. Finish "
      LOCATE , 21: PRINT "playing before the computer runs out of water and gets"
      LOCATE , 21: PRINT "hot. R(up), F(down), and G(smash) control your good "
      LOCATE , 21: PRINT "hand. T relieves the computer's steam pressure."
      END SUB

      SUB Orig.Draw.Dail (x%, y%)
      CIRCLE (x%, y%), 54, 7 'frame
      CIRCLE (x%, y%), 55, 15
      CIRCLE (x%, y%), 56, 7
      FOR R% = 40 TO 50 'scale
      CIRCLE (x%, y%), R%, 12, 0, 1.0472
      CIRCLE (x%, y%), R%, 14, 1.0472, 2.09439
      CIRCLE (x%, y%), R%, 8, 2.09439, 3.14159
      NEXT R%
      END SUB

      SUB Orig.Draw.Level (x%, y%, rot%, c%)
      DRAW "C" + STR$(c%) + " BM" + STR$(x%) + "," + STR$(y%) + " TA" + STR$(180 - rot%)
      DRAW "BUR1L2D2R2U2 M+37,+1M-37,+1"
      END SUB

      SUB Orig.Draw.Wheel (x%, y%, rot%, c%)
      DRAW "C" + STR$(c%) + " BM" + STR$(x%) + "," + STR$(y%) + " TA" + STR$(180 - rot%)
      DRAW "BL1BU1L18D2R39U2L18U18L2D39R2U18"
      IF c% <> 8 THEN DRAW "C0"
      DRAW "BM" + STR$(x%) + "," + STR$(y%)
      DRAW "BR1U17D34U17L17R34"
      END SUB

      SUB Orig.Explode
      WHILE INKEY$ <> "": WEND
      s = TIMER + 2
      WHILE s > TIMER AND INKEY$ = ""
      PAINT (0, 0), 12
      PAINT (0, 0), 14
      PAINT (0, 0), 15
      WEND
      END SUB

      SUB Orig.Main
      LINE (4, 4)-(635, 475), 0, BF
      Orig.Draw
      SLEEP
      k$ = INKEY$

      water = 135: newWater = 135
      pressure = 0: newPressure = 0
      temp = 10: newTemp = 10
      go% = 0
      gy% = 110
      x% = 444: y% = 110: newX% = 445: newY% = 110
      rot% = 0
      DO
      k$ = UCASE$(INKEY$)
      s = TIMER + .1

      IF k$ = "R" AND go% = 0 AND y% > 110 THEN
      newY% = y% - 24
      ELSEIF k$ = "F" AND go% = 0 AND y% < 326 THEN
      newY% = y% + 24
      ELSEIF k$ = "T" AND pressure >= 55 THEN
      newPressure = pressure - 45
      ELSEIF k$ = "G" THEN
      go% = 1
      END IF

      Orig.Draw.Wheel 520, 329, rot%, 8
      rot% = (rot% + 10) MOD 360
      Orig.Draw.Wheel 520, 329, rot%, 7

      newPressure = newPressure + temp / 45 * SGN(water) + SGN(180 - temp) * 5
      IF water > 0 THEN newWater = water - 1
      newTemp = temp + 5 * (1 - SGN(water)) + 110 / temp - 1

      Orig.Draw.Level 64, 112, INT(pressure), 0
      pressure = newPressure
      Orig.Draw.Level 64, 112, INT(pressure), 15
      Orig.Draw.Level 64, 368, INT(water), 0
      water = newWater
      Orig.Draw.Level 64, 368, INT(water), 15
      Orig.Draw.Level 64, 240, INT(temp), 0
      temp = newTemp
      Orig.Draw.Level 64, 240, INT(temp), 15

      IF water <= 0 THEN LINE (160, 110)-(460, 350), 0, BF
      IF pressure >= 180 THEN Orig.Explode: EXIT SUB
      IF pressure < 0 THEN EXIT SUB

      IF go% = 1 THEN
      newX% = newX% - 15
      END IF
      IF newX% <> x% OR newY% <> y% THEN
      LINE (x%, y%)-(x% + 15, y% + 24), 0, BF
      x% = newX%: y% = newY%
      LINE (x%, y%)-(x% + 15, y% + 24), 15, BF
      END IF
      LINE (160, gy%)-(175, gy% + 24), 0, BF
      gy% = gy% + (INT(RND * 3) - 1) * 24
      IF gy% < 110 THEN gy% = 110
      IF gy% > 326 THEN gy% = 326
      LINE (160, gy%)-(175, gy% + 24), 15, BF

      cx% = (cx% + 1) MOD 132
      CIRCLE (cx% + 468, 80 - RND * 30), 10, INT(RND * 2) + 7

      IF x% = 160 AND y% = gy% THEN
      WHILE INKEY$ <> "": WEND
      WHILE INKEY$ = ""
      s = TIMER + .3
      LINE (160, 110)-(460, 350), 15, BF
      WHILE s > TIMER: WEND
      s = TIMER + .3
      LINE (160, 110)-(460, 350), 0, BF
      WHILE s > TIMER: WEND
      WEND
      EXIT SUB
      END IF
      IF x% = 160 THEN EXIT SUB

      WHILE s > TIMER: WEND
      LOOP WHILE k$ <> CHR$(27)
      END SUB


      'Free software
      'Copyright 2007 ComputerGhost (Nathan Belue)
      'Um, credits to mennonite for the idea and Mac for inspiring the idea.
      'Distribute, Edit, Delete, Ignore, whatever - except don't sell this.
    Login Status
  • You are not logged in
    • Login
      Password
       

      Optional
      Provides additional benefits such as notifications, signatures, and user authentication.


      Create Account
    Your Name
    Message Title
    Message Text
    Options
          


     Copyright © 1999-2014 Network54. All rights reserved.   Terms of Use   Privacy Statement  

    Newbies usually go to www.qbasic.com and click on The QBasic Forum
    Forum regulars have their own ways, which include The QBasic Community Forums