'Hamster Republic Productions Classic Game Source Code
'(C) Copyright Brian Fisher and James Paige and Hamster Republic Productions
'GPL software: Please read LICENSE.TXT
'
'This is the unreleased "Bob the Hamster 2", a side-scrolling platform jumper
'
'Portions of this code are adapted from the OHRRPGCE, many thanks to Simon
'Bradley who pioneered the technique of porting allmodex QB code to FreeBasic
'Many thanks to all the other OHR developers.

'$DYNAMIC
DEFINT A-Z

#include "compat.bi"
#include "allmodex.bi"
#include "util.bi"
#include "common.bi"

DECLARE FUNCTION nextitem (itpic()) AS INTEGER
DECLARE FUNCTION solid (x, y, itx(), ity(), itpic(), bob, jump) AS INTEGER
DECLARE SUB cabbage (x, y, itx(), ity(), itpic())

DIM SHARED AS INTEGER vpage, dpage
DIM master(255) AS RGBColor
DIM oldpalbuf(767)
DIM font(1024), placeh(260), placeb(112), item(200), pal(1584), timing(4), animate(200), noffx(25), noffy(25), aframe(30), area(3, 13), itpoff(20), swal(20), auto(20), yoffi(20), itpic( _
200), itx(200), ity(200), itfall(200), roll(200), itgo(200), itdir(200), map(16002), pass(16002)
DIM AS INTEGER delay, horph, spit, nospit, eatcab, seeds, jump, fall, duck, dash, xgo, cap, walk, maxj, mapx, mapy

processcommandline

DIM SHARED homedir AS STRING
DIM SHARED tmpdir AS STRING
DIM SHARED workingdir AS STRING
workingdir = exepath$ + SLASH
#IFDEF __FB_LINUX__
homedir = ENVIRON$("HOME")
tmpdir = homedir + SLASH + ".bob_the_hamster_platformer" + SLASH
IF NOT isdir(tmpdir) THEN makedir tmpdir
#ELSE
'Custom on Windows works in the current dir
homedir = ENVIRON$("USERPROFILE") & SLASH & "My Documents" 'Is My Documents called something else for non-English versions of Windows?
tmpdir = exepath$ + SLASH
#ENDIF

RANDOMIZE TIMER
GOSUB prepare

FOR i = 0 TO 3
itpic(i) = INT(RND * 4) + 5: itx(i) = INT(RND * 320): ity(i) = INT(RND * 160): itfall(i) = 1
NEXT i
FOR i = 4 TO 5
itpic(i) = 2: itx(i) = INT(RND * 320): ity(i) = INT(RND * 160): itfall(i) = 1
NEXT i

setkeys
DO: setwait delay
setkeys
IF keyval(1) > 1 THEN GOTO finis
IF keyval(88) > 1 THEN storepage "future.mxs", 0, vpage
GOSUB itemupdate
IF keyval(44) > 0 AND horph = 0 AND spit = 0 AND nospit = 0 AND eatcab = 0 THEN GOSUB eatit
IF keyval(44) > 0 AND spit = 0 AND nospit = 0 AND horph = 0 AND seeds + eatcab > 0 THEN spit = 8: nospit = 1
IF keyval(44) > 0 AND nospit = 1 THEN nospit = 0
IF keyval(80) > 0 AND jump = 0 AND fall = 0 AND duck = 0 THEN body = 3: move = 1
IF keyval(80) > 0 AND jump = 0 AND fall = 0 THEN duck = 1: move = 1
IF keyval(80) = 0 AND duck = 1 THEN duck = 0
IF (keyval(45) = 0 OR duck = 1) AND dash = 1 THEN dash = 0
IF keyval(45) > 0 AND dash = 0 AND duck = 0 AND jump = 0 AND fall = 0 THEN dash = 1
IF keyval(75) > 0 AND xgo > (cap + (dash * 3) - duck - ABS(eatcab)) * -1 THEN xgo = xgo - 2: direction = 0
IF keyval(77) > 0 AND xgo < (cap + (dash * 3) - duck - ABS(eatcab)) THEN xgo = xgo + 2: direction = 1
IF xgo <> 0 AND jump = 0 AND fall = 0 THEN move = 1: body = aframe(walk + (dash * 4) + (duck * 8)): walk = loopvar(walk, 0, 3, 1): IF walk / (2 - dash) = INT(walk / (2 - dash)) THEN playsfx 1
nex = nex + xgo
GOSUB pushcab
GOSUB scrolling
IF jump = 0 AND fall = 0 THEN xgo = xgo - SGN(xgo)
IF (keyval(57) > 0 OR keyval(72) > 0) AND jump > 0 AND fall = 0 THEN jump = jump + (1 - ABS(eatcab))
IF (keyval(57) > 0 OR keyval(72) > 0) AND jump = 0 AND fall = 0 THEN jump = maxj + dash - (ABS(eatcab)): head = 1 + dash: body = 5: duck = 0: playsfx 3
IF spit > 0 THEN GOSUB spitanim
IF horph > 0 THEN
 horph = horph - 1: move = 1: head = aframe(16 + horph)
 IF horph = 1 AND eatcab = -1 THEN eatcab = 1
 IF horph = 1 AND eatcab = 0 THEN seeds = seeds + 1
END IF
IF jump > 0 THEN ney = ney - (jump * .5): jump = jump - 3: move = 1: IF jump <= 0 THEN jump = 0: fall = 1
IF fall > 0 THEN fall = small(fall + 2, maxj + dash): ney = ney + (fall * .5): move = 1
sol = solid(nex, ney, itx(), ity(), itpic(), 1, jump)
IF sol = 0 AND fall = 0 AND jump = 0 AND readpassblock((nex - 10) / 20, ney / 20) = 0 THEN fall = 1
 IF readpassblock(INT(nex / 20), INT((ney - 20) / 20)) = 6 AND readpassblock(INT(nex / 20), INT(ney / 20)) <> 6 THEN ney = (INT((ney - 20) / 20) * 20) + (20 - (nex - (INT(nex / 20) * 20))): move = 1: fall = 0
 IF readpassblock(INT(nex / 20), INT(ney / 20)) = 6 AND readpassblock(INT(nex / 20), INT((ney - 20) / 20)) <> 6 THEN ney = (INT(ney / 20) * 20) + (20 - (nex - (INT(nex / 20) * 20))): move = 1: fall = 0
 IF sol > 0 THEN
  IF sol = 1 THEN ney = INT(ney / 20) * 20
  IF sol = 2 THEN CALL cabbage(nex, ney, itx(), ity(), itpic())
  IF fall > 4 THEN playsfx 5: move = 0
  fall = 0
 END IF
IF move = 0 THEN body = 0 + (duck * 3): head = 0
IF eatcab = 1 THEN head = 5
move = move - SGN(move)
GOSUB drawall
dowait
LOOP

drawall:
drawmap mapx, mapy, 0, 0, dpage
loadsprite placeb(), 0, 2860 + (body * 112), 0, 16, 14, 2
loadsprite placeh(), 0, 0 + (head * 260), 0, 26, 20, 2
IF direction = 0 THEN drawsprite placeb(), 0, pal(), 0 * 16, nex - noffx(body + 11) - mapx, ney - 13 - mapy, dpage
IF direction = 1 THEN wardsprite placeb(), 0, pal(), 0 * 16, nex + noffx(body + 11) - 13 - mapx, ney - 13 - mapy, dpage
IF direction = 0 THEN drawsprite placeh(), 0, pal(), 0 * 16, nex - noffx(head) - mapx, (ney - 13) + noffy(body + 11) - noffy(head) - mapy, dpage
IF direction = 1 THEN wardsprite placeh(), 0, pal(), 0 * 16, nex + noffx(head) - 23 - mapx, (ney - 13) + noffy(body + 11) - noffy(head) - mapy, dpage
FOR i = 0 TO 200
IF itpic(i) > 0 AND ity(i) - mapy < 200 AND ity(i) - mapy > 20 AND itx(i) - mapx > -20 AND itx(i) - mapx < 339 THEN
 loadsprite item(), 0, 4428 + ((itpic(i) - 1) * 200), 0, 20, 20, 2
 IF itdir(i) = 0 THEN drawsprite item(), 0, pal(), itpoff(itpic(i) - 1) * 16, (itx(i) - 10) - mapx, (ity(i) - (20 - yoffi(itpic(i) - 1))) - mapy, dpage
 IF itdir(i) = 1 THEN wardsprite item(), 0, pal(), itpoff(itpic(i) - 1) * 16, (itx(i) - 10) - mapx, (ity(i) - (20 - yoffi(itpic(i) - 1))) - mapy, dpage
END IF
NEXT i
IF seeds > 0 THEN printstr "Seeds X" + STR$(seeds), 0, 0, dpage
IF eatcab > 0 THEN printstr "Cabbage", 0, 0, dpage
printstr STR$(readpassblock((nex - 10) / 20, ney / 20)), 160, 0, dpage: IF keyval(15) > 1 THEN w = getkey
SWAP vpage, dpage
setvispage vpage
RETRACE

itemupdate:
FOR i = 0 TO 200
IF itpic(i) > 0 THEN
 IF itgo(i) <> 0 AND itpic(i) = 9 THEN GOSUB itup3
 IF itgo(i) <> 0 AND itpic(i) >= 5 AND itpic(i) <= 8 THEN GOSUB itup2
 sol = solid(itx(i), ity(i), itx(), ity(), itpic(), 0, jump)
 IF ABS(nex - itx(i)) < 16 AND ABS((ney - (14 - noffy(body + 11)) - (noffy(head) * .5)) - ity(i)) < 10 THEN sol = 2
 IF sol = 1 THEN ity(i) = INT(ity(i) / 20) * 20: itfall(i) = 0
 IF sol <> 1 AND itfall(i) <> 0 THEN GOSUB itup1
END IF
NEXT i
RETRACE
itup1:
IF sol = 0 AND itfall(i) = 0 THEN itfall(i) = 1
IF sol > 1 THEN itfall(i) = -12
IF sol = 0 AND itfall(i) > 0 THEN itfall(i) = small(itfall(i) + 2, 14): ity(i) = ity(i) + (itfall(i) * .5)
IF itfall(i) < 0 THEN ity(i) = ity(i) + (itfall(i) * .5): itfall(i) = itfall(i) + 3: IF itfall(i) >= 0 THEN itfall(i) = 1
RETRACE
itup2:
itx(i) = itx(i) + itgo(i)
unmove = 0
FOR o = 0 TO 200
 IF o <> i AND itpic(o) >= 5 AND itpic(o) <= 8 AND ABS(itx(o) - itx(i)) < 18 AND ABS(ity(o) - ity(i)) < 16 THEN unmove = 1
NEXT o
IF ABS(itx(i) - nex) < 14 AND ABS(ity(i) - ney) < 14 THEN unmove = 1
IF unmove = 1 THEN itgo(i) = itgo(i) * -1
roll(i) = roll(i) + itgo(i)
IF roll(i) > 3 THEN roll(i) = -3: itpic(i) = loopvar(itpic(i), 5, 8, 1)
IF roll(i) < -3 THEN roll(i) = 3: itpic(i) = loopvar(itpic(i), 5, 8, -1)
IF itfall(i) = 0 THEN itgo(i) = itgo(i) - SGN(itgo(i))
RETRACE
itup3:
itx(i) = itx(i) + itgo(i)
unmove = 0
FOR o = 0 TO 200
 IF o <> i AND itpic(o) >= 5 AND itpic(o) <= 8 AND ABS(itx(o) - itx(i)) < 18 AND ABS(ity(o) - ity(i)) < 16 THEN unmove = 1
NEXT o
'WALL CHECKING
'ENEMY CHECKING
'IF unmove = 1 THEN : 'BREAKING
IF itx(i) > 380 THEN itpic(i) = 0
IF itx(i) < -60 THEN itpic(i) = 0
RETRACE

pushcab: oldgo = xgo
FOR i = 0 TO 200
IF itpic(i) >= 5 AND itpic(i) <= 8 THEN
 IF ABS(ity(i) - ney) < 17 AND ABS(itx(i) - nex) < 10 + area(3, body) AND SGN(itx(i) - nex) = SGN(xgo) THEN
setkeys
blocked: setkeys
  itx(i) = itx(i) + xgo
  unmove = 0
  FOR o = 0 TO 200
   IF o <> i AND itpic(o) >= 5 AND itpic(o) <= 8 AND ABS(itx(o) - itx(i)) < 18 AND ABS(ity(o) - ity(i)) < 16 THEN unmove = 1: itx(i) = itx(i) - (SGN(itx(o) - itx(i)) * 2)
  NEXT o
  IF ABS(itx(i) - nex) < 10 + area(3, body) AND ABS(ity(i) - ney) < 16 THEN nex = nex - (SGN(itx(i) - nex) * 2)
  IF unmove = 1 THEN nex = nex - oldgo: oldgo = 0: itx(i) = itx(i) - xgo: xgo = xgo - SGN(xgo): GOTO blocked
  roll(i) = roll(i) + xgo
  IF roll(i) > 3 THEN roll(i) = -3: itpic(i) = loopvar(itpic(i), 5, 8, 1)
  IF roll(i) < -3 THEN roll(i) = 3: itpic(i) = loopvar(itpic(i), 5, 8, -1)
  itfall(i) = 1
 END IF
END IF
NEXT i
RETRACE

spitanim:
spit = spit - 1: move = 1: head = aframe(12 + INT(spit * .5))
IF spit = 4 THEN
 IF eatcab = 1 THEN eatcab = 0: playsfx 6: GOSUB spitcab
 IF seeds > 0 THEN seeds = seeds - 1: playsfx 4: GOSUB spitseed
END IF
RETRACE

spitcab:
freei = nextitem(itpic())
itpic(freei) = 5: ity(freei) = ney: itx(freei) = nex + ((2 * direction) - 1) * noffx(head): itgo(freei) = ((direction * 2) - 1) * 4: itfall(freei) = -4
RETRACE
spitseed:
freei = nextitem(itpic())
itpic(freei) = 9: ity(freei) = ney - (5 - (duck * 5)): itx(freei) = nex + ((2 * direction) - 1) * 20: itgo(freei) = ((direction * 2) - 1) * 10: itdir(freei) = direction
RETRACE

eatit:
FOR i = 0 TO 200
IF ABS(itx(i) - nex) < 18 AND ABS(ity(i) - ney) < 16 AND itpic(i) = 2 AND seeds < 15 AND eatcab = 0 THEN itpic(i) = 0: horph = 8
IF ABS(itx(i) - nex) < 26 AND ABS(ity(i) - ney) < 14 AND SGN(itx(i) - nex) = (direction * 2) - 1 AND horph = 0 AND itpic(i) >= 5 AND itpic(i) <= 8 AND seeds = 0 THEN itpic(i) = 0: horph = 8: eatcab = -1
NEXT i
RETRACE

scrolling:
nex = small(large(nex, 0), map(0) * 20): ney = small(large(ney, 30), map(1) * 20)
IF nex - mapx < 50 THEN mapx = large(mapx - 1, 0)
IF nex - mapx > 270 THEN mapx = small(mapx + 1, (map(0) * 20) - 320)
IF nex - mapx < 120 THEN mapx = large(mapx - ABS(xgo), 0)
IF nex - mapx > 200 THEN mapx = small(mapx + ABS(xgo), (map(0) * 20) - 320)
IF ney - mapy < 80 THEN mapy = large(0, mapy - (80 - (ney - mapy)))
IF ney - mapy > 120 THEN mapy = small((map(1) * 20) - 200, mapy + ((ney - mapy) - 120))
RETRACE

prepare:
setupsound
setmodex
setwindowtitle "Bob the Hamster - Platformer"
xbload data_file("palette.mas"), oldpalbuf(), "master palette missing"
convertpalette oldpalbuf(), master()
setpal master()
xbload data_file("bob.ohf"), font(), "font missing"
setfont font()
textcolor 15, 0
xbload data_file("bob.pal"), pal(), "16-color palettes missing"
load_map "temp", map(), pass()
setmapdata map(), pass(), 0, 0
fall = 1: delay = 60: nex = 160: ney = 100: maxj = 20: cap = 3: vpage = 0: dpage = 1
loadpage data_file("bob.all"), 0, 2
'DIFFERENT MAP BLOCK SETS
 loadpage data_file("bob.all"), 1, 3
a$ = " "
OPEN data_file("bob.dat") FOR BINARY AS #1
FOR i = 0 TO 24
GET #1, i + 1, a$
noffx(i) = ASC(a$)
GET #1, i + 26, a$
noffy(i) = ASC(a$)
NEXT i
FOR i = 0 TO 13
FOR o = 0 TO 3
GET #1, 51 + (4 * i) + o, a$
area(o, i) = ASC(a$)
NEXT o: NEXT i
FOR i = 0 TO 9
GET #1, 110 + (4 * i) + 0, a$
itpoff(i) = ASC(a$)
GET #1, 110 + (4 * i) + 1, a$
swal(i) = ASC(a$)
GET #1, 110 + (4 * i) + 2, a$
auto(i) = ASC(a$)
GET #1, 110 + (4 * i) + 3, a$
yoffi(i) = ASC(a$)
NEXT i
CLOSE #1
FOR i = 0 TO 24: READ aframe(i)
NEXT i
RETRACE
DATA  0,1,0,2,6,7,6,7,3,4,3,4,0,8,5,4,0,5,4,5,4,5,4,5,2

finis:
fadeto 0, 0, 0
closesound
SYSTEM

REM $STATIC
SUB cabbage (x, y, itx(), ity(), itpic())
FOR i = 0 TO 200
IF itpic(i) >= 5 AND itpic(i) <= 8 THEN
 IF ABS(itx(i) - x) < 10 AND ABS((ity(i) - 10) - y) < 16 THEN y = ity(i) - 16
END IF
NEXT i
END SUB

FUNCTION nextitem (itpic())
a = -1
FOR i = 200 TO 0 STEP -1
IF itpic(i) = 0 THEN a = i
NEXT i
nextitem = a
END FUNCTION

FUNCTION solid (x, y, itx(), ity(), itpic(), bob, jump)
FOR i = 0 TO 200
IF itpic(i) >= 5 AND itpic(i) <= 8 THEN
 IF ity(i) = y AND itx(i) = x THEN GOTO solid1
 IF ABS(itx(i) - x) < 16 - (6 * bob) AND ABS((ity(i) - 10) - y) < 16 THEN solid = 2
END IF
solid1:
NEXT i
 IF (readpassblock((x - 10) / 20, y / 20) = 2 OR readpassblock((x - 10) / 20, y / 20) = 1) AND (y / 20 - INT(y / 20)) * 20 < 10 AND jump = 0 THEN solid = 1
 'IF readpassblock((x - 10) / 20, (y / 20) - 1) > 2 AND jump = 0 THEN solid = readpassblock((x - 10) / 20, y / 20)
END FUNCTION