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 key..." Italic = True KgenFont X, Y, Font$, KgenBlueMin, Italic X = X1 + 33 Y = Y1 + 29 Font$ = "Press 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