Qbasic program to make leap guy game
DECLARE SUB HighScores ()
DECLARE SUB paldef (c!, r!, g!, B!)
DECLARE SUB ClearKeyBuffer (n!)
DECLARE SUB centre (y!, t$)
DECLARE SUB Die ()
DECLARE SUB Bullet ()
DECLARE SUB pandisplay (xp!, yp!)
DECLARE SUB DrawGuy (x!, y!)
DIM SHARED graph(1000), pf(40, 25) AS STRING, snd
DIM SHARED bgraph(100), x, y, xx, xy, DontDraw, lives, dead, bombs, Points
DIM SHARED DartSpeed, GuySpeed, Delay, ResetFlag, Bonus
DIM SHARED Score(15), Name$(15), TotalScore, FileName$
RANDOMIZE TIMER
KEY 15, CHR$(0) + CHR$(1) 'ON KEY(15) GOSUB Ending
ON TIMER(10) GOSUB DecrementBonus
TIMER OFF KEY(15) ON
lives = 6
snd = 1 rt$ = "6" lt$ = "4" UP$ = "8" dn$ = "2" Delay = 1 FileName$ = "SCORES.DAT"
SCREEN 13
y = 0: x = 0
FOR s = 1 TO 25
READ l$
x = 0
FOR d = 1 TO 40
a$ = MID$(l$, d, 1)
IF a$ = "W" THEN
c = 15
ELSEIF a$ = "R" THEN
c = 4
ELSEIF a$ = "M" THEN
c = 5
ELSEIF a$ = "C" THEN
c = 3
ELSEIF a$ = "Y" THEN
c = 14
ELSEIF a$ = "G" THEN
c = 2
ELSEIF a$ = "B" THEN
c = 1
ELSE
c = 0
END IF
LINE (x, y)-(x + 7, y + 7), c, BF
x = x + 8
NEXT
y = y + 8
NEXT
WHILE INKEY$ = "": WEND
CALL HighScores
PLAY "mbt128 O3 C16 O1 c16"
CLS
COLOR 3
centre 2, "LeapGuy"
LOCATE 6: PRINT
COLOR 5
PRINT " Movement:"
COLOR 14
PRINT " 7 8 9 Make sure your numlock"
PRINT " key is ON. Use 7, 8, "
PRINT " 4 6 and 9 to jump left, up,"
PRINT " or right."
PRINT " 2 "
LOCATE 19: COLOR 2
PRINT "Choose a speed for LeapGuy,"
PRINT "from 0 (fast) to 15 (slow):";
INPUT "", GuySpeed
'IF GuySpeed = 0 THEN GuySpeed = 8
GuySpeed = GuySpeed * 100
DartSpeed = GuySpeed 25
IF DartSpeed = 0 THEN DartSpeed = 10
NextLevel:
FOR y = 1 TO 25
READ l$
IF l$ = "STOP" THEN GOTO YouWon
FOR x = 1 TO 40
pf(x, y) = MID$(l$, x, 1)
NEXT
NEXT
READ OriginalX, OriginalY
ClearKeyBuffer 15
Bonus = 1000
ReDraw:
IF lives = 0 THEN
TIMER OFF
PLAY "T128 MB O1 L4 c2 e2 g2 >c1"
seconds = TIMER
WHILE TIMER - seconds < 4
pandisplay 1, 0
paldef 2, 63, 63, 63
FOR d = 1 TO 100: NEXT
pandisplay 0, 0
paldef 2, 32, 0, 0
FOR d = 1 TO 100: NEXT
WEND
paldef 2, 0, 32, 0
PLAY "MBO3 C8 C8 2 THEN
FOR s = 1 TO 8
xx = xx - 1
CALL DrawGuy(xx, xy)
NEXT
x = x - 1
ELSEIF a$ = UP$ AND pf(x, y) = "#" THEN
FOR s = 1 TO 8
xy = xy - 1
CALL DrawGuy(xx, xy)
NEXT
y = y - 1
ELSEIF a$ = dn$ AND pf(x, y + 1) = "#" THEN
FOR s = 1 TO 8
xy = xy + 1
CALL DrawGuy(xx, xy)
NEXT
y = y + 1
END IF
IF pf(x, y) = "#" THEN jump = 0
IF pf(x, y) = "=" THEN
FOR s = 1 TO 8
xy = xy - 1
CALL DrawGuy(xx, xy)
NEXT
y = y - 1
jump = 0
ELSEIF pf(x, y + 1) = " " AND jump = 0 AND pf(x, y) <> "#" THEN
fell = 0
FOR d = 1 TO 2
IF pf(x, y + 1) <> " " THEN EXIT FOR
snd = 0
FOR s = 1 TO 8
xy = xy + 1
CALL DrawGuy(xx, xy)
NEXT
snd = 1
y = y + 1
fell = fell + 1
NEXT
IF pf(x, y + 1) = " " AND fell = 2 THEN
CALL Die
GOTO ReDraw
END IF
ELSEIF pf(x, y) = "+" OR pf(x, y - 1) = "+" THEN
FOR s = 1 TO 8
xy = xy - 1
CALL DrawGuy(xx, xy)
NEXT
y = y - 1
jump = 2
ELSEIF pf(x, y) = "o" OR pf(x, y - 1) = "o" THEN
PUT (xx - 8, xy - 16), graph, PSET
IF pf(x, y) = "o" THEN
pf(x, y) = " "
LINE (xx - 8, xy - 8)-(xx, xy - 1), 0, BF
ELSE
pf(x, y - 1) = " "
LINE (xx - 16, xy - 16)-(xx - 8, xy - 8), 0, BF
'LINE (xx - 8, xy - 16)-(xx, xy - 1), 0, BF
END IF
PLAY "t128 mb o1 l32 c o4 ccc"
LINE (xx - 8, xy - 16)-(xx, xy - 1), 0, BF
GET (xx - 8, xy - 16)-(xx + 7, xy - 1), graph
CALL DrawGuy(xx, xy)
Points = Points + 1
CALL UpdateScore
END IF
IF jump = 1 THEN
IF x < 38 AND x > 2 THEN
snd = 0
FOR s = 1 TO 8
xy = xy + 2
xx = xx + xstep
CALL DrawGuy(xx, xy)
NEXT
y = y + 2
x = x + xstep
snd = 0
END IF
jump = 2
END IF
IF (a$ = UP$ OR a$ = "7" OR a$ = "9") AND pf(x, y) <> "#" THEN 'Jump.
IF a$ = "9" AND x < 38 THEN
xstep = 2
ELSEIF a$ = "7" AND x > 2 THEN
xstep = -2
max = 2
ELSE
xstep = 0
END IF
PLAY "MBT128L32ML o3 CEG>CC< G8 F8 G8 E16 F16 G16 A16 B16 >C16 D16 C1"
CASE 1
PLAY "O2 L4MN T200 CC< G >CL8 GF#G G# G G# A A# A A# B >CC2"
CASE 2
PLAY "O2 L4MN MBT200MN C8 D# G8 >C< A#. G2 D#8 F D#8 F# A#2 F#8 F8 D#8 C8 C1"
END SELECT
GOTO NextLevel
YouWon:
TIMER OFF
CLS
COLOR 15
ClearKeyBuffer 15
centre 12, "* YOU WON *"
WHILE INKEY$ = "": WEND
CALL HighScores END DecrementBonus:
IF Bonus > 0 THEN
Bonus = Bonus - 100
SOUND 440, 1
CALL UpdateScore
END IF
RETURN
Ending:
CLS
COLOR 14
centre 12, CHR$(2) + " Buh-Bye! " + CHR$(2)
END
RETURN
CreateNewFile:
CLOSE 1
OPEN FileName$ FOR OUTPUT AS 1
FOR s = 1 TO 15
PRINT #1, "------------"
PRINT #1, 0
NEXT
CLOSE 1
RESUME
'This following is the intro-screen graphic.
DATA " CCC C CC CC CCCC CC CC CC C C"
DATA " C C C C C C C C C C C C C CC C"
DATA "C C C C C C CCCC C C CCCC C CC"
DATA " CC CCC C C C C C C C C C"
DATA " "
DATA " BBBBBBBBBBBB "
DATA " WWWW BB BB "
DATA " WWWW WW BB BB "
DATA " RRRRRRRRRR BB BB "
DATA " RR RRRR BBBBBBBBBBBB "
DATA " WW RRRR BB BB "
DATA " MMMM BB BB "
DATA " MMMMMMMMMM BB BB "
DATA " MM MM BBBBBBBBBBBB "
DATA " WW WWWW BB BB "
DATA " YYYY BB BB "
DATA " YYYY BB BB "
DATA " BBBBBBBBBBBB "
DATA " BB BB "
DATA " GGGGGGGGGGGGGGGGGGGGBBGGGGGGGGBB "
DATA " GG GG GG GG GG BB GG GGBB "
DATA " GGGGGGGGGGGGGGGGGGGGBBBBBBBBBBBB "
DATA " "
DATA " "
DATA " "
DATA " "
DATA " "
DATA " "
DATA " o o o o "
DATA " ==#=== ==== o o ==== ====#== "
DATA " # # # "
DATA " # ====#==== # "
DATA " # o # o # "
DATA " # ==== # ==== # "
DATA " # ======#===== # "
DATA " o # o # o # o "
DATA " # # # "
DATA " # # # # # "
DATA " ==== === ==#=======#== === ==== "
DATA " + # # + "
DATA " + # # + "
DATA " # # "
DATA " # =================== # "
DATA " ==#======= ========#== "
DATA " # # "
DATA " # o o # "
DATA " # # "
DATA " o # ======= # o "
DATA " ====================================== "
DATA " "
DATA 20,17
DATA " "
DATA " "
DATA " "
DATA " o o "
DATA " # o =========#========= o # "
DATA " #==== # ======# "
DATA " # === # # # === # "
DATA " # ====#==============#==== # "
DATA " # # # # "
DATA " # o # # o # o # "
DATA " === =#=============================# "
DATA " # # "
DATA " # # "
DATA " # # "
DATA " # # o # o # "
DATA " #============= =======#========= "
DATA " # # "
DATA " # # # "
DATA " #=============== ==#========# "
DATA " # === # # "
DATA " # === # # "
DATA " # o === o # # "
DATA " ====== ========= === "
DATA " "
DATA " "
DATA 37,22
DATA " "
DATA " "
DATA " "
DATA " "
DATA " o # o o # o "
DATA " ===========#===== ======#=========== "
DATA " # # "
DATA " # # "
DATA " o # # # o "
DATA " === ======= ===#== ======= === "
DATA " + # + "
DATA " + # + "
DATA " + # o # o # + "
DATA " + =#======== ===== =======#= + "
DATA " + # o o # + "
DATA " + # # + "
DATA " + # # + "
DATA " + # # # # + "
DATA " + ===========#======#=========== + "
DATA " + # # + "
DATA " o # # o "
DATA " o # # o "
DATA " ====================================== "
DATA " "
DATA " "
DATA 21,13
DATA " "
DATA " "
DATA " "
DATA " o o o o "
DATA " =#======== ==== ==== =========#= "
DATA " # # "
DATA " # # "
DATA " # o o # # "
DATA " ======== ==================#======== "
DATA " + == # "
DATA " == # "
DATA " o == o # o # o "
DATA " ==================#=================== "
DATA " + # + "
DATA " # "
DATA " o o # o o "
DATA " ======== =======#======== ======== "
DATA " + # + "
DATA " + o # o + "
DATA " + === ========#========= === + "
DATA " + # + "
DATA " + # + "
DATA " +o # o+ "
DATA " ====================================== "
DATA " "
DATA 20,12
DATA "STOP"
SUB Bullet
STATIC B, PrevX, PrevY, xtep, ytep, px, py, elapsed, DontChase
IF Delay = 1 THEN
elapsed = elapsed + 1
IF elapsed < DartSpeed THEN
EXIT SUB
ELSE
elapsed = 0
END IF
END IF
IF ResetFlag = 1 THEN B = 0
IF B = 0 OR dead = 1 THEN
IF INT(RND * 500) <> 99 THEN EXIT SUB
elapsed = 0
DontChase = 0
B = 1
a = INT(RND * 2)
IF a = 0 THEN
px = 2
py = INT(RND * 180) + 2
xtep = .2
ytep = 0
ELSE
px = INT(RND * 290) + 2
py = 2
xtep = 0
ytep = .2
END IF
PrevX = px
PrevY = py
GET (px, py)-(px + 1, py + 1), bgraph
END IF
px = px + xtep
py = py + ytep
PUT (PrevX, PrevY), bgraph, PSET
PrevX = px
PrevY = py
GET (px, py)-(px + 1, py + 1), bgraph
LINE (px, py)-(px + 1, py + 1), 15, B
cx = px 8 + 1
cy = py 8 + 1
IF cx = x AND cy = y THEN
CALL Die
EXIT SUB
END IF
IF x < cx OR y < cy THEN d = -1
IF y > cy OR x > cx THEN d = 1
IF cx = x AND DontChase = 0 THEN
ytep = d
xtep = 0
DontChase = 1
SOUND 400, 1: SOUND 1000, 1
END IF
IF cy = y AND DontChase = 0 THEN
ytep = 0
xtep = d
DontChase = 1
SOUND 400, 1: SOUND 1000, 1
END IF
IF PrevX > 290 OR PrevY > 180 OR PrevX < 2 OR PrevY < 2 THEN
PUT (PrevX, PrevY), bgraph, PSET
PrevX = 0
PrevY = 0
px = 0
py = 0
B = 0
END IF
END SUB
SUB centre (y, t$)
LOCATE y, 20 - LEN(t$) / 2
PRINT t$;
END SUB
SUB ClearKeyBuffer (n)
FOR s = 1 TO n
a$ = INKEY$
NEXT
END SUB
SUB Die
DontDraw = 1
snd = 0
FOR i = xy TO 200 STEP 3
CALL DrawGuy(xx, i)
SOUND 400 + (200 - i), .4
NEXT
snd = 1
SLEEP 1
DontDraw = 0
PLAY "t200o3 MF MN L4 c2ccc2d#ddccc"
lives = lives - 1
dead = 1
END SUB
SUB DrawGuy (x, y)
STATIC a, B, PrevX, PrevY
FOR s = 1 TO GuySpeed: NEXT
IF ResetFlag = 1 THEN B = 0
px = x - 8
py = y - 16
IF B = 0 THEN
B = 1
PrevX = px
PrevY = py
GET (px, py)-(px + 15, py + 15), graph
END IF
PUT (PrevX, PrevY), graph, PSET
PrevX = px
PrevY = py
GET (px, py)-(px + 15, py + 15), graph
a = a + .5
IF a = 4 THEN a = 0
LINE (px + 3, py)-(px + 5, py + 2), 15, BF
LINE (px + 2, py + 3)-(px + 6, py + 6), 4, BF
LINE (px + 4, py + 6)-(px + 4 - a, py + 13), 5
LINE (px + 4, py + 5)-(px + 5 + a, py + 13), 5
LINE (px + 4 - a, py + 14)-(px + 4 - a + 1, py + 15), 15, BF
LINE (px + 4, py + 14)-(px + 5 + a + 1, py + 15), 15, BF
IF DontDraw = 0 THEN
Delay = 0
CALL Bullet
Delay = 1
END IF
IF snd = 1 THEN SOUND 10000, .1
END SUB
SUB HighScores
ON ERROR GOTO CreateNewFile
OPEN FileName$ FOR INPUT AS 1
ON ERROR GOTO 0
FOR s = 1 TO 15
INPUT #1, Name$(s)
INPUT #1, Score(s)
NEXT
CLOSE 1
FOR outside = 1 TO 15
FOR inside = outside + 1 TO 15
IF Score(outside) < Score(inside) THEN
SWAP Score(outside), Score(inside)
SWAP Name$(outside), Name$(inside)
END IF
NEXT
NEXT
PLAY "T128 O2 L4 MS MB G8>C8 G8 G8 C8 G8 G8 C8 D16 E16 F8 E16 D16 C2"
COLOR 14
centre 2, "High Scores"
COLOR 3
PRINT : PRINT
FOR s = 1 TO 15
LOCATE s + 3, 10
PRINT Name$(s); TAB(22); Score(s); " "
NEXT
LINE (68, 4)-(236, 144), 4, B
LINE (68, 20)-(236, 20), 4
ClearKeyBuffer 15
IF TotalScore * 100 > Score(1) THEN
COLOR 14
centre 20, CHR$(2) + " NEW HIGH SCORE " + CHR$(2)
PRINT
INPUT "Please enter your name: ", n$
n$ = LEFT$(n$, 12)
FOR s = 14 TO 1 STEP -1
Name$(s + 1) = Name$(s)
Score(s + 1) = Score(s)
NEXT
Name$(1) = n$
Score(1) = TotalScore * 100
OPEN FileName$ FOR OUTPUT AS 1
FOR s = 1 TO 15
LOCATE s + 3, 10
PRINT Name$(s); TAB(22); Score(s); " "
PRINT #1, Name$(s)
PRINT #1, Score(s)
NEXT
LINE (68, 4)-(236, 144), 4, B
CLOSE 1
END IF
WHILE INKEY$ = "": WEND
END SUB
SUB paldef (c, r, g, B)
OUT &H3C8, c
OUT &H3C9, r
OUT &H3C9, g
OUT &H3C9, B
END SUB
SUB pandisplay (xp, yp)
OUT &H3D4, 12: OUT &H3D5, yp
OUT &H3D4, 13: OUT &H3D5, xp
END SUB
0 Comments