Skip to content

Instantly share code, notes, and snippets.

@jlong
Created May 4, 2015 17:23
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save jlong/d01cb97f1d0055243ed4 to your computer and use it in GitHub Desktop.
Save jlong/d01cb97f1d0055243ed4 to your computer and use it in GitHub Desktop.
DECLARE SUB EraseBackToGB (X AS INTEGER, Y AS INTEGER)
DECLARE SUB AddRoundAbout (X AS INTEGER, Y AS INTEGER, Dir AS STRING)
DECLARE SUB DoRoundAbouts ()
'The SMiLEY Game
'$DYNAMIC
DECLARE SUB AnimateLevWarp ()
DECLARE SUB AnimateSmiley ()
DECLARE SUB AddBouncer (X AS INTEGER, Y AS INTEGER, v AS INTEGER, Dir AS STRING)
DECLARE SUB AddCaterpillar (X AS STRING, Y AS STRING, Dir AS STRING)
DECLARE SUB AddCoin (X AS INTEGER, Y AS INTEGER)
DECLARE SUB AddToManPos (X AS INTEGER, Y AS INTEGER)
DECLARE SUB AddToNumMen (Num AS INTEGER)
DECLARE SUB AddToScore (scr AS INTEGER)
DECLARE SUB CFont (text AS STRING, X AS INTEGER, Y AS INTEGER, Fore AS INTEGER)
DECLARE SUB DelFirstInStr (StringToSearch AS STRING, DelStr AS STRING)
DECLARE SUB DoBouncers ()
DECLARE SUB DoCaterpillars ()
DECLARE SUB DoCoins ()
DECLARE SUB DrawBoard ()
DECLARE SUB EndGame ()
DECLARE SUB GameOver ()
DECLARE FUNCTION Get3x5FontLen% (text AS STRING)
DECLARE FUNCTION GetCPUSpeed& ()
DECLARE SUB GLoad (FileName AS STRING, GLoadArray() AS INTEGER)
DECLARE FUNCTION Inputbox$ (text AS STRING, length AS INTEGER)
DECLARE SUB KillCoin (X AS INTEGER, Y AS INTEGER)
DECLARE SUB KillMan ()
DECLARE SUB LoadLevel (FileName AS STRING)
DECLARE SUB LoadSmileyDat ()
DECLARE SUB MsgBoxMsg (text AS STRING)
DECLARE FUNCTION MsgboxYesNo$ (text AS STRING)
DECLARE SUB NextLevel ()
DECLARE SUB PalLoad (PalFile$)
DECLARE SUB Pause ()
DECLARE SUB p5x7Font (text$, X!, Y!, colour!)
'---------------------------------------------------------------
CONST AppPath = "C:\Dos\MyStuff\Smiley\"
CONST NumMen = 5 'Number of Men you start out with (1 to 99)
CONST NumLevels = 12
' Don't mess with these
CONST cCobble = 0
CONST cBlueBlock = 1
CONST cApple = 2
CONST cCoin = 3
CONST cLevWarp = 5
CONST cRoundAbout = 6
CONST cBouncer = 7
CONST cCaterpillar = 8
CONST cFreeMan = 9
CONST cMan = 10
'---------------------------------------------------------------
' Declare Types here
TYPE PalType
r AS INTEGER
G AS INTEGER
B AS INTEGER
END TYPE
TYPE LevStat
X AS INTEGER
Y AS INTEGER
LevStatus AS INTEGER
END TYPE
TYPE Mn
X AS INTEGER
Y AS INTEGER
StartX AS INTEGER
StartY AS INTEGER
END TYPE
TYPE Bouncr
X AS INTEGER
Y AS INTEGER
v AS INTEGER
Dir AS STRING * 1
ID AS INTEGER
END TYPE
TYPE Cn
X AS INTEGER
Y AS INTEGER
CnNum AS INTEGER
Flip AS INTEGER
ID AS INTEGER
END TYPE
TYPE Caterpil
X AS STRING * 5
Y AS STRING * 5
Dir AS STRING * 5
ID AS INTEGER
END TYPE
TYPE RndAbt
X AS INTEGER
Y AS INTEGER
Dir AS STRING * 1
AttachedSqrPos AS INTEGER
ID AS INTEGER
END TYPE
TYPE HghScrDat
Date AS STRING * 6
FullName AS STRING * 30
Score AS LONG
END TYPE
' Game Variables
DIM SHARED GameBoard(1 TO 32, 1 TO 20) AS INTEGER
DIM SHARED GameBoardLive(1 TO 32, 1 TO 20) AS STRING
DIM SHARED Man AS Mn
DIM SHARED LevWarp AS LevStat
DIM SHARED Score AS LONG
DIM SHARED Bouncer(0) AS Bouncr 'The Array that Stores all Bouncer Info
DIM SHARED NumBouncers AS INTEGER
DIM SHARED NumBouncersOnLevel AS INTEGER
DIM SHARED Caterpillar(0) AS Caterpil 'The Array that Stores all Caterpillar Info
DIM SHARED NumCaterpillars AS INTEGER
DIM SHARED NumCaterpillarsOnLevel AS INTEGER
DIM SHARED RoundAbout(0) AS RndAbt 'The Array that Stores all Caterpillar Info
DIM SHARED NumRoundAbouts AS INTEGER
DIM SHARED NumRoundAboutsOnLevel AS INTEGER
DIM SHARED Coin(0) AS Cn 'The Array that Stores all Coin Info
DIM SHARED NumCoins AS INTEGER
DIM SHARED NumCoinsOnLevel AS INTEGER
DIM SHARED GameSpeed AS INTEGER
DIM SHARED CurrentLevel AS INTEGER
DIM SHARED CPUSpeed AS LONG
DIM SHARED SmileyOhMode AS INTEGER
DIM SHARED IsMenuDriven AS INTEGER
DIM i AS INTEGER, Oldi AS INTEGER
' Image Arrays
DIM SHARED ManImg(0) AS INTEGER
DIM SHARED FreemanImg(0) AS INTEGER
DIM SHARED BouncerImg(0) AS INTEGER
DIM SHARED CatHeadImg(0) AS INTEGER
DIM SHARED CatSegImg(0) AS INTEGER
DIM SHARED CobbleImg(0) AS INTEGER
DIM SHARED BlueBlockImg(0) AS INTEGER
DIM SHARED AppleImg(0) AS INTEGER
DIM SHARED LevWarp1Img(0) AS INTEGER
DIM SHARED LevWarp2Img(0) AS INTEGER
DIM SHARED LevWarp3Img(0) AS INTEGER
DIM SHARED LevWarp4Img(0) AS INTEGER
DIM SHARED LCD1Img(0) AS INTEGER
DIM SHARED LCD2Img(0) AS INTEGER
DIM SHARED LCD3Img(0) AS INTEGER
DIM SHARED LCD4Img(0) AS INTEGER
DIM SHARED LCD5Img(0) AS INTEGER
DIM SHARED LCD6Img(0) AS INTEGER
DIM SHARED LCD7Img(0) AS INTEGER
DIM SHARED LCD8Img(0) AS INTEGER
DIM SHARED LCD9Img(0) AS INTEGER
DIM SHARED LCD0Img(0) AS INTEGER
DIM SHARED SMiLEYimg(0) AS INTEGER
DIM SHARED SmileyOhImg(0) AS INTEGER
DIM SHARED Coin1Img(0) AS INTEGER
DIM SHARED Coin2Img(0) AS INTEGER
DIM SHARED Coin3Img(0) AS INTEGER
DIM SHARED Coin4Img(0) AS INTEGER
DIM SHARED Coin5Img(0) AS INTEGER
DIM SHARED RoundAboutImg(0) AS INTEGER
' Needed for the LoadPal sub
DIM SHARED pall(256) AS PalType
DIM SHARED pal(768)
'Define the Random Function
RANDOMIZE TIMER
DEF FnRan (X) = INT(RND * X) + 1
SCREEN 13 ' Screen Mode
LoadSmileyDat
' Load Images...
PRINT "Loading Images.";
PalLoad AppPath + "draw": PRINT ".";
GLoad AppPath + "gSMiLEY.img", SMiLEYimg(): PRINT ".";
GLoad AppPath + "Cobble.img", CobbleImg(): PRINT ".";
GLoad AppPath + "BlBlock.img", BlueBlockImg(): PRINT ".";
GLoad AppPath + "CatHead.img", CatHeadImg(): PRINT ".";
GLoad AppPath + "CatSeg.img", CatSegImg(): PRINT ".";
GLoad AppPath + "Round.img", RoundAboutImg()
GLoad AppPath + "Smiley2.img", ManImg(): PRINT ".";
GLoad AppPath + "SmileyOh.img", SmileyOhImg()
GLoad AppPath + "Apple.img", AppleImg(): PRINT ".";
GLoad AppPath + "LevWarp1.img", LevWarp1Img(): PRINT ".";
GLoad AppPath + "LevWarp2.img", LevWarp2Img(): PRINT ".";
GLoad AppPath + "LevWarp3.img", LevWarp3Img(): PRINT ".";
GLoad AppPath + "LevWarp4.img", LevWarp4Img(): PRINT ".";
GLoad AppPath + "Bouncer.img", BouncerImg(): PRINT ".";
GLoad AppPath + "Freeman.img", FreemanImg(): PRINT ".";
GLoad AppPath + "1.img", LCD1Img(): PRINT ".";
GLoad AppPath + "2.img", LCD2Img(): PRINT ".";
GLoad AppPath + "3.img", LCD3Img(): PRINT ".";
GLoad AppPath + "4.img", LCD4Img(): PRINT ".";
GLoad AppPath + "5.img", LCD5Img(): PRINT ".";
GLoad AppPath + "6.img", LCD6Img(): PRINT ".";
GLoad AppPath + "7.img", LCD7Img()
GLoad AppPath + "8.img", LCD8Img()
GLoad AppPath + "9.img", LCD9Img()
GLoad AppPath + "0.img", LCD0Img()
GLoad AppPath + "Coin1.img", Coin1Img()
GLoad AppPath + "Coin2.img", Coin2Img()
GLoad AppPath + "Coin3.img", Coin3Img()
GLoad AppPath + "Coin4.img", Coin4Img()
GLoad AppPath + "Coin5.img", Coin5Img(): PRINT "Done!": PRINT
DIM SHARED font(127, 4, 6) 'DIM array for fonts
FOR offset = 0 TO 127 'read in fonts
FOR Y = 0 TO 6 'top to bottom
FOR X = 0 TO 4 'left to right
READ dat 'get data
font(offset, X, Y) = dat 'store it
NEXT
NEXT
NEXT
CLS
' Load Level 1
AddToNumMen 5
CurrentLevel = 10
NextLevel
DO
i = INP(96)
IF i = 124 THEN i = Oldi
SELECT CASE i
CASE 75: AddToManPos -1, 0
CASE 77: AddToManPos 1, 0
CASE 72: AddToManPos 0, -1
CASE 80: AddToManPos 0, 1
END SELECT
Oldi = i
FOR P& = 1 TO (CPUSpeed * 1.5): NEXT P&
DoCoins
DoBouncers
DoCaterpillars
DoRoundAbouts
AnimateLevWarp
AnimateSmiley
IF SmileyOhMode = 1 THEN AnimateSmiley
Key$ = INKEY$
IF UCASE$(Key$) = "R" THEN DrawBoard
IF UCASE$(Key$) = "P" THEN Pause
IF UCASE$(Key$) = "N" THEN
IF MsgboxYesNo("Start a New Game? (y/n)") = "Y" THEN
AddToNumMen -1000
AddToNumMen 5
Score = 0
LoadLevel "Level1.lvl"
CurrentLevel = 1
DrawBoard
END IF
END IF
IF Key$ = CHR$(27) THEN EndGame
LOOP
END
'font bitmaps, duplicates first 128 charactors of ASCII set
' 0 NUL
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 0,0,0,0,0
' 1
DATA 1,1,0,1,1
DATA 1,1,0,1,1
DATA 0,1,0,1,0
DATA 0,0,0,0,0
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 1,1,1,1,1
' 2
DATA 1,1,1,1,1
DATA 1,0,1,0,1
DATA 1,0,1,0,1
DATA 1,1,1,1,1
DATA 1,0,1,0,1
DATA 1,0,0,0,1
DATA 1,1,1,1,1
' 3
DATA 0,0,0,0,0
DATA 0,1,0,1,0
DATA 1,1,1,1,1
DATA 1,1,1,1,1
DATA 0,1,1,1,0
DATA 0,0,1,0,0
DATA 0,0,0,0,0
'4
DATA 0,0,0,0,0
DATA 0,0,1,0,0
DATA 0,1,1,1,0
DATA 1,1,1,1,1
DATA 1,1,1,1,1
DATA 0,1,1,1,0
DATA 0,0,1,0,0
'5
DATA 0,1,1,1,0
DATA 0,1,1,1,0
DATA 1,1,1,1,1
DATA 1,1,1,1,1
DATA 1,1,1,1,1
DATA 0,0,1,0,0
DATA 0,0,1,0,0
'6
DATA 0,0,1,0,0
DATA 0,1,1,1,0
DATA 1,1,1,1,1
DATA 1,1,0,1,1
DATA 0,0,1,0,0
DATA 0,0,1,0,0
DATA 0,0,0,0,0
'7
DATA 0,0,0,0,0
DATA 0,0,1,0,0
DATA 0,1,1,1,0
DATA 0,1,1,1,0
DATA 1,1,1,1,1
DATA 1,1,1,1,1
DATA 0,0,0,1,0
'8
DATA 1,1,1,1,1
DATA 1,1,0,1,1
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 1,1,1,0,1
'9
DATA 0,0,0,0,0
DATA 0,1,1,1,0
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 0,1,1,1,0
DATA 0,0,0,0,0
'10
DATA 1,1,1,1,1
DATA 1,0,0,0,1
DATA 0,1,1,1,0
DATA 0,1,1,1,0
DATA 0,1,1,1,0
DATA 1,0,0,0,1
DATA 1,1,1,1,1
'11
DATA 0,0,1,1,1
DATA 0,0,0,1,1
DATA 0,0,1,0,1
DATA 0,1,1,0,0
DATA 1,0,0,1,0
DATA 1,0,0,1,0
DATA 0,1,1,0,0
'12
DATA 0,1,1,1,0
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 0,1,1,1,0
DATA 0,0,1,0,0
DATA 0,1,1,1,0
DATA 0,0,1,0,0
'13
DATA 0,0,1,1,1
DATA 0,0,1,0,0
DATA 0,0,1,1,0
DATA 0,0,1,0,0
DATA 1,1,1,0,0
DATA 1,1,1,0,0
DATA 1,1,1,0,0
'14
DATA 1,1,1,1,1
DATA 1,0,0,0,1
DATA 1,1,1,1,1
DATA 0,1,0,0,1
DATA 1,1,0,0,1
DATA 1,1,0,1,1
DATA 0,0,0,1,1
'15
DATA 1,0,1,0,1
DATA 0,1,1,1,0
DATA 0,1,0,1,0
DATA 1,1,0,1,1
DATA 0,1,0,1,0
DATA 0,1,1,1,0
DATA 1,0,1,0,1
'16
DATA 1,1,0,0,0
DATA 1,1,1,0,0
DATA 1,1,1,1,0
DATA 1,1,1,1,1
DATA 1,1,1,1,0
DATA 1,1,1,0,0
DATA 1,1,0,0,0
'17
DATA 0,0,0,1,1
DATA 0,0,1,1,1
DATA 0,1,1,1,1
DATA 1,1,1,1,1
DATA 0,1,1,1,1
DATA 0,0,1,1,1
DATA 0,0,0,1,1
'18
DATA 0,0,1,0,0
DATA 0,1,1,1,0
DATA 0,0,1,0,0
DATA 0,0,1,0,0
DATA 0,1,1,1,0
DATA 0,1,1,1,0
DATA 0,0,1,0,0
'19
DATA 1,1,0,1,1
DATA 1,1,0,1,1
DATA 1,1,0,1,1
DATA 1,1,0,1,1
DATA 1,1,0,1,1
DATA 0,0,0,0,0
DATA 1,1,0,1,1
'20
DATA 1,1,1,1,1
DATA 1,1,0,1,0
DATA 1,1,0,1,0
DATA 0,1,0,1,0
DATA 0,1,0,1,0
DATA 0,1,0,1,0
DATA 0,1,0,1,0
'21
DATA 0,0,1,1,0
DATA 0,1,0,0,1
DATA 0,0,1,0,0
DATA 0,0,0,1,0
DATA 0,0,0,0,1
DATA 0,0,0,0,1
DATA 1,1,1,1,0
'22
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 1,1,1,1,1
DATA 1,1,1,1,1
'23
DATA 0,0,1,0,0
DATA 0,1,1,1,0
DATA 0,0,1,0,0
DATA 0,0,1,0,0
DATA 0,1,1,1,0
DATA 0,0,1,0,0
DATA 1,1,1,1,1
'24
DATA 0,0,1,0,0
DATA 0,1,1,1,0
DATA 1,1,1,1,1
DATA 0,0,1,0,0
DATA 0,0,1,0,0
DATA 0,0,1,0,0
DATA 0,0,1,0,0
'25
DATA 0,0,1,0,0
DATA 0,0,1,0,0
DATA 0,0,1,0,0
DATA 0,0,1,0,0
DATA 1,1,1,1,1
DATA 0,1,1,1,0
DATA 0,0,1,0,0
'26
DATA 0,0,0,0,0
DATA 0,0,1,0,0
DATA 0,0,1,1,0
DATA 1,1,1,1,1
DATA 0,0,1,1,0
DATA 0,0,1,0,0
DATA 0,0,0,0,0
'27
DATA 0,0,0,0,0
DATA 0,0,1,0,0
DATA 0,1,1,0,0
DATA 1,1,1,1,1
DATA 0,1,1,0,0
DATA 0,0,1,0,0
DATA 0,0,0,0,0
'28
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 1,0,0,0,0
DATA 1,1,1,1,1
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 0,0,0,0,0
'29
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 0,1,0,1,0
DATA 1,1,1,1,1
DATA 0,1,0,1,0
DATA 0,0,0,0,0
DATA 0,0,0,0,0
'30
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 0,0,1,0,0
DATA 0,1,1,1,0
DATA 1,1,1,1,1
'31
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 1,1,1,1,1
DATA 0,1,1,1,0
DATA 0,0,1,0,0
'32
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 0,0,0,0,0
'33
DATA 1,0,0,0,0
DATA 1,0,0,0,0
DATA 1,0,0,0,0
DATA 1,0,0,0,0
DATA 1,0,0,0,0
DATA 0,0,0,0,0
DATA 1,0,0,0,0
'34
DATA 0,1,0,1,0
DATA 0,1,0,1,0
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 0,0,0,0,0
'35
DATA 0,1,0,1,0
DATA 0,1,0,1,0
DATA 1,1,1,1,1
DATA 0,1,0,1,0
DATA 1,1,1,1,1
DATA 0,1,0,1,0
DATA 0,1,0,1,0
'36
DATA 0,0,1,0,0
DATA 1,1,1,1,1
DATA 1,0,0,0,0
DATA 1,1,1,1,1
DATA 0,0,0,0,1
DATA 1,1,1,1,1
DATA 0,0,1,0,0
'37
DATA 1,1,0,0,0
DATA 1,1,0,0,1
DATA 0,0,0,1,0
DATA 0,0,1,0,0
DATA 0,1,0,0,0
DATA 1,0,0,1,1
DATA 0,0,0,1,1
'38
DATA 0,1,1,0,0
DATA 1,0,0,0,0
DATA 1,0,0,0,0
DATA 0,1,0,0,0
DATA 1,0,1,1,0
DATA 1,0,1,1,0
DATA 0,1,0,0,1
'39
DATA 0,1,0,0,0
DATA 1,0,0,0,0
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 0,0,0,0,0
'40
DATA 0,1,0,0,0
DATA 1,0,0,0,0
DATA 1,0,0,0,0
DATA 1,0,0,0,0
DATA 1,0,0,0,0
DATA 1,0,0,0,0
DATA 0,1,0,0,0
'41
DATA 1,0,0,0,0
DATA 0,1,0,0,0
DATA 0,1,0,0,0
DATA 0,1,0,0,0
DATA 0,1,0,0,0
DATA 0,1,0,0,0
DATA 1,0,0,0,0
'42
DATA 0,0,0,0,0
DATA 1,0,1,0,1
DATA 0,1,1,1,0
DATA 1,1,1,1,1
DATA 0,1,1,1,0
DATA 1,0,1,0,1
DATA 0,0,0,0,0
'43
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 0,0,1,0,0
DATA 0,1,1,1,0
DATA 0,0,1,0,0
DATA 0,0,0,0,0
DATA 0,0,0,0,0
'44
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 0,1,0,0,0
DATA 1,0,0,0,0
'45
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 0,1,1,1,0
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 0,0,0,0,0
'46
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 1,0,0,0,0
'47
DATA 0,0,0,0,0
DATA 0,0,0,0,1
DATA 0,0,0,1,0
DATA 0,0,1,0,0
DATA 0,1,0,0,0
DATA 1,0,0,0,0
DATA 0,0,0,0,0
'48
'Numbers
DATA 0,1,1,1,0
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 0,1,1,1,0
'49
DATA 0,1,1,0,0
DATA 0,0,1,0,0
DATA 0,0,1,0,0
DATA 0,0,1,0,0
DATA 0,0,1,0,0
DATA 0,0,1,0,0
DATA 0,1,1,1,0
'50
DATA 0,1,1,1,0
DATA 1,0,0,0,1
DATA 0,0,0,1,0
DATA 0,0,1,0,0
DATA 0,1,0,0,0
DATA 1,0,0,0,0
DATA 1,1,1,1,1
'51
DATA 0,1,1,1,0
DATA 1,0,0,0,1
DATA 0,0,0,0,1
DATA 0,1,1,1,0
DATA 0,0,0,0,1
DATA 1,0,0,0,1
DATA 0,1,1,1,0
'52
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 0,1,1,1,1
DATA 0,0,0,0,1
DATA 0,0,0,0,1
DATA 0,0,0,0,1
'53
DATA 1,1,1,1,1
DATA 1,0,0,0,0
DATA 1,0,0,0,0
DATA 1,1,1,1,0
DATA 0,0,0,0,1
DATA 0,0,0,0,1
DATA 1,1,1,1,0
'54
DATA 1,0,0,0,0
DATA 1,0,0,0,0
DATA 1,0,0,0,0
DATA 1,1,1,1,0
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 0,1,1,1,0
'55
DATA 1,1,1,1,0
DATA 0,0,0,0,1
DATA 0,0,0,0,1
DATA 0,0,0,0,1
DATA 0,0,0,0,1
DATA 0,0,0,0,1
DATA 0,0,0,0,1
'56
DATA 0,1,1,1,0
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 0,1,1,1,0
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 0,1,1,1,0
'57
DATA 0,1,1,1,0
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 0,1,1,1,1
DATA 0,0,0,0,1
DATA 0,0,0,0,1
DATA 0,0,0,0,1
'58
DATA 0,0,0,0,0
DATA 0,0,1,0,0
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 0,0,1,0,0
DATA 0,0,0,0,0
'59
DATA 0,0,0,0,0
DATA 0,0,1,0,0
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 0,0,1,0,0
DATA 0,1,0,0,0
'60
DATA 0,0,0,0,0
DATA 0,0,0,1,0
DATA 0,0,1,0,0
DATA 0,1,0,0,0
DATA 0,0,1,0,0
DATA 0,0,0,1,0
DATA 0,0,0,0,0
'61
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 1,1,1,1,1
DATA 0,0,0,0,0
DATA 1,1,1,1,1
DATA 0,0,0,0,0
DATA 0,0,0,0,0
'62
DATA 0,0,0,0,0
DATA 0,1,0,0,0
DATA 0,0,1,0,0
DATA 0,0,0,1,0
DATA 0,0,1,0,0
DATA 0,1,0,0,0
DATA 0,0,0,0,0
'63
DATA 0,1,1,1,0
DATA 1,0,0,0,1
DATA 0,0,0,0,1
DATA 0,0,0,1,0
DATA 0,0,1,0,0
DATA 0,0,0,0,0
DATA 0,0,1,0,0
'64
DATA 0,1,1,1,0
DATA 1,0,0,0,1
DATA 1,0,1,0,1
DATA 1,0,1,1,1
DATA 1,0,0,0,0
DATA 1,0,0,0,1
DATA 0,1,1,1,0
' 65 Capitol
DATA 1,1,1,1,1
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 1,1,1,1,1
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 1,0,0,0,1
'66
DATA 1,1,1,1,0
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 1,1,1,1,0
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 1,1,1,1,0
'67
DATA 1,1,1,1,1
DATA 1,0,0,0,0
DATA 1,0,0,0,0
DATA 1,0,0,0,0
DATA 1,0,0,0,0
DATA 1,0,0,0,0
DATA 1,1,1,1,1
'68
DATA 1,1,1,1,0
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 1,1,1,1,0
'69
DATA 1,1,1,1,1
DATA 1,0,0,0,0
DATA 1,0,0,0,0
DATA 1,1,1,0,0
DATA 1,0,0,0,0
DATA 1,0,0,0,0
DATA 1,1,1,1,1
'70
DATA 1,1,1,1,1
DATA 1,0,0,0,0
DATA 1,0,0,0,0
DATA 1,1,1,0,0
DATA 1,0,0,0,0
DATA 1,0,0,0,0
DATA 1,0,0,0,0
'71
DATA 1,1,1,1,1
DATA 1,0,0,0,0
DATA 1,0,0,0,0
DATA 1,0,1,1,1
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 1,1,1,1,1
'72
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 1,1,1,1,1
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 1,0,0,0,1
'73
DATA 1,1,1,1,1
DATA 0,0,1,0,0
DATA 0,0,1,0,0
DATA 0,0,1,0,0
DATA 0,0,1,0,0
DATA 0,0,1,0,0
DATA 1,1,1,1,1
'74
DATA 0,0,0,0,1
DATA 0,0,0,0,1
DATA 0,0,0,0,1
DATA 0,0,0,0,1
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 1,1,1,1,1
'75
DATA 1,0,0,0,1
DATA 1,0,0,1,0
DATA 1,0,1,0,0
DATA 1,1,0,0,0
DATA 1,0,1,0,0
DATA 1,0,0,1,0
DATA 1,0,0,0,1
'76
DATA 1,0,0,0,0
DATA 1,0,0,0,0
DATA 1,0,0,0,0
DATA 1,0,0,0,0
DATA 1,0,0,0,0
DATA 1,0,0,0,0
DATA 1,1,1,1,1
'77
DATA 1,0,0,0,1
DATA 1,1,0,1,1
DATA 1,0,1,0,1
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 1,0,0,0,1
'78
DATA 1,0,0,0,1
DATA 1,1,0,0,1
DATA 1,0,1,0,1
DATA 1,0,0,1,1
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 1,0,0,0,1
'79
DATA 1,1,1,1,1
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 1,1,1,1,1
'80
DATA 1,1,1,1,1
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 1,1,1,1,1
DATA 1,0,0,0,0
DATA 1,0,0,0,0
DATA 1,0,0,0,0
'81
DATA 0,1,1,1,0
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 0,0,0,1,1
DATA 0,1,1,1,1
'82
DATA 1,1,1,1,1
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 1,1,1,1,1
DATA 1,1,0,0,0
DATA 1,0,1,0,0
DATA 1,0,0,1,1
'83
DATA 1,1,1,1,1
DATA 1,0,0,0,0
DATA 1,0,0,0,0
DATA 1,1,1,1,1
DATA 0,0,0,0,1
DATA 0,0,0,0,1
DATA 1,1,1,1,1
'84
DATA 1,1,1,1,1
DATA 0,0,1,0,0
DATA 0,0,1,0,0
DATA 0,0,1,0,0
DATA 0,0,1,0,0
DATA 0,0,1,0,0
DATA 0,0,1,0,0
'85
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 1,1,1,1,1
'86
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 0,1,0,1,0
DATA 0,1,0,1,0
DATA 0,0,1,0,0
'87
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 1,0,1,0,1
DATA 1,0,1,0,1
DATA 1,1,1,1,1
'88
DATA 1,0,0,0,1
DATA 0,1,0,1,0
DATA 0,1,0,1,0
DATA 0,0,1,0,0
DATA 0,1,0,1,0
DATA 0,1,0,1,0
DATA 1,0,0,0,1
'89
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 0,1,0,1,0
DATA 0,0,1,0,0
DATA 0,0,1,0,0
DATA 0,0,1,0,0
DATA 0,0,1,0,0
'90
DATA 1,1,1,1,1
DATA 0,0,0,0,1
DATA 0,0,0,1,0
DATA 0,0,1,0,0
DATA 0,1,0,0,0
DATA 1,0,0,0,0
DATA 1,1,1,1,1
'91
DATA 0,1,1,1,0
DATA 0,1,0,0,0
DATA 0,1,0,0,0
DATA 0,1,0,0,0
DATA 0,1,0,0,0
DATA 0,1,0,0,0
DATA 0,1,1,1,0
'92
DATA 0,0,0,0,0
DATA 1,0,0,0,0
DATA 0,1,0,0,0
DATA 0,0,1,0,0
DATA 0,0,0,1,0
DATA 0,0,0,0,1
DATA 0,0,0,0,0
'93
DATA 0,1,1,1,0
DATA 0,0,0,1,0
DATA 0,0,0,1,0
DATA 0,0,0,1,0
DATA 0,0,0,1,0
DATA 0,0,0,1,0
DATA 0,1,1,1,0
'94
DATA 0,0,1,0,0
DATA 0,1,0,1,0
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 0,0,0,0,0
'95
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 1,1,1,1,1
'96
DATA 0,0,1,0,0
DATA 0,0,0,1,0
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 0,0,0,0,0
'97
'Lower case
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 0,1,1,1,1
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 1,0,0,1,1
DATA 0,1,1,0,1
'98
DATA 1,0,0,0,0
DATA 1,0,0,0,0
DATA 1,1,1,1,1
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 1,1,1,1,1
'99
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 1,1,1,1,1
DATA 1,0,0,0,0
DATA 1,0,0,0,0
DATA 1,0,0,0,0
DATA 1,1,1,1,1
'100
DATA 0,0,0,0,1
DATA 0,0,0,0,1
DATA 1,1,1,1,1
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 1,1,1,1,1
'101
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 1,1,1,1,1
DATA 1,0,0,0,1
DATA 1,1,1,1,1
DATA 1,0,0,0,0
DATA 1,1,1,1,1
'102
DATA 0,0,1,1,1
DATA 0,1,0,0,0
DATA 1,1,1,1,1
DATA 0,1,0,0,0
DATA 0,1,0,0,0
DATA 0,1,0,0,0
DATA 0,1,0,0,0
'103
DATA 1,1,1,1,1
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 1,1,1,1,1
DATA 0,0,0,0,1
DATA 1,1,1,1,1
'104
DATA 1,0,0,0,0
DATA 1,0,0,0,0
DATA 1,1,1,1,1
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 1,0,0,0,1
'105
DATA 1,0,0,0,0
DATA 0,0,0,0,0
DATA 1,0,0,0,0
DATA 1,0,0,0,0
DATA 1,0,0,0,0
DATA 1,0,0,0,0
DATA 1,0,0,0,0
'106
DATA 0,0,0,1,0
DATA 0,0,0,0,0
DATA 0,0,0,1,0
DATA 0,0,0,1,0
DATA 0,0,0,1,0
DATA 0,0,0,1,0
DATA 1,1,1,1,0
'107
DATA 1,0,0,0,0
DATA 1,0,0,0,0
DATA 1,0,0,0,1
DATA 1,0,0,1,0
DATA 1,1,1,0,0
DATA 1,0,0,1,0
DATA 1,0,0,0,1
'108
DATA 1,0,0,0,0
DATA 1,0,0,0,0
DATA 1,0,0,0,0
DATA 1,0,0,0,0
DATA 1,0,0,0,0
DATA 1,0,0,0,0
DATA 1,0,0,0,0
'109
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 1,1,1,1,1
DATA 1,0,1,0,1
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 1,0,0,0,1
'110
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 1,1,1,1,0
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 1,0,0,0,1
'111
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 1,1,1,1,1
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 1,1,1,1,1
'112
DATA 1,1,1,1,1
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 1,1,1,1,1
DATA 1,0,0,0,0
DATA 1,0,0,0,0
'113
DATA 1,1,1,1,1
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 1,1,1,1,1
DATA 0,0,0,0,1
DATA 0,0,0,0,1
'114
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 1,1,1,1,0
DATA 1,0,0,0,0
DATA 1,0,0,0,0
DATA 1,0,0,0,0
DATA 1,0,0,0,0
'115
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 1,1,1,1,1
DATA 1,0,0,0,0
DATA 1,1,1,1,1
DATA 0,0,0,0,1
DATA 1,1,1,1,1
'116
DATA 0,0,1,0,0
DATA 0,0,1,0,0
DATA 1,1,1,1,1
DATA 0,0,1,0,0
DATA 0,0,1,0,0
DATA 0,0,1,0,0
DATA 0,0,1,0,0
'117
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 1,1,1,1,1
'118
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 0,1,0,1,0
DATA 0,1,0,1,0
DATA 0,0,1,0,0
'119
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 1,0,1,0,1
DATA 1,0,1,0,1
DATA 1,1,1,1,1
'120
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 1,0,0,0,1
DATA 0,1,0,1,0
DATA 0,0,1,0,0
DATA 0,1,0,1,0
DATA 1,0,0,0,1
'121
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 1,0,0,0,1
DATA 1,1,1,1,1
DATA 0,0,0,0,1
DATA 0,0,0,0,1
DATA 1,1,1,1,1
'122
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 1,1,1,1,1
DATA 0,0,0,1,0
DATA 0,0,1,0,0
DATA 0,1,0,0,0
DATA 1,1,1,1,1
'123
DATA 0,0,1,0,0
DATA 0,1,0,0,0
DATA 0,1,0,0,0
DATA 1,0,0,0,0
DATA 0,1,0,0,0
DATA 0,1,0,0,0
DATA 0,0,1,0,0
'124
DATA 0,0,1,0,0
DATA 0,0,1,0,0
DATA 0,0,1,0,0
DATA 0,0,0,0,0
DATA 0,0,1,0,0
DATA 0,0,1,0,0
DATA 0,0,1,0,0
'125
DATA 0,0,1,0,0
DATA 0,0,0,1,0
DATA 0,0,0,1,0
DATA 0,0,0,0,1
DATA 0,0,0,1,0
DATA 0,0,0,1,0
DATA 0,0,1,0,0
'126
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 0,0,1,0,1
DATA 0,1,0,1,0
DATA 0,0,0,0,0
DATA 0,0,0,0,0
'127
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 0,0,0,0,0
DATA 0,0,1,0,0
DATA 0,1,0,1,0
DATA 1,0,0,0,1
DATA 1,1,1,1,1
REM $STATIC
SUB AddBouncer (X AS INTEGER, Y AS INTEGER, v AS INTEGER, Dir AS STRING)
STATIC NewID AS LONG
IF NewID >= 10000 THEN NewID = 0
NewID = NewID + 1
IF NumBouncers <> 0 THEN
DIM CopyBouncer(1 TO NumBouncers) AS Bouncr
FOR i = 1 TO NumBouncers
CopyBouncer(i) = Bouncer(i)
NEXT i
ERASE Bouncer
REDIM Bouncer(1 TO NumBouncers + 1)
FOR i = 1 TO NumBouncers
Bouncer(i) = CopyBouncer(i)
NEXT i
Bouncer(NumBouncers + 1).X = X
Bouncer(NumBouncers + 1).Y = Y
Bouncer(NumBouncers + 1).v = v
Bouncer(NumBouncers + 1).Dir = Dir
Bouncer(NumBouncers + 1).ID = NewID
ELSE
ERASE Bouncer
REDIM Bouncer(1 TO 1)
Bouncer(NumBouncers + 1).X = X
Bouncer(NumBouncers + 1).Y = Y
Bouncer(NumBouncers + 1).v = v
Bouncer(NumBouncers + 1).Dir = Dir
Bouncer(NumBouncers + 1).ID = NewID
END IF
NumBouncers = NumBouncers + 1
END SUB
SUB AddCaterpillar (X AS STRING, Y AS STRING, Dir AS STRING)
STATIC NewID AS LONG
IF NewID >= 10000 THEN NewID = 0
NewID = NewID + 1
IF NumCaterpillars <> 0 THEN
DIM CopyCaterpillar(1 TO NumCaterpillars) AS Caterpil
FOR i = 1 TO NumCaterpillars
CopyCaterpillar(i) = Caterpillar(i)
NEXT i
ERASE Caterpillar
REDIM Caterpillar(1 TO NumCaterpillars + 1)
FOR i = 1 TO NumCaterpillars
Caterpillar(i) = CopyCaterpillar(i)
NEXT i
Caterpillar(NumCaterpillars + 1).X = X
Caterpillar(NumCaterpillars + 1).Y = Y
Caterpillar(NumCaterpillars + 1).Dir = Dir
Caterpillar(NumCaterpillars + 1).ID = NewID
ELSE
ERASE Caterpillar
REDIM Caterpillar(1 TO 1)
Caterpillar(NumCaterpillars + 1).X = X
Caterpillar(NumCaterpillars + 1).Y = Y
Caterpillar(NumCaterpillars + 1).Dir = Dir
Caterpillar(NumCaterpillars + 1).ID = NewID
END IF
NumCaterpillars = NumCaterpillars + 1
END SUB
SUB AddCoin (X AS INTEGER, Y AS INTEGER)
STATIC NewID AS LONG
IF NewID >= 10000 THEN NewID = 0
NewID = NewID + 1
IF NumCoins <> 0 THEN
DIM CopyCoin(1 TO NumCoins) AS Cn
FOR i = 1 TO NumCoins
CopyCoin(i) = Coin(i)
NEXT i
ERASE Coin
REDIM Coin(1 TO NumCoins + 1)
FOR i = 1 TO NumCoins
Coin(i) = CopyCoin(i)
NEXT i
Coin(NumCoins + 1).X = X
Coin(NumCoins + 1).Y = Y
Coin(NumCoins + 1).CnNum = FnRan(5)
Coin(NumCoins + 1).Flip = FnRan(2)
IF Coin(NumCoins + 1).Flip = 2 THEN Coin(NumCoins + 1).Flip = -1
Coin(NumCoins + 1).ID = NewID
ELSE
ERASE Coin
REDIM Coin(1 TO 1)
Coin(NumCoins + 1).X = X
Coin(NumCoins + 1).Y = Y
Coin(NumCoins + 1).CnNum = FnRan(5)
Coin(NumCoins + 1).Flip = FnRan(2)
IF Coin(NumCoins + 1).Flip = 2 THEN Coin(NumCoins + 1).Flip = -1
Coin(NumCoins + 1).ID = NewID
END IF
NumCoins = NumCoins + 1
END SUB
SUB AddRoundAbout (X AS INTEGER, Y AS INTEGER, Dir AS STRING)
STATIC NewID AS LONG
IF NewID >= 10000 THEN NewID = 0
NewID = NewID + 1
IF NumRoundAbouts <> 0 THEN
DIM CopyRoundAbout(1 TO NumRoundAbouts) AS RndAbt
FOR i = 1 TO NumRoundAbouts
CopyRoundAbout(i) = RoundAbout(i)
NEXT i
ERASE RoundAbout
REDIM RoundAbout(1 TO NumRoundAbouts + 1) AS RndAbt
FOR i = 1 TO NumRoundAbouts
RoundAbout(i) = CopyRoundAbout(i)
NEXT i
RoundAbout(NumRoundAbouts + 1).X = X
RoundAbout(NumRoundAbouts + 1).Y = Y
RoundAbout(NumRoundAbouts + 1).Dir = Dir
RoundAbout(NumRoundAbouts + 1).ID = NewID
ELSE
ERASE RoundAbout
REDIM RoundAbout(1 TO 1) AS RndAbt
RoundAbout(NumRoundAbouts + 1).X = X
RoundAbout(NumRoundAbouts + 1).Y = Y
RoundAbout(NumRoundAbouts + 1).Dir = Dir
RoundAbout(NumRoundAbouts + 1).ID = NewID
END IF
NumRoundAbouts = NumRoundAbouts + 1
END SUB
SUB AddToManPos (X AS INTEGER, Y AS INTEGER)
SELECT CASE GameBoard(Man.X + X, Man.Y + Y)
CASE cCobble, cApple, cCoin, cFreeMan, cLevWarp
SELECT CASE GameBoardLive(Man.X + X, Man.Y + Y)
CASE ""
DelFirstInStr GameBoardLive(Man.X, Man.Y), CHR$(cMan)
GameBoardLive(Man.X + X, Man.Y + Y) = GameBoardLive(Man.X + X, Man.Y + Y) + CHR$(cMan)
PUT ((Man.X * 10) - 10, (Man.Y * 10) - 10), CobbleImg(0), PSET
SELECT CASE GameBoard(Man.X + X, Man.Y + Y)
CASE cCobble
CASE cApple
AddToScore 50
PLAY "MBL64T100<<ab>>"
CASE cCoin
AddToScore 100
PLAY "MBL64T255<a>baa "
KillCoin Man.X + X, Man.Y + Y
CASE cLevWarp
PLAY "T64MBL64<<aabbcc>ab>"
NextLevel
EXIT SUB
CASE cFreeMan
AddToScore 100
PLAY "T64MBL64<<g>a>"
AddToNumMen 1
END SELECT
GameBoard(Man.X, Man.Y) = cCobble
Man.X = Man.X + X
Man.Y = Man.Y + Y
PUT ((Man.X * 10) - 10, (Man.Y * 10) - 10), ManImg(0), PSET
CASE ELSE
IF INSTR(GameBoardLive(Man.X + X, Man.Y + Y), CHR$(cCaterpillar)) OR INSTR(GameBoardLive(Man.X + X, Man.Y + Y), CHR$(cBouncer)) THEN
KillMan
END IF
END SELECT
CASE cBlueBlock
IF SmileyOhMode = 0 THEN
SmileyOhMode = 1
END IF
END SELECT
END SUB
SUB AddToNumMen (Num AS INTEGER)
STATIC CurrentNumberOfMen AS INTEGER, flag AS INTEGER
IF Num = -1000 THEN CurrentNumberOfMen = 0: EXIT SUB
IF Num > 99 THEN EXIT SUB
CurrentNumberOfMen = CurrentNumberOfMen + Num
IF CurrentNumberOfMen = 0 THEN GameOver
IF flag = 0 THEN
flag = 1
EXIT SUB
END IF
PUT (11 + 105, 5), ManImg(0), PSET
PUT (11 + 15, 4), SMiLEYimg(0), PSET
PSET (11 + 105, 5), 0
PSET (11 + 105, 14), 0
PSET (11 + 114, 5), 0
PSET (11 + 114, 14), 0
PSET (11 + 105, 6), 119
PSET (11 + 105, 13), 119
PSET (11 + 114, 6), 119
PSET (11 + 114, 13), 119
PSET (11 + 106, 5), 119
PSET (11 + 106, 14), 119
PSET (11 + 113, 5), 119
PSET (11 + 113, 14), 119
CNOM$ = LTRIM$(STR$(CurrentNumberOfMen))
CNOM$ = STRING$(2 - LEN(CNOM$), "0") + CNOM$
FOR i = 1 TO LEN(CNOM$)
SELECT CASE RIGHT$(LEFT$(CNOM$, i), 1)
CASE "1"
PUT ((i * 11) + 117, 5), LCD1Img(0), PSET
CASE "2"
PUT ((i * 11) + 117, 5), LCD2Img(0), PSET
CASE "3"
PUT ((i * 11) + 117, 5), LCD3Img(0), PSET
CASE "4"
PUT ((i * 11) + 117, 5), LCD4Img(0), PSET
CASE "5"
PUT ((i * 11) + 117, 5), LCD5Img(0), PSET
CASE "6"
PUT ((i * 11) + 117, 5), LCD6Img(0), PSET
CASE "7"
PUT ((i * 11) + 117, 5), LCD7Img(0), PSET
CASE "8"
PUT ((i * 11) + 117, 5), LCD8Img(0), PSET
CASE "9"
PUT ((i * 11) + 117, 5), LCD9Img(0), PSET
CASE "0"
PUT ((i * 11) + 117, 5), LCD0Img(0), PSET
END SELECT
NEXT i
END SUB
SUB AddToScore (scr AS INTEGER)
DIM ScrText$
Score = Score + scr
ScrText$ = LTRIM$(STR$(Score))
ScrText$ = STRING$(9 - LEN(ScrText$), "0") + ScrText$
FOR i = 1 TO LEN(ScrText$)
SELECT CASE RIGHT$(LEFT$(ScrText$, i), 1)
CASE "1"
PUT ((i * 11) + 184, 5), LCD1Img(0), PSET
CASE "2"
PUT ((i * 11) + 184, 5), LCD2Img(0), PSET
CASE "3"
PUT ((i * 11) + 184, 5), LCD3Img(0), PSET
CASE "4"
PUT ((i * 11) + 184, 5), LCD4Img(0), PSET
CASE "5"
PUT ((i * 11) + 184, 5), LCD5Img(0), PSET
CASE "6"
PUT ((i * 11) + 184, 5), LCD6Img(0), PSET
CASE "7"
PUT ((i * 11) + 184, 5), LCD7Img(0), PSET
CASE "8"
PUT ((i * 11) + 184, 5), LCD8Img(0), PSET
CASE "9"
PUT ((i * 11) + 184, 5), LCD9Img(0), PSET
CASE "0"
PUT ((i * 11) + 184, 5), LCD0Img(0), PSET
END SELECT
NEXT i
END SUB
SUB AnimateLevWarp
STATIC Count AS INTEGER
Count = Count + 1
SELECT CASE Count
CASE 2: PUT (LevWarp.X, LevWarp.Y), LevWarp1Img(0), PSET
CASE 4: PUT (LevWarp.X, LevWarp.Y), LevWarp2Img(0), PSET
CASE 6: PUT (LevWarp.X, LevWarp.Y), LevWarp3Img(0), PSET
CASE 8: PUT (LevWarp.X, LevWarp.Y), LevWarp4Img(0), PSET
CASE ELSE: IF Count > 8 THEN Count = 0
END SELECT
END SUB
SUB AnimateSmiley
STATIC OhModeFlag AS INTEGER
IF SmileyOhMode = 1 THEN
OhModeFlag = OhModeFlag + 1
SELECT CASE OhModeFlag
CASE 1
PUT ((Man.X * 10) - 10, (Man.Y * 10) - 10), SmileyOhImg(0), PSET
CASE 10
PUT ((Man.X * 10) - 10, (Man.Y * 10) - 10), ManImg(0), PSET
OhModeFlag = 0
SmileyOhMode = 0
END SELECT
END IF
END SUB
'---------------------------------------------------------
'NOTE: this is an altered form of the OFont Procedure by
' Jay Coen. It now prints just the text at the
' specified position. Allowing the programer to not
' be bound by the laws of the land as far as columns
' and rows go! It also does not turn the background
' black so the programer can put the text on any
' color in Screen 13! This procedure however only
' works with Screen 13.
'---------------------------------------------------------
'
SUB CFont (text AS STRING, X AS INTEGER, Y AS INTEGER, Fore AS INTEGER)
DEF SEG = &HFFA6 'Stores masks for letters
FOR Letter = 1 TO LEN(text$) 'Does each letter
Address = (8 * ASC(MID$(text$, Letter))) + 14 'Address for start of letter
FOR height = 0 TO 7 'Each letter is an 8x8 pixel matrix
Mask = PEEK(Address + height) * 128 'Address for mask of each line of letter
LINE (X + Curntx, Y + height)-(X + 8 + Curntx, Y + height), Fore%, , Mask
NEXT
Curntx = Curntx + 8 'Advances X axis by 8 for next letter
NEXT 'Continue to next letter
DEF SEG 'Put us back where
END SUB 'We started
SUB DelFirstInStr (StringToSearch AS STRING, DelStr AS STRING)
DIM StrPos AS INTEGER
DIM GBL AS STRING
GBL = StringToSearch
StrPos = INSTR(GBL, DelStr)
IF StrPos THEN StringToSearch = LEFT$(GBL, StrPos - 1) + RIGHT$(GBL, LEN(GBL) - StrPos)
END SUB
SUB DoBouncers
DIM KillManFlag AS INTEGER
STATIC Speed AS INTEGER
IF UBOUND(Bouncer) = 0 THEN EXIT SUB
Speed = Speed + 1
IF Speed > 1 THEN Speed = 0
KillManFlag = 0
IF Speed = 1 THEN
FOR i = 1 TO NumBouncers
DelFirstInStr GameBoardLive(Bouncer(i).X, Bouncer(i).Y), CHR$(cBouncer)
SELECT CASE GameBoard(Bouncer(i).X, Bouncer(i).Y)
CASE 0
PUT ((Bouncer(i).X * 10) - 10, (Bouncer(i).Y * 10) - 10), CobbleImg(0), PSET
CASE 2
PUT ((Bouncer(i).X * 10) - 10, (Bouncer(i).Y * 10) - 10), AppleImg(0), PSET
CASE 9
PUT ((Bouncer(i).X * 10) - 10, (Bouncer(i).Y * 10) - 10), FreemanImg(0), PSET
END SELECT
IF Bouncer(i).Dir = "H" AND GameBoard(Bouncer(i).X + Bouncer(i).v, Bouncer(i).Y) = 1 THEN Bouncer(i).v = -Bouncer(i).v
IF Bouncer(i).Dir = "V" AND GameBoard(Bouncer(i).X, Bouncer(i).Y + Bouncer(i).v) = 1 THEN Bouncer(i).v = -Bouncer(i).v
IF Bouncer(i).Dir = "H" THEN Bouncer(i).X = Bouncer(i).X + Bouncer(i).v
IF Bouncer(i).Dir = "V" THEN Bouncer(i).Y = Bouncer(i).Y + Bouncer(i).v
IF INSTR(GameBoardLive(Bouncer(i).X, Bouncer(i).Y), CHR$(cMan)) THEN
KillManFlag = 1
END IF
PUT ((Bouncer(i).X * 10) - 10, (Bouncer(i).Y * 10) - 10), BouncerImg(0), PSET
GameBoardLive(Bouncer(i).X, Bouncer(i).Y) = CHR$(cBouncer)
NEXT i
END IF
IF KillManFlag = 1 THEN
KillMan
END IF
END SUB
SUB DoCaterpillars
STATIC Count AS INTEGER
DIM Segment AS INTEGER
DIM SegDir AS STRING
DIM SegX AS INTEGER, SegY AS INTEGER
DIM X AS INTEGER, Y AS INTEGER
DIM NewDir$
DIM KillManFlag AS INTEGER
KillManFlag = 0
IF Count <= 2 THEN Count = Count + 1 ELSE Count = 0
IF Count = 2 THEN
FOR i = 1 TO NumCaterpillars
FOR Segment = 5 TO 1 STEP -1
SegX = ASC(MID$(Caterpillar(i).X, Segment, 1))
SegY = ASC(MID$(Caterpillar(i).Y, Segment, 1))
IF Segment = 5 THEN
SELECT CASE GameBoard(SegX, SegY)
CASE cCobble
PUT ((SegX * 10) - 10, (SegY * 10) - 10), CobbleImg(0), PSET
CASE cApple
PUT ((SegX * 10) - 10, (SegY * 10) - 10), AppleImg(0), PSET
CASE cFreeMan
PUT ((SegX * 10) - 10, (SegY * 10) - 10), FreemanImg(0), PSET
END SELECT
END IF
DelFirstInStr GameBoardLive(SegX, SegY), CHR$(cCaterpillar)
IF Segment = 1 THEN
SegDir = MID$(Caterpillar(i).Dir, Segment, 1)
100 SELECT CASE SegDir
CASE "U": X = 0: Y = -1
CASE "D": X = 0: Y = 1
CASE "L": X = -1: Y = 0
CASE "R": X = 1: Y = 0
END SELECT
IF GameBoard(SegX + X, SegY + Y) = 1 THEN
NewDir$ = ""
IF GameBoard(SegX, SegY - 1) <> 1 THEN NewDir$ = "U"
IF GameBoard(SegX, SegY + 1) <> 1 THEN NewDir$ = NewDir$ + "D"
IF GameBoard(SegX - 1, SegY) <> 1 THEN NewDir$ = NewDir$ + "L"
IF GameBoard(SegX + 1, SegY) <> 1 THEN NewDir$ = NewDir$ + "R"
'STOP
SegDir = MID$(NewDir$, FnRan(LEN(NewDir$)), 1)
MID$(Caterpillar(i).Dir, Segment, 1) = SegDir
SELECT CASE SegDir
CASE "U": X = 0: Y = -1
CASE "D": X = 0: Y = 1
CASE "L": X = -1: Y = 0
CASE "R": X = 1: Y = 0
END SELECT
END IF
SegX = SegX + X
SegY = SegY + Y
ELSE
SegDir = MID$(Caterpillar(i).Dir, Segment - 1, 1)
MID$(Caterpillar(i).Dir, Segment, 1) = SegDir
SegX = ASC(MID$(Caterpillar(i).X, Segment - 1, 1))
SegY = ASC(MID$(Caterpillar(i).Y, Segment - 1, 1))
END IF
MID$(Caterpillar(i).X, Segment, 1) = CHR$(SegX)
MID$(Caterpillar(i).Y, Segment, 1) = CHR$(SegY)
NEXT Segment
FOR Segment = 5 TO 1 STEP -1
SegX = ASC(MID$(Caterpillar(i).X, Segment, 1))
SegY = ASC(MID$(Caterpillar(i).Y, Segment, 1))
IF Segment = 1 THEN
PUT ((SegX * 10) - 10, (SegY * 10) - 10), CatHeadImg(0), PSET
ELSE
PUT ((SegX * 10) - 10, (SegY * 10) - 10), CatSegImg(0), PSET
END IF
IF INSTR(GameBoardLive(SegX, SegY), CHR$(cMan)) THEN
KillManFlag = 1
END IF
GameBoardLive(SegX, SegY) = GameBoardLive(SegX, SegY) + CHR$(cCaterpillar)
NEXT Segment
NEXT i
END IF
IF KillManFlag = 1 THEN
GameBoard(Man.X, Man.Y) = cCobble
KillMan
END IF
END SUB
SUB DoCoins
FOR i = 1 TO NumCoins
IF GameBoardLive(Coin(i).X, Coin(i).Y) = "" THEN
IF Coin(i).CnNum > 5 OR Coin(i).CnNum < 1 THEN Coin(i).Flip = -Coin(i).Flip
Coin(i).CnNum = Coin(i).CnNum + Coin(i).Flip
SELECT CASE Coin(i).CnNum
CASE 1
PUT ((Coin(i).X * 10) - 10, (Coin(i).Y * 10) - 10), Coin1Img(0), PSET
CASE 2
PUT ((Coin(i).X * 10) - 10, (Coin(i).Y * 10) - 10), Coin2Img(0), PSET
CASE 3
PUT ((Coin(i).X * 10) - 10, (Coin(i).Y * 10) - 10), Coin3Img(0), PSET
CASE 4
PUT ((Coin(i).X * 10) - 10, (Coin(i).Y * 10) - 10), Coin4Img(0), PSET
CASE 5
PUT ((Coin(i).X * 10) - 10, (Coin(i).Y * 10) - 10), Coin5Img(0), PSET
END SELECT
END IF
NEXT i
END SUB
SUB DoRoundAbouts
STATIC Count AS INTEGER
IF NumRoundAbouts = 0 THEN EXIT SUB
IF Count <= 2 THEN Count = Count + 1 ELSE Count = 0
IF Count = 2 THEN
FOR i = 1 TO NumRoundAbouts
DelFirstInStr GameBoardLive(RoundAbout(i).X, RoundAbout(i).Y), CHR$(cRoundAbout)
EraseBackToGB RoundAbout(i).X, RoundAbout(i).Y
IF RoundAbout(i).AttachedSqrPos = 0 THEN
IF GameBoard(RoundAbout(i).X - 1, RoundAbout(i).Y - 1) = cBlueBlock THEN PosSqrPos$ = "1"
IF GameBoard(RoundAbout(i).X, RoundAbout(i).Y - 1) = cBlueBlock THEN PosSqrPos$ = PosSqrPos$ + "2"
IF GameBoard(RoundAbout(i).X + 1, RoundAbout(i).Y - 1) = cBlueBlock THEN PosSqrPos$ = PosSqrPos$ + "3"
IF GameBoard(RoundAbout(i).X - 1, RoundAbout(i).Y) = cBlueBlock THEN PosSqrPos$ = PosSqrPos$ + "4"
IF GameBoard(RoundAbout(i).X + 1, RoundAbout(i).Y) = cBlueBlock THEN PosSqrPos$ = PosSqrPos$ + "5"
IF GameBoard(RoundAbout(i).X - 1, RoundAbout(i).Y + 1) = cBlueBlock THEN PosSqrPos$ = PosSqrPos$ + "6"
IF GameBoard(RoundAbout(i).X, RoundAbout(i).Y + 1 - 1) = cBlueBlock THEN PosSqrPos$ = PosSqrPos$ + "7"
IF GameBoard(RoundAbout(i).X + 1, RoundAbout(i).Y + 1) = cBlueBlock THEN PosSqrPos$ = PosSqrPos$ + "8"
RoundAbout(i).AttachedSqrPos = VAL(MID$(PosSqrPos$, FnRan(LEN(PosSqrPos$)), 1))
END IF
SELECT CASE RoundAbout(i).AttachedSqrPos
CASE 1
SELECT CASE RoundAbout(i).Dir
CASE "U"
X = RoundAbout(i).X
Y = RoundAbout(i).Y - 1
IF GameBoard(X, Y) = 0 THEN
Y = Y + 1
RoundAbout(i).AttachedSqrPos = 2
ELSE
RoundAbout(i).AttachedSqrPos = 4
END IF
CASE "D"
X = RoundAbout(i).X - 1
Y = RoundAbout(i).Y
RoundAbout(i).AttachedSqrPos = 2
RoundAbout(i).Dir = "L"
CASE "R"
X = RoundAbout(i).X
Y = RoundAbout(i).Y - 1
RoundAbout(i).AttachedSqrPos = 4
RoundAbout(i).Dir = "U"
CASE "L"
X = RoundAbout(i).X - 1
Y = RoundAbout(i).Y
RoundAbout(i).AttachedSqrPos = 2
END SELECT
CASE 2
SELECT CASE RoundAbout(i).Dir
CASE "U"
X = RoundAbout(i).X + 1
Y = RoundAbout(i).Y
IF GameBoard(X, Y - 1) = cBlueBlock THEN
RoundAbout(i).AttachedSqrPos = 2
RoundAbout(i).Dir = "R"
ELSE
RoundAbout(i).AttachedSqrPos = 1
END IF
CASE "D"
X = RoundAbout(i).X - 1
Y = RoundAbout(i).Y
IF GameBoard(X, Y - 1) = cBlueBlock THEN
RoundAbout(i).AttachedSqrPos = 2
RoundAbout(i).Dir = "L"
ELSE
RoundAbout(i).AttachedSqrPos = 3
RoundAbout(i).Dir = "U"
END IF
CASE "R"
X = RoundAbout(i).X + 1
Y = RoundAbout(i).Y
IF GameBoard(X, Y - 1) = cBlueBlock THEN
RoundAbout(i).AttachedSqrPos = 2
ELSE
RoundAbout(i).AttachedSqrPos = 1
RoundAbout(i).Dir = "U"
END IF
CASE "L"
X = RoundAbout(i).X - 1
Y = RoundAbout(i).Y
IF GameBoard(X, Y - 1) = cBlueBlock THEN
RoundAbout(i).AttachedSqrPos = 2
ELSE
RoundAbout(i).AttachedSqrPos = 3
RoundAbout(i).Dir = "U"
END IF
END SELECT
CASE 3
SELECT CASE RoundAbout(i).Dir
CASE "U"
X = RoundAbout(i).X
Y = RoundAbout(i).Y - 1
IF GameBoard(X, Y) = 0 THEN
Y = Y + 1
RoundAbout(i).AttachedSqrPos = 2
ELSE
RoundAbout(i).AttachedSqrPos = 5
END IF
CASE "D"
X = RoundAbout(i).X + 1
Y = RoundAbout(i).Y
RoundAbout(i).AttachedSqrPos = 2
RoundAbout(i).Dir = "R"
CASE "R"
X = RoundAbout(i).X + 1
Y = RoundAbout(i).Y
RoundAbout(i).AttachedSqrPos = 2
CASE "L"
X = RoundAbout(i).X
Y = RoundAbout(i).Y - 1
RoundAbout(i).AttachedSqrPos = 5
RoundAbout(i).Dir = "U"
END SELECT
CASE 4
SELECT CASE RoundAbout(i).Dir
CASE "U"
X = RoundAbout(i).X
Y = RoundAbout(i).Y - 1
IF GameBoard(X - 1, Y) = cBlueBlock THEN
RoundAbout(i).AttachedSqrPos = 4
ELSE
RoundAbout(i).AttachedSqrPos = 6
RoundAbout(i).Dir = "L"
END IF
CASE "D"
X = RoundAbout(i).X
Y = RoundAbout(i).Y + 1
IF GameBoard(X - 1, Y) = cBlueBlock THEN
RoundAbout(i).AttachedSqrPos = 4
ELSE
RoundAbout(i).AttachedSqrPos = 1
RoundAbout(i).Dir = "R"
END IF
CASE "R"
X = RoundAbout(i).X
Y = RoundAbout(i).Y - 1
IF GameBoard(X - 1, Y) = cBlueBlock THEN
RoundAbout(i).AttachedSqrPos = 4
RoundAbout(i).Dir = "U"
ELSE
RoundAbout(i).AttachedSqrPos = 6
RoundAbout(i).Dir = "L"
END IF
CASE "L"
X = RoundAbout(i).X
Y = RoundAbout(i).Y + 1
IF GameBoard(X - 1, Y) = cBlueBlock THEN
RoundAbout(i).AttachedSqrPos = 4
RoundAbout(i).Dir = "D"
ELSE
RoundAbout(i).AttachedSqrPos = 1
END IF
END SELECT
CASE 5
SELECT CASE RoundAbout(i).Dir
CASE "U"
X = RoundAbout(i).X
Y = RoundAbout(i).Y - 1
IF GameBoard(X + 1, Y) = cBlueBlock THEN
RoundAbout(i).AttachedSqrPos = 5
ELSE
RoundAbout(i).AttachedSqrPos = 8
RoundAbout(i).Dir = "L"
END IF
CASE "D"
X = RoundAbout(i).X
Y = RoundAbout(i).Y + 1
IF GameBoard(X + 1, Y) = cBlueBlock THEN
RoundAbout(i).AttachedSqrPos = 5
ELSE
RoundAbout(i).AttachedSqrPos = 3
RoundAbout(i).Dir = "R"
END IF
CASE "R"
X = RoundAbout(i).X
Y = RoundAbout(i).Y + 1
IF GameBoard(X + 1, Y) = cBlueBlock THEN
RoundAbout(i).AttachedSqrPos = 5
RoundAbout(i).Dir = "D"
ELSE
RoundAbout(i).AttachedSqrPos = 3
END IF
CASE "L"
X = RoundAbout(i).X
Y = RoundAbout(i).Y - 1
IF GameBoard(X + 1, Y) = cBlueBlock THEN
RoundAbout(i).AttachedSqrPos = 5
RoundAbout(i).Dir = "U"
ELSE
RoundAbout(i).AttachedSqrPos = 8
RoundAbout(i).Dir = "R"
END IF
END SELECT
CASE 6
SELECT CASE RoundAbout(i).Dir
CASE "U"
X = RoundAbout(i).X - 1
Y = RoundAbout(i).Y
RoundAbout(i).AttachedSqrPos = 7
RoundAbout(i).Dir = "L"
CASE "D"
X = RoundAbout(i).X
Y = RoundAbout(i).Y + 1
IF GameBoard(X, Y) = 0 THEN
Y = Y - 1
RoundAbout(i).AttachedSqrPos = 7
ELSE
RoundAbout(i).AttachedSqrPos = 4
END IF
CASE "R"
X = RoundAbout(i).X
Y = RoundAbout(i).Y - 1
RoundAbout(i).AttachedSqrPos = 4
CASE "L"
X = RoundAbout(i).X - 1
Y = RoundAbout(i).Y
RoundAbout(i).AttachedSqrPos = 7
END SELECT
CASE 7
SELECT CASE RoundAbout(i).Dir
CASE "U"
X = RoundAbout(i).X - 1
Y = RoundAbout(i).Y
IF GameBoard(X, Y + 1) = cBlueBlock THEN
RoundAbout(i).AttachedSqrPos = 7
RoundAbout(i).Dir = "L"
ELSE
RoundAbout(i).AttachedSqrPos = 8
END IF
CASE "D"
X = RoundAbout(i).X + 1
Y = RoundAbout(i).Y
IF GameBoard(X, Y + 1) = cBlueBlock THEN
RoundAbout(i).AttachedSqrPos = 7
RoundAbout(i).Dir = "R"
ELSE
RoundAbout(i).AttachedSqrPos = 6
RoundAbout(i).Dir = "D"
END IF
CASE "R"
X = RoundAbout(i).X + 1
Y = RoundAbout(i).Y
IF GameBoard(X, Y + 1) = cBlueBlock THEN
RoundAbout(i).AttachedSqrPos = 7
ELSE
RoundAbout(i).AttachedSqrPos = 6
RoundAbout(i).Dir = "D"
END IF
CASE "L"
X = RoundAbout(i).X - 1
Y = RoundAbout(i).Y
IF GameBoard(X, Y + 1) = cBlueBlock THEN
RoundAbout(i).AttachedSqrPos = 7
ELSE
RoundAbout(i).AttachedSqrPos = 8
RoundAbout(i).Dir = "D"
END IF
END SELECT
CASE 8
SELECT CASE RoundAbout(i).Dir
CASE "U"
X = RoundAbout(i).X + 1
Y = RoundAbout(i).Y
RoundAbout(i).AttachedSqrPos = 7
RoundAbout(i).Dir = "R"
CASE "D"
X = RoundAbout(i).X
Y = RoundAbout(i).Y + 1
IF GameBoard(X, Y) = 0 THEN
Y = Y - 1
RoundAbout(i).AttachedSqrPos = 7
ELSE
RoundAbout(i).AttachedSqrPos = 5
END IF
CASE "R"
X = RoundAbout(i).X + 1
Y = RoundAbout(i).Y
RoundAbout(i).AttachedSqrPos = 7
CASE "L"
X = RoundAbout(i).X
Y = RoundAbout(i).Y + 1
RoundAbout(i).AttachedSqrPos = 5
RoundAbout(i).Dir = "D"
END SELECT
END SELECT
IF X > 32 THEN X = 32
IF X < 1 THEN X = 1
IF Y > 20 THEN Y = 32
IF Y < 1 THEN Y = 1
SELECT CASE GameBoard(X, Y)
CASE cBlueBlock: GOSUB PickRADir
CASE ELSE
RoundAbout(i).X = X
RoundAbout(i).Y = Y
END SELECT
PUT ((RoundAbout(i).X * 10) - 10, (RoundAbout(i).Y * 10) - 10), RoundAboutImg(0), PSET
GameBoardLive(RoundAbout(i).X, RoundAbout(i).Y) = GameBoardLive(RoundAbout(i).X, RoundAbout(i).Y) + CHR$(cRoundAbout)
NEXT i
END IF
EXIT SUB
PickRADir:
RETURN
END SUB
SUB DrawBoard
DIM ScreenPos(1 TO 20) AS STRING
DIM Y AS INTEGER, X AS INTEGER, i AS INTEGER, J AS INTEGER
DIM yPos AS STRING, zPos AS INTEGER
FOR Y = 1 TO 20
yPos = yPos + CHR$(Y)
NEXT Y
FOR Y = 1 TO 20
FOR X = 1 TO 32
ScreenPos(Y) = ScreenPos(Y) + CHR$(X)
NEXT X
NEXT Y
DO
RepickBlack:
IF LEN(yPos) = 0 THEN EXIT DO
Y = INT(RND * LEN(yPos)) + 1
Y = ASC(MID$(yPos, Y, 1))
IF LEN(ScreenPos(Y)) = 0 THEN
zPos = INSTR(yPos, CHR$(Y))
yPos = LEFT$(yPos, zPos - 1) + RIGHT$(yPos, LEN(yPos) - zPos)
GOTO RepickBlack
END IF
X = INT(RND * LEN(ScreenPos(Y))) + 1
X = ASC(MID$(ScreenPos(Y), X, 1))
zPos = INSTR(ScreenPos(Y), CHR$(X))
ScreenPos(Y) = LEFT$(ScreenPos(Y), zPos - 1) + RIGHT$(ScreenPos(Y), LEN(ScreenPos(Y)) - zPos)
LINE ((X * 10) - 10, (Y * 10) - 10)-(X * 10, Y * 10), 0, BF
LOOP
FOR Y = 1 TO 20
yPos = yPos + CHR$(Y)
NEXT Y
FOR Y = 1 TO 20
FOR X = 1 TO 32
ScreenPos(Y) = ScreenPos(Y) + CHR$(X)
NEXT X
NEXT Y
DO
Repick:
IF LEN(yPos) = 0 THEN EXIT DO
Y = INT(RND * LEN(yPos)) + 1
Y = ASC(MID$(yPos, Y, 1))
IF LEN(ScreenPos(Y)) = 0 THEN
zPos = INSTR(yPos, CHR$(Y))
yPos = LEFT$(yPos, zPos - 1) + RIGHT$(yPos, LEN(yPos) - zPos)
GOTO Repick
END IF
X = INT(RND * LEN(ScreenPos(Y))) + 1
X = ASC(MID$(ScreenPos(Y), X, 1))
zPos = INSTR(ScreenPos(Y), CHR$(X))
ScreenPos(Y) = LEFT$(ScreenPos(Y), zPos - 1) + RIGHT$(ScreenPos(Y), LEN(ScreenPos(Y)) - zPos)
SELECT CASE GameBoard(X, Y)
CASE cCobble 'Cobble Stone
PUT ((X * 10) - 10, (Y * 10) - 10), CobbleImg(0), PSET
CASE cBlueBlock 'Wall
PUT ((X * 10) - 10, (Y * 10) - 10), BlueBlockImg(0), PSET
CASE cApple 'Apple
PUT ((X * 10) - 10, (Y * 10) - 10), AppleImg(0), PSET
CASE cCoin 'Coin
PUT ((X * 10) - 10, (Y * 10) - 10), Coin1Img(0), PSET
CASE cLevWarp 'LevWarp
PUT ((X * 10) - 10, (Y * 10) - 10), LevWarp1Img(0), PSET
LevWarp.X = (X * 10) - 10
LevWarp.Y = (Y * 10) - 10
CASE cBouncer 'Bouncer
PUT ((X * 10) - 10, (Y * 10) - 10), BouncerImg(0), PSET
CASE cCaterpillar 'Caterpillar
PUT ((X * 10) - 10, (Y * 10) - 10), CatSegImg(0), PSET
CASE cFreeMan
PUT ((X * 10) - 10, (Y * 10) - 10), FreemanImg(0), PSET
END SELECT
LOOP
PUT ((Man.X * 10) - 10, (Man.Y * 10) - 10), ManImg(0), PSET
LINE (23, 3)-(295, 16), 0, BF
LINE (23, 3)-(295, 16), 32, B
LINE (23, 3)-(295, 3), 84
LINE (23, 3)-(23, 16), 84
AddToScore 0
AddToNumMen 0
END SUB
SUB EndGame
IF MsgboxYesNo("Are you sure you want to exit? (y/n)") = "Y" THEN
IF IsMenuDriven THEN
CHAIN "menu.bas"
END IF
END
ELSE
IF NumMen = 0 OR CurrentLevel > NumLevels THEN
AddToNumMen -1000
AddToNumMen 5
Score = 0
LoadLevel "Level1.lvl"
CurrentLevel = 1
DrawBoard
END IF
END IF
END SUB
SUB EraseBackToGB (X AS INTEGER, Y AS INTEGER)
SELECT CASE GameBoard(X, Y)
CASE cCobble
PUT ((X * 10) - 10, (Y * 10) - 10), CobbleImg(0), PSET
CASE cBlueBlock
PUT ((X * 10) - 10, (Y * 10) - 10), BlueBlockImg(0), PSET
CASE cApple
PUT ((X * 10) - 10, (Y * 10) - 10), AppleImg(0), PSET
CASE cCoin
PUT ((X * 10) - 10, (Y * 10) - 10), Coin1Img(0), PSET
CASE cFreeMan
PUT ((X * 10) - 10, (Y * 10) - 10), FreemanImg(0), PSET
CASE cLevWarp
PUT ((X * 10) - 10, (Y * 10) - 10), LevWarp1Img(0), PSET
END SELECT
END SUB
SUB GameOver
PLAY "MBL16T64<<<ggffa>>>"
MsgBoxMsg "GAME OVER!"
IF MsgboxYesNo$("Play Again? (y/n)") = "Y" THEN
AddToNumMen -1000
AddToNumMen NumMen
Score = 0
AddToScore 0
CurrentLevel = 0
NextLevel
DrawBoard
ELSE
EndGame
END IF
END SUB
FUNCTION Get3x5FontLen% (text AS STRING)
DIM kernx AS INTEGER
FOR i = 1 TO LEN(text)
piece$ = MID$(text$, i, 1)
SELECT CASE (piece$) 'kern adjusment
CASE "i": kernx = kernx + 2 'ditto
CASE "j": kernx = kernx + 5 'ditto
CASE "l": kernx = kernx + 2 'ditto
CASE "r": kernx = kernx + 5 'ditto
CASE ".": kernx = kernx + 3 'ditto
CASE "(": kernx = kernx + 3 'ditto
CASE ")": kernx = kernx + 3 'ditto
CASE "'": kernx = kernx + 2 'ditto
CASE "!": kernx = kernx + 2 'ditto
CASE ELSE: kernx = kernx + 6 'ditto
END SELECT
NEXT i
Get3x5FontLen = kernx
END FUNCTION
FUNCTION GetCPUSpeed&
TimeStart& = TIMER
DO
LOOP UNTIL TIMER - TimeStart& > 1
TimeStart& = TIMER
DO
Speed& = Speed& + 1
LOOP UNTIL TIMER - TimeStart& > 5
GetCPUSpeed& = Speed&
END FUNCTION
DEFINT A-Z
SUB GLoad (FileName AS STRING, GLoadArray() AS INTEGER)
DIM FileNum AS INTEGER
FileNum = FREEFILE
OPEN FileName FOR BINARY AS #FileNum
GET #1, , size%
REDIM GLoadArray(size%) AS INTEGER
FOR i = 0 TO size%
GET #1, , GLoadArray(i)
NEXT i
CLOSE #FileNum
END SUB
DEFSNG A-Z
'-----------------------------------------------------
'Inputbox$
' Inputbox$ is used to get input from the user kind
' of like the INPUT function but only a lot better!
' This function is great for graphical programs
' which would like to get input from the user
' without changing the graphics on the screen.
'
' It has two parameters:
' text = The Text that you want the user to
' see on the screen. (ex. "Enter your
' text here")
' Length = the max length of the string
' returned to you.
'
' More cool stuff:
' If you preface the begining of your text with
' chr$(0) then it will turn your Inputbox into
' a FileName box, which only recieves the
' characters which are legal file names. Pretty
' cool, huh?
'
'-----------------------------------------------------
FUNCTION Inputbox$ (text AS STRING, length AS INTEGER)
CONST ButtonColor = 29
CONST ButtonLight = 29
CONST ButtonHighlight = 31
CONST ButtonText = 0
CONST ButtonShadow = 25
CONST ButtonShadowDk = 16
DIM wdth AS INTEGER, hght AS INTEGER, tp AS INTEGER, lft AS INTEGER
DIM Key$
DIM size%
DIM RetText$
DIM EndofBox AS INTEGER
DIM FileFlag AS INTEGER
IF LEFT$(text, 1) = CHR$(0) THEN
FileFlag = 1
text = RIGHT$(text, LEN(text) - 1)
END IF
IF LEN(text) > 38 THEN
text = LEFT$(text, 35) + "..."
END IF
EndofBox = LEN(text) - 1
wdth = ((LEN(text) + 2) * 8) - 1
hght = 40
lft = ((320 - wdth) / 2)
tp = ((200 - 40) / 2)
size% = 4 + INT(((PMAP(lft + wdth, 0) - PMAP(lft, 0) + 1) * 8 + 7) / 8) * 1 * (PMAP(tp + hght, 1) - PMAP(tp, 1) + 1)
DIM TheAreaBehind(size%) AS INTEGER
GET (lft, tp)-(lft + wdth, tp + hght), TheAreaBehind(0)
LINE (lft, tp)-(lft + wdth, tp + hght), ButtonColor, BF
LINE (lft, tp)-(lft + wdth, tp + hght), ButtonShadowDk, B
LINE (lft + 1, tp + 1)-(lft + wdth - 1, tp + hght - 1), ButtonShadow, B
LINE (lft, tp)-(lft + wdth - 1, tp), ButtonLight
LINE (lft, tp)-(lft, tp + hght - 1), ButtonLight
LINE (lft + wdth - 2, tp + 1)-(lft + 1, tp + 1), ButtonHighlight
LINE (lft + 1, tp + 1)-(lft + 1, tp + hght - 2), ButtonHighlight
CFont text, ((320 - (LEN(text) * 8)) \ 2), tp + 8, ButtonText
LINE (lft + 6, tp + hght - 19)-(lft + wdth - 6, tp + hght - 6), ButtonHighlight, BF
LINE (lft + 7, tp + hght - 18)-(lft + wdth - 7, tp + hght - 7), ButtonLight, B
LINE (lft + 6, tp + hght - 19)-(lft + wdth - 6, tp + hght - 19), ButtonShadow
LINE (lft + 6, tp + hght - 19)-(lft + 6, tp + hght - 6), ButtonShadow
LINE (lft + 7, tp + hght - 18)-(lft + wdth - 7, tp + hght - 18), ButtonShadowDk
LINE (lft + 7, tp + hght - 18)-(lft + 7, tp + hght - 7), ButtonShadowDk
COLOR 30: LOCATE 14, (21 - (LEN(text) \ 2))
Key$ = CHR$(8)
DO
SELECT CASE ASC(Key$)
CASE 13 'CReturn
EXIT DO
CASE 8 'Backspace
IF LEN(RetText$) > 1 THEN
RetText$ = LEFT$(RetText$, LEN(RetText$) - 1)
ELSE
RetText$ = ""
END IF
DisText$ = RIGHT$(RetText$ + "_", EndofBox)
IF LEN(RetText$) <= EndofBox - 2 AND LEN(RetText$) > 0 THEN
LINE (lft + 9 + ((LEN(DisText$) - 1) * 8), tp + hght - 16)-(lft + wdth - 8, tp + hght - 9), ButtonHighlight, BF
ELSE
LINE (lft + 9, tp + hght - 16)-(lft + wdth - 8, tp + hght - 9), ButtonHighlight, BF
END IF
CFont DisText$, lft + 9, tp + hght - 16, ButtonText
CASE 27
Inputbox = ""
EXIT FUNCTION
CASE 46, 48 TO 57, 65 TO 90, 97 TO 122
IF LEN(RetText$) < length THEN
LINE (lft + 9 + ((LEN(DisText$) - 1) * 8), tp + hght - 16)-(lft + wdth - 8, tp + hght - 9), ButtonHighlight, BF
RetText$ = RetText$ + Key$
IF LEN(RetText$) >= EndofBox THEN
LINE (lft + 9, tp + hght - 16)-(lft + wdth - 8, tp + hght - 9), ButtonHighlight, BF
END IF
DisText$ = RIGHT$(RetText$ + "_", EndofBox)
CFont DisText$, lft + 9, tp + hght - 16, ButtonText
END IF
CASE ELSE
IF LEN(RetText$) < length AND FileFlag = 0 THEN
LINE (lft + 9 + ((LEN(DisText$) - 1) * 8), tp + hght - 16)-(lft + wdth - 8, tp + hght - 9), ButtonHighlight, BF
RetText$ = RetText$ + Key$
IF LEN(RetText$) >= EndofBox THEN
LINE (lft + 9, tp + hght - 16)-(lft + wdth - 8, tp + hght - 9), ButtonHighlight, BF
END IF
DisText$ = RIGHT$(RetText$ + "_", EndofBox)
CFont DisText$, lft + 9, tp + hght - 16, ButtonText
END IF
END SELECT
DO
Key$ = INKEY$
LOOP WHILE Key$ = ""
LOOP
PUT (lft, tp), TheAreaBehind(0), PSET
Inputbox = RetText$
END FUNCTION
DEFINT A-Z
SUB KillCoin (X AS INTEGER, Y AS INTEGER)
NumCoins = NumCoins - 1
IF NumCoins = 0 THEN
REDIM Coins(0)
EXIT SUB
END IF
DIM CopyCoin(1 TO NumCoins) AS Cn
FOR i = 1 TO NumCoins + 1
CoinToDelete = i
IF Coin(i).X = X AND Coin(i).Y = Y THEN EXIT FOR
NEXT i
IF Coin(i).X <> X AND Coin(i).Y <> Y THEN EXIT SUB
IF CoinToDelete <> 1 THEN
FOR i = 1 TO CoinToDelete - 1
CopyCoin(i) = Coin(i)
NEXT i
END IF
IF CoinToDelete <> NumCoins + 1 THEN
FOR i = (CoinToDelete + 1) TO NumCoins + 1
CopyCoin(i - 1) = Coin(i)
NEXT i
END IF
REDIM Coin(1 TO NumCoins)
FOR i = 1 TO NumCoins
Coin(i) = CopyCoin(i)
NEXT i
END SUB
DEFSNG A-Z
SUB KillMan
GameBoard(Man.X, Man.Y) = cCobble
DelFirstInStr GameBoardLive(Man.X, Man.Y), CHR$(cMan)
PUT ((Man.X * 10) - 10, (Man.Y * 10) - 10), CobbleImg(0), PSET
AddToNumMen -1
PLAY "MBL64T64<<gfgfefededcdcbcbaba>>"
GameBoardLive(Man.StartX, Man.StartY) = GameBoardLive(Man.StartX, Man.StartY) + CHR$(cMan)
Man.X = Man.StartX
Man.Y = Man.StartY
PUT ((Man.X * 10) - 10, (Man.Y * 10) - 10), ManImg(0), PSET
MsgBoxMsg "Ready!"
END SUB
DEFINT A-Z
SUB LoadLevel (FileName AS STRING)
DIM r AS INTEGER, rText AS STRING * 1, FileStamp AS STRING
DIM FileNum AS INTEGER
FileNum = FREEFILE
ERASE Caterpillar
REDIM Caterpillar(0) AS Caterpil
ERASE Bouncer
REDIM Bouncer(0) AS Bouncr
ERASE Coin
REDIM Coin(0) AS Cn
ERASE GameBoard
REDIM GameBoard(1 TO 32, 1 TO 20) AS INTEGER
ERASE GameBoardLive
REDIM GameBoardLive(1 TO 32, 1 TO 20) AS STRING
Man.StartX = 0
Man.X = 0
Man.StartY = 0
Man.Y = 0
NumCaterpillars = 0
NumCaterpillarsOnLevel = 0
NumBouncers = 0
NumBouncersOnLevel = 0
NumCoins = 0
NumCoinsOnLevel = 0
OPEN FileName FOR BINARY AS #FileNum
GET FileNum, , r: Man.StartX = r
Man.X = Man.StartX
GET FileNum, , r: Man.StartY = r
Man.Y = Man.StartY
GET FileNum, , r: NumCaterpillarsOnLevel = r
IF NumCaterpillarsOnLevel > 0 THEN
FOR i = 1 TO NumCaterpillarsOnLevel
AddCaterpillar "", "", ""
FOR J = 1 TO 5
GET FileNum, , r
Caterpillar(i).X = RTRIM$(Caterpillar(i).X) + CHR$(r)
GET FileNum, , r
Caterpillar(i).Y = RTRIM$(Caterpillar(i).Y) + CHR$(r)
GET FileNum, , rText
Caterpillar(i).Dir = RTRIM$(Caterpillar(i).Dir) + rText
NEXT J
NEXT i
END IF
GET FileNum, , r: NumBouncersOnLevel = r
IF NumBouncersOnLevel > 0 THEN
FOR i = 1 TO NumBouncersOnLevel
AddBouncer 0, 0, 0, ""
GET FileNum, , r: Bouncer(i).X = r
GET FileNum, , r: Bouncer(i).Y = r
GET FileNum, , r: Bouncer(i).v = r
GET FileNum, , rText: Bouncer(i).Dir = rText
NEXT i
END IF
FOR X = 0 TO 310 STEP 10
FOR Y = 0 TO 190 STEP 10
GET FileNum, , r: GameBoard((X + 10) / 10, (Y + 10) / 10) = r
IF GameBoard((X + 10) / 10, (Y + 10) / 10) = 3 THEN
AddCoin ((X + 10) / 10), ((Y + 10) / 10)
END IF
NEXT Y
NEXT X
'
' This next section of code checks the version of the file to
' see what kind of monsters are enabled, if it finds nothing
' it sets the shared variable LevVersion to 1
'
IF NOT EOF(FileNum) THEN 'Check to see what version
GET FileNum, , rText
IF rText = "<" THEN
FileStamp = "<"
DO
GET FileNum, , rText
FileStamp = FileStamp + rText
IF LEN(FileStamp) > 100 THEN EXIT DO
LOOP UNTIL rText = ">"
IF LEN(FileStamp) > 1 AND LTRIM$(RTRIM$(FileStamp)) <> "" THEN
SELECT CASE FileStamp
CASE "<Smiley Level Version 1.1>"
GET FileNum, , r: NumRoundAboutsOnLevel = r
IF NumRoundAboutsOnLevel > 0 THEN
FOR i = 1 TO NumRoundAboutsOnLevel
AddRoundAbout 0, 0, ""
GET FileNum, , r: RoundAbout(i).X = r
GET FileNum, , r: RoundAbout(i).Y = r
GET FileNum, , rText: RoundAbout(i).Dir = rText
LeveVersion = 1.1
NEXT i
END IF
END SELECT
END IF
'
ELSE ' Version 1 our first Smiley Files
' which have no version stamp
'
LevVersion = 1
END IF
END IF
CLOSE FileNum
END SUB
DEFSNG A-Z
SUB LoadSmileyDat
DIM FileNum AS INTEGER
DIM Dir AS STRING * 255
Dir = AppPath
REM CHDIR AppPath
FileNum = FREEFILE
OPEN "Smiley.Dat" FOR BINARY AS FileNum
PUT FileNum, , Dir
CLOSE FileNum
OPEN "Smiley.Dat" FOR BINARY AS FileNum
GET FileNum, , Dir
GET FileNum, , CPUSpeed&
GET FileNum, , IsMenuDriven
CLOSE FileNum
IF CPUSpeed = 0 THEN
PRINT "Calculating CPUSpeed...";
CPUSpeed = GetCPUSpeed&
OPEN "Smiley.Dat" FOR BINARY AS FileNum
PUT FileNum, , Dir
PUT FileNum, , CPUSpeed
CLOSE FileNum
PRINT "Done."
END IF
END SUB
SUB MsgBoxMsg (text AS STRING)
CONST ButtonColor = 29
CONST ButtonLight = 29
CONST ButtonHighlight = 31
CONST ButtonText = 0
CONST ButtonShadow = 25
CONST ButtonShadowDk = 16
DIM wdth AS INTEGER, hght AS INTEGER, tp AS INTEGER, lft AS INTEGER
DIM size%
wdth = Get3x5FontLen(text) + 10
hght = 24
lft = ((320 - wdth) \ 2) - 1
tp = (8 * 10)
size% = 4 + INT(((PMAP(lft + wdth, 0) - PMAP(lft, 0) + 1) * 8 + 7) / 8) * 1 * (PMAP(tp + hght, 1) - PMAP(tp, 1) + 1)
DIM TheAreaBehind(size%) AS INTEGER
GET (lft, tp)-(lft + wdth, tp + hght), TheAreaBehind(0)
LINE (lft, tp)-(lft + wdth, tp + hght), ButtonColor, BF
LINE (lft, tp)-(lft + wdth, tp + hght), ButtonShadowDk, B
LINE (lft + 1, tp + 1)-(lft + wdth - 1, tp + hght - 1), ButtonShadow, B
LINE (lft, tp)-(lft + wdth - 1, tp), ButtonLight
LINE (lft, tp)-(lft, tp + hght - 1), ButtonLight
LINE (lft + wdth - 2, tp + 1)-(lft + 1, tp + 1), ButtonHighlight
LINE (lft + 1, tp + 1)-(lft + 1, tp + hght - 2), ButtonHighlight
p5x7Font text, lft + 5, tp + 8, ButtonText
SLEEP
PUT (lft, tp), TheAreaBehind(0), PSET
DO: LOOP UNTIL INKEY$ = ""
END SUB
FUNCTION MsgboxYesNo$ (text AS STRING)
CONST ButtonColor = 29
CONST ButtonLight = 29
CONST ButtonHighlight = 31
CONST ButtonText = 0
CONST ButtonShadow = 25
CONST ButtonShadowDk = 16
DIM wdth AS INTEGER, hght AS INTEGER, tp AS INTEGER, lft AS INTEGER
DIM MsgBox AS STRING * 1
DIM size%
wdth = Get3x5FontLen(text) + 10
hght = 24
lft = ((320 - wdth) \ 2) - 1
tp = (8 * 10)
size% = 4 + INT(((PMAP(lft + wdth, 0) - PMAP(lft, 0) + 1) * 8 + 7) / 8) * 1 * (PMAP(tp + hght, 1) - PMAP(tp, 1) + 1)
DIM TheAreaBehind(size%) AS INTEGER
GET (lft, tp)-(lft + wdth, tp + hght), TheAreaBehind(0)
LINE (lft, tp)-(lft + wdth, tp + hght), ButtonColor, BF
LINE (lft, tp)-(lft + wdth, tp + hght), ButtonShadowDk, B
LINE (lft + 1, tp + 1)-(lft + wdth - 1, tp + hght - 1), ButtonShadow, B
LINE (lft, tp)-(lft + wdth - 1, tp), ButtonLight
LINE (lft, tp)-(lft, tp + hght - 1), ButtonLight
LINE (lft + wdth - 2, tp + 1)-(lft + 1, tp + 1), ButtonHighlight
LINE (lft + 1, tp + 1)-(lft + 1, tp + hght - 2), ButtonHighlight
p5x7Font text, lft + 5, tp + 8, ButtonText
DO
MsgBox = UCASE$(INKEY$)
LOOP UNTIL MsgBox = "Y" OR MsgBox = "N"
PUT (lft, tp), TheAreaBehind(0), PSET
MsgboxYesNo = MsgBox
END FUNCTION
SUB NextLevel
CurrentLevel = CurrentLevel + 1
IF CurrentLevel > NumLevels THEN GameOver
LoadLevel AppPath + "Level" + LTRIM$(STR$(CurrentLevel)) + ".lvl"
DrawBoard
PLAY "MBT255L64ab"
MsgBoxMsg "Level" + STR$(CurrentLevel)
END SUB
SUB p5x7Font (text$, X, Y, colour)
length = LEN(text$) 'get characters to print
IF length = 0 THEN EXIT SUB 'check length
FOR char = 0 TO length - 1 'print loop
piece$ = MID$(text$, char + 1, 1) 'look at each piece of string
aski = ASC(piece$) 'assign it's ASCII value
SELECT CASE (piece$) 'adjust lower case
CASE "g": kerny = kerny + 2 'ditto
CASE "j": kerny = kerny + 1 'ditto
CASE "p": kerny = kerny + 2 'ditto
CASE "q": kerny = kerny + 2 'ditto
CASE "y": kerny = kerny + 2 'ditto
END SELECT
FOR ybit = 0 TO 6 'top to Bottom
FOR xbit = 0 TO 4 'left to right
IF font(aski, xbit, ybit) = 1 THEN 'set true bits only
PSET (X + xbit + kernx, Y + ybit + kerny), colour 'PSET data
END IF
NEXT
NEXT
SELECT CASE (piece$) 'kern adjusment
CASE "i": kernx = kernx + 2 'ditto
CASE "j": kernx = kernx + 5 'ditto
CASE "l": kernx = kernx + 2 'ditto
CASE "r": kernx = kernx + 5 'ditto
CASE ".": kernx = kernx + 3 'ditto
CASE "(": kernx = kernx + 3 'ditto
CASE ")": kernx = kernx + 3 'ditto
CASE "'": kernx = kernx + 2 'ditto
CASE "!": kernx = kernx + 2 'ditto
CASE ELSE: kernx = kernx + 6 'ditto
END SELECT
kerny = 0 'reset
NEXT
END SUB
SUB PalLoad (PalFile$)
CLOSE
OPEN PalFile$ + ".PAL" FOR BINARY AS #1
IF LOF(1) = 0 THEN
CLOSE #1
KILL PalFile$ + ".PAL"
EXIT SUB
END IF
CLOSE #1
OPEN PalFile$ + ".PAL" FOR INPUT AS #1
FOR i = 1 TO 768
INPUT #1, pal(i)
NEXT i
CLOSE #1
Num = 1
an = 1
DO
pall(an).r = pal(Num)
Num = Num + 1
pall(an).G = pal(Num)
Num = Num + 1
pall(an).B = pal(Num)
Num = Num + 1
an = an + 1
LOOP UNTIL Num > 768
OUT &H3C7, 0: OUT &H3C8, 0
FOR a% = 1 TO 256 * 3:
OUT &H3C9, pal(a%)
NEXT a%
END SUB
SUB Pause
MsgBoxMsg "Game Paused"
END SUB
SUB ViewHighScores
DIM FileNum AS INTEGER
FileNum = FREEFILE
OPEN AppPath FOR RANDOM AS FileNum
CLOSE FileNum
END SUB
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment