mirror of
https://github.com/QB64-Phoenix-Edition/QB64pe.git
synced 2024-09-20 06:44:44 +00:00
9ee89d6ff4
These tests use a variety of sample code (with some of the larger files removed, so they are not complete!) and verifies that they all compile successfully.
5826 lines
122 KiB
QBasic
5826 lines
122 KiB
QBasic
CHDIR ".\programs\samples\qb45com\action\arqanoid"
|
|
|
|
DECLARE SUB DoEnding ()
|
|
DECLARE SUB DoLogos ()
|
|
DECLARE SUB LoadTitle ()
|
|
DECLARE SUB DoIntro ()
|
|
DECLARE SUB DoStory ()
|
|
DECLARE SUB LoadFlyExpImage ()
|
|
DECLARE SUB DoLangaw (Stat%)
|
|
DECLARE SUB CheckforLangaw (X%, Y%)
|
|
DECLARE SUB CalcLangawCoord ()
|
|
DECLARE SUB PutLangaw (X%, Y%, Axn%)
|
|
DECLARE SUB LoadLangawImage ()
|
|
DECLARE FUNCTION DoTimer% (MaxTime%)
|
|
DECLARE SUB PrintLives (EraseIt%)
|
|
DECLARE SUB CalcBombCoord (RandFactor%)
|
|
DECLARE SUB CheatError ()
|
|
DECLARE FUNCTION RGBCounter% (MaxCounter%)
|
|
DECLARE SUB EraseSaveFiles ()
|
|
DECLARE SUB Check4HoF ()
|
|
DECLARE SUB SortIt ()
|
|
DECLARE FUNCTION SubMenu% ()
|
|
DECLARE FUNCTION PullDown% (X%, Y%, Item$(), Italic%)
|
|
DECLARE SUB NameEntry ()
|
|
DECLARE SUB DoHallOfFame ()
|
|
DECLARE SUB LoadSaveFiles ()
|
|
DECLARE SUB DialogBox (X%, Y%, MaxLen%, MinColor%, Title$, Text$, Italic%, Sysmod%)
|
|
DECLARE SUB LoadGame ()
|
|
DECLARE SUB SaveGame ()
|
|
DECLARE SUB ScrollKgenTT (TopY%, Text$, Xscale%, Yscale%, MinColor%, Shadow%, OverTop%, OverTopY%, Italic%, FirstTime%)
|
|
DECLARE SUB DoCredits ()
|
|
DECLARE SUB DoGameOver ()
|
|
DECLARE SUB KgenTTFont (X%, Y%, Font$, MinColor%, Xscale%, Yscale%, Italic%)
|
|
DECLARE SUB GetDirection ()
|
|
DECLARE SUB SfxOpenDialog ()
|
|
DECLARE FUNCTION SpecialStage% (DX%, DY%, MaxLen%, Tmin%, Title$, Text$)
|
|
DECLARE SUB SfxPowerUp ()
|
|
DECLARE FUNCTION CheckPowerCaps% (X%, Y%)
|
|
DECLARE SUB DoPowerCaps (PowType%)
|
|
DECLARE SUB PutPowerCapsBG ()
|
|
DECLARE SUB GetPowerCapsBG ()
|
|
DECLARE SUB PutPowerCaps (X%, Y%, PowType%)
|
|
DECLARE SUB DoPadLsr ()
|
|
DECLARE SUB PutPadLsrBG (Image1%(), Image2%())
|
|
DECLARE SUB GetPadLsrBG (Image1%(), Image2%())
|
|
DECLARE SUB GetPadLsrCoord (I%)
|
|
DECLARE SUB PutPadLsr (X%, Y%)
|
|
DECLARE SUB LoadPadLsrImage ()
|
|
DECLARE SUB DrawBoss (BossX%, BossY%, BossFile$)
|
|
DECLARE SUB HazyFx ()
|
|
DECLARE SUB LoadPowerCapsImage ()
|
|
DECLARE SUB DoBallExp ()
|
|
DECLARE SUB LoadBallExpImage ()
|
|
DECLARE SUB LoadBallImage ()
|
|
DECLARE SUB LoadPaddleImage ()
|
|
DECLARE SUB DrawSpike (X%, Y%)
|
|
DECLARE FUNCTION MenuSub% ()
|
|
DECLARE SUB SndExplode ()
|
|
DECLARE SUB PutPointer (X%, Y%, X2%, Y2%)
|
|
DECLARE FUNCTION Menu% ()
|
|
DECLARE SUB LoadPointerImage ()
|
|
DECLARE SUB EraseKgen ()
|
|
DECLARE SUB FadeStep (R%, g%, B%)
|
|
DECLARE SUB GetBlkHoleBG ()
|
|
DECLARE SUB PutBlkHoleBG ()
|
|
DECLARE SUB GetBG (X1%, Y1%, X2%, Y2%, Image%())
|
|
DECLARE SUB DoExplode ()
|
|
DECLARE SUB LoadExplodeImage ()
|
|
DECLARE SUB PutBombBG ()
|
|
DECLARE SUB PutBomb (X%, Y%, Switch%)
|
|
DECLARE SUB DoBlkHole ()
|
|
DECLARE SUB DoBomb ()
|
|
DECLARE SUB PutBlkHole (X%, Y%)
|
|
DECLARE SUB PrintLevel ()
|
|
DECLARE SUB RefreshKey ()
|
|
DECLARE SUB MakeImageIndex (ImageArray%(), IndexArray%())
|
|
DECLARE SUB InitImageData (FileName$, ImageArray%())
|
|
DECLARE SUB LevelDoneBox ()
|
|
DECLARE SUB InitTrans ()
|
|
DECLARE SUB TransLuc (n%, X1%, Y1%, X2%, Y2%)
|
|
DECLARE SUB CheckBounceCounter (BounceCounter%)
|
|
DECLARE SUB ReInitBallSpd ()
|
|
DECLARE SUB RotateRGB ()
|
|
DECLARE SUB PrintScore ()
|
|
DECLARE SUB KgenFont (X%, Y%, Font$, MinColor%, Italic%)
|
|
DECLARE SUB LimitScore ()
|
|
DECLARE SUB ReinitValues ()
|
|
DECLARE SUB SelectLevel ()
|
|
DECLARE FUNCTION BossHit% (X%, Y%)
|
|
DECLARE SUB BlinkTile (Switch%)
|
|
DECLARE SUB CheckTile (X%, Y%)
|
|
DECLARE FUNCTION HitSpike% (X%, Y%)
|
|
DECLARE SUB StartGame ()
|
|
DECLARE SUB BlinkBoss ()
|
|
DECLARE SUB Init ()
|
|
DECLARE SUB RestoreColors ()
|
|
DECLARE SUB HideBuild ()
|
|
DECLARE SUB SaveColors ()
|
|
DECLARE SUB ReadRGB (C%, R%, g%, B%)
|
|
DECLARE SUB Fade (R%, g%, B%)
|
|
DECLARE SUB OpenLvlFile (File$)
|
|
DECLARE SUB DrawTile (X%, Y%, Clr%)
|
|
DECLARE SUB PlayGame ()
|
|
DECLARE SUB InitNums ()
|
|
DECLARE SUB PrintNum (X%, Y%, n$)
|
|
DECLARE FUNCTION Format$ (Score&)
|
|
DECLARE SUB PrintFonts (X%, Y%, n$)
|
|
DECLARE SUB DrawFonts ()
|
|
DECLARE SUB InitFonts ()
|
|
DECLARE FUNCTION Inside% (X%, Y%, X1%, Y1%, X2%, Y2%)
|
|
DECLARE SUB ReadLevel (Lvl%)
|
|
DECLARE SUB GetTileBackGround ()
|
|
DECLARE SUB InitValues ()
|
|
DECLARE SUB DrawBorder ()
|
|
DECLARE FUNCTION Collide% ()
|
|
DECLARE SUB GetBallCenter (BallCenterX%, BallCenterY%)
|
|
DECLARE SUB PutPaddle (PadX%, PadY%)
|
|
DECLARE FUNCTION MovePaddle% (PadX%, PadY%)
|
|
DECLARE SUB GetPaddleBG (PadX%, PadY%)
|
|
DECLARE FUNCTION FastKB% ()
|
|
DECLARE SUB PutBall (BallX%, BallY%)
|
|
DECLARE SUB GetBallBG (BallX%, BallY%)
|
|
DECLARE SUB PutBallBG (BallOldX%, BallOldY%)
|
|
DECLARE SUB DrawLevelBG (BGMode%, ColorStep%, ColorAttr%)
|
|
DECLARE SUB WriteRGB (C%, R%, g%, B%)
|
|
DECLARE SUB InitColors ()
|
|
DECLARE SUB MilliDelay (msecs%)
|
|
DECLARE SUB PutPaddleBG (PadOldX%, PadOldY%)
|
|
DECLARE SUB LoadBombImage ()
|
|
DECLARE SUB LoadBlkHoleImage ()
|
|
DEFINT A-Z
|
|
REM $DYNAMIC
|
|
|
|
|
|
'==========Type declarations====================================
|
|
TYPE TileType
|
|
X AS INTEGER
|
|
Y AS INTEGER
|
|
C AS INTEGER
|
|
F AS INTEGER
|
|
END TYPE
|
|
|
|
TYPE RGBtype
|
|
R AS INTEGER
|
|
g AS INTEGER
|
|
B AS INTEGER
|
|
END TYPE
|
|
|
|
TYPE CoordType
|
|
X AS INTEGER
|
|
Y AS INTEGER
|
|
END TYPE
|
|
|
|
TYPE SaveType
|
|
Num AS INTEGER
|
|
Namer AS STRING * 12
|
|
Score AS LONG
|
|
Level AS INTEGER
|
|
Lives AS INTEGER
|
|
END TYPE
|
|
|
|
TYPE HallOfFameType
|
|
Rank AS INTEGER
|
|
Namer AS STRING * 12
|
|
Score AS LONG
|
|
END TYPE
|
|
|
|
|
|
|
|
'====================Constants==================================
|
|
'Misc Const
|
|
CONST False = 0, True = NOT False
|
|
|
|
'Screen const
|
|
CONST MinX = 0, MaxX = 260, MinY = 0, MaxY = 200
|
|
|
|
'KeyConstants
|
|
CONST KRight = 77, KLeft = 75, KDown = 80, KUp = 72, KEsc = 1
|
|
CONST KW = &H11, KA = &H1E, KS = &H1F, KD = &H20, KPgd = &H51
|
|
CONST KSpc = &H39, KEnt = &H1C, KCtrl = &H1D, KTab = &HF, KEnd = &H4F
|
|
|
|
|
|
'Paddle Const
|
|
CONST PadSpd = 3
|
|
'Ball Const
|
|
CONST BallRadius = 4
|
|
|
|
'Color Const
|
|
CONST PadColorMin = 30, PadColorMax = 39
|
|
CONST BorderMin = 40, Bordermax = 47
|
|
CONST SpikeMin = 50, SpikeMax = 57
|
|
CONST TcolorMin = 60, TcolorMax = 93
|
|
CONST FColorMin = 96, FcolorMax = 100
|
|
CONST KgenMin = 220, KgenMax = 227
|
|
CONST KgenBlueMin = 228, KgenBlueMax = 235
|
|
CONST KgenGreenMin = 236, KgenGreenMax = 243
|
|
CONST SnColorMin = 101, SnColorMax = 105
|
|
CONST BossColorMin = 106, BossColorMax = 121
|
|
|
|
'Offset and Tile Const
|
|
CONST OffsetBG = 122 'TileY=19(0 to 180/6), TileX=12(0 to 220/20)
|
|
CONST TileMax = 227 '0 to 227
|
|
CONST TileW = 19, TileH = 5 ' 0 to 19, 0 to 5 (20*6)
|
|
|
|
'Font constant
|
|
CONST FontOffset = 12 'Size of SmallFonts
|
|
|
|
'Directional Const
|
|
CONST UR = 1, UL = 2, DR = 3, DL = 4
|
|
|
|
'RGBCounter
|
|
CONST RGBC = 7 'for Counter of RotateRGB/RGBCounter function
|
|
|
|
|
|
'==================Shared Arrays===================
|
|
DIM SHARED Ball(1), BallBG(30), BallIndex(1)
|
|
DIM SHARED Paddle(1), PaddleIndex(1), PaddleBG(181 * 2)
|
|
DIM SHARED BackGround(27816) 'BackGround for erasing tiles
|
|
DIM SHARED SpikeBG(1) 'BackGround for erasing tiles
|
|
DIM SHARED Tile(TileMax) AS TileType
|
|
DIM SHARED Trans(256)
|
|
DIM SHARED SavRGB(0 TO 255) AS RGBtype
|
|
DIM SHARED Boss(1), BossMask(1), BossBG(1)
|
|
DIM SHARED BlkHole(1), BlkHoleMsk(1), BlkHoleIndex(1)
|
|
DIM SHARED BlkHoleXY(1 TO 4) AS CoordType
|
|
DIM SHARED BlkHoleBG(130 * 4)
|
|
DIM SHARED Bomb(1), BombMsk(1), BombIndex(1)
|
|
DIM SHARED BombXY(1 TO 91) AS CoordType
|
|
DIM SHARED BombBG(130 * 91)
|
|
DIM SHARED Explode(1 TO 1), Explodemsk(1 TO 1), ExplodeIndex(1 TO 1)
|
|
DIM SHARED BallExp(1 TO 1), BallExpmsk(1 TO 1), BallExpIndex(1 TO 1)
|
|
DIM SHARED Pointer(1 TO 1), PointerIndex(1 TO 1)
|
|
DIM SHARED PowerCaps(1), PowerCapsIndex(1)
|
|
DIM SHARED PowerCapsBG(1), PowerCapsCoord(0) AS CoordType, PowerCapsOldCoord(0) AS CoordType
|
|
DIM SHARED Padlsr(1), PadlsrIndex(1), PadLsrCoord(1) AS CoordType'(0 to 1)
|
|
DIM SHARED PadLsrBG1(1), PadLsrBG2(1), PadLsrOldCoord(1) AS CoordType
|
|
DIM SHARED Save(1 TO 8) AS SaveType
|
|
DIM SHARED Hall(1 TO 5) AS HallOfFameType
|
|
DIM SHARED Langaw(1 TO 1), LangawIndex(1 TO 1), LangawCoord(1) AS CoordType
|
|
DIM SHARED LangawOldCoord(1) AS CoordType, LangawBG1(1), LangawBG2(1), FlyExp(1)
|
|
DIM SHARED FlyExpIndex(1)
|
|
|
|
'==================Non-Global Arrays===============
|
|
DIM SmallFonts(396) AS INTEGER
|
|
DIM SmallNum(132) AS INTEGER
|
|
|
|
'==================Shared Variables
|
|
DIM SHARED BallOldX, BallOldY, BallX, BallY, BallXV, BallYV, Direction
|
|
DIM SHARED BallCenterX, BallCenterY 'Used to Process collission detection
|
|
DIM SHARED PadX, PadY, PadOldX, PadOldY
|
|
DIM SHARED Finished, BallSpd, Score&, OutStart, BounceCounter
|
|
DIM SHARED ColorAttr, ColorStep
|
|
DIM SHARED Level, TileNumber, GameOver, BossLife, BombNum, BombDes, MaxBomb, Lives
|
|
DIM SHARED PadPower, Replicant, BombSTG, BossStg
|
|
DIM SHARED SdHitPad, SdHitBoss, SdHitTile
|
|
DIM SHARED BossX, BossY, BossEnter, SpStage
|
|
DIM SHARED Shooting, Power, PowerType, Lshot, Rshot, AutoFire
|
|
DIM SHARED Path$
|
|
|
|
|
|
RANDOMIZE TIMER
|
|
|
|
CLS
|
|
SCREEN 13
|
|
|
|
'Path$ = "C:\qbasic\Arqanoid\"
|
|
'Path$ = "c:\rel\arqanoid\"
|
|
Path$ = ""
|
|
Init
|
|
|
|
|
|
|
|
DO
|
|
|
|
PlayGame
|
|
|
|
LOOP UNTIL GameOver
|
|
|
|
Fade 0, 0, 0
|
|
|
|
DoGameOver
|
|
|
|
|
|
CLS
|
|
SCREEN 0
|
|
END
|
|
|
|
'====Data statements
|
|
Credits:
|
|
|
|
|
|
DATA "GOD/Jesus Christ"
|
|
DATA " Gave me everything I have. LIFE."
|
|
DATA ""
|
|
|
|
DATA "Richard Eric M. Lope BSN RN"
|
|
DATA " Coding/Story/Sound/Grafix(Mostly)."
|
|
DATA ""
|
|
|
|
DATA "Anya Therese Lope"
|
|
DATA " Cutest & Loudest baby in the world!"
|
|
DATA ""
|
|
|
|
DATA "Pedro & Lily Lope"
|
|
DATA " For their undying support."
|
|
DATA ""
|
|
|
|
DATA "Marie & Cristina Lope"
|
|
DATA " Twinblades of Sara,Iloilo."
|
|
DATA ""
|
|
|
|
DATA "Loreni Farillon"
|
|
DATA " Kitiki-TXT.2k dtym 2snd SMS L8@Nyt."
|
|
DATA ""
|
|
|
|
DATA "WIC I-net/Jason Babila,Alan,Shote&Tin2"
|
|
DATA " Mabini St. Iloilo city."
|
|
DATA ""
|
|
|
|
DATA "Archie Aurelio/Joey of Zap Zone"
|
|
DATA " Arcade Game buddies."
|
|
DATA ""
|
|
|
|
DATA "Special Thanks!!!"
|
|
DATA ""
|
|
DATA ""
|
|
|
|
|
|
DATA "Andrew Ayers (Blast Lib maker)"
|
|
DATA " For his tutor on Get/Put offsetting."
|
|
DATA ""
|
|
|
|
DATA "Chris Chadwick (PP256 Developer)"
|
|
DATA " PP256 made my life easier!!!"
|
|
DATA ""
|
|
|
|
DATA "Vance Velez (Vplanet)"
|
|
DATA " Best Review site!!!"
|
|
DATA ""
|
|
|
|
DATA "Gianncarlo (GBGames)"
|
|
DATA " Best QB link ever!!!"
|
|
DATA ""
|
|
|
|
DATA "Jorden Chamid (FutureSoft)"
|
|
DATA " Best QB site. Period!!!"
|
|
DATA ""
|
|
|
|
DATA "Vic Luce (VQB Maker)"
|
|
DATA " Great tutorial on Masking."
|
|
DATA ""
|
|
|
|
DATA "Danny Gump (VirtuaSoft-Dash Lib Maker)"
|
|
DATA " Taught me the Get/Put Array system."
|
|
DATA ""
|
|
|
|
DATA "ZKman (?????)"
|
|
DATA " Translucency(Non Alpha) Tutorial."
|
|
DATA ""
|
|
|
|
|
|
DATA "Steven Sivek (stevensivek@hotmail.com)"
|
|
DATA " For the ROM address/Offset of text."
|
|
DATA ""
|
|
|
|
DATA "Dark Dread (Darkness Etherial)"
|
|
DATA " DCrown perked me up 2 make a QBGame."
|
|
DATA ""
|
|
|
|
DATA "Andre(who are you?)"
|
|
DATA " Used his MilliDelay in this game."
|
|
DATA ""
|
|
|
|
DATA "Nesticle"
|
|
DATA " Heaven sent emulator!"
|
|
DATA ""
|
|
|
|
DATA "Kgen and LoopyNes"
|
|
DATA " Great emulators!"
|
|
DATA ""
|
|
|
|
DATA "The QB Times"
|
|
DATA " Provided me with BMP file system."
|
|
DATA ""
|
|
|
|
DATA "NeoZones"
|
|
DATA " Got a lot of tutorials there!"
|
|
DATA ""
|
|
|
|
DATA "KONAMI(tm)"
|
|
DATA " Ripped their LifeForce sprites."
|
|
DATA ""
|
|
|
|
DATA "IREM(tm),COMPILE(tm) & Broderbund(tm)"
|
|
DATA " Ripped their Guardian Legend sprs."
|
|
DATA ""
|
|
|
|
DATA "TAXAN(tm)"
|
|
DATA " Ripped their Burai Fighter sprites."
|
|
DATA ""
|
|
|
|
DATA "The Smashing Pumpkins"
|
|
DATA " Best band in the world. Forever!"
|
|
DATA ""
|
|
|
|
DATA "PSYKYO"
|
|
DATA " Strikers Series...Best Arcade Game!"
|
|
DATA ""
|
|
|
|
DATA "Samurai X & DragonBall Z"
|
|
DATA " Animes I like very much."
|
|
DATA ""
|
|
|
|
DATA ""
|
|
DATA ""
|
|
DATA ""
|
|
DATA ""
|
|
DATA ""
|
|
|
|
DATA "End"
|
|
|
|
|
|
|
|
Story:
|
|
|
|
DATA " From days of long ago, from the "
|
|
DATA "uncharted regions fo the universe, "
|
|
DATA "comes a legend... the Legend of"
|
|
DATA "BALOTRON!(Yeah, right. sounds familiar)"
|
|
DATA ""
|
|
DATA " One day, while the people of"
|
|
DATA "BALOTLAND were living peacefully,"
|
|
DATA "Ten long years post the victory of their"
|
|
DATA "Gredius,Goardic, and Buray missions, a"
|
|
DATA "Balotland shattering BALOTQUAKE occured!"
|
|
DATA ""
|
|
DATA " The inhabitants of BalotLand(Paddle-"
|
|
DATA "Like beings) panicked! And in the "
|
|
DATA "confusion the bacterial beings,"
|
|
DATA "imprisoned underground for ten years, "
|
|
DATA "led by the ever charming GIGA, seized"
|
|
DATA "control of the planet and imprisoned"
|
|
DATA "most of the BalotLings. While the"
|
|
DATA "others were forced to do mining at"
|
|
DATA "the Obsidian lake which has precious"
|
|
DATA "stones below it, including Balotron's"
|
|
DATA "love, Balotae! BTW, Balotron wasn't"
|
|
DATA "captured(He was taking a nap outside"
|
|
DATA "the city. Or else we won't have a story)."
|
|
DATA ""
|
|
DATA " Now armed w/ his trusty BALOTBALL,"
|
|
DATA "both embarked on a journey to save the "
|
|
DATA "people of Balotland. But before they "
|
|
DATA "could save them and face GIGA, they"
|
|
DATA "must defeat his governors of Pain, and"
|
|
DATA "his army of... well, what else... "
|
|
DATA "COLORFUL BLOCKS!"
|
|
DATA "Nuff said! Let's begin..."
|
|
DATA ""
|
|
DATA ""
|
|
DATA ""
|
|
DATA ""
|
|
DATA ""
|
|
DATA ""
|
|
DATA "END"
|
|
|
|
Ending:
|
|
|
|
DATA 0,"--THE END--",220
|
|
DATA 20,"Balotron together w/ his friend",228
|
|
DATA 30,"Boy Balot, rescued princess",228
|
|
DATA 40,"Balotae from the clutches",228
|
|
DATA 50,"of GIGA, and his minions.",228
|
|
DATA 60,"the people of Balotland",228
|
|
DATA 70,"rejoiced and made our hero",228
|
|
DATA 80,"their king! (He wasn't",228
|
|
DATA 90,"supposed to be, but he married",228
|
|
DATA 100,"the princess so he will be.)",228
|
|
DATA 110,"Lucky him....",228
|
|
DATA 130,"However....",236
|
|
DATA 140,"this is an arcade game.",236
|
|
DATA 150,"so you have to continue your",236
|
|
DATA 160,"quest. Right from the start...",236
|
|
DATA 190,"End",228
|
|
|
|
'====End data
|
|
|
|
|
|
|
|
'=================temp
|
|
|
|
'-===================================================
|
|
|
|
|
|
Temp:
|
|
|
|
END
|
|
|
|
REM $STATIC
|
|
SUB BlinkBoss STATIC
|
|
|
|
WAIT &H3DA, 8
|
|
SOUND 1000, .2
|
|
SOUND 500, .4
|
|
|
|
FOR I = 106 TO 121
|
|
WriteRGB I, 0, 63, INT(RND * 63)
|
|
NEXT I
|
|
|
|
SOUND 1000, .3
|
|
SOUND 700, .2
|
|
WAIT &H3DA, 8
|
|
|
|
FOR I = 106 TO 121
|
|
R = SavRGB(I).R
|
|
g = SavRGB(I).g
|
|
B = SavRGB(I).B
|
|
WriteRGB I, R, g, B
|
|
NEXT I
|
|
|
|
SOUND 1000, .2
|
|
|
|
END SUB
|
|
|
|
SUB BlinkTile (Switch%) STATIC
|
|
|
|
IF Switch THEN
|
|
FOR I = 84 TO 86
|
|
WriteRGB I, 63, 0, INT(RND * 63)
|
|
NEXT I
|
|
ELSE
|
|
FOR I = 84 TO 86
|
|
R = SavRGB(I).R
|
|
g = SavRGB(I).g
|
|
B = SavRGB(I).B
|
|
WriteRGB I, R, g, B
|
|
NEXT I
|
|
END IF
|
|
|
|
END SUB
|
|
|
|
FUNCTION BossHit (X, Y) STATIC
|
|
|
|
|
|
|
|
BossHit = False
|
|
IF POINT(X, Y) >= BossColorMin AND POINT(X, Y) <= BossColorMax THEN
|
|
BossHit = True
|
|
BlinkBoss
|
|
Score& = Score& + 2000&
|
|
LimitScore
|
|
PrintScore
|
|
BossLife = BossLife - 100
|
|
REM GOSUB InitPwrCaps 'Disabled for OverKill Reasons unrem if u want 2 have powerups on bosses
|
|
GOSUB CheckBossKilled
|
|
END IF
|
|
|
|
|
|
EXIT FUNCTION
|
|
|
|
|
|
'=========Subs===============
|
|
|
|
CheckBossKilled:
|
|
|
|
IF BossLife <= 0 THEN
|
|
|
|
PutBlkHoleBG
|
|
PutBombBG
|
|
LevelDoneBox
|
|
EraseKgen
|
|
PrintLives True
|
|
|
|
T1& = TIMER
|
|
|
|
DO
|
|
T2& = TIMER
|
|
KK$ = INKEY$
|
|
IF KK$ = CHR$(13) THEN EXIT DO
|
|
|
|
DoExplode
|
|
FadeStep 0, 0, 0
|
|
|
|
SndExplode
|
|
LOOP UNTIL T2& - T1& > 9&
|
|
|
|
Finished = True
|
|
IF Level = 50 THEN
|
|
DoEnding
|
|
END IF
|
|
|
|
END IF
|
|
|
|
RETURN
|
|
|
|
'==================
|
|
InitPwrCaps:
|
|
|
|
IF NOT Power THEN
|
|
|
|
PowPow = INT(RND * 5)
|
|
IF PowPow = 1 THEN
|
|
Power = True
|
|
PowerCapsCoord(0).X = 10 + INT(RND * 220)
|
|
PowerCapsCoord(0).Y = 10 + INT(RND * 50)
|
|
PutPadLsrBG PadLsrBG1(), PadLsrBG2()
|
|
GetPowerCapsBG
|
|
PowerType = 1 + INT(RND * 3)
|
|
END IF
|
|
END IF
|
|
|
|
RETURN
|
|
|
|
|
|
END FUNCTION
|
|
|
|
SUB CalcBombCoord (RandFactor) STATIC
|
|
|
|
I = 0
|
|
FOR Y = 10 TO 108 STEP 16
|
|
FOR X = 26 TO 220 STEP 16
|
|
Rand = 1 + INT(RND * RandFactor)
|
|
IF Rand = 1 THEN
|
|
IF I < 100 THEN
|
|
I = I + 1
|
|
BombXY(I).X = X
|
|
BombXY(I).Y = Y
|
|
END IF
|
|
END IF
|
|
NEXT X
|
|
NEXT Y
|
|
|
|
BombNum = I
|
|
MaxBomb = BombNum
|
|
BombSTG = True
|
|
|
|
|
|
END SUB
|
|
|
|
SUB CalcLangawCoord STATIC
|
|
|
|
LangawCoord(0).X = BlkHoleXY(1 + INT(RND * 4)).X
|
|
LangawCoord(0).Y = BlkHoleXY(1 + INT(RND * 4)).Y
|
|
LangawCoord(1).X = BlkHoleXY(1 + INT(RND * 4)).X
|
|
LangawCoord(1).Y = BlkHoleXY(1 + INT(RND * 4)).Y
|
|
|
|
GetBG LangawOldCoord(0).X, LangawOldCoord(0).Y, LangawOldCoord(0).X + 16, LangawOldCoord(0).Y + 16, LangawBG1()
|
|
GetBG LangawOldCoord(1).X, LangawOldCoord(1).Y, LangawOldCoord(1).X + 16, LangawOldCoord(1).Y + 16, LangawBG2()
|
|
|
|
END SUB
|
|
|
|
SUB CheatError STATIC
|
|
|
|
DX = 26
|
|
DY = 40
|
|
MaxLen = 26
|
|
Title$ = " Cheat Error!!!"
|
|
Tmin = PadColorMin
|
|
Sysmod = True
|
|
Text$ = CHR$(11) + " Sorry! I intentionally disabled this cheat code on SPECIAL STAGES because I think it would be an overkill... ie. 2 easy a game."
|
|
DialogBox DX, DY, MaxLen, Tmin, Title$, Text$, False, Sysmod
|
|
|
|
|
|
END SUB
|
|
|
|
SUB Check4HoF STATIC
|
|
|
|
IF Score& > Hall(5).Score THEN
|
|
NameEntry
|
|
END IF
|
|
|
|
END SUB
|
|
|
|
SUB CheckBounceCounter (BounceCounter) STATIC
|
|
|
|
IF BounceCounter < 50 THEN
|
|
BounceCounter = BounceCounter + 1
|
|
END IF
|
|
SELECT CASE BounceCounter
|
|
CASE IS <= 40
|
|
BallSpd = 1
|
|
ReInitBallSpd
|
|
CASE IS = 41
|
|
BallSpd = 2
|
|
ReInitBallSpd
|
|
CASE ELSE
|
|
END SELECT
|
|
|
|
|
|
END SUB
|
|
|
|
SUB CheckforLangaw (X, Y) STATIC
|
|
|
|
IF Inside(X, Y, LangawCoord(0).X, LangawCoord(0).Y, LangawCoord(0).X + 16, LangawCoord(0).Y + 16) THEN
|
|
PUT (LangawOldCoord(0).X, LangawOldCoord(0).Y), LangawBG1, PSET
|
|
GOSUB XFlies
|
|
LangawCoord(0).X = BlkHoleXY(1 + INT(RND * 4)).X
|
|
LangawCoord(0).Y = BlkHoleXY(1 + INT(RND * 4)).Y
|
|
GetBG LangawOldCoord(0).X, LangawOldCoord(0).Y, LangawOldCoord(0).X + 16, LangawOldCoord(0).Y + 16, LangawBG1()
|
|
ELSEIF Inside(X, Y, LangawCoord(1).X, LangawCoord(1).Y, LangawCoord(1).X + 16, LangawCoord(1).Y + 16) THEN
|
|
PUT (LangawOldCoord(1).X, LangawOldCoord(1).Y), LangawBG2, PSET
|
|
GOSUB XFlies
|
|
LangawCoord(1).X = BlkHoleXY(1 + INT(RND * 4)).X
|
|
LangawCoord(1).Y = BlkHoleXY(1 + INT(RND * 4)).Y
|
|
GetBG LangawOldCoord(1).X, LangawOldCoord(1).Y, LangawOldCoord(1).X + 16, LangawOldCoord(1).Y + 16, LangawBG2()
|
|
END IF
|
|
|
|
EXIT SUB
|
|
|
|
|
|
XFlies:
|
|
REDIM Temp(1)
|
|
GetBG X - 5, Y - 5, (X - 5) + 25, (Y - 5) + 25, Temp()
|
|
PUT (X - 5, Y - 5), FlyExp(FlyExpIndex(2)), AND
|
|
PUT (X - 5, Y - 5), FlyExp(FlyExpIndex(1)), OR
|
|
FOR J = 0 TO 3
|
|
WAIT &H3DA, 8
|
|
WAIT &H3DA, 8, 8
|
|
SOUND 1500 - (J * 150), .3
|
|
NEXT J
|
|
BounceCounter = 40
|
|
Score& = Score& + 11
|
|
LimitScore
|
|
PrintScore
|
|
PUT (X - 5, Y - 5), Temp, PSET
|
|
ERASE Temp
|
|
|
|
RETURN
|
|
|
|
|
|
END SUB
|
|
|
|
FUNCTION CheckPowerCaps (X, Y) STATIC
|
|
|
|
|
|
CheckPowerCaps = False
|
|
|
|
IF Inside(X, Y, PowerCapsCoord(0).X, PowerCapsCoord(0).Y, PowerCapsCoord(0).X + 20, PowerCapsCoord(0).Y + 10) THEN
|
|
CheckPowerCaps = True
|
|
END IF
|
|
|
|
END FUNCTION
|
|
|
|
SUB CheckTile (X, Y) STATIC
|
|
|
|
FOR I = 0 TO 227
|
|
IF Tile(I).F THEN
|
|
IF Inside(X, Y, Tile(I).X, Tile(I).Y, Tile(I).X + TileW, Tile(I).Y + TileH) THEN
|
|
GOSUB FindType
|
|
LimitScore
|
|
PrintScore
|
|
GOSUB InitPowerCaps
|
|
END IF
|
|
END IF
|
|
NEXT I
|
|
|
|
EXIT SUB
|
|
|
|
'===========================================================================
|
|
FindType:
|
|
SELECT CASE Tile(I).C
|
|
CASE 1
|
|
SOUND 700, .5
|
|
Score& = Score& + 100&
|
|
GOSUB DestroyTiles
|
|
CASE 2
|
|
SOUND 900, .5
|
|
Score& = Score& + 200&
|
|
GOSUB DestroyTiles
|
|
CASE 3
|
|
SOUND 1100, .5
|
|
Score& = Score& + 300&
|
|
GOSUB DestroyTiles
|
|
CASE 4
|
|
SOUND 1300, .5
|
|
Score& = Score& + 400&
|
|
GOSUB DestroyTiles
|
|
CASE 5
|
|
SOUND 1500, .5
|
|
Score& = Score& + 500&
|
|
GOSUB DestroyTiles
|
|
CASE 6
|
|
SOUND 1700, .5
|
|
Score& = Score& + 600&
|
|
GOSUB DestroyTiles
|
|
CASE 7
|
|
SOUND 1900, .5
|
|
Score& = Score& + 700&
|
|
Tile(I).C = Tile(I).C - 1 'Change Tile
|
|
DrawTile Tile(I).X, Tile(I).Y, Tile(I).C
|
|
CASE 8
|
|
SOUND 2100, .5
|
|
Score& = Score& + 800&
|
|
Tile(I).C = Tile(I).C - 1 'Change Tile
|
|
DrawTile Tile(I).X, Tile(I).Y, Tile(I).C
|
|
CASE 9
|
|
SdHitTile = True
|
|
BlinkTile True
|
|
CASE ELSE
|
|
END SELECT
|
|
RETURN
|
|
|
|
|
|
DestroyTiles:
|
|
|
|
|
|
IF Power THEN
|
|
IF CheckPowerCaps(X, Y) THEN
|
|
PutPowerCapsBG
|
|
Power = False
|
|
END IF
|
|
END IF
|
|
|
|
PUT (Tile(I).X, Tile(I).Y), BackGround(I * OffsetBG), PSET
|
|
Tile(I).F = False
|
|
|
|
'Check if all Tiles are Destroyed
|
|
TileNumber = TileNumber - 1
|
|
|
|
IF TileNumber < 1 THEN
|
|
|
|
LevelDoneBox
|
|
Shooting = False
|
|
Lshot = False
|
|
Rshot = False
|
|
T1& = TIMER
|
|
DO
|
|
T2& = TIMER
|
|
KK$ = INKEY$
|
|
IF KK$ = CHR$(13) THEN EXIT DO
|
|
WAIT &H3DA, 8
|
|
WAIT &H3DA, 8, 8
|
|
IF RGBCounter(RGBC * 5) THEN
|
|
RotateRGB
|
|
END IF
|
|
|
|
LOOP UNTIL T2& - T1& > 7&
|
|
|
|
Finished = True
|
|
OutStart = True
|
|
END IF
|
|
|
|
RETURN
|
|
|
|
'========
|
|
InitPowerCaps:
|
|
|
|
IF NOT Power THEN
|
|
IF Tile(I).C <> 9 THEN
|
|
PowPow = INT(RND * 10)
|
|
IF PowPow = 1 THEN
|
|
Power = True
|
|
PowerCapsCoord(0).X = Tile(I).X
|
|
PowerCapsCoord(0).Y = Tile(I).Y
|
|
PutPadLsrBG PadLsrBG1(), PadLsrBG2()
|
|
GetPowerCapsBG
|
|
PowerType = 1 + INT(RND * 3)
|
|
END IF
|
|
END IF
|
|
END IF
|
|
|
|
RETURN
|
|
|
|
|
|
END SUB
|
|
|
|
FUNCTION Collide STATIC
|
|
'This is the heart and soul of the game! this may be long and confusing but
|
|
'I made great effort in trying to make this as comprehensive as possible!
|
|
'If you still don't understand, print it!
|
|
|
|
|
|
IF BombSTG THEN
|
|
IF DoTimer(61) THEN
|
|
Perfect = False
|
|
GOSUB Endit
|
|
END IF
|
|
END IF
|
|
|
|
Collide = False
|
|
BallSS = BallSpd
|
|
|
|
BallX = BallX + BallXV
|
|
BallY = BallY + BallYV
|
|
|
|
GetBallCenter BallCenterX, BallCenterY
|
|
|
|
GetDirection
|
|
|
|
SELECT CASE Direction
|
|
CASE UR
|
|
IF POINT(BallCenterX + (BallRadius + BallSS), BallCenterY) < 129 THEN 'Right
|
|
X = BallCenterX + (BallRadius + BallSS)
|
|
Y = BallCenterY
|
|
BallXV = -BallXV
|
|
'BallX = BallX + BallXV
|
|
Collide = True
|
|
GOSUB CheckForSpike
|
|
IF BossStg THEN GOSUB CheckForBossHit
|
|
GOSUB CheckForPadHit
|
|
GOSUB CheckForPowerHit
|
|
GOSUB CheckForTile
|
|
IF BombSTG THEN GOSUB Check4Bomb
|
|
IF BossStg THEN CheckforLangaw X, Y
|
|
ELSEIF POINT(BallCenterX, BallCenterY - (BallRadius + BallSS)) < 129 THEN 'Up
|
|
X = BallCenterX
|
|
Y = BallCenterY - (BallRadius + BallSS)
|
|
BallYV = -BallYV
|
|
'BallY = BallY + BallYV
|
|
Collide = True
|
|
GOSUB CheckForSpike
|
|
IF BossStg THEN GOSUB CheckForBossHit
|
|
GOSUB CheckForPadHit
|
|
GOSUB CheckForPowerHit
|
|
GOSUB CheckForTile
|
|
IF BombSTG THEN GOSUB Check4Bomb
|
|
IF BossStg THEN CheckforLangaw X, Y
|
|
ELSE
|
|
END IF
|
|
|
|
CASE UL
|
|
IF POINT(BallCenterX - (BallRadius + BallSS), BallCenterY) < 129 THEN 'Left
|
|
X = BallCenterX - (BallRadius + BallSS)
|
|
Y = BallCenterY
|
|
BallXV = -BallXV
|
|
'BallX = BallX + BallXV
|
|
Collide = True
|
|
GOSUB CheckForSpike
|
|
IF BossStg THEN GOSUB CheckForBossHit
|
|
GOSUB CheckForPadHit
|
|
GOSUB CheckForPowerHit
|
|
GOSUB CheckForTile
|
|
IF BombSTG THEN GOSUB Check4Bomb
|
|
IF BossStg THEN CheckforLangaw X, Y
|
|
ELSEIF POINT(BallCenterX, BallCenterY - (BallRadius + BallSS)) < 129 THEN 'Up
|
|
X = BallCenterX
|
|
Y = BallCenterY - (BallRadius + BallSS)
|
|
BallYV = -BallYV
|
|
'BallY = BallY + BallYV
|
|
Collide = True
|
|
GOSUB CheckForSpike
|
|
IF BossStg THEN GOSUB CheckForBossHit
|
|
GOSUB CheckForPadHit
|
|
GOSUB CheckForPowerHit
|
|
GOSUB CheckForTile
|
|
IF BombSTG THEN GOSUB Check4Bomb
|
|
IF BossStg THEN CheckforLangaw X, Y
|
|
ELSE
|
|
END IF
|
|
|
|
CASE DR
|
|
IF POINT(BallCenterX + (BallRadius + BallSS), BallCenterY) < 129 THEN 'Right
|
|
X = BallCenterX + (BallRadius + BallSS)
|
|
Y = BallCenterY
|
|
BallXV = -BallXV
|
|
'BallX = BallX + BallXV
|
|
Collide = True
|
|
GOSUB CheckForSpike
|
|
IF BossStg THEN GOSUB CheckForBossHit
|
|
GOSUB CheckForPadHit
|
|
GOSUB CheckForPowerHit
|
|
GOSUB CheckForTile
|
|
IF BombSTG THEN GOSUB Check4Bomb
|
|
IF BossStg THEN CheckforLangaw X, Y
|
|
ELSEIF POINT(BallCenterX, BallCenterY + (BallRadius + BallSS)) < 129 THEN 'Up
|
|
X = BallCenterX
|
|
Y = BallCenterY + (BallRadius + BallSS)
|
|
BallYV = -BallYV
|
|
'BallY = BallY + BallYV
|
|
Collide = True
|
|
GOSUB CheckForSpike
|
|
IF BossStg THEN GOSUB CheckForBossHit
|
|
GOSUB CheckForPadHit
|
|
GOSUB CheckForPowerHit
|
|
GOSUB CheckForTile
|
|
IF BombSTG THEN GOSUB Check4Bomb
|
|
IF BossStg THEN CheckforLangaw X, Y
|
|
ELSE
|
|
END IF
|
|
|
|
CASE DL
|
|
IF POINT(BallCenterX - (BallRadius + BallSS), BallCenterY) < 129 THEN 'Left
|
|
X = BallCenterX - (BallRadius + BallSS)
|
|
Y = BallCenterY
|
|
BallXV = -BallXV
|
|
'BallX = BallX + BallXV
|
|
Collide = True
|
|
GOSUB CheckForSpike
|
|
IF BossStg THEN GOSUB CheckForBossHit
|
|
GOSUB CheckForPadHit
|
|
GOSUB CheckForPowerHit
|
|
GOSUB CheckForTile
|
|
IF BombSTG THEN GOSUB Check4Bomb
|
|
IF BossStg THEN CheckforLangaw X, Y
|
|
ELSEIF POINT(BallCenterX, BallCenterY + (BallRadius + BallSS)) < 129 THEN 'Up
|
|
X = BallCenterX
|
|
Y = BallCenterY + (BallRadius + BallSS)
|
|
BallYV = -BallYV
|
|
'BallY = BallY + BallYV
|
|
Collide = True
|
|
GOSUB CheckForSpike
|
|
IF BossStg THEN GOSUB CheckForBossHit
|
|
GOSUB CheckForPadHit
|
|
GOSUB CheckForPowerHit
|
|
GOSUB CheckForTile
|
|
IF BombSTG THEN GOSUB Check4Bomb
|
|
IF BossStg THEN CheckforLangaw X, Y
|
|
ELSE
|
|
END IF
|
|
|
|
|
|
CASE ELSE
|
|
END SELECT
|
|
|
|
|
|
|
|
EXIT FUNCTION
|
|
|
|
'=======================Subroutines=====================================
|
|
|
|
|
|
CheckForBossHit:
|
|
IF BossHit(X, Y) THEN
|
|
END IF
|
|
RETURN
|
|
|
|
CheckForTile:
|
|
CheckTile X, Y
|
|
RETURN
|
|
|
|
|
|
CheckForSpike:
|
|
|
|
IF HitSpike(X, Y) THEN
|
|
|
|
SOUND 900, 1
|
|
|
|
PutBallBG BallOldX, BallOldY
|
|
PutPaddleBG PadOldX, PadOldY
|
|
DoBallExp
|
|
StartGame
|
|
EXIT FUNCTION
|
|
END IF
|
|
|
|
RETURN
|
|
|
|
'==============
|
|
CheckForPadHit:
|
|
|
|
IF POINT(X, Y) >= PadColorMin AND POINT(X, Y) <= PadColorMax THEN
|
|
SdHitPad = True
|
|
END IF
|
|
|
|
|
|
RETURN
|
|
|
|
'===============
|
|
CheckForPowerHit:
|
|
|
|
IF CheckPowerCaps(X, Y) THEN
|
|
|
|
IF Power THEN
|
|
PutPowerCapsBG
|
|
Power = False
|
|
PutPaddleBG PadOldX, PadOldY
|
|
SELECT CASE PowerType
|
|
CASE 1 'PadPower
|
|
IF NOT PadPower THEN
|
|
PadPower = True
|
|
GetPadLsrCoord 0
|
|
GetPadLsrBG PadLsrBG1(), PadLsrBG2()
|
|
SfxPowerUp
|
|
END IF
|
|
CASE 2 'Replicant
|
|
Replicant = True
|
|
SfxPowerUp
|
|
CASE 3 '1Up
|
|
Lives = Lives + 1
|
|
IF Lives > 100 THEN Lives = 100
|
|
PrintLives False
|
|
SfxPowerUp
|
|
CASE ELSE
|
|
END SELECT
|
|
END IF
|
|
END IF
|
|
|
|
RETURN
|
|
|
|
|
|
'=========================
|
|
Check4Bomb:
|
|
|
|
FOR I = 1 TO UBOUND(BombXY)
|
|
IF BombXY(I).X <> 0 THEN
|
|
|
|
IF Inside(X, Y, BombXY(I).X, BombXY(I).Y, BombXY(I).X + 16, BombXY(I).Y + 16) THEN
|
|
PUT (BombXY(I).X, BombXY(I).Y), BombBG(130 * (I - 1)), PSET
|
|
II = 1 + INT(RND * UBOUND(ExplodeIndex))
|
|
REDIM Temp(1)
|
|
GetBG BombXY(I).X, BombXY(I).Y, BombXY(I).X + 25, BombXY(I).Y + 25, Temp()
|
|
PUT (BombXY(I).X, BombXY(I).Y), Explodemsk(ExplodeIndex(II)), AND
|
|
PUT (BombXY(I).X, BombXY(I).Y), Explode(ExplodeIndex(II)), OR
|
|
FOR J = 0 TO 3
|
|
WAIT &H3DA, 8
|
|
WAIT &H3DA, 8, 8
|
|
SOUND 400 - (J * 50), .3
|
|
NEXT J
|
|
PUT (BombXY(I).X, BombXY(I).Y), Temp, PSET
|
|
BombXY(I).X = 0
|
|
BombXY(I).Y = 0
|
|
ERASE Temp
|
|
BombNum = BombNum - 1
|
|
BombDes = BombDes + 1
|
|
|
|
|
|
IF BombNum < 1 THEN
|
|
Perfect = True
|
|
GOSUB Endit
|
|
END IF
|
|
END IF
|
|
|
|
END IF
|
|
|
|
NEXT I
|
|
|
|
RETURN
|
|
|
|
'=-==========
|
|
|
|
Endit:
|
|
|
|
'=======================
|
|
|
|
DX = 47
|
|
DY = 10
|
|
MaxLen = 21
|
|
Tmin = PadColorMin
|
|
Sysmod = False
|
|
IF NOT Perfect THEN
|
|
Title$ = " Bonus"
|
|
Text$ = "2000 x = "
|
|
ELSE
|
|
Title$ = " Perfect!!!"
|
|
Text$ = "2000 x = "
|
|
Text$ = Text$ + "**Bonus +20,000**"
|
|
END IF
|
|
|
|
REDIM DBTemp(1) 'for DialogBox
|
|
REDIM BTemp(1) 'For num BG
|
|
|
|
GetBG DX, DY, DX + MaxLen * 8, DY + 37, DBTemp()
|
|
SOUND 500, 1
|
|
SOUND 1300, 2
|
|
DialogBox DX, DY, MaxLen, Tmin, Title$, Text$, False, Sysmod
|
|
GetBG DX + (13 * 8) - 3, DY + 13, (DX + (13 * 8)) + 8 * 7, DY + 13 + 8, BTemp()
|
|
KgenFont DX + 8 * 9, DY + 14, LTRIM$(STR$(BombDes)), KgenMin, False
|
|
|
|
VL& = BombDes * 2000&
|
|
|
|
Inc = 200
|
|
|
|
DO
|
|
|
|
KgenFont DX + 86 + (9 * 8) - (LEN(LTRIM$(STR$(VL&))) * 8), DY + 14, LTRIM$(STR$(VL&)), KgenBlueMin, False
|
|
IF RGBCounter(RGBC * 4) THEN RotateRGB
|
|
WAIT &H3DA, 8
|
|
WAIT &H3DA, 8, 8
|
|
SOUND 2500, .5
|
|
SOUND 3000, .2
|
|
VL& = VL& - Inc
|
|
Score& = Score& + Inc
|
|
LimitScore
|
|
PrintScore
|
|
|
|
WAIT &H3DA, 8
|
|
WAIT &H3DA, 8, 8
|
|
|
|
PUT (DX + (13 * 8) - 3, DY + 13), BTemp, PSET
|
|
IF VL& <= 0 THEN
|
|
IF Perfect THEN
|
|
VL& = VL& + 20000&
|
|
Perfect = False
|
|
KgenFont DX + 86 + (9 * 8) - (LEN(LTRIM$(STR$(VL&))) * 8), DY + 14, LTRIM$(STR$(VL&)), KgenBlueMin, False
|
|
SOUND 1500, 1
|
|
SOUND 3500, 1
|
|
FOR II = 1 TO 10
|
|
RotateRGB
|
|
MilliDelay 100
|
|
NEXT II
|
|
END IF
|
|
END IF
|
|
|
|
LOOP UNTIL VL& <= 0 AND NOT Perfect
|
|
|
|
|
|
PUT (DX, DY), DBTemp, PSET
|
|
|
|
'=======================
|
|
|
|
LevelDoneBox
|
|
Shooting = False
|
|
Lshot = False
|
|
Rshot = False
|
|
T1& = TIMER
|
|
DO
|
|
T2& = TIMER
|
|
KK$ = INKEY$
|
|
IF KK$ = CHR$(13) THEN EXIT DO
|
|
WAIT &H3DA, 8
|
|
WAIT &H3DA, 8, 8
|
|
IF RGBCounter(RGBC * 3) THEN
|
|
RotateRGB
|
|
END IF
|
|
|
|
LOOP UNTIL T2& - T1& > 7&
|
|
|
|
Finished = True
|
|
OutStart = True
|
|
|
|
RETURN
|
|
|
|
|
|
|
|
END FUNCTION
|
|
|
|
SUB DialogBox (X, Y, MaxLen, MinColor, Title$, Text$, Italic, Sysmod)
|
|
|
|
'========Draws an auto wrap text DialogBox
|
|
'=========Sample code=====================
|
|
'Note: to Indent first row, Pls use "~~~~" instead of Space
|
|
'DX = 22
|
|
'DY = 70
|
|
'MaxLen = 27
|
|
'Title$ = "SAVOT"
|
|
'Tmin = PadColorMin
|
|
'SysMod=True
|
|
'Text$ = "~~~~This would be your last stop! Ull die here 4 sure. I Savot will shave all of your hair! Mwa ha ha ha..."
|
|
'DialogBox DX, DY, MaxLen, Tmin, Title$, Text$, False,Sysmod
|
|
'=========End Sample=======================
|
|
|
|
DIM Row$(24) 'Maximum number of Rows
|
|
REDIM Dtemp(1) 'Array for background
|
|
|
|
P = 1
|
|
CurrentRow = 1
|
|
Leng = LEN(Text$)
|
|
|
|
WHILE P < Leng + 1
|
|
WHILE Char$ <> " " AND P < Leng + 1
|
|
Char$ = MID$(Text$, P, 1)
|
|
IF Char$ <> " " THEN
|
|
Word$ = Word$ + Char$
|
|
END IF
|
|
P = P + 1
|
|
WEND
|
|
|
|
IF LEN(Row$(CurrentRow)) + LEN(Word$) + 1 < MaxLen THEN
|
|
Row$(CurrentRow) = Row$(CurrentRow) + " " + Word$
|
|
ELSE
|
|
CurrentRow = CurrentRow + 1
|
|
Row$(CurrentRow) = Row$(CurrentRow) + " " + Word$
|
|
END IF
|
|
Word$ = ""
|
|
Char$ = ""
|
|
|
|
WEND
|
|
|
|
|
|
X1 = X + 5
|
|
Y1 = Y + 5
|
|
|
|
IF Title$ <> "" THEN
|
|
CurrentRow = CurrentRow + 1
|
|
PosStart = 2
|
|
Y1 = Y1 + 9
|
|
ELSE
|
|
PosStart = 1
|
|
END IF
|
|
|
|
|
|
'DrawTrnsBox
|
|
|
|
TX1 = X
|
|
TY1 = Y
|
|
IF Italic THEN
|
|
TX2 = (MaxLen * 8) + TX1 + 8
|
|
ELSE
|
|
TX2 = (MaxLen * 8) + TX1
|
|
END IF
|
|
|
|
TY2 = (CurrentRow * 9) + TY1 + 9
|
|
|
|
GetBG TX1, TY1, TX2, TY2, Dtemp()
|
|
|
|
TransLuc 170, TX1, TY1, TX2, TY2 '170 best
|
|
|
|
|
|
'Print it
|
|
'Title
|
|
IF PosStart > 1 THEN
|
|
Font$ = Title$
|
|
KgenFont X1 - 2, Y + 5, Font$, PadColorMin, Italic
|
|
KgenFont X1 - 1, Y + 4, Font$, KgenGreenMin, Italic
|
|
END IF
|
|
|
|
|
|
|
|
FOR I = 1 TO CurrentRow
|
|
IF I = 1 THEN
|
|
Font$ = LTRIM$(Row$(I))
|
|
IF LEFT$(Font$, 4) = "~~~~" THEN
|
|
Font$ = SPACE$(4) + RIGHT$(Font$, LEN(Font$) - 4)
|
|
END IF
|
|
ELSE
|
|
Font$ = LTRIM$(Row$(I))
|
|
END IF
|
|
KgenFont X1, Y1, Font$, MinColor, Italic
|
|
Y1 = Y1 + (9)
|
|
NEXT I
|
|
|
|
DO
|
|
IF RGBCounter(RGBC * 5) THEN RotateRGB
|
|
WAIT &H3DA, 8
|
|
K$ = INKEY$
|
|
LOOP UNTIL K$ = CHR$(13) OR K$ = CHR$(27) OR NOT Sysmod
|
|
|
|
SfxOpenDialog
|
|
|
|
IF Sysmod THEN
|
|
PUT (TX1, TY1), Dtemp, PSET
|
|
ELSE
|
|
|
|
END IF
|
|
|
|
RefreshKey
|
|
|
|
ERASE Row$, Dtemp
|
|
|
|
END SUB
|
|
|
|
SUB DoBallExp STATIC
|
|
|
|
|
|
Lives = Lives - 1
|
|
|
|
GetPaddleBG PadX, PadY
|
|
|
|
PutPaddle PadX, PadY
|
|
|
|
REDIM ExpTemp(1)
|
|
|
|
FOR J = 1 TO 2
|
|
|
|
GetBG BallX - 5, BallY - 5, (BallX - 5) + 19, (BallY - 5) + 19, ExpTemp()
|
|
SD = 110
|
|
FOR I = 1 TO UBOUND(BallExpIndex)
|
|
SD = SD * (2 + (INT(RND * 3)))
|
|
PUT (BallX - 5, BallY - 5), BallExpmsk(BallExpIndex(I)), AND
|
|
PUT (BallX - 5, BallY - 5), BallExp(BallExpIndex(I)), OR
|
|
|
|
WAIT &H3DA, 8
|
|
MilliDelay 50
|
|
|
|
SOUND SD, .5
|
|
|
|
NEXT I
|
|
|
|
PUT (BallX - 5, BallY - 5), ExpTemp, PSET
|
|
|
|
NEXT J
|
|
|
|
|
|
IF PadPower THEN
|
|
PutPadLsrBG PadLsrBG1(), PadLsrBG2()
|
|
PadPower = False
|
|
END IF
|
|
IF Replicant THEN
|
|
Replicant = False
|
|
END IF
|
|
|
|
|
|
PutPaddleBG PadOldX, PadOldY
|
|
|
|
IF PadPower THEN
|
|
PutPadLsrBG PadLsrBG1(), PadLsrBG2()
|
|
END IF
|
|
|
|
IF Power THEN
|
|
PutPowerCapsBG
|
|
END IF
|
|
|
|
|
|
END SUB
|
|
|
|
SUB DoBlkHole STATIC
|
|
|
|
FOR I = 1 TO 4
|
|
IF BlkHoleXY(I).X <> 0 THEN
|
|
PutBlkHole BlkHoleXY(I).X, BlkHoleXY(I).Y
|
|
END IF
|
|
NEXT I
|
|
|
|
END SUB
|
|
|
|
SUB DoBomb STATIC
|
|
|
|
|
|
FOR I = 1 TO UBOUND(BombXY)
|
|
IF BombXY(I).X <> 0 THEN
|
|
GET (BombXY(I).X, BombXY(I).Y)-STEP(15, 15), BombBG(130 * (I - 1))
|
|
END IF
|
|
NEXT I
|
|
|
|
SW = NOT SW
|
|
IF SW THEN
|
|
Switch = 1
|
|
ELSE
|
|
Switch = 2
|
|
END IF
|
|
|
|
FOR I = 1 TO UBOUND(BombXY)
|
|
IF BombXY(I).X <> 0 THEN
|
|
PutBomb BombXY(I).X, BombXY(I).Y, Switch
|
|
END IF
|
|
NEXT I
|
|
|
|
END SUB
|
|
|
|
SUB DoCredits
|
|
|
|
|
|
Fade 0, 0, 0
|
|
LINE (0, 0)-(319, 199), 0, BF
|
|
|
|
VS = 4
|
|
VE = 23
|
|
VIEW PRINT VS TO VE
|
|
RESTORE Credits
|
|
|
|
X = 320
|
|
Y = 0
|
|
Xscale = 1
|
|
Yscale = 1
|
|
Font$ = "-Shameless Self-Promotion-"
|
|
Italic = False
|
|
KgenTTFont 159 - (4 * Xscale * LEN(Font$)), Y - 1, Font$, PadColorMin, Xscale, Yscale, Italic
|
|
KgenTTFont X, Y, Font$, KgenGreenMin, Xscale, Yscale, Italic
|
|
|
|
|
|
Text$ = "Pls. visit these sites.... 1.[WWW.QB45.com] 2.[GBGames.com] "
|
|
Text$ = Text$ + "3.[WWW.Hulla-Balloo.Com/Members/Vplanet/Index.Shtml] 4.[NeoZones.teksCode.com] "
|
|
Text$ = Text$ + "4.[WWW.ChainMailSales.com/Virtuasoft/] 5.[WWW.BasicGuru.com/abc] "
|
|
Text$ = Text$ + "6.[Members.Aol.Com/RadioHands/Index.Html 7.[www.geocities.com/TimesSquare/Ring/1683/Index.Html/ "
|
|
Xscale = 2
|
|
Yscale = 1
|
|
TopY = 199 - ((Yscale) * 9)
|
|
MinColor = KgenBlueMin
|
|
Shadow = True
|
|
OverTop = True
|
|
OtY = 10
|
|
Italic = True
|
|
FirstTime = True
|
|
|
|
RestoreColors
|
|
|
|
DO
|
|
|
|
K$ = INKEY$
|
|
ScrollKgenTT TopY, Text$, Xscale, Yscale, MinColor, Shadow, OverTop, OtY, Italic, FirstTime
|
|
|
|
IF RGBCounter(RGBC * 5) THEN RotateRGB
|
|
|
|
KC = KC MOD 188 + 1
|
|
IF KC = 1 THEN
|
|
READ T$
|
|
IF UCASE$(T$) = "END" THEN
|
|
EXIT DO
|
|
END IF
|
|
|
|
LOCATE VE, 1
|
|
PRINT
|
|
FC = FC MOD 3 + 1
|
|
IF FC = 1 THEN
|
|
KgenFont 0, 176, T$, KgenGreenMin, False
|
|
ELSE
|
|
KgenFont 0, 176, T$, PadColorMin, True
|
|
END IF
|
|
END IF
|
|
|
|
LOOP UNTIL K$ = CHR$(13)
|
|
|
|
|
|
OutStart = True
|
|
Finished = True
|
|
Level = Level - 1
|
|
|
|
|
|
|
|
END SUB
|
|
|
|
SUB DoEnding STATIC
|
|
|
|
REDIM Font(1)
|
|
LINE (0, 0)-(319, 199), 0, BF
|
|
RestoreColors
|
|
|
|
Txt$ = "Congratulations!!! You have beaten the game! "
|
|
Txt$ = Txt$ + "My hats off to you. Relsoft 2000. "
|
|
Xscale = 1
|
|
Yscale = 3
|
|
TopY = 199 - ((Yscale) * 9)
|
|
MinColor = KgenBlueMin
|
|
Shadow = True
|
|
OverTop = False
|
|
OtY = 0
|
|
Italic = True
|
|
FirstTime = True
|
|
|
|
X = 0
|
|
RESTORE Ending
|
|
EndRead = False
|
|
|
|
DO
|
|
IF NOT EndRead THEN
|
|
READ Y
|
|
READ Text$
|
|
READ Clr
|
|
ELSE
|
|
ScrollKgenTT TopY, Txt$, Xscale, Yscale, MinColor, Shadow, OverTop, OtY, Italic, FirstTime
|
|
IF RGBCounter(RGBC * 5) THEN RotateRGB
|
|
END IF
|
|
IF UCASE$(Text$) = "END" THEN
|
|
EndRead = True
|
|
ELSE
|
|
GOSUB MoveIt
|
|
END IF
|
|
LOOP UNTIL INKEY$ <> ""
|
|
|
|
HazyFx
|
|
Fade 0, 0, 0
|
|
LINE (0, 0)-(319, 199), 0, BF
|
|
|
|
EXIT SUB
|
|
|
|
MoveIt:
|
|
|
|
FOR I = 1 TO LEN(Text$)
|
|
|
|
Font$ = MID$(Text$, (LEN(Text$) + 1) - I, 1)
|
|
|
|
IF Font$ <> " " THEN
|
|
KgenFont X, Y, Font$, Clr, False
|
|
Center = (160 + (LEN(Text$) * 9) \ 2) - (9 * I)
|
|
GetBG 0, Y, 9, Y + 9, Font()
|
|
FOR J = 0 TO Center
|
|
PUT (J, Y), Font, PSET
|
|
Scount = Scount MOD 16 + 1
|
|
IF Scount = 1 THEN
|
|
ScrollKgenTT TopY, Txt$, Xscale, Yscale, MinColor, Shadow, OverTop, OtY, Italic, FirstTime
|
|
IF RGBCounter(RGBC * 5) THEN RotateRGB
|
|
END IF
|
|
K$ = INKEY$
|
|
IF K$ = CHR$(13) THEN
|
|
HazyFx
|
|
Fade 0, 0, 0
|
|
LINE (0, 0)-(319, 199), 0, BF
|
|
EXIT SUB
|
|
END IF
|
|
NEXT J
|
|
END IF
|
|
|
|
NEXT I
|
|
|
|
|
|
RETURN
|
|
|
|
|
|
|
|
|
|
END SUB
|
|
|
|
SUB DoExplode STATIC
|
|
|
|
|
|
Xmax = (Boss(0) \ 8 - 1) - 25
|
|
Ymax = (Boss(1) - 1) - 25
|
|
I = I MOD UBOUND(ExplodeIndex) + 1
|
|
|
|
X = BossX + INT(RND * Xmax)
|
|
Y = BossY + INT(RND * Ymax)
|
|
X1 = BossX + INT(RND * Xmax)
|
|
Y1 = BossY + INT(RND * Ymax)
|
|
X2 = BossX + INT(RND * Xmax)
|
|
Y2 = BossY + INT(RND * Ymax)
|
|
X3 = BossX + INT(RND * Xmax)
|
|
Y3 = BossY + INT(RND * Ymax)
|
|
|
|
|
|
PUT (X, Y), Explodemsk(ExplodeIndex(I)), AND
|
|
PUT (X, Y), Explode(ExplodeIndex(I)), OR
|
|
PUT (X1, Y1), Explodemsk(ExplodeIndex(I)), AND
|
|
PUT (X1, Y1), Explode(ExplodeIndex(I)), OR
|
|
PUT (X2, Y2), Explodemsk(ExplodeIndex(I)), AND
|
|
PUT (X2, Y2), Explode(ExplodeIndex(I)), OR
|
|
PUT (X3, Y3), Explodemsk(ExplodeIndex(I)), AND
|
|
PUT (X3, Y3), Explode(ExplodeIndex(I)), OR
|
|
|
|
WAIT &H3DA, 8
|
|
WAIT &H3DA, 8, 8
|
|
MilliDelay 100
|
|
|
|
PUT (BossX, BossY), BossBG, PSET
|
|
PUT (BossX, BossY), BossMask, AND
|
|
PUT (BossX, BossY), Boss, OR
|
|
|
|
RotateRGB
|
|
|
|
|
|
|
|
END SUB
|
|
|
|
SUB DoGameOver STATIC
|
|
|
|
LINE (0, 0)-(320, 199), 0, BF
|
|
HideBuild
|
|
|
|
|
|
X = 320
|
|
Y = 80
|
|
Xscale = 3
|
|
Yscale = 4
|
|
Font$ = "Game Over!"
|
|
Italic = False
|
|
KgenTTFont 159 - (4 * Xscale * LEN(Font$)), Y - 1, Font$, KgenMin, Xscale, Yscale, Italic
|
|
KgenTTFont X, Y, Font$, KgenGreenMin, Xscale, Yscale, Italic
|
|
|
|
X = 320
|
|
Y = 60
|
|
Font$ = "Press [ESC] while playing 4 the MENU."
|
|
Italic = False
|
|
KgenFont X, Y, Font$, KgenMin, Italic
|
|
|
|
X = 320
|
|
Y = 130
|
|
Font$ = "vic_viperph@yahoo.com"
|
|
Italic = False
|
|
KgenFont X, Y, Font$, KgenMin, Italic
|
|
|
|
X = 320
|
|
Y = 120
|
|
Font$ = "Info on Level Designer is in Readme.Txt"
|
|
Italic = False
|
|
KgenFont X, Y, Font$, KgenMin, Italic
|
|
|
|
|
|
|
|
Text$ = " You lost!!! Pls. try again.... Go for the Record!!! You may become the first Hall Of Famer!!! "
|
|
Xscale = 3
|
|
Yscale = 5
|
|
TopY = 199 - ((Yscale) * 9)
|
|
MinColor = KgenBlueMin
|
|
Shadow = True
|
|
OverTop = True
|
|
OtY = 0
|
|
Italic = True
|
|
FirstTime = True
|
|
|
|
RestoreColors
|
|
|
|
DO
|
|
K$ = INKEY$
|
|
ScrollKgenTT TopY, Text$, Xscale, Yscale, MinColor, Shadow, OverTop, OtY, Italic, FirstTime
|
|
IF RGBCounter(RGBC * 5) THEN RotateRGB
|
|
LOOP UNTIL K$ = CHR$(13) OR K$ = CHR$(27)
|
|
|
|
|
|
|
|
END SUB
|
|
|
|
SUB DoHallOfFame STATIC
|
|
|
|
DX = 32
|
|
DY = 50
|
|
MaxLen = 25
|
|
Title$ = "Power Players: Score:"
|
|
Tmin = PadColorMin
|
|
Sysmod = True
|
|
|
|
Rnk$ = LTRIM$(STR$(Hall(1).Rank))
|
|
Nm$ = "." + LTRIM$(RTRIM$(Hall(1).Namer))
|
|
IF LEN(Nm$) < 12 THEN
|
|
Nm$ = Nm$ + SPACE$(13 - LEN(Nm$))
|
|
END IF
|
|
Nm$ = Nm$ + ":"
|
|
Scr$ = LTRIM$(STR$(Hall(1).Score))
|
|
Text$ = Rnk$ + Nm$ + STRING$(8 - (LEN(Scr$)), "-") + Scr$
|
|
|
|
FOR I = 2 TO 5
|
|
Rnk$ = " " + LTRIM$(STR$(Hall(I).Rank))
|
|
Nm$ = "." + LTRIM$(RTRIM$(Hall(I).Namer))
|
|
IF LEN(Nm$) < 12 THEN
|
|
Nm$ = Nm$ + SPACE$(13 - LEN(Nm$))
|
|
END IF
|
|
Nm$ = Nm$ + ":"
|
|
Scr$ = LTRIM$(STR$(Hall(I).Score))
|
|
Text$ = Text$ + Rnk$ + Nm$ + STRING$(8 - (LEN(Scr$)), "-") + Scr$
|
|
NEXT I
|
|
|
|
|
|
DialogBox DX, DY, MaxLen, Tmin, Title$, Text$, False, Sysmod
|
|
|
|
END SUB
|
|
|
|
SUB DoIntro STATIC
|
|
|
|
LoadTitle
|
|
|
|
|
|
DoStory
|
|
|
|
END SUB
|
|
|
|
SUB DoLangaw (Stat) STATIC
|
|
|
|
'"Langaw" means Fly as in the insect in our country.
|
|
|
|
PUT (LangawOldCoord(0).X, LangawOldCoord(0).Y), LangawBG1, PSET
|
|
PUT (LangawOldCoord(1).X, LangawOldCoord(1).Y), LangawBG2, PSET
|
|
|
|
IF NOT Stat THEN
|
|
J = J MOD 10 + 1
|
|
|
|
FOR I = 0 TO 1
|
|
IF J = 1 THEN
|
|
LXR! = RND * 5
|
|
LYR! = RND * 5
|
|
END IF
|
|
|
|
IF LXR! < 2.5 THEN
|
|
LX = -2
|
|
ELSE
|
|
LX = 2
|
|
END IF
|
|
|
|
IF LYR! < 2.5 THEN
|
|
LY = -2
|
|
ELSE
|
|
LY = 2
|
|
END IF
|
|
IF I = 1 THEN
|
|
LX = -LX
|
|
LY = -LY
|
|
END IF
|
|
LangawCoord(I).X = LangawCoord(I).X + LX
|
|
IF LangawCoord(I).X > 230 THEN
|
|
LangawCoord(I).X = 230
|
|
ELSEIF LangawCoord(I).X < 10 THEN
|
|
LangawCoord(I).X = 10
|
|
END IF
|
|
|
|
LangawCoord(I).Y = LangawCoord(I).Y + LY
|
|
IF LangawCoord(I).Y > 140 THEN
|
|
LangawCoord(I).Y = 140
|
|
ELSEIF LangawCoord(I).Y < 50 THEN
|
|
LangawCoord(I).Y = 50
|
|
END IF
|
|
|
|
LangawOldCoord(I).X = LangawCoord(I).X
|
|
LangawOldCoord(I).Y = LangawCoord(I).Y
|
|
NEXT I
|
|
|
|
END IF
|
|
|
|
GetBG LangawOldCoord(0).X, LangawOldCoord(0).Y, LangawOldCoord(0).X + 16, LangawOldCoord(0).Y + 16, LangawBG1()
|
|
GetBG LangawOldCoord(1).X, LangawOldCoord(1).Y, LangawOldCoord(1).X + 16, LangawOldCoord(1).Y + 16, LangawBG2()
|
|
|
|
Axn = Axn MOD 2 + 1
|
|
PutLangaw LangawCoord(0).X, LangawCoord(0).Y, Axn
|
|
PutLangaw LangawCoord(1).X, LangawCoord(1).Y, Axn
|
|
|
|
END SUB
|
|
|
|
SUB DoLogos STATIC
|
|
|
|
SaveColors
|
|
HideBuild
|
|
|
|
X = 320
|
|
Y = 20
|
|
Xscale = 4
|
|
Yscale = 2
|
|
Font$ = "RelSoft"
|
|
Italic = False
|
|
KgenTTFont X, Y, Font$, 24, Xscale, Yscale, Italic
|
|
|
|
|
|
X = 320
|
|
Y = 77
|
|
Xscale = 2
|
|
Yscale = 1
|
|
Font$ = "and"
|
|
Italic = False
|
|
KgenTTFont X, Y, Font$, 80, Xscale, Yscale, Italic
|
|
|
|
|
|
X = 52
|
|
Y = 120
|
|
Xscale = 3
|
|
Yscale = 4
|
|
Font$ = "AnyaTech"
|
|
Italic = True
|
|
KgenTTFont 50, 118, Font$, 24, Xscale, Yscale, Italic
|
|
KgenTTFont X, Y, Font$, 59, Xscale, Yscale, Italic
|
|
|
|
|
|
RestoreColors
|
|
T& = TIMER
|
|
DO
|
|
T2& = TIMER
|
|
LOOP UNTIL T2& - T& > 2
|
|
Fade 0, 0, 0
|
|
|
|
LINE (0, 0)-(320, 199), 0, BF
|
|
|
|
|
|
X = 320
|
|
Y = 50
|
|
Xscale = 1
|
|
Yscale = 2
|
|
Font$ = "Proudly"
|
|
Italic = False
|
|
KgenTTFont X, Y, Font$, 24, Xscale, Yscale, Italic
|
|
|
|
X = 320
|
|
Y = 100
|
|
Xscale = 3
|
|
Yscale = 1
|
|
Font$ = "Presents"
|
|
Italic = False
|
|
KgenTTFont X, Y, Font$, 24, Xscale, Yscale, Italic
|
|
|
|
|
|
RestoreColors
|
|
T& = TIMER
|
|
DO
|
|
T2& = TIMER
|
|
LOOP UNTIL T2& - T& > 1
|
|
|
|
Fade 0, 0, 0
|
|
|
|
LINE (0, 0)-(320, 199), 0, BF
|
|
|
|
RestoreColors
|
|
|
|
|
|
END SUB
|
|
|
|
SUB DoPadLsr STATIC
|
|
|
|
LsrSpeed = 2
|
|
|
|
|
|
IF AutoFire THEN
|
|
Lshot = True
|
|
Rshot = True
|
|
END IF
|
|
|
|
IF Lshot THEN
|
|
PadLsrCoord(0).Y = PadLsrCoord(0).Y - LsrSpeed
|
|
ELSE
|
|
GetPadLsrCoord 1
|
|
END IF
|
|
IF Rshot THEN
|
|
PadLsrCoord(1).Y = PadLsrCoord(1).Y - LsrSpeed
|
|
ELSE
|
|
GetPadLsrCoord 2
|
|
END IF
|
|
|
|
|
|
GetPadLsrBG PadLsrBG1(), PadLsrBG2()
|
|
|
|
PutPadLsr PadLsrCoord(0).X, PadLsrCoord(0).Y
|
|
PutPadLsr PadLsrCoord(1).X, PadLsrCoord(1).Y
|
|
|
|
I = 1
|
|
X = PadLsrCoord(0).X + 2
|
|
Y = PadLsrCoord(0).Y - 3
|
|
GOSUB CheckForHit
|
|
I = 2
|
|
X = PadLsrCoord(1).X + 2
|
|
Y = PadLsrCoord(1).Y - 3
|
|
GOSUB CheckForHit
|
|
|
|
|
|
EXIT SUB
|
|
''=========
|
|
CheckForHit:
|
|
|
|
IF POINT(X, Y) < 129 THEN
|
|
SELECT CASE I
|
|
CASE 1
|
|
Lshot = False
|
|
GetPadLsrCoord 1
|
|
CASE 2
|
|
Rshot = False
|
|
GetPadLsrCoord 2
|
|
CASE ELSE
|
|
END SELECT
|
|
|
|
GetBallBG BallX, BallY
|
|
GetPaddleBG PadX, PadY
|
|
|
|
|
|
PutBall BallX, BallY
|
|
PutPaddle PadX, PadY
|
|
|
|
CheckTile X, Y
|
|
|
|
PutPaddleBG PadOldX, PadOldY
|
|
PutBallBG BallOldX, BallOldY
|
|
|
|
IF NOT Lshot AND NOT Rshot THEN
|
|
Shooting = False
|
|
END IF
|
|
|
|
END IF
|
|
|
|
|
|
RETURN
|
|
|
|
|
|
END SUB
|
|
|
|
SUB DoPowerCaps (PowType) STATIC
|
|
|
|
PowSpeed = 1
|
|
|
|
|
|
PowerCapsCoord(0).Y = PowerCapsCoord(0).Y + PowSpeed
|
|
|
|
GetPowerCapsBG
|
|
|
|
PutPowerCaps PowerCapsCoord(0).X, PowerCapsCoord(0).Y, PowType
|
|
|
|
|
|
|
|
|
|
|
|
|
|
X = PowerCapsCoord(0).X + 9
|
|
Y = PowerCapsCoord(0).Y + 13
|
|
GOSUB Check4Hit
|
|
|
|
X = PowerCapsCoord(0).X
|
|
Y = PowerCapsCoord(0).Y + 13
|
|
GOSUB Check4Hit
|
|
|
|
X = PowerCapsCoord(0).X + 9
|
|
Y = PowerCapsCoord(0).Y + 13
|
|
GOSUB Check4Hit
|
|
|
|
|
|
|
|
|
|
|
|
|
|
EXIT SUB
|
|
''=========
|
|
Check4Hit:
|
|
|
|
|
|
|
|
IF POINT(X, Y) < 129 THEN
|
|
|
|
'Spike
|
|
IF POINT(X, Y) >= SpikeMin AND POINT(X, Y) <= SpikeMax THEN
|
|
|
|
PutPowerCapsBG
|
|
Power = False
|
|
|
|
END IF
|
|
|
|
'Border
|
|
IF POINT(X, Y) >= BorderMin AND POINT(X, Y) <= Bordermax THEN
|
|
|
|
PutPowerCapsBG
|
|
Power = False
|
|
|
|
END IF
|
|
|
|
|
|
END IF
|
|
|
|
|
|
'Check for Paddle
|
|
|
|
IF Replicant THEN
|
|
PadXXStep = 72
|
|
ELSE
|
|
PadXXStep = 38
|
|
END IF
|
|
|
|
IF Inside(X, Y, PadX - 5, PadY, PadX + PadXXStep, PadY + 8) THEN
|
|
|
|
IF Power THEN
|
|
PutPowerCapsBG
|
|
Power = False
|
|
|
|
SELECT CASE PowerType
|
|
CASE 1 'PadPower
|
|
IF NOT PadPower THEN
|
|
PadPower = True
|
|
GetPadLsrCoord 0
|
|
GetPadLsrBG PadLsrBG1(), PadLsrBG2()
|
|
SfxPowerUp
|
|
END IF
|
|
CASE 2 'Replicant
|
|
Replicant = True
|
|
SfxPowerUp
|
|
CASE 3 '1Up
|
|
Lives = Lives + 1
|
|
IF Lives > 100 THEN Lives = 100
|
|
PrintLives False
|
|
SfxPowerUp
|
|
CASE ELSE
|
|
END SELECT
|
|
END IF
|
|
|
|
END IF
|
|
|
|
|
|
RETURN
|
|
|
|
|
|
END SUB
|
|
|
|
SUB DoStory STATIC
|
|
|
|
|
|
VS = 4
|
|
VE = 23
|
|
VIEW PRINT VS TO VE
|
|
RESTORE Story
|
|
|
|
X = 320
|
|
Y = 0
|
|
Xscale = 1
|
|
Yscale = 2
|
|
Font$ = "-ARQANOID... the untold story-"
|
|
Italic = False
|
|
KgenTTFont 159 - (4 * Xscale * LEN(Font$)), Y - 1, Font$, PadColorMin, Xscale, Yscale, Italic
|
|
KgenTTFont X, Y, Font$, KgenGreenMin, Xscale, Yscale, Italic
|
|
|
|
|
|
Text$ = " This story has been passed from generation to generation... Damn! I really suck at storytelling. (Actually, I made the game before the story... hehehehehe. Note: I intentionally mispelled some words. ie game titles. FYI, BALOT is a"
|
|
Text$ = Text$ + " native delicacy in our country made from duck eggs."
|
|
Xscale = 2
|
|
Yscale = 1
|
|
TopY = 199 - ((Yscale) * 9)
|
|
MinColor = KgenBlueMin
|
|
Shadow = True
|
|
OverTop = False
|
|
OtY = 10
|
|
Italic = False
|
|
FirstTime = True
|
|
|
|
RestoreColors
|
|
|
|
DO
|
|
|
|
K$ = INKEY$
|
|
ScrollKgenTT TopY, Text$, Xscale, Yscale, MinColor, Shadow, OverTop, OtY, Italic, FirstTime
|
|
|
|
IF RGBCounter(RGBC * 5) THEN RotateRGB
|
|
|
|
KC = KC MOD 288 + 1
|
|
IF KC = 1 THEN
|
|
READ T$
|
|
IF UCASE$(T$) = "END" THEN
|
|
EXIT DO
|
|
END IF
|
|
|
|
LOCATE VE, 1
|
|
PRINT
|
|
KgenFont 0, 176, T$, PadColorMin, False
|
|
END IF
|
|
|
|
LOOP UNTIL K$ = CHR$(13)
|
|
|
|
HazyFx
|
|
Fade 0, 0, 0
|
|
LINE (0, 0)-(319, 199), 0, BF
|
|
|
|
END SUB
|
|
|
|
FUNCTION DoTimer (MaxTime) STATIC
|
|
|
|
IF BombNum = MaxBomb THEN
|
|
SecondTime = False
|
|
MaxBomb = MaxBomb + 1
|
|
END IF
|
|
|
|
IF NOT SecondTime THEN
|
|
TT = 0
|
|
T = 0
|
|
END IF
|
|
|
|
SecondTime = True
|
|
|
|
T& = TIMER
|
|
DoTimer = False
|
|
IF T& > OldTime& THEN
|
|
GOSUB PrintTime
|
|
END IF
|
|
|
|
EXIT FUNCTION
|
|
|
|
'==========================
|
|
PrintTime:
|
|
T = T MOD MaxTime + 1
|
|
TT = MaxTime - T
|
|
|
|
X = 289
|
|
Y = 125
|
|
Font$ = STR$(TT)
|
|
Italic = False
|
|
LINE (X + 8, Y)-STEP(24, 9), 0, BF
|
|
KgenFont X - 1, Y + 1, Font$, KgenMin, Italic
|
|
|
|
IF TT = 0 THEN
|
|
DoTimer = True
|
|
SfxOpenDialog
|
|
SecondTime = False
|
|
END IF
|
|
|
|
OldTime& = TIMER
|
|
|
|
RETURN
|
|
|
|
|
|
|
|
END FUNCTION
|
|
|
|
SUB DrawBorder STATIC
|
|
|
|
FOR I = 0 TO 6
|
|
LINE (I, I)-(260 - I, 200 - I), BorderMin + I, B
|
|
NEXT I
|
|
|
|
|
|
END SUB
|
|
|
|
SUB DrawBoss (BossX, BossY, BossFile$) STATIC
|
|
|
|
BossFileSpr$ = Path$ + "Images\" + BossFile$ + ".QBN"
|
|
BossFileMsk$ = Path$ + "Images\" + BossFile$ + ".Msk"
|
|
|
|
OPEN BossFileSpr$ FOR INPUT AS #1
|
|
|
|
INPUT #1, ArrSize
|
|
|
|
REDIM Boss(ArrSize)
|
|
REDIM BossMask(ArrSize)
|
|
|
|
|
|
FOR I = 0 TO ArrSize
|
|
|
|
INPUT #1, Boss(I)
|
|
|
|
|
|
NEXT I
|
|
|
|
|
|
CLOSE
|
|
|
|
OPEN BossFileMsk$ FOR INPUT AS #1
|
|
INPUT #1, ArrSize
|
|
|
|
FOR I = 0 TO ArrSize
|
|
|
|
INPUT #1, BossMask(I)
|
|
|
|
|
|
NEXT I
|
|
|
|
CLOSE
|
|
|
|
REDIM BossBG(ArrSize)
|
|
|
|
GET (BossX, BossY)-STEP(Boss(0) \ 8 - 1, Boss(1) - 1), BossBG
|
|
|
|
PUT (BossX, BossY), BossMask, AND
|
|
PUT (BossX, BossY), Boss, OR
|
|
|
|
|
|
END SUB
|
|
|
|
SUB DrawFonts STATIC
|
|
|
|
X = 268
|
|
Y = 2
|
|
Txt$ = "i Score:"
|
|
PrintFonts X, Y, Txt$
|
|
X = 265
|
|
Y = 0
|
|
Font$ = "H"
|
|
Italic = False
|
|
KgenFont X - 1, Y + 1, Font$, KgenBlueMin, Italic
|
|
KgenFont X, Y, Font$, KgenMin, Italic
|
|
|
|
|
|
IF Score& < 100000 THEN
|
|
X = 280
|
|
Y = 12
|
|
PrintNum X, Y, "100,000"
|
|
ELSE
|
|
PrintScore
|
|
END IF
|
|
|
|
|
|
|
|
|
|
X = 268
|
|
Y = 27
|
|
Txt$ = "core:"
|
|
PrintFonts X, Y, Txt$
|
|
X = 265
|
|
Y = 25
|
|
Font$ = "S"
|
|
Italic = False
|
|
KgenFont X - 1, Y + 1, Font$, KgenBlueMin, Italic
|
|
KgenFont X, Y, Font$, KgenMin, Italic
|
|
|
|
|
|
'SCORE
|
|
Temp$ = LTRIM$(Format$(Score&))
|
|
PrintNum 315 - (LEN(Temp$) * 5), 35, Temp$
|
|
|
|
|
|
X = 268
|
|
Y = 52
|
|
Txt$ = "evel:"
|
|
PrintFonts X, Y, Txt$
|
|
X = 265
|
|
Y = 50
|
|
Font$ = "L"
|
|
Italic = False
|
|
KgenFont X - 1, Y + 1, Font$, KgenBlueMin, Italic
|
|
KgenFont X, Y, Font$, KgenMin, Italic
|
|
|
|
|
|
X = 268
|
|
Y = 67
|
|
Txt$ = "ives:"
|
|
PrintFonts X, Y, Txt$
|
|
|
|
X = 265
|
|
Y = 65
|
|
Font$ = "L"
|
|
Italic = False
|
|
KgenFont X - 1, Y + 1, Font$, KgenBlueMin, Italic
|
|
KgenFont X, Y, Font$, KgenMin, Italic
|
|
|
|
|
|
X = 268
|
|
Y = 127
|
|
Txt$ = "ime:"
|
|
PrintFonts X, Y, Txt$
|
|
|
|
X = 265
|
|
Y = 125
|
|
Font$ = "T"
|
|
Italic = False
|
|
KgenFont X - 1, Y + 1, Font$, KgenBlueMin, Italic
|
|
KgenFont X, Y, Font$, KgenMin, Italic
|
|
|
|
X = 289
|
|
Y = 125
|
|
Font$ = STR$(60)
|
|
Italic = False
|
|
KgenFont X - 1, Y + 1, Font$, KgenMin, Italic
|
|
|
|
|
|
|
|
X = 268
|
|
Y = 155
|
|
Txt$ = "mail:"
|
|
PrintFonts X, Y, Txt$
|
|
|
|
X = 265
|
|
Y = 153
|
|
Font$ = "E"
|
|
Italic = False
|
|
KgenFont X - 1, Y + 1, Font$, KgenBlueMin, Italic
|
|
KgenFont X, Y, Font$, KgenMin, Italic
|
|
|
|
X = 261
|
|
Y = 167
|
|
Txt$ = "vic viperph"
|
|
PrintFonts X, Y, Txt$
|
|
|
|
LINE (281, 171)-STEP(3, 0), FcolorMax, BF
|
|
|
|
X = 261
|
|
Y = 174
|
|
Txt$ = "@Yahoo.Com"
|
|
PrintFonts X, Y, Txt$
|
|
|
|
|
|
|
|
X = 261
|
|
Y = 183
|
|
Font$ = "RelSoft"
|
|
Italic = True
|
|
KgenFont X - 1, Y - 1, Font$, KgenGreenMin, Italic
|
|
KgenFont X, Y, Font$, KgenBlueMin, Italic
|
|
|
|
X = 271
|
|
Y = 193
|
|
Font$ = "2001"
|
|
Italic = True
|
|
KgenFont X - 1, Y - 1, Font$, KgenGreenMin, Italic
|
|
KgenFont X, Y, Font$, KgenBlueMin, Italic
|
|
|
|
|
|
|
|
|
|
|
|
END SUB
|
|
|
|
SUB DrawLevelBG (BGMode, ColorStep, ColorAttr) STATIC
|
|
|
|
LINE (0, 0)-(319, 199), 255, BF 'Bug Fix
|
|
|
|
Clr = 145
|
|
|
|
FOR Y = 0 TO 199 STEP 5
|
|
FOR X = 0 TO 320 STEP 5
|
|
|
|
IF CC = 0 THEN
|
|
Clr = Clr + ColorStep
|
|
ELSE
|
|
Clr = Clr - ColorStep
|
|
END IF
|
|
IF BGMode = 1 THEN
|
|
LINE (X, Y)-(X + 4, Y + 4), Clr, BF
|
|
LINE (X + 1, Y + 1)-(X + 3, Y + 3), Clr + 5, BF
|
|
LINE (X + 1, Y + 1)-(X + 1, Y + 1), Clr + 11, BF
|
|
ELSE
|
|
LINE (X, Y)-(X + 4, Y + 4), Clr, B
|
|
LINE (X + 1, Y + 1)-(X + 3, Y + 3), Clr + 5, B
|
|
LINE (X + 1, Y + 1)-(X + 1, Y + 1), Clr + 11, B
|
|
END IF
|
|
IF Clr >= 180 THEN CC = 1
|
|
IF Clr <= 150 THEN CC = 0
|
|
NEXT X
|
|
NEXT Y
|
|
|
|
'Erase RightSide for Info,Scores,Etc.
|
|
|
|
LINE (MaxX, MinY)-(320, 200), 255, BF
|
|
LINE (0, 200)-(320, 200), 255, BF
|
|
|
|
|
|
|
|
GetBG 7, 183, 253, 193, SpikeBG()
|
|
|
|
'Draw Spikes
|
|
|
|
FOR X = 5 TO 250 STEP 10
|
|
DrawSpike X, 205
|
|
NEXT X
|
|
|
|
DrawBorder
|
|
DrawFonts
|
|
|
|
|
|
END SUB
|
|
|
|
SUB DrawSpike (X, Y) STATIC
|
|
|
|
FOR I = 1 TO 5
|
|
LINE (X + I, Y)-STEP(0, -(I * 4.5)), SpikeMax - I
|
|
LINE ((X + 10) - I, Y)-STEP(0, -(I * 4.5)), SpikeMax - I
|
|
NEXT I
|
|
|
|
|
|
END SUB
|
|
|
|
SUB DrawTile (X, Y, Clr)
|
|
|
|
SELECT CASE Clr
|
|
CASE 1
|
|
TB = 60
|
|
TC = 61
|
|
TM = 62
|
|
CASE 2
|
|
TB = 63
|
|
TC = 64
|
|
TM = 65
|
|
CASE 3
|
|
TB = 66
|
|
TC = 67
|
|
TM = 68
|
|
CASE 4
|
|
TB = 69
|
|
TC = 70
|
|
TM = 71
|
|
CASE 5
|
|
TB = 72
|
|
TC = 73
|
|
TM = 74
|
|
CASE 6
|
|
TB = 75
|
|
TC = 76
|
|
TM = 77
|
|
CASE 7
|
|
TB = 78
|
|
TC = 79
|
|
TM = 80
|
|
CASE 8
|
|
TB = 81
|
|
TC = 82
|
|
TM = 83
|
|
CASE 9
|
|
TB = 84
|
|
TC = 85
|
|
TM = 86
|
|
CASE ELSE
|
|
END SELECT
|
|
|
|
|
|
LINE (X, Y)-STEP(TileW, TileH), TC, BF
|
|
LINE (X, Y)-STEP(TileW, TileH), TM, B
|
|
LINE (X, Y)-STEP(0, TileH), TB
|
|
LINE (X, Y + TileH)-STEP(TileW - 1, 0), TB
|
|
|
|
|
|
|
|
END SUB
|
|
|
|
SUB EraseKgen STATIC
|
|
|
|
KgenStart = 49
|
|
|
|
X = 265
|
|
Y = 0
|
|
Font$ = "H"
|
|
Italic = False
|
|
KgenFont X - 1, Y + 1, Font$, KgenStart, Italic
|
|
KgenFont X, Y, Font$, KgenStart, Italic
|
|
|
|
|
|
X = 265
|
|
Y = 25
|
|
Font$ = "S"
|
|
Italic = False
|
|
KgenFont X - 1, Y + 1, Font$, KgenStart, Italic
|
|
KgenFont X, Y, Font$, KgenStart, Italic
|
|
|
|
|
|
X = 265
|
|
Y = 50
|
|
Font$ = "L"
|
|
Italic = False
|
|
KgenFont X - 1, Y + 1, Font$, KgenStart, Italic
|
|
KgenFont X, Y, Font$, KgenStart, Italic
|
|
|
|
|
|
|
|
X = 265
|
|
Y = 65
|
|
Font$ = "L"
|
|
Italic = False
|
|
KgenFont X - 1, Y + 1, Font$, KgenStart, Italic
|
|
KgenFont X, Y, Font$, KgenStart, Italic
|
|
|
|
|
|
|
|
X = 265
|
|
Y = 125
|
|
Font$ = "T"
|
|
Italic = False
|
|
KgenFont X - 1, Y + 1, Font$, KgenStart, Italic
|
|
KgenFont X, Y, Font$, KgenStart, Italic
|
|
|
|
|
|
X = 289
|
|
Y = 125
|
|
Font$ = STR$(60)
|
|
Italic = False
|
|
KgenFont X - 1, Y + 1, Font$, KgenStart, Italic
|
|
|
|
|
|
X = 265
|
|
Y = 153
|
|
Font$ = "E"
|
|
Italic = False
|
|
KgenFont X - 1, Y + 1, Font$, KgenStart, Italic
|
|
KgenFont X, Y, Font$, KgenStart, Italic
|
|
|
|
|
|
X = 261
|
|
Y = 183
|
|
Font$ = "RelSoft"
|
|
Italic = True
|
|
KgenFont X - 1, Y - 1, Font$, KgenStart, Italic
|
|
KgenFont X, Y, Font$, KgenStart, Italic
|
|
|
|
X = 271
|
|
Y = 193
|
|
Font$ = "2001"
|
|
Italic = True
|
|
KgenFont X - 1, Y - 1, Font$, KgenStart, Italic
|
|
KgenFont X, Y, Font$, KgenStart, Italic
|
|
|
|
|
|
X = 297
|
|
Y = 51
|
|
|
|
IF Level < 10 THEN
|
|
LV$ = "0" + LTRIM$(STR$(Level))
|
|
ELSE
|
|
LV$ = LTRIM$(STR$(Level))
|
|
END IF
|
|
|
|
Font$ = LV$
|
|
Italic = True
|
|
KgenFont X - 2, Y + 1, Font$, KgenStart, Italic
|
|
KgenFont X, Y, Font$, KgenStart, Italic
|
|
|
|
|
|
END SUB
|
|
|
|
SUB EraseSaveFiles STATIC
|
|
|
|
|
|
GOSUB ConfirmErase
|
|
|
|
IF K$ = CHR$(27) THEN
|
|
EXIT SUB
|
|
END IF
|
|
|
|
GOSUB MakeBackUp
|
|
|
|
'===================================Hall of Fame
|
|
FOR I = 1 TO 5
|
|
Hall(I).Rank = I
|
|
Hall(I).Namer = "Relsoft 2000"
|
|
Hall(I).Score = 0
|
|
NEXT I
|
|
|
|
OPEN Path$ + "saves\" + "qbnoid.hof" FOR OUTPUT AS #1
|
|
|
|
FOR I = 1 TO 5
|
|
PRINT #1, Hall(I).Rank
|
|
PRINT #1, Hall(I).Namer
|
|
PRINT #1, Hall(I).Score
|
|
NEXT I
|
|
|
|
CLOSE
|
|
|
|
|
|
|
|
'=================================='SaveFiles for Loading
|
|
|
|
|
|
|
|
|
|
FOR I = 1 TO 8
|
|
Save(I).Num = I
|
|
Save(I).Namer = "Relsoft 2000"
|
|
Save(I).Score = 0
|
|
Save(I).Level = 1
|
|
Save(I).Lives = 2
|
|
|
|
NEXT I
|
|
|
|
OPEN Path$ + "saves\" + "qbnoid.qsv" FOR OUTPUT AS #1
|
|
|
|
|
|
FOR I = 1 TO 8
|
|
|
|
PRINT #1, Save(I).Num
|
|
PRINT #1, Save(I).Namer
|
|
PRINT #1, Save(I).Score
|
|
PRINT #1, Save(I).Level
|
|
PRINT #1, Save(I).Lives
|
|
NEXT I
|
|
|
|
CLOSE
|
|
EXIT SUB
|
|
|
|
|
|
'================Subs==================
|
|
MakeBackUp:
|
|
|
|
'===========Hall of Fame
|
|
OPEN Path$ + "saves\" + "qbnbck.hof" FOR OUTPUT AS #1
|
|
|
|
FOR I = 1 TO 5
|
|
PRINT #1, Hall(I).Rank
|
|
PRINT #1, Hall(I).Namer
|
|
PRINT #1, Hall(I).Score
|
|
NEXT I
|
|
|
|
CLOSE
|
|
|
|
|
|
|
|
'=================================='SaveFiles for Loading
|
|
|
|
OPEN Path$ + "saves\" + "qbnbck.qsv" FOR OUTPUT AS #1
|
|
|
|
|
|
FOR I = 1 TO 8
|
|
|
|
PRINT #1, Save(I).Num
|
|
PRINT #1, Save(I).Namer
|
|
PRINT #1, Save(I).Score
|
|
PRINT #1, Save(I).Level
|
|
PRINT #1, Save(I).Lives
|
|
NEXT I
|
|
|
|
CLOSE
|
|
|
|
RETURN
|
|
|
|
'==============================
|
|
|
|
ConfirmErase:
|
|
|
|
REDIM Temp(1)
|
|
DX = 40
|
|
DY = 40
|
|
MaxLen = 21
|
|
Title$ = " WARNING!!!"
|
|
Tmin = PadColorMin
|
|
Sysmod = False
|
|
Text$ = "~~~~This will erase your Hi-Scores and Load/Save file datas!!! Press [Escape] to undo or [Enter] to confirm."
|
|
GetBG DX, DY, DX + MaxLen * 8, DY + 9 * 8, Temp()
|
|
DialogBox DX, DY, MaxLen, Tmin, Title$, Text$, False, Sysmod
|
|
DO
|
|
K$ = INKEY$
|
|
IF RGBCounter(RGBC * 5) THEN RotateRGB
|
|
WAIT &H3DA, 8
|
|
LOOP UNTIL K$ = CHR$(27) OR K$ = CHR$(13)
|
|
|
|
SfxOpenDialog
|
|
PUT (DX, DY), Temp, PSET
|
|
ERASE Temp
|
|
|
|
RETURN
|
|
|
|
|
|
END SUB
|
|
|
|
SUB Fade (R%, g%, B%)
|
|
|
|
|
|
|
|
FOR I = 0 TO 63
|
|
|
|
|
|
FOR X = 0 TO 255
|
|
|
|
RefreshKey
|
|
|
|
ReadRGB X, RD, GN, BLL
|
|
|
|
|
|
IF R% > RD THEN
|
|
RD = RD + 1
|
|
ELSEIF R% < RD THEN
|
|
RD = RD - 1
|
|
ELSE
|
|
'Do nothing
|
|
END IF
|
|
|
|
IF g% > GN THEN
|
|
GN = GN + 1
|
|
ELSEIF g% < GN THEN
|
|
GN = GN - 1
|
|
ELSE
|
|
'Do nothing
|
|
END IF
|
|
|
|
IF B% > BLL THEN
|
|
BLL = BLL + 1
|
|
ELSEIF B% < BLL THEN
|
|
BLL = BLL - 1
|
|
ELSE
|
|
'Do nothing
|
|
END IF
|
|
|
|
WriteRGB X, RD, GN, BLL
|
|
|
|
NEXT X
|
|
|
|
MilliDelay 30
|
|
WAIT &H3DA, 8
|
|
WAIT &H3DA, 8, 8
|
|
|
|
NEXT I
|
|
|
|
END SUB
|
|
|
|
SUB FadeStep (R%, g%, B%) STATIC
|
|
|
|
|
|
|
|
I = I + 1
|
|
|
|
IF I > 63 THEN
|
|
I = 0
|
|
EXIT SUB
|
|
END IF
|
|
|
|
FOR X = 0 TO 255
|
|
|
|
RefreshKey
|
|
|
|
ReadRGB X, RD, GN, BLL
|
|
|
|
IF R% > RD THEN
|
|
RD = RD + 1
|
|
ELSEIF R% < RD THEN
|
|
RD = RD - 1
|
|
ELSE
|
|
'Do nothing
|
|
END IF
|
|
|
|
IF g% > GN THEN
|
|
GN = GN + 1
|
|
ELSEIF g% < GN THEN
|
|
GN = GN - 1
|
|
ELSE
|
|
'Do nothing
|
|
END IF
|
|
|
|
IF B% > BLL THEN
|
|
BLL = BLL + 1
|
|
ELSEIF B% < BLL THEN
|
|
BLL = BLL - 1
|
|
ELSE
|
|
'Do nothing
|
|
END IF
|
|
|
|
WriteRGB X, RD, GN, BLL
|
|
|
|
NEXT X
|
|
|
|
END SUB
|
|
|
|
FUNCTION FastKB STATIC
|
|
FastKB = INP(&H60)
|
|
DO WHILE LEN(INKEY$): LOOP
|
|
|
|
END FUNCTION
|
|
|
|
FUNCTION Format$ (Score&) STATIC
|
|
|
|
Score$ = RTRIM$(LTRIM$(STR$(Score&)))
|
|
|
|
L = LEN(Score$)
|
|
Temp$ = ""
|
|
II = 0
|
|
|
|
FOR I = L TO 1 STEP -1
|
|
I$ = MID$(Score$, I, 1)
|
|
|
|
IF II = 3 THEN
|
|
Temp$ = Temp$ + "," + I$
|
|
ELSE
|
|
Temp$ = Temp$ + I$
|
|
END IF
|
|
II = (II MOD 3) + 1
|
|
|
|
NEXT I
|
|
|
|
'Reverse it
|
|
|
|
L = LEN(Temp$)
|
|
Temp2$ = ""
|
|
|
|
FOR I = L TO 1 STEP -1
|
|
I$ = MID$(Temp$, I, 1)
|
|
Temp2$ = Temp2$ + I$
|
|
NEXT I
|
|
|
|
Format$ = LTRIM$(RTRIM$(Temp2$))
|
|
|
|
END FUNCTION
|
|
|
|
SUB GetBallBG (BallX, BallY) STATIC
|
|
BallOldX = BallX
|
|
BallOldY = BallY
|
|
GET (BallX, BallY)-STEP(6, 6), BallBG
|
|
END SUB
|
|
|
|
SUB GetBallCenter (BallCenterX, BallCenterY) STATIC
|
|
BallCenterX = BallX + BallRadius - 1
|
|
BallCenterY = BallY + BallRadius - 1
|
|
END SUB
|
|
|
|
SUB GetBG (X1, Y1, X2, Y2, Image())
|
|
|
|
'Image() Must be Dynamic
|
|
|
|
Size = (((((((X2 + 1) - X1) * ((Y2 + 1) - Y1))))) \ 2) + 2
|
|
|
|
REDIM Image(Size)
|
|
|
|
GET (X1, Y1)-(X2, Y2), Image
|
|
|
|
|
|
END SUB
|
|
|
|
SUB GetBlkHoleBG STATIC
|
|
|
|
FOR I = 1 TO 4
|
|
IF BlkHoleXY(I).X <> 0 THEN
|
|
GET (BlkHoleXY(I).X, BlkHoleXY(I).Y)-STEP(15, 15), BlkHoleBG(130 * (I - 1))
|
|
END IF
|
|
NEXT I
|
|
|
|
END SUB
|
|
|
|
SUB GetDirection STATIC
|
|
|
|
SELECT CASE SGN(BallXV)
|
|
CASE 1
|
|
IF SGN(BallYV) = -1 THEN
|
|
Direction = UR
|
|
ELSE
|
|
Direction = DR
|
|
END IF
|
|
CASE -1
|
|
IF SGN(BallYV) = -1 THEN
|
|
Direction = UL
|
|
ELSE
|
|
Direction = DL
|
|
END IF
|
|
|
|
CASE ELSE
|
|
END SELECT
|
|
|
|
SELECT CASE SGN(BallYV)
|
|
CASE 1
|
|
IF SGN(BallXV) = -1 THEN
|
|
ELSE
|
|
END IF
|
|
|
|
CASE -1
|
|
IF SGN(BallXV) = -1 THEN
|
|
ELSE
|
|
END IF
|
|
|
|
CASE ELSE
|
|
END SELECT
|
|
|
|
END SUB
|
|
|
|
SUB GetPaddleBG (PadX, PadY) STATIC
|
|
PadOldX = PadX
|
|
PadOldY = PadY
|
|
|
|
IF NOT Replicant THEN
|
|
GET (PadX, PadY)-STEP(39, 8), PaddleBG
|
|
ELSE
|
|
GET (PadX, PadY)-STEP(39 * 2, 8), PaddleBG
|
|
END IF
|
|
END SUB
|
|
|
|
SUB GetPadLsrBG (Image1(), Image2()) STATIC
|
|
|
|
|
|
PadLsrOldCoord(0).X = PadLsrCoord(0).X
|
|
PadLsrOldCoord(0).Y = PadLsrCoord(0).Y
|
|
PadLsrOldCoord(1).X = PadLsrCoord(1).X
|
|
PadLsrOldCoord(1).Y = PadLsrCoord(1).Y
|
|
|
|
|
|
GetBG PadLsrCoord(0).X, PadLsrCoord(0).Y, PadLsrCoord(0).X + 4, PadLsrCoord(0).Y + 8, Image1()
|
|
GetBG PadLsrCoord(1).X, PadLsrCoord(1).Y, PadLsrCoord(1).X + 4, PadLsrCoord(1).Y + 8, Image2()
|
|
|
|
END SUB
|
|
|
|
SUB GetPadLsrCoord (I) STATIC
|
|
|
|
SELECT CASE I
|
|
CASE 0
|
|
PadLsrCoord(0).X = PadX + 1
|
|
PadLsrCoord(0).Y = PadY - 9
|
|
IF Replicant THEN
|
|
PadLsrCoord(1).X = PadX + 71
|
|
ELSE
|
|
PadLsrCoord(1).X = PadX + 33
|
|
END IF
|
|
PadLsrCoord(1).Y = PadY - 9
|
|
CASE 1
|
|
PadLsrCoord(0).X = PadX + 1
|
|
PadLsrCoord(0).Y = PadY - 9
|
|
CASE 2
|
|
IF Replicant THEN
|
|
PadLsrCoord(1).X = PadX + 71
|
|
ELSE
|
|
PadLsrCoord(1).X = PadX + 33
|
|
END IF
|
|
PadLsrCoord(1).Y = PadY - 9
|
|
CASE ELSE
|
|
PadLsrCoord(0).X = PadX + 1
|
|
PadLsrCoord(0).Y = PadY - 9
|
|
IF Replicant THEN
|
|
PadLsrCoord(1).X = PadX + 71
|
|
ELSE
|
|
PadLsrCoord(1).X = PadX + 33
|
|
END IF
|
|
PadLsrCoord(1).Y = PadY - 9
|
|
END SELECT
|
|
|
|
|
|
END SUB
|
|
|
|
SUB GetPowerCapsBG STATIC
|
|
|
|
PowerCapsOldCoord(0).X = PowerCapsCoord(0).X
|
|
PowerCapsOldCoord(0).Y = PowerCapsCoord(0).Y
|
|
|
|
|
|
GetBG PowerCapsCoord(0).X, PowerCapsCoord(0).Y, PowerCapsCoord(0).X + 19, PowerCapsCoord(0).Y + 9, PowerCapsBG()
|
|
|
|
|
|
END SUB
|
|
|
|
SUB GetTileBackGround STATIC
|
|
|
|
I = 0
|
|
FOR Y = 0 TO 108 STEP 6
|
|
FOR X = 0 TO 220 STEP 20
|
|
GET (10 + X, 10 + Y)-STEP(19, 5), BackGround(OffsetBG * I)
|
|
I = I + 1
|
|
NEXT X
|
|
NEXT Y
|
|
|
|
END SUB
|
|
|
|
SUB HazyFx STATIC
|
|
|
|
StepX = 2
|
|
StepY = 2
|
|
|
|
FOR I = 1 TO 8
|
|
|
|
StepX = StepX + 2
|
|
StepY = StepY + 2
|
|
|
|
FOR Y = 0 TO 199 STEP StepY
|
|
FOR X = 0 TO 319 STEP StepX
|
|
C = POINT(X, Y)
|
|
LINE (X, Y)-STEP(StepX - 1, StepY - 1), C, BF
|
|
NEXT X
|
|
NEXT Y
|
|
|
|
MilliDelay 140
|
|
|
|
NEXT I
|
|
|
|
END SUB
|
|
|
|
SUB HideBuild
|
|
|
|
FOR I = 0 TO 255
|
|
R = 0
|
|
g = 0
|
|
B = 0
|
|
WriteRGB I, R, g, B
|
|
NEXT I
|
|
|
|
END SUB
|
|
|
|
FUNCTION HitSpike (X, Y) STATIC
|
|
|
|
HitSpike = False
|
|
|
|
IF POINT(X, Y) >= SpikeMin AND POINT(X, Y) <= SpikeMax THEN
|
|
HitSpike = True
|
|
END IF
|
|
|
|
END FUNCTION
|
|
|
|
SUB Init STATIC
|
|
|
|
LoadSaveFiles
|
|
|
|
InitValues
|
|
|
|
DoLogos
|
|
|
|
InitColors
|
|
|
|
InitTrans
|
|
|
|
|
|
SaveColors
|
|
|
|
HideBuild
|
|
|
|
DoIntro
|
|
|
|
InitFonts
|
|
InitNums
|
|
|
|
|
|
'Load Images
|
|
|
|
LoadBallImage
|
|
LoadBallExpImage
|
|
LoadPaddleImage
|
|
LoadBlkHoleImage
|
|
LoadBombImage
|
|
LoadExplodeImage
|
|
LoadPointerImage
|
|
LoadPadLsrImage
|
|
LoadPowerCapsImage
|
|
LoadLangawImage
|
|
LoadFlyExpImage
|
|
|
|
|
|
|
|
END SUB
|
|
|
|
SUB InitColors STATIC
|
|
|
|
WriteRGB 254, 63, 63, 63
|
|
'Color for Menu Pointer=============
|
|
WriteRGB 244, 0, 0, 0
|
|
WriteRGB 245, 0, 0, 0
|
|
|
|
|
|
'Color for Border============================================
|
|
R = 25
|
|
g = 25
|
|
B = 40
|
|
|
|
FOR I = BorderMin TO Bordermax
|
|
IF I <= BorderMin + 3 THEN
|
|
R = R + 5
|
|
g = g + 3
|
|
ELSE
|
|
R = R - 5
|
|
g = g - 3
|
|
END IF
|
|
|
|
WriteRGB I, R, g, B
|
|
NEXT I
|
|
|
|
'FontColors================================
|
|
R = 63
|
|
g = 63
|
|
B = 63
|
|
|
|
FOR I = FColorMin TO FcolorMax
|
|
R = R - 7
|
|
B = B - 7
|
|
WriteRGB I, R, g, B
|
|
NEXT I
|
|
|
|
'SmallNum colors============================
|
|
R = 63
|
|
g = 63
|
|
B = 63
|
|
|
|
FOR I = SnColorMin TO SnColorMax
|
|
R = R - 7
|
|
g = g - 7
|
|
WriteRGB I, R, g, B
|
|
NEXT I
|
|
|
|
'Tile Colors=================================
|
|
|
|
'60-93
|
|
|
|
FOR I = TcolorMin TO TcolorMax
|
|
II = II MOD 3 + 1
|
|
|
|
IF II = 1 THEN
|
|
IC = IC MOD 9 + 1
|
|
END IF
|
|
SELECT CASE II
|
|
CASE 1
|
|
R = 10: g = 10: B = 10 'Dark Borders
|
|
CASE 2
|
|
R = 30: g = 30: B = 30 'Tilecolor
|
|
CASE 3
|
|
R = 50: g = 50: B = 50 'Light Borders
|
|
CASE ELSE
|
|
END SELECT
|
|
'Tile color
|
|
SELECT CASE IC
|
|
CASE 1
|
|
g = 0
|
|
B = 0
|
|
CASE 2
|
|
R = 0
|
|
B = 0
|
|
CASE 3
|
|
R = 0
|
|
g = 0
|
|
CASE 4
|
|
R = 0
|
|
CASE 5
|
|
g = 0
|
|
CASE 6
|
|
B = 0
|
|
CASE 7
|
|
R = 25
|
|
CASE 8
|
|
g = 25
|
|
CASE 9
|
|
B = 25
|
|
CASE ELSE
|
|
END SELECT
|
|
|
|
WriteRGB I, R, g, B
|
|
NEXT I
|
|
|
|
'BackGround Colors==============================================
|
|
I = 0
|
|
|
|
FOR I = 130 TO 193
|
|
SELECT CASE ColorAttr
|
|
CASE 1 'Red
|
|
SavRGB(I).R = I \ 2
|
|
SavRGB(I).g = 0
|
|
SavRGB(I).B = 0
|
|
CASE 2 'Green
|
|
SavRGB(I).R = 0
|
|
SavRGB(I).g = I \ 2
|
|
SavRGB(I).B = 0
|
|
|
|
CASE 3 'Blue
|
|
SavRGB(I).R = 0
|
|
SavRGB(I).g = 0
|
|
SavRGB(I).B = I \ 2
|
|
|
|
CASE 4 'Yellow
|
|
SavRGB(I).R = I \ 2
|
|
SavRGB(I).g = I \ 2
|
|
SavRGB(I).B = 0
|
|
|
|
CASE 5 'Purple
|
|
SavRGB(I).R = I \ 2
|
|
SavRGB(I).g = 0
|
|
SavRGB(I).B = I \ 2
|
|
|
|
CASE 6 'Metallic Blue
|
|
SavRGB(I).R = 0
|
|
SavRGB(I).g = I \ 2
|
|
SavRGB(I).B = I \ 2
|
|
|
|
CASE 7 'White
|
|
SavRGB(I).R = I \ 2
|
|
SavRGB(I).g = I \ 2
|
|
SavRGB(I).B = I \ 2
|
|
|
|
CASE ELSE
|
|
SavRGB(I).R = I \ 2
|
|
SavRGB(I).g = I \ 2
|
|
SavRGB(I).B = I \ 2
|
|
END SELECT
|
|
|
|
NEXT I
|
|
I = 0
|
|
FOR I = 130 TO 193
|
|
WriteRGB I, SavRGB(I).R, SavRGB(I).g, SavRGB(I).B
|
|
NEXT I
|
|
|
|
'=========Boss Colors 106-121================
|
|
II = 0
|
|
FOR I = 106 TO 121
|
|
ReadRGB II, R, g, B
|
|
WriteRGB I, R, g, B
|
|
II = II + 1
|
|
NEXT I
|
|
|
|
|
|
'====================Kgen Colors==============================
|
|
'Red
|
|
R = 63
|
|
g = 63
|
|
B = 63
|
|
FOR I = KgenMin TO KgenMax
|
|
IF I <= KgenMin + 3 THEN
|
|
g = g - 13
|
|
B = B - 13
|
|
ELSE
|
|
g = g + 13
|
|
B = B + 13
|
|
END IF
|
|
SavRGB(I).R = R
|
|
SavRGB(I).g = g
|
|
SavRGB(I).B = B
|
|
WriteRGB I, SavRGB(I).R, SavRGB(I).g, SavRGB(I).B
|
|
NEXT I
|
|
|
|
'Blue
|
|
R = 63
|
|
g = 63
|
|
B = 63
|
|
FOR I = KgenBlueMin TO KgenBlueMax
|
|
IF I <= KgenBlueMin + 3 THEN
|
|
g = g - 13
|
|
R = R - 13
|
|
ELSE
|
|
g = g + 13
|
|
R = R + 13
|
|
END IF
|
|
SavRGB(I).R = R
|
|
SavRGB(I).g = g
|
|
SavRGB(I).B = B
|
|
WriteRGB I, SavRGB(I).R, SavRGB(I).g, SavRGB(I).B
|
|
NEXT I
|
|
|
|
'Green
|
|
R = 63
|
|
g = 63
|
|
B = 63
|
|
FOR I = KgenGreenMin TO KgenGreenMax
|
|
IF I <= KgenGreenMin + 3 THEN
|
|
B = B - 13
|
|
R = R - 13
|
|
ELSE
|
|
B = B + 13
|
|
R = R + 13
|
|
END IF
|
|
SavRGB(I).R = R
|
|
SavRGB(I).g = g
|
|
SavRGB(I).B = B
|
|
WriteRGB I, SavRGB(I).R, SavRGB(I).g, SavRGB(I).B
|
|
NEXT I
|
|
|
|
'===========Paddle==========
|
|
|
|
R = 63
|
|
g = 63
|
|
B = 63
|
|
|
|
FOR I = PadColorMin TO PadColorMax
|
|
IF I <= PadColorMin + 5 THEN
|
|
R = R - 4
|
|
g = g - 4
|
|
ELSE
|
|
R = R + 4
|
|
g = g + 4
|
|
END IF
|
|
SavRGB(I).R = R
|
|
SavRGB(I).g = g
|
|
SavRGB(I).B = B
|
|
WriteRGB I, SavRGB(I).R, SavRGB(I).g, SavRGB(I).B
|
|
NEXT I
|
|
|
|
'==========pointer
|
|
WriteRGB 244, 0, 63, 33 'Inside of pointer
|
|
WriteRGB 245, 63, 33, 63 'Border of pointer
|
|
|
|
|
|
END SUB
|
|
|
|
SUB InitFonts STATIC
|
|
|
|
SHARED SmallFonts() AS INTEGER
|
|
CLS
|
|
OPEN Path$ + "images\" + "small.fnt" FOR INPUT AS #1
|
|
|
|
INPUT #1, Maxfont
|
|
|
|
|
|
|
|
'Small numbers 0 to 4 height, 0 to 3 wide
|
|
|
|
FOR I = 1 TO Maxfont
|
|
FOR Y = 0 TO 4
|
|
JC = JC MOD 5 + 1
|
|
FOR X = 0 TO 3
|
|
INPUT #1, J
|
|
IF J <> 0 THEN
|
|
PSET (X + XX, Y), JC + (FColorMin - 1)
|
|
END IF
|
|
NEXT X
|
|
NEXT Y
|
|
XX = XX + 5
|
|
NEXT I
|
|
|
|
CLOSE
|
|
|
|
NI = 0
|
|
X = 0
|
|
Y = 0
|
|
FOR I = 1 TO Maxfont
|
|
GET (X, Y)-STEP(3, 4), SmallFonts(NI * FontOffset%)
|
|
NI = NI + 1
|
|
X = X + 5
|
|
NEXT I
|
|
|
|
END SUB
|
|
|
|
SUB InitImageData (FileName$, ImageArray())
|
|
|
|
IF FileName$ <> "" THEN
|
|
'***** Read image data from file *****
|
|
|
|
'Establish size of integer array required.
|
|
FileNo = FREEFILE
|
|
OPEN FileName$ FOR BINARY AS #FileNo
|
|
Ints = (LOF(FileNo) - 7) \ 2
|
|
CLOSE #FileNo
|
|
REDIM ImageArray(1 TO Ints)
|
|
|
|
'Load image data directly into array memory.
|
|
DEF SEG = VARSEG(ImageArray(1))
|
|
BLOAD FileName$, 0
|
|
DEF SEG
|
|
ELSE
|
|
'***** Read image data from DATA statements *****
|
|
|
|
'Establish size of integer array required.
|
|
READ IntCount
|
|
REDIM ImageArray(1 TO IntCount)
|
|
|
|
'READ image DATA into array.
|
|
FOR n = 1 TO IntCount
|
|
READ X
|
|
ImageArray(n) = X
|
|
NEXT n
|
|
END IF
|
|
|
|
END SUB
|
|
|
|
SUB InitNums STATIC
|
|
SHARED SmallNum() AS INTEGER
|
|
CLS
|
|
|
|
OPEN Path$ + "images\" + "smallnum.fnt" FOR INPUT AS #1
|
|
|
|
INPUT #1, MaxNum
|
|
|
|
|
|
'Small numbers 0 to 4 height, 0 to 3 wide
|
|
FOR I = 1 TO MaxNum
|
|
FOR Y = 0 TO 4
|
|
JC = JC MOD 5 + 1
|
|
FOR X = 0 TO 3
|
|
INPUT #1, J
|
|
IF J <> 0 THEN
|
|
PSET (X + XX, Y), JC + (SnColorMin - 1)
|
|
END IF
|
|
NEXT X
|
|
NEXT Y
|
|
XX = XX + 5
|
|
NEXT I
|
|
|
|
CLOSE
|
|
|
|
NI = 0
|
|
X = 0
|
|
Y = 0
|
|
FOR I = 1 TO 11
|
|
GET (X, Y)-STEP(3, 4), SmallNum(NI * FontOffset)
|
|
NI = NI + 1
|
|
X = X + 5
|
|
NEXT I
|
|
|
|
END SUB
|
|
|
|
SUB InitTrans
|
|
'init Trans
|
|
|
|
FOR I = 0 TO 255
|
|
ReadRGB I, R, g, B
|
|
|
|
IF R >= B AND R >= g THEN
|
|
Trans(I) = FIX(R / 4)
|
|
ELSEIF B >= g AND B >= R THEN
|
|
Trans(I) = FIX(B / 4)
|
|
ELSEIF g >= R AND g >= B THEN
|
|
Trans(I) = FIX(g / 4)
|
|
ELSE
|
|
Trans(I) = FIX(g / 4)
|
|
END IF
|
|
'Trans(I) = (r + g + b) \ 2 '16 NORMAL
|
|
NEXT I
|
|
|
|
|
|
END SUB
|
|
|
|
SUB InitValues STATIC
|
|
|
|
BallSpd = 1 'Change for Speed
|
|
|
|
BallXV = BallSpd
|
|
BallYV = -BallSpd
|
|
PadX = 100
|
|
PadY = 170
|
|
PadOldX = PadX
|
|
PadOldY = PadY
|
|
|
|
Score& = 0
|
|
Lives = 2
|
|
|
|
ColorAttr = 1 + INT(RND * 7)
|
|
ColorStep = 1 + INT(RND * 50)
|
|
Level = 0
|
|
|
|
END SUB
|
|
|
|
FUNCTION Inside (X, Y, X1, Y1, X2, Y2) STATIC
|
|
|
|
Inside = False
|
|
|
|
|
|
IF X >= X1 AND X <= X2 THEN
|
|
IF Y >= Y1 AND Y <= Y2 THEN
|
|
Inside = True
|
|
END IF
|
|
END IF
|
|
|
|
IF Y >= Y1 AND Y < Y2 THEN
|
|
IF X >= X1 AND X <= X2 THEN
|
|
Inside = True
|
|
END IF
|
|
END IF
|
|
|
|
|
|
END FUNCTION
|
|
|
|
SUB KgenFont (X, Y, Font$, MinColor, Italic) STATIC
|
|
|
|
'=======Prints system fonts on screen specified by X,Y
|
|
'=======Uses 8 colors from mincolor to Mincolor+8
|
|
'=======Font$ is the string, italic? Duh!!!!!
|
|
'=====Sample Code
|
|
'Note Kgen....Min are constants
|
|
'X = 261
|
|
'Y = 183
|
|
'Font$ = "RelSoft"
|
|
'Italic = True
|
|
'KgenFont X - 1, Y - 1, Font$, KgenGreenMin, Italic
|
|
'KgenFont X, Y, Font$, KgenBlueMin, Italic
|
|
'End Sample
|
|
'======================================================
|
|
|
|
DIM E(7): E(0) = 1: FOR F = 1 TO 7: E(F) = E(F - 1) + E(F - 1): NEXT F
|
|
|
|
XXX = X
|
|
YYY = Y
|
|
|
|
IF X = 320 THEN X = 160 - (4 * LEN(Font$))
|
|
|
|
|
|
|
|
|
|
DEF SEG = &HFFA6
|
|
FOR A = 1 TO LEN(Font$)
|
|
KC = 0
|
|
IF Italic THEN
|
|
Ita = 8
|
|
ELSE
|
|
Ita = 0
|
|
END IF
|
|
|
|
X = X + 8
|
|
D = ASC(MID$(Font$, A, 1)) * 8 + 14
|
|
FOR B = 0 TO 7
|
|
FOR C = 0 TO 7
|
|
IF PEEK(B + D) AND E(C) THEN PSET ((X - C) + Ita, Y + B), MinColor + KC
|
|
NEXT C
|
|
KC = KC MOD 8 + 1
|
|
IF Italic THEN
|
|
Ita = Ita - 1
|
|
END IF
|
|
NEXT B
|
|
NEXT A
|
|
|
|
DEF SEG
|
|
|
|
X = XXX
|
|
Y = YYY
|
|
|
|
END SUB
|
|
|
|
SUB KgenTTFont (X, Y, Font$, MinColor, Xscale, Yscale, Italic) STATIC
|
|
|
|
'=======Prints scalable system fonts on screen specified by X,Y
|
|
'=======Uses 8 colors from mincolor to Mincolor+8
|
|
'=======Font$ is the string, italic? Duh!!!!!
|
|
'=======Xscale/Yscale are scale to enlarge the font
|
|
'=====Sample Code
|
|
'Note Kgen....Min are constants
|
|
'X = 261
|
|
'Y = 183
|
|
'Xscale=3
|
|
'Yscale=2
|
|
'Font$ = "RelSoft"
|
|
'Italic = True
|
|
'KgenTTFont X - 1, Y - 1, Font$, KgenGreenMin,Xscale,Yscale Italic
|
|
'KgenTTFont X, Y, Font$, KgenBlueMin,,Xscale,Yscale Italic
|
|
'End Sample
|
|
'======================================================
|
|
|
|
DIM E(7): E(0) = 1: FOR F = 1 TO 7: E(F) = E(F - 1) + E(F - 1): NEXT F
|
|
|
|
XXX = X
|
|
YYY = Y
|
|
XSS = Xscale
|
|
YSS = Yscale
|
|
|
|
IF X = 320 THEN X = 160 - ((4 * Xscale * LEN(Font$)))
|
|
|
|
|
|
|
|
IF Italic THEN
|
|
Ita = 8
|
|
ELSE
|
|
Ita = 0
|
|
END IF
|
|
|
|
|
|
DEF SEG = &HFFA6
|
|
FOR A = 1 TO LEN(Font$)
|
|
|
|
KC = 0
|
|
YY = 0
|
|
XX = 0
|
|
|
|
X = X + (8 * Xscale)
|
|
D = ASC(MID$(Font$, A, 1)) * 8 + 14
|
|
FOR B = 0 TO 7
|
|
YY = YY + Yscale
|
|
XX = 0
|
|
FOR C = 0 TO 7
|
|
IF PEEK(B + D) AND E(C) THEN LINE (X - (C * Xscale) + Ita, Y + YY)-STEP(-(Xscale - 1), Yscale - 1), MinColor + KC, BF
|
|
XX = XX + Xscale
|
|
NEXT C
|
|
KC = KC MOD 8 + 1
|
|
|
|
IF Italic THEN
|
|
Ita = Ita - 1
|
|
IF Ita < 1 THEN Ita = 8
|
|
END IF
|
|
|
|
NEXT B
|
|
|
|
NEXT A
|
|
|
|
DEF SEG
|
|
|
|
X = XXX
|
|
Y = YYY
|
|
Xscale = XSS
|
|
Yscale = YSS
|
|
|
|
END SUB
|
|
|
|
SUB LevelDoneBox STATIC
|
|
|
|
PutBall BallX, BallY
|
|
|
|
SELECT CASE Level
|
|
CASE 5, 10, 15, 20, 25, 30, 35, 40, 45, 50
|
|
X1 = 20
|
|
Y1 = 140
|
|
X2 = 240
|
|
Y2 = Y1 + 40
|
|
CASE ELSE
|
|
X1 = 20
|
|
Y1 = 115
|
|
X2 = 240
|
|
Y2 = Y1 + 40
|
|
END SELECT
|
|
|
|
TransLuc 170, X1, Y1, X2, Y2 '170 best
|
|
|
|
|
|
X = X1 + 41
|
|
Y = Y1 + 4
|
|
Font$ = CHR$(1) + " Well done!!!! " + CHR$(1)
|
|
Italic = False
|
|
KgenFont X, Y, Font$, KgenMin, Italic
|
|
|
|
X = X1 + 42
|
|
Y = Y1 + 5
|
|
Font$ = CHR$(1) + " Well done!!!! " + CHR$(1)
|
|
Italic = False
|
|
KgenFont X, Y, Font$, KgenGreenMin, Italic
|
|
|
|
|
|
|
|
X = X1 + 5
|
|
Y = Y1 + 15
|
|
Font$ = "You have defeated LEVEL:" + LTRIM$(STR$(Level))
|
|
Italic = False
|
|
KgenFont X, Y, Font$, KgenBlueMin, Italic
|
|
|
|
X = X1 + 32
|
|
Y = Y1 + 28
|
|
Font$ = "Press <Enter> key..."
|
|
Italic = True
|
|
KgenFont X, Y, Font$, KgenBlueMin, Italic
|
|
|
|
X = X1 + 33
|
|
Y = Y1 + 29
|
|
Font$ = "Press <Enter> key..."
|
|
Italic = True
|
|
KgenFont X, Y, Font$, KgenGreenMin, Italic
|
|
|
|
|
|
SfxOpenDialog
|
|
|
|
END SUB
|
|
|
|
SUB LimitScore STATIC
|
|
|
|
IF Score& >= 99999999 THEN
|
|
Score& = 99999999
|
|
|
|
END IF
|
|
|
|
END SUB
|
|
|
|
SUB LoadBallExpImage STATIC
|
|
|
|
REDIM BallExp(1 TO 1)
|
|
REDIM BallExpmsk(1 TO 1)
|
|
REDIM BallExpIndex(1 TO 1)
|
|
|
|
FileName$ = "BallExp.put"
|
|
FileName$ = Path$ + "Images\" + FileName$
|
|
InitImageData FileName$, BallExp()
|
|
FileName$ = "BallExp.msk"
|
|
FileName$ = Path$ + "Images\" + FileName$
|
|
InitImageData FileName$, BallExpmsk()
|
|
|
|
MakeImageIndex BallExp(), BallExpIndex()
|
|
|
|
END SUB
|
|
|
|
SUB LoadBallImage STATIC
|
|
|
|
REDIM Ball(1 TO 1) '1st image=Mask, 2nd=Ball
|
|
REDIM BallIndex(1 TO 1)
|
|
|
|
FileName$ = "QbBall.put"
|
|
FileName$ = Path$ + "Images\" + FileName$
|
|
InitImageData FileName$, Ball()
|
|
|
|
MakeImageIndex Ball(), BallIndex()
|
|
|
|
END SUB
|
|
|
|
SUB LoadBlkHoleImage STATIC
|
|
|
|
|
|
REDIM BlkHole(1 TO 1)
|
|
REDIM BlkHoleMask(1 TO 1)
|
|
|
|
REDIM BlkHoleIndex(1 TO 1)
|
|
|
|
FileName$ = "BlkHole.put"
|
|
FileName$ = Path$ + "Images\" + FileName$
|
|
InitImageData FileName$, BlkHole()
|
|
FileName$ = "BlkHole.Msk"
|
|
FileName$ = Path$ + "Images\" + FileName$
|
|
InitImageData FileName$, BlkHoleMsk()
|
|
|
|
|
|
MakeImageIndex BlkHole(), BlkHoleIndex()
|
|
|
|
|
|
END SUB
|
|
|
|
SUB LoadBombImage STATIC
|
|
|
|
REDIM Bomb(1 TO 1)
|
|
REDIM BombMsk(1 TO 1)
|
|
REDIM BombIndex(1 TO 1)
|
|
|
|
FileName$ = "Bomb.put"
|
|
FileName$ = Path$ + "Images\" + FileName$
|
|
InitImageData FileName$, Bomb()
|
|
FileName$ = "Bomb.msk"
|
|
FileName$ = Path$ + "Images\" + FileName$
|
|
InitImageData FileName$, BombMsk()
|
|
|
|
MakeImageIndex Bomb(), BombIndex()
|
|
|
|
END SUB
|
|
|
|
SUB LoadExplodeImage STATIC
|
|
|
|
REDIM Explode(1 TO 1)
|
|
REDIM Explodemsk(1 TO 1)
|
|
REDIM ExplodeIndex(1 TO 1)
|
|
|
|
FileName$ = "Explode.put"
|
|
FileName$ = Path$ + "Images\" + FileName$
|
|
InitImageData FileName$, Explode()
|
|
FileName$ = "Explode.msk"
|
|
FileName$ = Path$ + "Images\" + FileName$
|
|
InitImageData FileName$, Explodemsk()
|
|
|
|
|
|
MakeImageIndex Explode(), ExplodeIndex()
|
|
|
|
END SUB
|
|
|
|
SUB LoadFlyExpImage STATIC
|
|
REDIM FlyExp(1 TO 1) '1st image=Spr, 2nd =Mask
|
|
REDIM FlyExpIndex(1 TO 1)
|
|
FileName$ = "FlyExp.put"
|
|
FileName$ = Path$ + "Images\" + FileName$
|
|
InitImageData FileName$, FlyExp()
|
|
|
|
MakeImageIndex FlyExp(), FlyExpIndex()
|
|
|
|
END SUB
|
|
|
|
SUB LoadGame STATIC
|
|
|
|
X = 0
|
|
Y = 0
|
|
REDIM Item$(8)
|
|
|
|
Item$(0) = "* * Load * *"
|
|
FOR I = 1 TO UBOUND(Item$)
|
|
Item$(I) = LTRIM$(STR$(Save(I).Num)) + "." + Save(I).Namer
|
|
NEXT I
|
|
|
|
P = PullDown(X, Y, Item$(), False)
|
|
|
|
IF P <> 0 THEN
|
|
'Loadit
|
|
Score& = Save(P).Score
|
|
Level = Save(P).Level - 1
|
|
Lives = Save(P).Lives
|
|
OutStart = True
|
|
Finished = True
|
|
END IF
|
|
|
|
|
|
END SUB
|
|
|
|
SUB LoadLangawImage STATIC
|
|
|
|
REDIM Langaw(1 TO 1) '1st/2nd image=Spr, 3/4 =Masks
|
|
REDIM LangawIndex(1 TO 1)
|
|
|
|
FileName$ = "Langaw.put"
|
|
FileName$ = Path$ + "Images\" + FileName$
|
|
InitImageData FileName$, Langaw()
|
|
|
|
MakeImageIndex Langaw(), LangawIndex()
|
|
|
|
END SUB
|
|
|
|
SUB LoadPaddleImage STATIC
|
|
|
|
REDIM Paddle(1 TO 1) '1st image=Mask, 2nd=paddle,3rd & 4th= PoweredUp Paddle
|
|
REDIM PaddleIndex(1 TO 1)
|
|
|
|
FileName$ = "Paddle.put"
|
|
FileName$ = Path$ + "Images\" + FileName$
|
|
InitImageData FileName$, Paddle()
|
|
|
|
MakeImageIndex Paddle(), PaddleIndex()
|
|
|
|
END SUB
|
|
|
|
SUB LoadPadLsrImage STATIC
|
|
|
|
REDIM Padlsr(1 TO 1) '1st image=Laser, 2nd =Mask
|
|
REDIM PadlsrIndex(1 TO 1)
|
|
|
|
FileName$ = "PadLasr.put"
|
|
FileName$ = Path$ + "Images\" + FileName$
|
|
InitImageData FileName$, Padlsr()
|
|
|
|
MakeImageIndex Padlsr(), PadlsrIndex()
|
|
|
|
END SUB
|
|
|
|
SUB LoadPointerImage STATIC
|
|
|
|
REDIM Pointer(1 TO 1) '1st image=Mask, 2nd =pointer
|
|
REDIM PointerIndex(1 TO 1)
|
|
|
|
FileName$ = "Pointer.put"
|
|
FileName$ = Path$ + "Images\" + FileName$
|
|
InitImageData FileName$, Pointer()
|
|
|
|
MakeImageIndex Pointer(), PointerIndex()
|
|
|
|
END SUB
|
|
|
|
SUB LoadPowerCapsImage STATIC
|
|
|
|
REDIM PowerCaps(1 TO 1) '1st to 3rd image=PowerCaps, 4nd =Mask
|
|
REDIM PowerCapsIndex(1 TO 1)
|
|
|
|
FileName$ = "PwerCaps.put"
|
|
FileName$ = Path$ + "Images\" + FileName$
|
|
InitImageData FileName$, PowerCaps()
|
|
|
|
MakeImageIndex PowerCaps(), PowerCapsIndex()
|
|
|
|
END SUB
|
|
|
|
SUB LoadSaveFiles STATIC
|
|
|
|
|
|
'Saved Games for Loading and Saving
|
|
OPEN Path$ + "saves\" + "qbnoid.qsv" FOR INPUT AS #1
|
|
|
|
FOR I = 1 TO 8
|
|
INPUT #1, SaveNum
|
|
INPUT #1, Name$
|
|
INPUT #1, ScoreTemp&
|
|
INPUT #1, LevelTemp
|
|
INPUT #1, LivesTemp
|
|
Save(I).Num = SaveNum
|
|
Save(I).Namer = Name$
|
|
Save(I).Score = ScoreTemp&
|
|
Save(I).Level = LevelTemp
|
|
Save(I).Lives = LivesTemp
|
|
NEXT I
|
|
|
|
CLOSE
|
|
|
|
'Hall of Fame
|
|
|
|
OPEN Path$ + "saves\" + "qbnoid.hof" FOR INPUT AS #1
|
|
|
|
FOR I = 1 TO 5
|
|
INPUT #1, Rank
|
|
INPUT #1, Name$
|
|
INPUT #1, ScoreTemp&
|
|
Hall(I).Rank = Rank
|
|
Hall(I).Namer = Name$
|
|
Hall(I).Score = ScoreTemp&
|
|
NEXT I
|
|
|
|
CLOSE
|
|
|
|
SortIt
|
|
|
|
|
|
END SUB
|
|
|
|
SUB LoadTitle STATIC
|
|
|
|
LINE (0, 0)-(320, 199), 0, BF
|
|
|
|
DEF SEG = &HA000
|
|
BLOAD Path$ + "images\" + "arqanoid.bsv", 0
|
|
|
|
RestoreColors
|
|
|
|
DO
|
|
IF RGBCounter(RGBC * 5) THEN RotateRGB
|
|
WAIT &H3DA, 8
|
|
WAIT &H3DA, 8, 8
|
|
LOOP UNTIL INKEY$ <> ""
|
|
DEF SEG
|
|
|
|
HazyFx
|
|
Fade 0, 0, 0
|
|
|
|
LINE (0, 0)-(319, 199), 0, BF
|
|
|
|
END SUB
|
|
|
|
SUB MakeImageIndex (ImageArray(), IndexArray())
|
|
|
|
'The index will initially be built in a temporary array, allowing
|
|
'for the maximum 1000 images per file.
|
|
DIM Temp(1 TO 1000)
|
|
Ptr& = 1: IndexNo = 1: LastInt = UBOUND(ImageArray)
|
|
DO
|
|
Temp(IndexNo) = Ptr&
|
|
IndexNo = IndexNo + 1
|
|
|
|
'Evaluate descriptor of currently referenced image to
|
|
'calculate the beginning of the next image.
|
|
X& = (ImageArray(Ptr&) \ 8) * (ImageArray(Ptr& + 1)) + 4
|
|
IF X& MOD 2 THEN X& = X& + 1
|
|
Ptr& = Ptr& + (X& \ 2)
|
|
LOOP WHILE Ptr& < LastInt
|
|
|
|
LastImage = IndexNo - 1
|
|
|
|
'Copy the image index values into the actual index array.
|
|
REDIM IndexArray(1 TO LastImage)
|
|
FOR n = 1 TO LastImage
|
|
IndexArray(n) = Temp(n)
|
|
NEXT n
|
|
|
|
END SUB
|
|
|
|
FUNCTION Menu STATIC
|
|
|
|
Menu = 0
|
|
|
|
X = 48
|
|
Y = 10
|
|
REDIM Item$(7)
|
|
|
|
Item$(0) = CHR$(2) + CHR$(2) + " Menu " + CHR$(2) + CHR$(2)
|
|
|
|
Item$(1) = "New Game"
|
|
Item$(2) = "Save Game"
|
|
Item$(3) = "Load Game"
|
|
Item$(4) = "Special(???)" + CHR$(1)
|
|
Item$(5) = "View Credits"
|
|
Item$(6) = "Hall of Fame"
|
|
Item$(7) = "Exit Game"
|
|
|
|
|
|
M = PullDown(X, Y, Item$(), True)
|
|
|
|
Menu = M
|
|
|
|
END FUNCTION
|
|
|
|
SUB MilliDelay (msecs) STATIC
|
|
|
|
IF sysfact& THEN 'calc- system speed yet?
|
|
IF msecs THEN 'have to want a delay
|
|
COUNT& = (sysfact& * msecs) \ -54 'calc- # of loops needed
|
|
DO
|
|
COUNT& = COUNT& + 1 'negative - add to get to 0
|
|
IF COUNT& = z THEN EXIT DO 'when its 0 we're done
|
|
LOOP UNTIL T2 = PEEK(&H6C) 'make it the same as below
|
|
END IF
|
|
ELSE 'calc- system speed
|
|
DEF SEG = &H40 'point to low memory
|
|
T1 = PEEK(&H6C) 'get tick count
|
|
DO
|
|
T2 = PEEK(&H6C) 'get tick count
|
|
LOOP UNTIL T2 <> T1 'wait 'til its a new tick
|
|
DO
|
|
sysfact& = sysfact& + 1 'count number of loops
|
|
IF sysfact& = z THEN EXIT DO 'make it the same as above
|
|
LOOP UNTIL T2 <> PEEK(&H6C) 'wait 'til its a new tick
|
|
T2 = 256 'prevent the above UNTIL
|
|
END IF
|
|
|
|
END SUB
|
|
|
|
FUNCTION MovePaddle (PadX, PadY) STATIC
|
|
|
|
GOSUB CheckLives
|
|
|
|
IF Replicant THEN
|
|
PadXMax = 180
|
|
IF PadX > PadXMax THEN
|
|
PutPaddleBG PadOldX, PadOldY
|
|
PadX = PadXMax
|
|
END IF
|
|
ELSE
|
|
PadXMax = 217
|
|
END IF
|
|
|
|
|
|
MovePaddle = False
|
|
SELECT CASE FastKB
|
|
CASE KRight, KD
|
|
IF PadX < PadXMax - PadSpd THEN
|
|
PadX = PadX + PadSpd
|
|
MovePaddle = True
|
|
END IF
|
|
CASE KLeft, KA
|
|
IF PadX > PadSpd + 5 THEN
|
|
PadX = PadX - PadSpd
|
|
MovePaddle = True
|
|
END IF
|
|
CASE KDown, KS, KEnd
|
|
AutoFire = False
|
|
Shooting = False
|
|
Lshot = False
|
|
Rshot = False
|
|
CASE KUp, KW, KCtrl
|
|
AutoFire = True
|
|
Shooting = True
|
|
Lshot = True
|
|
Rshot = True
|
|
CASE KSpc, KPgd, KTab
|
|
OutStart = True
|
|
AutoFire = False
|
|
Shooting = True
|
|
Lshot = True
|
|
Rshot = True
|
|
CASE KEsc
|
|
M = Menu
|
|
GOSUB CheckMval
|
|
RefreshKey
|
|
CASE KEnt
|
|
CASE ELSE
|
|
END SELECT
|
|
|
|
|
|
EXIT FUNCTION
|
|
|
|
|
|
|
|
'=====================subs=================
|
|
CheckMval:
|
|
|
|
SELECT CASE M
|
|
CASE 0 'Pressed esc do nothing
|
|
CASE 1 'New game
|
|
Score& = 0
|
|
Level = 0
|
|
Lives = 2
|
|
OutStart = True
|
|
Finished = True
|
|
CASE 2 'Save Game
|
|
SaveGame
|
|
CASE 3 'Load Game
|
|
LoadGame
|
|
CASE 4 'Special
|
|
MS = SubMenu
|
|
GOSUB CheckMSval
|
|
CASE 5 'Credits
|
|
DoCredits
|
|
CASE 6 'HallofFame
|
|
DoHallOfFame
|
|
CASE 7 'Exit Game
|
|
OutStart = True
|
|
Finished = True
|
|
GameOver = True
|
|
Check4HoF
|
|
CASE ELSE
|
|
END SELECT
|
|
|
|
RETURN
|
|
'==========
|
|
CheckMSval:
|
|
SELECT CASE MS
|
|
CASE 0
|
|
CASE 1 'Skip Level
|
|
OutStart = True
|
|
Finished = True
|
|
CASE 2 'MoreLives
|
|
Lives = 99
|
|
PrintLives False
|
|
CASE 3 'NoSpikes
|
|
PUT (7, 183), SpikeBG, PSET
|
|
CASE 4 'PadPower
|
|
IF NOT SpStage THEN
|
|
IF NOT PadPower THEN
|
|
PadPower = True
|
|
GOSUB InitPadlsr
|
|
END IF
|
|
ELSE
|
|
CheatError
|
|
END IF
|
|
CASE 5 'Replicant
|
|
IF NOT SpStage THEN
|
|
Replicant = True
|
|
ELSE
|
|
CheatError
|
|
END IF
|
|
CASE 6 'EraseFiles
|
|
EraseSaveFiles
|
|
CASE ELSE
|
|
END SELECT
|
|
RETURN
|
|
|
|
'==========
|
|
CheckLives:
|
|
|
|
IF Lives < -1 THEN
|
|
Finished = True
|
|
GameOver = True
|
|
OutStart = True
|
|
Check4HoF
|
|
END IF
|
|
|
|
RETURN
|
|
|
|
|
|
'=========
|
|
InitPadlsr:
|
|
|
|
GetPadLsrCoord 0
|
|
GetPadLsrBG PadLsrBG1(), PadLsrBG2()
|
|
|
|
RETURN
|
|
|
|
|
|
|
|
END FUNCTION
|
|
|
|
SUB NameEntry STATIC
|
|
|
|
|
|
DX = 10
|
|
DY = 10
|
|
MaxLen = 24
|
|
Title$ = "Ace Player!!!"
|
|
Tmin = PadColorMin
|
|
Sysmod = False
|
|
Text$ = "~~~~Congratulations!!! Kambal! You have a new record! Pls. Send your score to me and I'll give you money. Just jokin' hehehehe. "
|
|
Text$ = Text$ + "Actually, you earn NOTHING by playing this game. Just bragging rights.... "
|
|
|
|
REDIM Temp(1)
|
|
GetBG DX, DY, DX + 192, DY + 135, Temp()
|
|
DialogBox DX, DY, MaxLen, Tmin, Title$, Text$, False, Sysmod
|
|
KgenFont DX + 10, DY + 106, "Your Score:", KgenBlueMin, False
|
|
KgenFont DX + 10 + (8 * 11), DY + 106, LTRIM$(STR$(Score&)), KgenMin, False
|
|
KgenFont DX + 10, DY + 116, "EnterName:", KgenBlueMin, False
|
|
|
|
|
|
GOSUB EnterName
|
|
SfxOpenDialog
|
|
|
|
IF P$ = CHR$(13) THEN
|
|
'SaveHiscore
|
|
IF LEN(Item$) > 0 THEN
|
|
Hall(5).Namer = Item$
|
|
Hall(5).Score = Score&
|
|
SortIt
|
|
GOSUB SaveHOF
|
|
END IF
|
|
END IF
|
|
|
|
|
|
DoHallOfFame
|
|
|
|
EXIT SUB
|
|
|
|
'=======================
|
|
|
|
EnterName:
|
|
|
|
REDIM ST(1)
|
|
GetBG DX + 10 + (10 * 8), DY + 116, (DX + 10 + (10 * 8)) + (12 * 8), DY + 116 + 8, ST()
|
|
PUT (DX + 10 + (10 * 8), DY + 116), ST, PSET
|
|
Item$ = ""
|
|
|
|
|
|
DO
|
|
|
|
DO
|
|
P$ = INKEY$
|
|
IF LEN(Item$) < 12 THEN
|
|
KgenFont DX + 10 + (10 * 8) + (LEN(Item$) * 8), DY + 116, "_", KgenGreenMin, False
|
|
END IF
|
|
IF RGBCounter(RGBC * 5) THEN RotateRGB
|
|
WAIT &H3DA, 8
|
|
LOOP UNTIL P$ <> ""
|
|
|
|
IF ASC(P$) >= 32 AND ASC(P$) <= 127 THEN
|
|
IF LEN(Item$) < 12 THEN
|
|
Item$ = Item$ + (P$)
|
|
PUT (DX + 10 + (10 * 8), DY + 116), ST, PSET
|
|
KgenFont DX + 10 + (10 * 8), DY + 116, Item$, KgenMin, False
|
|
SOUND 1200, 1
|
|
RefreshKey
|
|
ELSE
|
|
RefreshKey
|
|
END IF
|
|
ELSE
|
|
IF P$ = CHR$(8) THEN
|
|
IF LEN(Item$) > 0 THEN
|
|
Item$ = LEFT$(Item$, LEN(Item$) - 1)
|
|
PUT (DX + 10 + (10 * 8), DY + 116), ST, PSET
|
|
KgenFont DX + 10 + (10 * 8), DY + 116, Item$, KgenMin, False
|
|
SOUND 1200, 1
|
|
RefreshKey
|
|
ELSE
|
|
RefreshKey
|
|
END IF
|
|
END IF
|
|
END IF
|
|
|
|
LOOP UNTIL P$ = CHR$(13) OR P$ = CHR$(27)
|
|
|
|
PUT (DX, DY), Temp, PSET
|
|
|
|
RETURN
|
|
|
|
'=======================
|
|
SaveHOF:
|
|
|
|
OPEN Path$ + "saves\" + "qbnoid.hof" FOR OUTPUT AS #1
|
|
|
|
FOR I = 1 TO 5
|
|
PRINT #1, Hall(I).Rank
|
|
PRINT #1, Hall(I).Namer
|
|
PRINT #1, Hall(I).Score
|
|
NEXT I
|
|
|
|
|
|
CLOSE
|
|
|
|
RETURN
|
|
|
|
END SUB
|
|
|
|
SUB OpenLvlFile (File$) STATIC
|
|
OPEN File$ FOR INPUT AS #1
|
|
|
|
FOR I = 0 TO TileMax
|
|
INPUT #1, Tile(I).X
|
|
INPUT #1, Tile(I).Y
|
|
INPUT #1, Tile(I).C
|
|
IF Tile(I).C = 0 THEN
|
|
Tile(I).F = False
|
|
ELSE
|
|
Tile(I).F = True
|
|
END IF
|
|
NEXT I
|
|
|
|
CLOSE
|
|
|
|
|
|
END SUB
|
|
|
|
SUB PlayGame STATIC
|
|
|
|
|
|
ReinitValues
|
|
|
|
|
|
DrawLevelBG Level, ColorStep, ColorAttr 'Bgmode(Unused),Type(looks),color
|
|
|
|
GetTileBackGround
|
|
|
|
|
|
|
|
|
|
SelectLevel
|
|
|
|
DoBlkHole
|
|
DoBomb
|
|
|
|
|
|
RestoreColors
|
|
|
|
Finished = False
|
|
|
|
|
|
GetBallCenter BallCenterX, BallCenterY
|
|
|
|
|
|
StartGame
|
|
|
|
|
|
DO
|
|
|
|
|
|
GOSUB CheckForPowerCaps
|
|
GOSUB CheckForPadPwr
|
|
|
|
|
|
|
|
GetBallBG BallX, BallY
|
|
GetPaddleBG PadX, PadY
|
|
|
|
|
|
PutBall BallX, BallY
|
|
PutPaddle PadX, PadY
|
|
|
|
|
|
|
|
GOSUB CheckSDHit
|
|
|
|
Flag = MovePaddle(PadX, PadY)
|
|
|
|
|
|
WAIT &H3DA, 8
|
|
WAIT &H3DA, 8, 8
|
|
|
|
GOSUB BugFix:
|
|
|
|
|
|
PutBallBG BallOldX, BallOldY
|
|
|
|
|
|
|
|
IF Collide THEN
|
|
CheckBounceCounter BounceCounter
|
|
END IF
|
|
|
|
|
|
|
|
PutPaddleBG PadOldX, PadOldY
|
|
|
|
|
|
IF PadPower THEN
|
|
PutPadLsrBG PadLsrBG1(), PadLsrBG2()
|
|
END IF
|
|
|
|
IF Power THEN
|
|
PutPowerCapsBG
|
|
END IF
|
|
|
|
GOSUB RotRGBETC
|
|
'IF BossSTG THEN
|
|
' DoLangaw False
|
|
'END IF
|
|
|
|
|
|
LOOP UNTIL Finished
|
|
|
|
HazyFx
|
|
|
|
GOSUB CheckFadeTo
|
|
|
|
EXIT SUB
|
|
|
|
'===========subs===========================
|
|
|
|
|
|
|
|
BugFix:
|
|
|
|
|
|
IF BallY < 40 THEN
|
|
MilliDelay 5
|
|
END IF
|
|
|
|
|
|
RETURN
|
|
|
|
|
|
CheckFadeTo:
|
|
|
|
SELECT CASE Level
|
|
CASE 5, 10, 15, 20, 25, 30, 35, 40, 45, 50
|
|
Fade 0, 0, 0
|
|
CASE ELSE
|
|
Fade INT(RND * 63), INT(RND * 63), INT(RND * 63)
|
|
END SELECT
|
|
|
|
RETURN
|
|
'===========
|
|
CheckSDHit:
|
|
|
|
IF SdHitPad THEN
|
|
SOUND 3000, 1
|
|
SOUND 3400, 1
|
|
SdHitPad = False
|
|
END IF
|
|
|
|
IF SdHitTile THEN
|
|
SOUND 2300, 1
|
|
SdHitTile = False
|
|
WAIT &H3DA, 8
|
|
WAIT &H3DA, 8, 8
|
|
BlinkTile False
|
|
END IF
|
|
|
|
|
|
RETURN
|
|
|
|
'=================
|
|
CheckForPadPwr:
|
|
|
|
IF PadPower THEN
|
|
IF NOT Shooting THEN
|
|
GetPadLsrCoord 0
|
|
GetPadLsrBG PadLsrBG1(), PadLsrBG2()
|
|
PutPadLsr PadLsrCoord(0).X, PadLsrCoord(0).Y
|
|
PutPadLsr PadLsrCoord(1).X, PadLsrCoord(1).Y
|
|
ELSE
|
|
DoPadLsr
|
|
END IF
|
|
ELSE
|
|
|
|
END IF
|
|
|
|
|
|
RETURN
|
|
|
|
'===========
|
|
CheckForPowerCaps:
|
|
IF Power THEN
|
|
DoPowerCaps PowerType
|
|
END IF
|
|
RETURN
|
|
|
|
|
|
'========
|
|
RotRGBETC:
|
|
BlkCount = BlkCount MOD 5 + 1
|
|
BombCount = BombCount MOD 50 + 1
|
|
LangawCount = LangawCount MOD 2 + 1
|
|
|
|
IF LangawCount = 1 THEN
|
|
IF BossStg THEN
|
|
DoLangaw False
|
|
END IF
|
|
END IF
|
|
|
|
|
|
IF BlkCount = 1 THEN
|
|
DoBlkHole
|
|
END IF
|
|
|
|
IF BombCount = 1 THEN
|
|
|
|
GetBallBG BallX, BallY
|
|
GetPaddleBG PadX, PadY
|
|
|
|
PutBall BallX, BallY
|
|
PutPaddle PadX, PadY
|
|
|
|
PutBombBG
|
|
DoBomb
|
|
|
|
PutPaddleBG PadOldX, PadOldY
|
|
PutBallBG BallOldX, BallOldY
|
|
END IF
|
|
|
|
IF RGBCounter(RGBC) THEN RotateRGB
|
|
|
|
RETURN
|
|
|
|
|
|
END SUB
|
|
|
|
SUB PrintFonts (X, Y, n$) STATIC
|
|
|
|
SHARED SmallFonts() AS INTEGER
|
|
|
|
n$ = LTRIM$(RTRIM$(UCASE$(n$)))
|
|
|
|
Letter$ = "@.,:!?ABCDEFGHIJKLMNOPQRSTUVWXYZ "
|
|
|
|
|
|
FOR I = 1 TO LEN(n$)
|
|
II$ = MID$(n$, I, 1)
|
|
OffSet = INSTR(Letter$, II$)
|
|
PUT ((I * 5) + X, Y), SmallFonts((OffSet - 1) * FontOffset), PSET
|
|
NEXT I
|
|
|
|
|
|
END SUB
|
|
|
|
SUB PrintLevel STATIC
|
|
|
|
X = 297
|
|
Y = 51
|
|
|
|
IF Level < 10 THEN
|
|
LV$ = "0" + LTRIM$(STR$(Level))
|
|
ELSE
|
|
LV$ = LTRIM$(STR$(Level))
|
|
END IF
|
|
|
|
Font$ = LV$
|
|
Italic = True
|
|
KgenFont X - 2, Y + 1, Font$, KgenMin, Italic
|
|
KgenFont X, Y, Font$, KgenBlueMin, Italic
|
|
|
|
|
|
END SUB
|
|
|
|
SUB PrintLives (EraseIt) STATIC
|
|
|
|
|
|
|
|
LY = 76
|
|
LX = 265
|
|
LINE (LX, LY - 1)-(320, 122), 0, BF
|
|
FOR I = 0 TO Lives
|
|
IF NOT EraseIt THEN
|
|
PUT (LX, LY), Ball(BallIndex(2)), PSET
|
|
ELSE
|
|
PUT (LX, LY), Ball(BallIndex(1)), PSET
|
|
END IF
|
|
|
|
LX = LX + 7
|
|
IF LX > 313 THEN
|
|
LX = 265
|
|
LY = LY + 7
|
|
END IF
|
|
|
|
IF I > 40 THEN EXIT FOR
|
|
|
|
NEXT I
|
|
|
|
|
|
END SUB
|
|
|
|
SUB PrintNum (X, Y, n$) STATIC
|
|
SHARED SmallNum() AS INTEGER
|
|
|
|
FOR I = 1 TO LEN(n$)
|
|
II$ = MID$(n$, I, 1)
|
|
OffSet = INSTR("1234567890,", II$)
|
|
PUT ((I * 5) + X, Y), SmallNum((OffSet - 1) * FontOffset), PSET
|
|
NEXT I
|
|
|
|
|
|
END SUB
|
|
|
|
SUB PrintScore STATIC
|
|
|
|
Temp$ = LTRIM$(Format$(Score&))
|
|
PrintNum 315 - (LEN(Temp$) * 5), 35, Temp$
|
|
|
|
IF Score& >= 100000 THEN
|
|
PrintNum 315 - (LEN(Temp$) * 5), 12, Temp$
|
|
END IF
|
|
|
|
END SUB
|
|
|
|
FUNCTION PullDown (X, Y, Item$(), Italic) STATIC
|
|
|
|
'=========Draws a PullDown menu==========
|
|
'=========Returns an integer (Value of I)
|
|
'======Sample Code=======================
|
|
'X = 10
|
|
'Y = 20
|
|
'REDIM Item$(8)
|
|
'Item$(0) = "* * Save * *"
|
|
'FOR I = 1 TO UBOUND(Item$)
|
|
'Item$(I) = LTRIM$(STR$(I)) + ".RelSoft 2000"
|
|
'NEXT I
|
|
'P = PullDown(X, Y, Item$(),True)
|
|
'========End Sample========================
|
|
|
|
MaxItem = UBOUND(Item$)
|
|
REDIM PointerCoord(0 TO MaxItem) AS CoordType
|
|
REDIM PointerCoord2(0 TO MaxItem) AS CoordType
|
|
|
|
REDIM PTemp(34), Ptemp2(34)
|
|
REDIM Temp(1)
|
|
|
|
PullDown = 0
|
|
KgenStart = 30
|
|
|
|
FOR I = 0 TO MaxItem
|
|
Item$(I) = LTRIM$(RTRIM$(Item$(I)))
|
|
NEXT I
|
|
|
|
'Calculate how big our box is
|
|
X1 = X
|
|
Y1 = Y
|
|
|
|
GOSUB CalcBox
|
|
|
|
|
|
GetBG X1, Y1, X2, Y2, Temp()
|
|
|
|
TransLuc 170, X1, Y1, X2, Y2 '170 best
|
|
|
|
'=Title
|
|
XX = ((X2 - X1) \ 2) - (4 * (LEN(Item$(0))))
|
|
KgenFont X1 + XX - 8, Y1 + 11, Item$(0), KgenMin, NOT Italic
|
|
KgenFont X1 + (XX - 8) + 1, Y1 + 12, Item$(0), KgenBlueMin, NOT Italic
|
|
|
|
GOSUB InitCoord
|
|
GOSUB DrawItem
|
|
OutPullDown = False
|
|
|
|
I = 1
|
|
GOSUB GetPLtemp
|
|
PutPointer PointerCoord(I).X - 12, PointerCoord(I).Y, PointerCoord2(I).X, PointerCoord2(I).Y
|
|
|
|
|
|
DO
|
|
|
|
|
|
IF RGBCounter(RGBC * 6) THEN RotateRGB
|
|
WAIT &H3DA, 8
|
|
GOSUB CheckKey
|
|
|
|
|
|
LOOP UNTIL OutPullDown
|
|
|
|
PUT (X1, Y1), Temp, PSET
|
|
|
|
RefreshKey
|
|
|
|
ERASE PointerCoord, PointerCoord2, PTemp, Ptemp2, Temp
|
|
|
|
EXIT FUNCTION
|
|
|
|
''==============Subs=========
|
|
'============
|
|
|
|
CheckKey:
|
|
|
|
SELECT CASE FastKB
|
|
CASE KRight, KD
|
|
CASE KLeft, KA
|
|
CASE KDown, KS
|
|
GOSUB PutPLtemp
|
|
I = I MOD MaxItem + 1
|
|
GOSUB GetPLtemp
|
|
PutPointer PointerCoord(I).X - 12, PointerCoord(I).Y, PointerCoord2(I).X, PointerCoord2(I).Y
|
|
GOSUB DosoundP
|
|
CASE KUp, KW
|
|
GOSUB PutPLtemp
|
|
I = (I + MaxItem - 2) MOD MaxItem + 1
|
|
GOSUB GetPLtemp
|
|
PutPointer PointerCoord(I).X - 12, PointerCoord(I).Y, PointerCoord2(I).X, PointerCoord2(I).Y
|
|
GOSUB DosoundP
|
|
CASE KEsc
|
|
OutPullDown = True
|
|
PullDown = 0
|
|
GOSUB Dosound2P
|
|
CASE KEnt, KSpc
|
|
OutPullDown = True
|
|
GOSUB Dosound2P
|
|
PullDown = I
|
|
CASE ELSE
|
|
END SELECT
|
|
|
|
RETURN
|
|
|
|
'============
|
|
InitCoord:
|
|
|
|
Ystep = 14
|
|
YY = Y1 + Ystep + 16
|
|
|
|
FOR I = 1 TO MaxItem
|
|
|
|
PointerCoord(I).X = X1 + 30
|
|
PointerCoord(I).Y = YY
|
|
YY = YY + Ystep
|
|
|
|
NEXT I
|
|
|
|
RETURN
|
|
|
|
|
|
|
|
|
|
'==========
|
|
DrawItem:
|
|
|
|
FOR I = 1 TO MaxItem
|
|
|
|
Font$ = LEFT$(LTRIM$(Item$(I)), 1)
|
|
Font2$ = RIGHT$(LTRIM$(Item$(I)), LEN(Item$(I)) - 1)
|
|
|
|
KgenFont PointerCoord(I).X + 1, PointerCoord(I).Y - 1, Font$, KgenMin, False
|
|
KgenFont PointerCoord(I).X, PointerCoord(I).Y, Font$, KgenGreenMin, False
|
|
KgenFont PointerCoord(I).X + 10, PointerCoord(I).Y, Font2$, KgenStart, Italic
|
|
IF Italic THEN
|
|
PointerCoord2(I).X = PointerCoord(I).X + ((LEN(Font2$) + 2) * 8) + 5
|
|
ELSE
|
|
PointerCoord2(I).X = PointerCoord(I).X + ((LEN(Font2$) + 2) * 8)
|
|
END IF
|
|
PointerCoord2(I).Y = PointerCoord(I).Y
|
|
|
|
NEXT I
|
|
|
|
RETURN
|
|
|
|
'========
|
|
DosoundP:
|
|
FOR SI = 500 TO 2000 STEP 100
|
|
SOUND SI, .1
|
|
NEXT SI
|
|
FOR SI = 1000 TO 500 STEP -100
|
|
SOUND SI, .1
|
|
NEXT SI
|
|
|
|
RETURN
|
|
'=======
|
|
Dosound2P:
|
|
|
|
DIM Dsi AS SINGLE
|
|
Dsi = .9
|
|
|
|
FOR SI = 300 TO 3000 STEP 50
|
|
IF Dsi > .1 THEN Dsi = Dsi - .1
|
|
SOUND SI, Dsi
|
|
NEXT SI
|
|
|
|
RETURN
|
|
|
|
|
|
|
|
'========
|
|
|
|
GetPLtemp:
|
|
GET (PointerCoord(I).X - 12, PointerCoord(I).Y)-STEP(8, 6), PTemp
|
|
GET (PointerCoord2(I).X, PointerCoord2(I).Y)-STEP(8, 6), Ptemp2
|
|
RETURN
|
|
|
|
PutPLtemp:
|
|
PUT (PointerCoord(I).X - 12, PointerCoord(I).Y), PTemp, PSET
|
|
PUT (PointerCoord2(I).X, PointerCoord2(I).Y), Ptemp2, PSET
|
|
|
|
RETURN
|
|
|
|
|
|
'===========
|
|
|
|
CalcBox:
|
|
|
|
|
|
FOR I = 0 TO MaxItem
|
|
IF LEN(Item$(I)) > 18 THEN
|
|
Item$(I) = LEFT$(Item$(I), 18)
|
|
END IF
|
|
NEXT I
|
|
|
|
Longest = LEN(Item$(0))
|
|
|
|
FOR I = 1 TO MaxItem
|
|
IF LEN(Item$(I)) > Longest THEN
|
|
Longest = LEN(Item$(I))
|
|
END IF
|
|
NEXT I
|
|
|
|
IF Italic THEN
|
|
LL = 16
|
|
ELSE
|
|
LL = 12
|
|
END IF
|
|
|
|
Y2 = (Y1 + 20 + 14 + (MaxItem * 14))
|
|
X2 = (X1 + (Longest * 8)) + 55 + LL
|
|
|
|
RETURN
|
|
|
|
|
|
END FUNCTION
|
|
|
|
SUB PutBall (BallX, BallY) STATIC
|
|
|
|
|
|
PUT (BallX, BallY), Ball(BallIndex(1)), AND
|
|
PUT (BallX, BallY), Ball(BallIndex(2)), XOR
|
|
|
|
END SUB
|
|
|
|
SUB PutBallBG (BallOldX, BallOldY) STATIC
|
|
PUT (BallOldX, BallOldY), BallBG, PSET
|
|
END SUB
|
|
|
|
SUB PutBlkHole (X, Y) STATIC
|
|
|
|
I = I MOD UBOUND(BlkHoleIndex) + 1
|
|
PUT (X, Y), BlkHoleMsk(BlkHoleIndex(I)), AND
|
|
PUT (X, Y), BlkHole(BlkHoleIndex(I)), OR
|
|
|
|
END SUB
|
|
|
|
SUB PutBlkHoleBG STATIC
|
|
|
|
FOR I = 1 TO 4
|
|
IF BlkHoleXY(I).X <> 0 THEN
|
|
PUT (BlkHoleXY(I).X, BlkHoleXY(I).Y), BlkHoleBG(130 * (I - 1)), PSET
|
|
END IF
|
|
NEXT I
|
|
|
|
END SUB
|
|
|
|
SUB PutBomb (X, Y, Switch) STATIC
|
|
|
|
'Switch must be 1 or 2
|
|
|
|
PUT (X, Y), BombMsk(BombIndex(Switch)), AND
|
|
PUT (X, Y), Bomb(BombIndex(Switch)), OR
|
|
|
|
END SUB
|
|
|
|
SUB PutBombBG STATIC
|
|
|
|
FOR I = 1 TO UBOUND(BombXY)
|
|
IF BombXY(I).X <> 0 THEN
|
|
PUT (BombXY(I).X, BombXY(I).Y), BombBG(130 * (I - 1)), PSET
|
|
END IF
|
|
NEXT I
|
|
|
|
END SUB
|
|
|
|
SUB PutLangaw (X, Y, Axn) STATIC
|
|
|
|
'Axn=1 or 2
|
|
PUT (X, Y), Langaw(LangawIndex(Axn + 2)), AND
|
|
PUT (X, Y), Langaw(LangawIndex(Axn)), OR
|
|
|
|
|
|
END SUB
|
|
|
|
SUB PutPaddle (PadX, PadY) STATIC
|
|
|
|
IF PadPower THEN
|
|
IF Replicant THEN
|
|
PUT (PadX, PadY), Paddle(PaddleIndex(3)), AND
|
|
PUT (PadX, PadY), Paddle(PaddleIndex(4)), OR
|
|
PUT (PadX + 38, PadY), Paddle(PaddleIndex(3)), AND
|
|
PUT (PadX + 38, PadY), Paddle(PaddleIndex(4)), OR
|
|
ELSE
|
|
PUT (PadX, PadY), Paddle(PaddleIndex(3)), AND
|
|
PUT (PadX, PadY), Paddle(PaddleIndex(4)), OR
|
|
END IF
|
|
ELSE
|
|
IF Replicant THEN
|
|
PUT (PadX, PadY), Paddle(PaddleIndex(1)), AND
|
|
PUT (PadX, PadY), Paddle(PaddleIndex(2)), OR
|
|
PUT (PadX + 38, PadY), Paddle(PaddleIndex(1)), AND
|
|
PUT (PadX + 38, PadY), Paddle(PaddleIndex(2)), OR
|
|
ELSE
|
|
PUT (PadX, PadY), Paddle(PaddleIndex(1)), AND
|
|
PUT (PadX, PadY), Paddle(PaddleIndex(2)), OR
|
|
END IF
|
|
|
|
END IF
|
|
|
|
END SUB
|
|
|
|
SUB PutPaddleBG (PadOldX, PadOldY) STATIC
|
|
PUT (PadOldX, PadOldY), PaddleBG, PSET
|
|
END SUB
|
|
|
|
SUB PutPadLsr (X, Y) STATIC
|
|
|
|
PUT (X, Y), Padlsr(PadlsrIndex(2)), AND
|
|
PUT (X, Y), Padlsr(PadlsrIndex(1)), OR
|
|
|
|
END SUB
|
|
|
|
SUB PutPadLsrBG (Image1(), Image2()) STATIC
|
|
|
|
PUT (PadLsrOldCoord(0).X, PadLsrOldCoord(0).Y), Image1, PSET
|
|
PUT (PadLsrOldCoord(1).X, PadLsrOldCoord(1).Y), Image2, PSET
|
|
|
|
END SUB
|
|
|
|
SUB PutPointer (X, Y, X2, Y2) STATIC
|
|
|
|
PUT (X, Y), Pointer(PointerIndex(1)), AND
|
|
PUT (X, Y), Pointer(PointerIndex(2)), OR
|
|
|
|
PUT (X2, Y2), Pointer(PointerIndex(3)), AND
|
|
PUT (X2, Y2), Pointer(PointerIndex(4)), OR
|
|
|
|
|
|
|
|
END SUB
|
|
|
|
SUB PutPowerCaps (X, Y, PowType) STATIC
|
|
|
|
PUT (X, Y), PowerCaps(PowerCapsIndex(4)), AND
|
|
PUT (X, Y), PowerCaps(PowerCapsIndex(PowType)), OR
|
|
|
|
END SUB
|
|
|
|
SUB PutPowerCapsBG STATIC
|
|
PUT (PowerCapsOldCoord(0).X, PowerCapsOldCoord(0).Y), PowerCapsBG, PSET
|
|
END SUB
|
|
|
|
SUB ReadLevel (Lvl) STATIC
|
|
|
|
OpenLvlFile Path$ + "levels\" + "qbnoid" + LTRIM$(STR$(Lvl)) + "." + "lvl"
|
|
|
|
TileNumber = 0
|
|
|
|
|
|
FOR I = 0 TO TileMax
|
|
IF Tile(I).F THEN
|
|
DrawTile Tile(I).X, Tile(I).Y, Tile(I).C
|
|
IF Tile(I).C <> 9 THEN
|
|
TileNumber = TileNumber + 1
|
|
END IF
|
|
END IF
|
|
NEXT I
|
|
|
|
END SUB
|
|
|
|
SUB ReadRGB (C%, R%, g%, B%)
|
|
|
|
OUT &H3C7, C%
|
|
R% = INP(&H3C9)
|
|
g% = INP(&H3C9)
|
|
B% = INP(&H3C9)
|
|
|
|
END SUB
|
|
|
|
SUB RefreshKey STATIC
|
|
|
|
DEF SEG = &H40
|
|
POKE &H1A, PEEK(&H1C)
|
|
DEF SEG
|
|
|
|
|
|
END SUB
|
|
|
|
SUB ReInitBallSpd STATIC
|
|
|
|
SELECT CASE SGN(BallXV)
|
|
CASE -1
|
|
BallXV = -BallSpd
|
|
CASE 1
|
|
BallXV = BallSpd
|
|
CASE ELSE
|
|
END SELECT
|
|
|
|
SELECT CASE SGN(BallYV)
|
|
CASE -1
|
|
BallYV = -BallSpd
|
|
CASE 1
|
|
BallYV = BallSpd
|
|
CASE ELSE
|
|
END SELECT
|
|
|
|
|
|
|
|
END SUB
|
|
|
|
SUB ReinitValues STATIC
|
|
|
|
BallSpd = 1 'Change for Speed
|
|
|
|
|
|
BallXV = BallSpd
|
|
BallYV = -BallSpd
|
|
|
|
|
|
|
|
PadX = 105
|
|
PadY = 170
|
|
PadOldX = PadX
|
|
PadOldY = PadY
|
|
|
|
|
|
ColorAttr = 1 + INT(RND * 7)
|
|
ColorStep = 1 + INT(RND * 50)
|
|
Level = Level MOD 50 + 1
|
|
|
|
'Power ups
|
|
PadPower = False 'Paddle changes and can shoot
|
|
Replicant = False 'Replicates ur paddle
|
|
MultiBall = False '?????? not a power up makes d game harder
|
|
Shooting = False
|
|
Lshot = False
|
|
Rshot = False
|
|
Power = False
|
|
BossEnter = False
|
|
|
|
|
|
'Sounds
|
|
SdHitPad = False 'Sound for PaddleHit
|
|
SdHitTile = False
|
|
SdHitBoss = False
|
|
|
|
LimitScore
|
|
|
|
|
|
END SUB
|
|
|
|
SUB RestoreColors
|
|
II = 0
|
|
I = 0
|
|
|
|
|
|
FOR II = 0 TO 63
|
|
|
|
|
|
FOR I = 0 TO 255
|
|
RefreshKey
|
|
|
|
ReadRGB I, RR, GG, BB
|
|
R = SavRGB(I).R
|
|
g = SavRGB(I).g
|
|
B = SavRGB(I).B
|
|
|
|
IF R > RR THEN
|
|
RR = RR + 1
|
|
ELSEIF R < RR THEN
|
|
RR = RR - 1
|
|
ELSE
|
|
'Do nothing
|
|
END IF
|
|
|
|
IF g > GG THEN
|
|
GG = GG + 1
|
|
ELSEIF g < GG THEN
|
|
GG = GG - 1
|
|
ELSE
|
|
'Do nothing
|
|
END IF
|
|
|
|
IF B > BB THEN
|
|
BB = BB + 1
|
|
ELSEIF B < BB THEN
|
|
BB = BB - 1
|
|
ELSE
|
|
'Do nothing
|
|
END IF
|
|
|
|
WriteRGB I, RR, GG, BB
|
|
|
|
NEXT I
|
|
|
|
MilliDelay 30
|
|
WAIT &H3DA, 8
|
|
WAIT &H3DA, 8, 8
|
|
|
|
NEXT II
|
|
|
|
|
|
END SUB
|
|
|
|
FUNCTION RGBCounter (MaxCounter) STATIC
|
|
|
|
'==========Counts until reaches MaxCounter then True is returned else False
|
|
'==========Used to make Color rotation at same speed
|
|
|
|
RGBCounter = False
|
|
|
|
I = I MOD MaxCounter + 1
|
|
IF I = MaxCounter THEN
|
|
RGBCounter = True
|
|
END IF
|
|
|
|
END FUNCTION
|
|
|
|
SUB RotateRGB STATIC
|
|
|
|
'==KGen==================
|
|
'red
|
|
FOR I = KgenMin TO KgenMax - 1
|
|
SWAP SavRGB(I), SavRGB(I + 1)
|
|
NEXT I
|
|
FOR I = KgenMin TO KgenMax
|
|
WriteRGB I, SavRGB(I).R, SavRGB(I).g, SavRGB(I).B
|
|
NEXT I
|
|
|
|
'blue
|
|
FOR I = KgenBlueMax TO KgenBlueMin + 1 STEP -1 'Shift Direction Down
|
|
SWAP SavRGB(I), SavRGB(I - 1)
|
|
NEXT I
|
|
FOR I = KgenBlueMin TO KgenBlueMax
|
|
WriteRGB I, SavRGB(I).R, SavRGB(I).g, SavRGB(I).B
|
|
NEXT I
|
|
|
|
'Green
|
|
FOR I = KgenGreenMin TO KgenGreenMax - 1
|
|
SWAP SavRGB(I), SavRGB(I + 1)
|
|
NEXT I
|
|
FOR I = KgenGreenMin TO KgenGreenMax
|
|
WriteRGB I, SavRGB(I).R, SavRGB(I).g, SavRGB(I).B
|
|
NEXT I
|
|
|
|
|
|
'==End Kgen==========================
|
|
|
|
'======Pointer=======================
|
|
|
|
IF PointerC > 57 THEN ClrDir = 1
|
|
IF PointerC < 20 THEN ClrDir = 0
|
|
|
|
IF ClrDir = 0 THEN PointerC = PointerC + 5
|
|
IF ClrDir = 1 THEN PointerC = PointerC - 5
|
|
|
|
WriteRGB 244, 0, PointerC, 33 'Inside of pointer
|
|
WriteRGB 245, PointerC, 33, PointerC 'Border of pointer
|
|
|
|
'======End pointer===================
|
|
|
|
'======Paddle========================
|
|
|
|
FOR I = PadColorMin TO PadColorMax - 1
|
|
SWAP SavRGB(I), SavRGB(I + 1)
|
|
NEXT I
|
|
FOR I = PadColorMin TO PadColorMax
|
|
WriteRGB I, SavRGB(I).R, SavRGB(I).g, SavRGB(I).B
|
|
NEXT I
|
|
|
|
'=====end paddle====================
|
|
|
|
END SUB
|
|
|
|
SUB SaveColors
|
|
|
|
FOR I = 0 TO 255
|
|
ReadRGB I, R, g, B
|
|
SavRGB(I).R = R
|
|
SavRGB(I).g = g
|
|
SavRGB(I).B = B
|
|
NEXT I
|
|
|
|
END SUB
|
|
|
|
SUB SaveGame STATIC
|
|
|
|
|
|
X = 0
|
|
Y = 0
|
|
REDIM Item$(8)
|
|
|
|
Item$(0) = "* * Save * *"
|
|
FOR I = 1 TO UBOUND(Item$)
|
|
Item$(I) = LTRIM$(STR$(Save(I).Num)) + "." + Save(I).Namer
|
|
NEXT I
|
|
|
|
|
|
P = PullDown(X, Y, Item$(), False)
|
|
|
|
IF P <> 0 THEN
|
|
|
|
GOSUB EnterLevel
|
|
|
|
IF LEN(LTRIM$(Item$(P))) > 1 AND P$ = CHR$(13) THEN
|
|
'Saveit
|
|
Save(P).Num = P
|
|
Save(P).Namer = Item$(P)
|
|
Save(P).Score = Score&
|
|
Save(P).Level = Level
|
|
Save(P).Lives = Lives
|
|
GOSUB Saveit
|
|
END IF
|
|
|
|
END IF
|
|
|
|
|
|
EXIT SUB
|
|
|
|
|
|
'================Subs========================
|
|
|
|
EnterLevel:
|
|
|
|
DX = 0
|
|
DY = 150
|
|
MaxLen = 39
|
|
Title$ = ""
|
|
Tmin = PadColorMin
|
|
Text$ = "Save this game as..." + "#" + LTRIM$(STR$(P)) + "[" + SPACE$(12) + "]"
|
|
Sysmod = False
|
|
REDIM Temp(1)
|
|
GetBG DX, DY, DX + 319, DY + 20, Temp()
|
|
DialogBox DX, DY, MaxLen, Tmin, Title$, Text$, False, Sysmod
|
|
Item$(P) = ""
|
|
|
|
REDIM ST(1)
|
|
GetBG DX + 188, DY + 4, DX + 188 + (12 * 8), DY + 4 + 8, ST()
|
|
PUT (DX + 188, DY + 4), ST, PSET
|
|
|
|
|
|
DO
|
|
|
|
DO
|
|
P$ = INKEY$
|
|
IF LEN(Item$(P)) < 12 THEN
|
|
KgenFont DX + 188 + (LEN(Item$(P)) * 8), DY + 5, "_", KgenMin, False
|
|
END IF
|
|
IF RGBCounter(RGBC * 5) THEN RotateRGB
|
|
WAIT &H3DA, 8
|
|
|
|
LOOP UNTIL P$ <> ""
|
|
|
|
IF ASC(P$) >= 32 AND ASC(P$) <= 127 THEN
|
|
IF LEN(Item$(P)) < 12 THEN
|
|
Item$(P) = Item$(P) + (P$)
|
|
PUT (DX + 188, DY + 4), ST, PSET
|
|
KgenFont DX + 188, DY + 5, Item$(P), KgenBlueMin, False
|
|
SOUND 1200, 1
|
|
RefreshKey
|
|
ELSE
|
|
RefreshKey
|
|
END IF
|
|
ELSE
|
|
IF P$ = CHR$(8) THEN
|
|
IF LEN(Item$(P)) > 0 THEN
|
|
Item$(P) = LEFT$(Item$(P), LEN(Item$(P)) - 1)
|
|
PUT (DX + 188, DY + 4), ST, PSET
|
|
KgenFont DX + 188, DY + 5, Item$(P), KgenBlueMin, False
|
|
SOUND 1200, 1
|
|
RefreshKey
|
|
ELSE
|
|
RefreshKey
|
|
END IF
|
|
END IF
|
|
END IF
|
|
|
|
LOOP UNTIL P$ = CHR$(13) OR P$ = CHR$(27)
|
|
|
|
PUT (DX, DY), Temp, PSET
|
|
SfxOpenDialog
|
|
|
|
RETURN
|
|
|
|
'=====================
|
|
|
|
Saveit:
|
|
|
|
OPEN Path$ + "saves\" + "qbnoid.qsv" FOR OUTPUT AS #1
|
|
|
|
FOR I = 1 TO 8
|
|
|
|
SaveNum = Save(I).Num
|
|
Name$ = Save(I).Namer
|
|
ScoreTemp& = Save(I).Score
|
|
LevelTemp = Save(I).Level
|
|
LivesTemp = Save(I).Lives
|
|
|
|
PRINT #1, SaveNum
|
|
PRINT #1, Name$
|
|
PRINT #1, ScoreTemp&
|
|
PRINT #1, LevelTemp
|
|
PRINT #1, LivesTemp
|
|
NEXT I
|
|
|
|
CLOSE
|
|
|
|
RETURN
|
|
|
|
|
|
END SUB
|
|
|
|
SUB ScrollKgenTT (TopY, Text$, Xscale, Yscale, MinColor, Shadow, OverTop, OverTopY, Italic, FirstTime) STATIC
|
|
|
|
'==========Scrolls Scalable KgenTT Fonts on screen=========================
|
|
'Sample code
|
|
'Text$ = "Richard Eric M. Lope Bsn Rn WVSU College of Nursing. This is Very Cool!!!!!! "
|
|
'Xscale = 2
|
|
'YScale = 5
|
|
'TopY = 199 - ((YScale) * 9)
|
|
'MinColor = KgenBlueMin
|
|
'Shadow = True
|
|
'OverTop = True
|
|
'OtY = 0
|
|
'Italic = True
|
|
'FirstTime=True 'always True
|
|
'DO
|
|
'ScrollKgenTT TopY, Text$, Xscale, YScale, MinColor, Shadow, OverTop, OtY, Italic
|
|
'CC = CC MOD 8 + 1
|
|
'IF CC = 1 THEN RotateRGB
|
|
'LOOP UNTIL INKEY$ <> ""
|
|
'End sample
|
|
'========================================================================
|
|
|
|
IF FirstTime THEN
|
|
P = 0
|
|
PP = 0
|
|
Counter = 0
|
|
FirstTime = NOT FirstTime
|
|
END IF
|
|
|
|
|
|
|
|
Y = TopY
|
|
Y2 = OverTopY
|
|
X = 1
|
|
T$ = Text$
|
|
Xs = Xscale
|
|
YS = Yscale
|
|
C = MinColor
|
|
L = LEN(Text$)
|
|
|
|
REDIM Scroll(1)
|
|
REDIM Scroll2(1)
|
|
REDIM L$(L)
|
|
|
|
FOR I = 1 TO L
|
|
L$(I) = MID$(T$, I, 1)
|
|
NEXT I
|
|
|
|
|
|
XX = 312 - (Xs * 9)
|
|
|
|
IF Shadow THEN
|
|
XXX = (8 * Xs) + 1
|
|
ELSE
|
|
XXX = 8 * Xs
|
|
END IF
|
|
|
|
|
|
GetBG X, Y, 319, Y + (8 * YS) + YS, Scroll()
|
|
PUT (X - 1, Y), Scroll, PSET
|
|
IF OverTop THEN
|
|
GetBG 0, Y2, 318, Y2 + (8 * YS) + YS, Scroll2()
|
|
PUT (1, Y2), Scroll2, PSET
|
|
END IF
|
|
|
|
Counter = (Counter MOD (Xs * 8)) + 1
|
|
|
|
|
|
IF Counter = 1 THEN
|
|
P = P MOD L + 1
|
|
PP = (PP + L - 2) MOD L + 1
|
|
IF Shadow THEN
|
|
KgenTTFont XX - 1, Y - 1, L$(P), KgenMin, Xs, YS, Italic
|
|
IF OverTop THEN
|
|
KgenTTFont XXX - 1, Y2, L$(PP), KgenMin, Xs, YS, Italic
|
|
END IF
|
|
END IF
|
|
|
|
KgenTTFont XX, Y, L$(P), C, Xs, YS, Italic
|
|
IF OverTop THEN
|
|
KgenTTFont XXX, Y2 + 1, L$(PP), C, Xs, YS, Italic
|
|
END IF
|
|
|
|
|
|
END IF
|
|
|
|
END SUB
|
|
|
|
SUB SelectLevel
|
|
|
|
|
|
ReadLevel Level
|
|
|
|
|
|
FOR I = 1 TO UBOUND(BombXY)
|
|
BombXY(I).X = 0
|
|
BombXY(I).Y = 0
|
|
NEXT I
|
|
|
|
BombNum = UBOUND(BombXY)
|
|
|
|
FOR I = 1 TO UBOUND(BlkHoleXY)
|
|
BlkHoleXY(I).X = 0
|
|
BlkHoleXY(I).Y = 0
|
|
NEXT I
|
|
BombSTG = False
|
|
BossStg = False
|
|
|
|
|
|
SELECT CASE Level
|
|
CASE 5
|
|
'Bonus 1
|
|
CalcBombCoord 5
|
|
CASE 10
|
|
'Boss 1
|
|
|
|
BossX = 73
|
|
BossY = 9
|
|
DrawBoss BossX, BossY, "Rotator"
|
|
TileNumber = 1
|
|
BossLife = 2000
|
|
BlkHoleXY(1).X = 24
|
|
BlkHoleXY(1).Y = 95
|
|
BlkHoleXY(2).X = 60
|
|
BlkHoleXY(2).Y = 55
|
|
BlkHoleXY(3).X = 185
|
|
BlkHoleXY(3).Y = 55
|
|
BlkHoleXY(4).X = 220
|
|
BlkHoleXY(4).Y = 95
|
|
BossStg = True
|
|
CalcLangawCoord
|
|
CASE 15
|
|
'Bonus 2
|
|
CalcBombCoord 4
|
|
CASE 20
|
|
'Boss 2
|
|
BossX = 85
|
|
BossY = 9
|
|
DrawBoss BossX, BossY, "TGL"
|
|
TileNumber = 1
|
|
BossLife = 2500
|
|
BlkHoleXY(1).X = 22
|
|
BlkHoleXY(1).Y = 59
|
|
BlkHoleXY(2).X = 230
|
|
BlkHoleXY(2).Y = 59
|
|
BlkHoleXY(3).X = 70
|
|
BlkHoleXY(3).Y = 91
|
|
BlkHoleXY(4).X = 180
|
|
BlkHoleXY(4).Y = 91
|
|
BossStg = True
|
|
CalcLangawCoord
|
|
CASE 25
|
|
'Bonus 3
|
|
CalcBombCoord 3
|
|
|
|
CASE 30
|
|
'Boss 3
|
|
BossX = 45
|
|
BossY = 11
|
|
DrawBoss BossX, BossY, "Ku2"
|
|
TileNumber = 1
|
|
BossLife = 3000
|
|
BlkHoleXY(1).X = 95
|
|
BlkHoleXY(1).Y = 110
|
|
BlkHoleXY(2).X = 150
|
|
BlkHoleXY(2).Y = 110
|
|
BlkHoleXY(3).X = 72
|
|
BlkHoleXY(3).Y = 90
|
|
BlkHoleXY(4).X = 176
|
|
BlkHoleXY(4).Y = 90
|
|
BossStg = True
|
|
CalcLangawCoord
|
|
CASE 35
|
|
'Bonus 4
|
|
CalcBombCoord 2
|
|
CASE 40
|
|
'Boss 4
|
|
BossX = 63
|
|
BossY = 9
|
|
DrawBoss BossX, BossY, "Mummy"
|
|
TileNumber = 1
|
|
BossLife = 4000
|
|
BlkHoleXY(1).X = 23
|
|
BlkHoleXY(1).Y = 100
|
|
BlkHoleXY(2).X = 23
|
|
BlkHoleXY(2).Y = 80
|
|
BlkHoleXY(3).X = 226
|
|
BlkHoleXY(3).Y = 80
|
|
BlkHoleXY(4).X = 226
|
|
BlkHoleXY(4).Y = 100
|
|
|
|
BossStg = True
|
|
CalcLangawCoord
|
|
CASE 45
|
|
'Bonus 5
|
|
CalcBombCoord 1
|
|
|
|
CASE 50
|
|
'Boss 5
|
|
|
|
BossX = 97
|
|
BossY = 11
|
|
DrawBoss BossX, BossY, "SkullQB"
|
|
TileNumber = 1
|
|
BossLife = 5000
|
|
BlkHoleXY(1).X = 17
|
|
BlkHoleXY(1).Y = 130
|
|
BlkHoleXY(2).X = 112
|
|
BlkHoleXY(2).Y = 130
|
|
BlkHoleXY(3).X = 133
|
|
BlkHoleXY(3).Y = 130
|
|
BlkHoleXY(4).X = 226
|
|
BlkHoleXY(4).Y = 130
|
|
|
|
BossStg = True
|
|
CalcLangawCoord
|
|
CASE ELSE
|
|
'load Normal Levels
|
|
BossLife = 1
|
|
FOR I = 1 TO 4
|
|
BlkHoleXY(I).X = 0
|
|
BlkHoleXY(I).Y = 0
|
|
NEXT
|
|
|
|
|
|
|
|
|
|
END SELECT
|
|
|
|
PrintLevel
|
|
GetBlkHoleBG
|
|
|
|
END SUB
|
|
|
|
SUB SfxOpenDialog STATIC
|
|
|
|
FOR II = 400 TO 900 STEP 10
|
|
SOUND II, .1
|
|
NEXT II
|
|
|
|
|
|
END SUB
|
|
|
|
SUB SfxPowerUp STATIC
|
|
|
|
DIM Dsi AS SINGLE
|
|
|
|
GetBallBG BallX, BallY
|
|
GetPaddleBG PadX, PadY
|
|
|
|
PutBall BallX, BallY
|
|
PutPaddle PadX, PadY
|
|
FOR SI = 500 TO 1400 STEP 100
|
|
Dsi = RND
|
|
SOUND SI, Dsi
|
|
NEXT SI
|
|
PutPaddleBG PadOldX, PadOldY
|
|
PutBallBG BallOldX, BallOldY
|
|
END SUB
|
|
|
|
SUB SndExplode STATIC
|
|
|
|
|
|
FOR SI = 3000 TO 400 STEP -250
|
|
SOUND SI, .1
|
|
NEXT SI
|
|
|
|
END SUB
|
|
|
|
SUB SortIt STATIC
|
|
'Dont Bother with this. It's bubble sort Slow but gets the job done this time
|
|
|
|
DO
|
|
Switcher = False
|
|
FOR I = 1 TO 4
|
|
IF Hall(I).Score < Hall(I + 1).Score THEN
|
|
|
|
Hall(I + 1).Rank = I
|
|
Hall(I).Rank = I + 1
|
|
SWAP Hall(I), Hall(I + 1)
|
|
|
|
Switcher = True
|
|
|
|
END IF
|
|
NEXT I
|
|
LOOP WHILE Switcher
|
|
|
|
|
|
END SUB
|
|
|
|
FUNCTION SpecialStage (DX, DY, MaxLen, Tmin, Title$, Text$)
|
|
|
|
SpecialStage = False
|
|
DX = 0
|
|
DY = 0
|
|
MaxLen = 0
|
|
Title$ = ""
|
|
Tmin = PadColorMin
|
|
Text$ = ""
|
|
|
|
|
|
SELECT CASE Level
|
|
'====Bosses=================
|
|
CASE 10
|
|
DX = 22
|
|
DY = 70
|
|
MaxLen = 27
|
|
Title$ = "Rotator:"
|
|
Tmin = PadColorMin
|
|
Text$ = "~~~~You have beat me first to have a chance at defeating GIGA!!! Not even KONAMI(tm) could stop me!"
|
|
SpecialStage = True
|
|
CASE 20
|
|
DX = 22
|
|
DY = 70
|
|
MaxLen = 27
|
|
Title$ = "ZAVOT:"
|
|
Tmin = PadColorMin
|
|
Text$ = "~~~~This would be your last stop! Ull die here 4 sure. I Zavot will shave all of your hair! Mwa ha ha ha..."
|
|
SpecialStage = True
|
|
CASE 30
|
|
DX = 22
|
|
DY = 70
|
|
MaxLen = 27
|
|
Title$ = "Ku2:"
|
|
Tmin = PadColorMin
|
|
Text$ = "~~~~Hik hik hik hik... I you dare challenge me?! The parasites of all parasites?! Ha! I'll kill you now..."
|
|
SpecialStage = True
|
|
CASE 40
|
|
DX = 22
|
|
DY = 70
|
|
MaxLen = 27
|
|
Title$ = "The Rock:"
|
|
Tmin = PadColorMin
|
|
Text$ = "~~~~Time will never stop me from conquering ur world. Without Brendan Frasier and his extremely vivacious wife 2 help u... I, the Scorpion King will be victorious!!!"
|
|
SpecialStage = True
|
|
|
|
CASE 50
|
|
DX = 22
|
|
DY = 70
|
|
MaxLen = 27
|
|
Title$ = "GIGA:"
|
|
Tmin = PadColorMin
|
|
Text$ = "~~~~You idiot!!! How many times do I have to kill one of your race 4 u 2 understand that even ur whole army can't withstand the wrath of Gago?! Now Die!!!"
|
|
SpecialStage = True
|
|
|
|
'======Bonus stages=========
|
|
CASE 5
|
|
GOSUB BonusDialog
|
|
CASE 15
|
|
GOSUB BonusDialog
|
|
CASE 25
|
|
GOSUB BonusDialog
|
|
CASE 35
|
|
GOSUB BonusDialog
|
|
CASE 45
|
|
GOSUB BonusDialog
|
|
CASE ELSE
|
|
END SELECT
|
|
|
|
|
|
EXIT FUNCTION
|
|
|
|
|
|
'==================
|
|
|
|
BonusDialog:
|
|
|
|
|
|
PUT (7, 183), SpikeBG, PSET
|
|
|
|
DX = 22
|
|
DY = 70
|
|
MaxLen = 27
|
|
Title$ = " Bonus Stage!"
|
|
Tmin = PadColorMin
|
|
Text$ = "~~~~Pop as much BOMBS as possible before time runs out! Good luck!"
|
|
SpecialStage = True
|
|
BombDes = 0
|
|
|
|
RETURN
|
|
|
|
END FUNCTION
|
|
|
|
SUB StartGame STATIC
|
|
|
|
|
|
PrintLives False
|
|
|
|
OutStart = False
|
|
BallSpd = 1
|
|
BounceCounter = 0
|
|
|
|
|
|
BallX = PadX + (16)
|
|
|
|
|
|
|
|
GetPadLsrCoord 0
|
|
GetPadLsrBG PadLsrBG1(), PadLsrBG2()
|
|
|
|
|
|
IF SpecialStage(DX, DY, MaxLen, MinColor, Title$, Text$) THEN
|
|
IF NOT BossEnter THEN
|
|
Sysmod = True
|
|
DialogBox DX, DY, MaxLen, MinColor, Title$, Text$, False, Sysmod
|
|
BossEnter = True
|
|
END IF
|
|
SpStage = True
|
|
ELSE
|
|
SpStage = False
|
|
END IF
|
|
|
|
|
|
'''==========Start Loop===============
|
|
|
|
DO
|
|
|
|
Shooting = False
|
|
Lshot = False
|
|
Rshot = False
|
|
|
|
GOSUB CheckForPadPower:
|
|
|
|
|
|
GetBallBG BallX, BallY
|
|
GetPaddleBG PadX, PadY
|
|
|
|
|
|
|
|
PutBall BallX, BallY
|
|
PutPaddle PadX, PadY
|
|
|
|
Flag = MovePaddle(PadX, PadY)
|
|
BallX = PadX + (16)
|
|
|
|
|
|
'Millidelay 2
|
|
|
|
|
|
WAIT &H3DA, 8
|
|
|
|
|
|
|
|
PutBallBG BallOldX, BallOldY
|
|
|
|
PutPaddleBG PadOldX, PadOldY
|
|
|
|
IF PadPower THEN
|
|
PutPadLsrBG PadLsrBG1(), PadLsrBG2()
|
|
END IF
|
|
|
|
|
|
GOSUB RotMisc
|
|
|
|
|
|
LOOP UNTIL OutStart
|
|
|
|
''===================End loop=========================
|
|
|
|
PutBombBG
|
|
DoBomb
|
|
|
|
|
|
BallXV = BallSpd
|
|
BallYV = -BallSpd
|
|
|
|
EXIT SUB
|
|
|
|
'==============Subs========================
|
|
CheckForPadPower:
|
|
|
|
IF PadPower THEN
|
|
IF NOT Shooting THEN
|
|
GetPadLsrCoord 0
|
|
GetPadLsrBG PadLsrBG1(), PadLsrBG2()
|
|
PutPadLsr PadLsrCoord(0).X, PadLsrCoord(0).Y
|
|
PutPadLsr PadLsrCoord(1).X, PadLsrCoord(1).Y
|
|
ELSE
|
|
DoPadLsr
|
|
END IF
|
|
BallY = PadY - 7
|
|
ELSE
|
|
BallY = PadY - 4
|
|
END IF
|
|
|
|
RETURN
|
|
|
|
'==============
|
|
RotMisc:
|
|
|
|
IF RGBCounter(RGBC) THEN RotateRGB
|
|
|
|
BlkCount = BlkCount MOD 5 + 1
|
|
BombCount = BombCount MOD 50 + 1
|
|
LangawCount = LangawCount MOD 2 + 1
|
|
|
|
IF LangawCount = 1 THEN
|
|
IF BossStg THEN
|
|
DoLangaw False
|
|
END IF
|
|
END IF
|
|
|
|
IF BlkCount = 1 THEN
|
|
DoBlkHole
|
|
|
|
END IF
|
|
|
|
IF BombCount = 1 THEN
|
|
GetBallBG BallX, BallY
|
|
GetPaddleBG PadX, PadY
|
|
|
|
PutBall BallX, BallY
|
|
PutPaddle PadX, PadY
|
|
|
|
PutBombBG
|
|
DoBomb
|
|
|
|
PutPaddleBG PadOldX, PadOldY
|
|
PutBallBG BallOldX, BallOldY
|
|
|
|
END IF
|
|
|
|
RETURN
|
|
|
|
|
|
|
|
|
|
END SUB
|
|
|
|
FUNCTION SubMenu STATIC
|
|
|
|
|
|
SubMenu = 0
|
|
|
|
X = 35
|
|
Y = 20
|
|
REDIM Item$(6)
|
|
|
|
Item$(0) = CHR$(2) + " Debug Code " + CHR$(2)
|
|
|
|
Item$(1) = "Skip Level!!!"
|
|
Item$(2) = "More Lives!!!"
|
|
Item$(3) = "No Spikes!!!"
|
|
Item$(4) = "Power Paddle!!!"
|
|
Item$(5) = "Replicant!!!"
|
|
Item$(6) = "Erase Saves!"
|
|
|
|
|
|
S = PullDown(X, Y, Item$(), True)
|
|
|
|
SubMenu = S
|
|
|
|
END FUNCTION
|
|
|
|
SUB TransLuc (n, X1, Y1, X2, Y2)
|
|
'N= Test Value of Color
|
|
'X1=MinX
|
|
'X2=MaxX
|
|
'Y1=MinY
|
|
'Y2=MaxY
|
|
|
|
|
|
DEF SEG = &HA000
|
|
FOR I = 0 TO 2
|
|
LINE (X1 + I, Y1 + I)-(X2 - I, Y1 + I), KgenMin + I + 1
|
|
LINE (X1 + I, Y1 + I)-STEP(0, I + 2), KgenMin + I + 1
|
|
LINE (X2 - I, Y1 + I)-STEP(0, I + 2), KgenMin + I + 1
|
|
NEXT I
|
|
|
|
FOR Y = Y1 + 3 TO Y2 - 3
|
|
POKE (Y * 320& + X1), KgenMin + 1
|
|
POKE (Y * 320& + X1 + 1), KgenMin + 2
|
|
POKE (Y * 320& + X1 + 2), KgenMin + 3
|
|
FOR X = X1 + 3 TO X2 - 3
|
|
C = PEEK(Y * 320& + X)
|
|
POKE (Y * 320& + X), Trans(C) + n
|
|
NEXT X
|
|
POKE (Y * 320& + X2), KgenMin + 1
|
|
POKE (Y * 320& + X2 - 1), KgenMin + 2
|
|
POKE (Y * 320& + X2 - 2), KgenMin + 3
|
|
NEXT Y
|
|
FOR I = 0 TO 2
|
|
LINE (X1 + I, Y2 - I)-(X2 - I, Y2 - I), KgenMin + I + 1
|
|
LINE (X1 + I, Y2 - I)-STEP(0, I - 2), KgenMin + I + 1
|
|
LINE (X2 - I, Y2 - I)-STEP(0, I - 2), KgenMin + I + 1
|
|
|
|
NEXT I
|
|
|
|
DEF SEG
|
|
|
|
END SUB
|
|
|
|
SUB WriteRGB (C%, R%, g%, B%)
|
|
|
|
OUT &H3C8, C%
|
|
|
|
OUT &H3C9, R%
|
|
OUT &H3C9, g%
|
|
OUT &H3C9, B%
|
|
|
|
END SUB
|
|
|