'=========================================================================== ' Subject: GERMS (DR. MARIO(TM) LIKE GAME) Date: 04-01-97 (00:00) ' Author: The ABC Programmer Code: QB, QBasic, PDS ' Origin: voxel@freenet.edmonton.ab.ca Packet: GAMES.ABC '=========================================================================== '==================[ GERMS v1.0 Programmed by William Yu ]=================== ' ' Release: GERMS Version 1.0 by William Yu (03-30-97) ' Status: 100% Public Domain, please give credit where due. ' Trademarks: DR. MARIO is a trademark of Nintendo(R) ' Contact: e-mail: voxel@freenet.edmonton.ab.ca ' ' Description: A Dr. Mario(TM) like game. ' If you've never played the game before, you'll be hooked! ' It's similar to Tetris (ie. one player, strategy, addictive) ' ' Design: In honest, I have forgotten what Dr. Mario(TM) looked like ' or exactly how it behaved. The foundation for this game ' was based on Paul R. Tupaczewski's "DoubleLink" ' Released version 1.0, January 19, 1991. ' I'm surprised I still have the game on my HD, but I was ' hooked on it back then. ' 'Documentation: I've documented my code fairly extensively. Perhaps too ' much in some cases. There is probably some confusion to ' my use of the variables Cells and CellLength. Cells (or ' pills, which is a better definition), refers to a single ' "pill," of two colours. CellLength, is the length of such ' a "pill." So ( | ) = One Cell/Pill. ' CellHeight refers to the height of the cell/pill when it is ' in the horizontal position ( | ). ' If it were upright, the length would be: 2*CellHeight ' ' Tragedy: Upon the creation of this game, especially the joystick ' part of it, I decided to compile this program to test the ' speed of it... well, after exiting the program, I normal ' delete the .EXE file (for some reason I always do this), ' and well, you know how this story goes. I accidentally ' deleted ths .BAS file! Luckily I had UNDELETE, however, ' only 80% of the program was recovered, the rest I had ' to re-do. So here's my lesson, get a better UNDELETE ' oh yeah, and back-up your programs if you have the time. ' ' GamePlay: ' Object: To eliminate all "germs" (meanies, badies, etc.) from the ' playing field with your anti-germ pills. ' ' Controls: Keyboard, or joystick. Keyboard recommended on slow machines. ' Configurable (Speed Down, Drop, Rotate, Move Left, Move Right) ' Rotate is always clockwise (change it if you wish to, ie. instead ' of incrementing the Cycle, decrement it). ' For joystick control, do not hold down the button, nothing ' will happen. Each rotation is initiated upon every depressed ' button status, pending it wasn't held. ' ' How to Play: You control the pills coming from above. ' Rotate, move, or drop them on to the playing field so that ' you align the same 4 (check variable MatchIt) colours ' horizontally or vertically. ' ' Example: Assume (X = Blue, Y = Red, Z = Yellow) ' (Colour|Colour) = Pill, and * = germ ' ' | Playing Field | NOTE: You can change the ' | | number of required ' | | cells to be of the same ' |(X|Y) | colour in order to obtain ' | * | a match by modifying ' |(Z|Y) (X|X)(X|X) | the variable: MatchIt ' +-----------------+ ' ^^^^^^^^^^ ' the above (4 blue colours) will be eliminated ' Assuming MatchIt = 4 ' '---------------------------------------------------------------------------- DEFINT A-Z DECLARE SUB DrawTitle (Pill%(), PillColours%(), Clock%()) DECLARE SUB InitJoystick (JoyStick() AS ANY) DECLARE FUNCTION MatchVertical% (Grid%(), SX%, SY%) DECLARE FUNCTION MatchHorizontal% (Grid%(), SX%, SY%) DECLARE SUB RandCycle (Cycle%) DECLARE SUB SetColours (PillColours%()) DECLARE SUB SetBoundary (StartX%, StartY%, EndX%, EndY%, BoundY%, BoundXMin%, BoundXMax%) DECLARE SUB InitPills (Pill%(), PillColours%()) DECLARE SUB DrawBackGround () DECLARE SUB InitGrid (Grid%(), GridJoin%()) DECLARE SUB RandGerms (Grid%(), PillColours%(), OrigX%, OrigY%, Germs%, MaxHeight%) DECLARE SUB Delay (Seconds!) DECLARE SUB CheckForSuspension (Grid%(), GridJoin%(), PillColours%(), OrigX%, OrigY%) DECLARE SUB CheckForMatch (Grid%(), GridJoin%(), PillColours%(), OrigX%, OrigY%, Match%) DECLARE SUB GetPill (PillColours%(), Clock%(), Colour1%, Colour2%) DECLARE SUB DrawPillVert (X%, Y%, PCol1%, PCol2%, RefCol1%, RefCol2%) DECLARE SUB BoxIt (StartX%, StartY%, EndX%, EndY%, Colour%) DECLARE SUB DrawPillHorz (X%, Y%, PCol1%, PCol2%, RefCol1%, RefCol2%) OPTION BASE 1 CONST False = 0 CONST True = NOT False '---------------------- Configurable to your liking --------------------- CONST ScreenMode = 7 '' Choose from 1,2,7,8,9,12,13 CONST XMax = 320 '' Author NOTE: for Screen 13, you must modify the CONST YMax = 200 '' dimension of each cell (DrawPill) '' You will also have to do some re-aligning of the '' text for other modes, but nothing major. CONST UseJoy = False '' Use a joystick? '' Not recommended for slow machines CONST SpeedDown = 32 '' Space Bar CONST Drop = -80 '' Down Arrow CONST Rotate = -72 '' Up Arrow (Clockwise rotation) CONST Right = -77 '' Right Arrow CONST Left = -75 '' Left Arrow CONST Cells = 4 '' # of ( | ) Horizontally CONST Height = 20 '' # of ( | ) Vertically CONST MatchIt = 4 '' ie XXXX = 1 match if MatchIt = 4 '' or XXXXX = 1 match if MatchIt = 5 '' etc... Do not exceed Max of Cells*2 CONST Colours = 3 '' See SUB SetColours if you wish to change them CONST GermScore = 125 '' GermScore * Eliminated germ(s) CONST DefaultScore = 125 '' Score for getting each match CONST TBonus = 1000 '' Total obtainable bonus points, -50 for every '' leftover pill(s). Level = 1 '' Max. 33 for Cells = 4, Height = 20 Speed! = 2 '' Don't go too fast! SpeedInc! = .1 '' Speed increment factor, not very much 'The following constants can be changed, but you need to make some 'other modifications (ie. DrawPillVert) CONST CellLength = 26 '' Length of each cell CONST CellHeight = 9 '' Height of each cell '------------------------------------------------------------------------ TYPE JoyType '' Store joystick values InitialX AS INTEGER '' See SUB InitJoystick InitialY AS INTEGER Up AS INTEGER Down AS INTEGER Left AS INTEGER Right AS INTEGER END TYPE DIM JoyStick(2) AS JoyType '' Get two values for consistency sake ''DIM Pill(CellLength * CellHeight^2 / 2) AS INTEGER DIM Pill(81 * 2 * 9) AS INTEGER '' Store all pills in one variable DIM Grid(Cells * 2, Height) AS INTEGER DIM GridJoin(Cells * 2, Height) AS INTEGER '' Implement joining (L|R), (U/D) DIM PillColours(Colours, 2) DIM Clock(4), ClockNext(4) DIM SHARED Germs DIM SHARED TotalScore AS LONG IF UseJoy THEN InitJoystick JoyStick() SCREEN ScreenMode '' Works for most screen modes '' for CGA, adjust the PillColours InitGrid Grid(), GridJoin() '' Set Grid Empty (it's redundant, BWTH). SetColours PillColours() '' Initialize colours SetBoundary StartX, StartY, EndX, EndY, BoundY, BoundXMin, BoundXMax ' Remove for all modes except 7,8,9 FOR I = 1 TO 15 PALETTE I, 0 '' hide everything from user NEXT I InitPills Pill(), PillColours() '' Draw and store pills in array Pill() DrawBackGround '' Draw background 'DrawTitle Pill(), PillColours(), Clock() '' Draw Title, annoying? BoxIt StartX, StartY, EndX, EndY - 1, 0 '' Create boxes BoxIt EndX + 15, StartY, EndX + 97, StartY + 45, 0 BoxIt EndX + 15, StartY + 65, EndX + 97, StartY + 160, 0 Horizontal = True '' Initial pill position OrigX = StartX '' Record all initial positions of grid OrigY = StartY '' for later referencing GridX = Cells '' Center pill on the grid GridY = 1 '' Always start at the top (of course!) GetPill PillColours(), Clock(), Colour1, Colour2 '' Use current pill GetPill PillColours(), ClockNext(), NColour1, NColour2 '' Record next pill Germs = Level * 3 '' Algorithm to calculate the # of germs on the '' playing field at each level '' Randomly place the germs on the grid RandGerms Grid(), PillColours(), OrigX, OrigY, Germs, Level + 1 RandCycle Cycle '' Get random position of pill (Horizontal only) RandCycle NextCycle StartX = StartX + (GridX - 1) * CellLength / 2 '' Starting XCoord of Pill PUT (StartX, StartY), Pill(Clock(Cycle)), PSET '' Put current on playing field PUT (257, 37), Pill(ClockNext(Cycle)), PSET '' Put next for user to see Done = False DropIt = False Clock = 1 ' 1,3 = Horizontal 2,4 = Vertical TotalScore = 0 LOCATE 3, 33: COLOR 15: PRINT "NEXT" LOCATE 11, 32: PRINT "SCORE" LOCATE 13, 31: COLOR 15: PRINT USING "###,###"; TotalScore LOCATE 15, 32: COLOR 10: PRINT "GERMS" LOCATE 17, 33: COLOR 11: PRINT Germs LOCATE 19, 32: COLOR 15: PRINT "LEVEL" LOCATE 21, 33: PRINT Level ' Remove for all modes except 7,8,9 FOR I = 1 TO 15 PALETTE I, I '' Unhide the screen NEXT I DropDelay! = TIMER + 1 / (Speed! + 1) '' Algorithm for delay in descending IF UseJoy THEN WHILE STRIG(0) OR STRIG(1): WEND END IF DO DO IF UseJoy THEN A = STICK(0) B = STICK(1) A$ = INKEY$ IF A$ = CHR$(27) THEN Char = 27 IF A = JoyStick(1).Left OR A = JoyStick(2).Left THEN Char = Left: A$ = " " IF A = JoyStick(1).Right OR A = JoyStick(2).Right THEN Char = Right: A$ = " " IF B = JoyStick(1).Down OR B = JoyStick(2).Down THEN Char = SpeedDown: A$ = " " IF STRIG(0) THEN GOSUB RotatePill ELSE A$ = INKEY$ '' Get input from user END IF GOSUB CheckDrop IF DropIt THEN A$ = "" LOOP UNTIL LEN(A$) IF NOT UseJoy THEN IF LEN(A$) = 2 THEN Char = -ASC(RIGHT$(A$, 1)) ELSE Char = ASC(A$) END IF SELECT CASE Char CASE SpeedDown DropDelay! = TIMER CASE Drop DropIt = True CASE Rotate GOSUB RotatePill CASE Right PUT (StartX, StartY), Pill(Clock(Cycle)) IF Horizontal THEN CheckX = StartX + CellLength / 2 ELSE CheckX = StartX IF CheckX <= BoundXMax THEN '' Check for occupied space in grid. IF Horizontal THEN IF (Grid(GridX + 2, GridY) = 0) THEN StartX = StartX + (CellLength / 2) GridX = GridX + 1 END IF ELSE IF (Grid(GridX + 1, GridY) = 0) AND (Grid(GridX + 1, GridY + 1) = 0) THEN StartX = StartX + (CellLength / 2) GridX = GridX + 1 END IF END IF END IF PUT (StartX, StartY), Pill(Clock(Cycle)), PSET CASE Left PUT (StartX, StartY), Pill(Clock(Cycle)) IF StartX > BoundXMin THEN ' Check for occupied space in grid. IF Horizontal THEN IF (Grid(GridX - 1, GridY) = 0) THEN StartX = StartX - (CellLength / 2) GridX = GridX - 1 END IF ELSE IF (Grid(GridX - 1, GridY) = 0) AND (Grid(GridX - 1, GridY + 1) = 0) THEN StartX = StartX - (CellLength / 2) GridX = GridX - 1 END IF END IF END IF PUT (StartX, StartY), Pill(Clock(Cycle)), PSET END SELECT DO: LOOP UNTIL INKEY$ = "" LOOP UNTIL Char = 27 '' loop until user pressed ESC END RotatePill: PUT (StartX, StartY), Pill(Clock(Cycle)) Horizontal = NOT Horizontal '' Rotate Horizontal <-> Vertical IF Horizontal = True THEN IF (StartX <= BoundXMax) THEN '' Can't rotate if on the right-most edge IF Grid(GridX + 1, GridY) = 0 THEN Cycle = Cycle + 1 IF Cycle = 5 THEN Cycle = 1 ELSE '' Can't rotate if something is beside it. Horizontal = False END IF ELSE Horizontal = False END IF ELSE IF StartY <= BoundY THEN ' Can't rotate if on last line IF Grid(GridX, GridY + 1) = 0 THEN Cycle = Cycle + 1 IF Cycle = 5 THEN Cycle = 1 ELSE ' Can't rotate if something is beneath it. Horizontal = True END IF ELSE Horizontal = True END IF END IF PUT (StartX, StartY), Pill(Clock(Cycle)), PSET IF UseJoy THEN WHILE STRIG(0) OR STRIG(1) GOSUB CheckDrop WEND END IF RETURN CheckDrop: IF TIMER >= DropDelay! OR DropIt THEN '' Move pill down PUT (StartX, StartY), Pill(Clock(Cycle)) DropDelay! = TIMER + 1 / (Speed! + 1) IF Horizontal THEN CheckY = StartY ELSE CheckY = StartY + CellHeight IF CheckY <= BoundY THEN '' Make sure pill hasn't reached the bottom IF Horizontal THEN '' Check for Horizontal Pill position '' Make sure there isn't anything underneath the pill IF (Grid(GridX, GridY + 1) = 0) AND (Grid(GridX + 1, GridY + 1) = 0) THEN StartY = StartY + CellHeight GridY = GridY + 1 '' Move pill down one ELSE Done = True '' Can't move any farther down END IF ELSE '' Check for vertical pill position '' Make sure there isn't anything underneath the pill IF (Grid(GridX, GridY + 1) = 0) AND (Grid(GridX, GridY + 2) = 0) THEN StartY = StartY + CellHeight GridY = GridY + 1 '' Move pill down one ELSE Done = True '' Can't move down any farther END IF END IF ELSE Done = True '' Pill has reached the bottom END IF IF Done THEN PUT (StartX, StartY), Pill(Clock(Cycle)), PSET StartY = OrigY StartX = OrigX IF Horizontal THEN SELECT CASE Cycle CASE 1 Grid(GridX, GridY) = Colour1 Grid(GridX + 1, GridY) = Colour2 GridJoin(GridX, GridY) = 1 '' Left GridJoin(GridX + 1, GridY) = 2 '' Right CASE 3 Grid(GridX, GridY) = Colour2 Grid(GridX + 1, GridY) = Colour1 GridJoin(GridX, GridY) = 1 GridJoin(GridX + 1, GridY) = 2 END SELECT ELSE SELECT CASE Cycle CASE 2 Grid(GridX, GridY) = Colour1 Grid(GridX, GridY + 1) = Colour2 GridJoin(GridX, GridY) = 3 '' Up GridJoin(GridX, GridY + 1) = 4 '' Down CASE 4 Grid(GridX, GridY) = Colour2 Grid(GridX, GridY + 1) = Colour1 GridJoin(GridX, GridY) = 3 GridJoin(GridX, GridY + 1) = 4 END SELECT END IF DO CheckForMatch Grid(), GridJoin(), PillColours(), OrigX, OrigY, Match IF Match THEN CheckForSuspension Grid(), GridJoin(), PillColours(), OrigX, OrigY END IF LOOP UNTIL Match = False LOCATE 13, 31: COLOR 15: PRINT USING "###,###"; TotalScore LOCATE 17, 33: COLOR 11: PRINT Germs GridX = Cells: GridY = 1 IF Grid(GridX, GridY) <> 0 OR Grid(GridX, GridY) <> 0 THEN END IF Germs = 0 THEN Bonus = TBonus '' Total obtainable bonus FOR I = 1 TO Height FOR J = 1 TO Cells * 2 '' Minus 50 for each cell left on playing field IF Grid(J, I) <> 0 THEN Bonus = Bonus - 50 SX = OrigX + ((J - 1) * CellLength / 2) SY = OrigY + (CellHeight * (I - 1)) LINE (SX, SY)-(SX + CellLength / 2 - 1, SY + CellHeight - 1), 0, BF Delay .001 END IF Grid(J, I) = 0 GridJoin(J, I) = 0 NEXT J NEXT I IF Bonus < 0 THEN Bonus = 0 TotalScore = TotalScore + Bonus LINE (125, 90)-(193, 125), 0, BF LINE (125, 90)-(193, 125), 12, B LOCATE 13, 18: PRINT "Bonus:" LOCATE 15, 18: PRINT Bonus IF UseJoy THEN WHILE NOT STRIG(0) AND NOT STRIG(1): WEND ELSE A$ = INPUT$(1) END IF Level = Level + 1 Lev = Level IF Level > 14 THEN Germs = Level * 3 + (Level - 15) Lev = 14 ELSE Germs = Level * 3 END IF IF Level = 33 THEN END ' You Win! Speed! = Speed! + SpeedInc! BoxIt StartX, StartY, EndX, EndY - 1, 0 RandGerms Grid(), PillColours(), OrigX, OrigY, Germs, Lev + 1 LOCATE 13, 31: COLOR 15: PRINT USING "###,###"; TotalScore LOCATE 17, 33: COLOR 11: PRINT Germs LOCATE 21, 33: PRINT Level END IF StartX = StartX + (GridX - 1) * CellLength / 2 Done = False DropIt = False FOR I = 1 TO 4 Clock(I) = ClockNext(I) '' Use next pill as current pill NEXT I Colour1 = NColour1 Colour2 = NColour2 Cycle = NextCycle RandCycle NextCycle '' Get next random position of pill GetPill PillColours(), ClockNext(), NColour1, NColour2 PUT (257, 37), Pill(ClockNext(NextCycle)), PSET Horizontal = True '' Always on the horizontal position END IF '' Done PUT (StartX, StartY), Pill(Clock(Cycle)), PSET END IF '' DropIt RETURN SUB BoxIt (StartX, StartY, EndX, EndY, Colour) '***************************************************************** ' Function: Draw a simple faded looking box from StartX, StartY ' to EndX, EndY. Colour, being the colour to fill the ' box with. '***************************************************************** LINE (StartX - 1, StartY - 1)-(EndX + 1, EndY + 1), 15, B LINE (StartX - 2, StartY - 2)-(EndX + 2, EndY + 2), 7, B LINE (StartX - 3, StartY - 3)-(EndX + 3, EndY + 3), 8, B LINE (StartX, StartY)-(EndX, EndY), Colour, BF END SUB SUB CheckForMatch (Grid(), GridJoin(), PillColours(), OrigX, OrigY, Match) '************************************************************************* ' Function: Scans through the entire grid (twice in worst case scenario), ' looking for a match. Will ONLY look up ONE match per call. ' Output: Eliminates the cells on the screen and the Grid() array '************************************************************************* Match = False Score = 0 IF MatchHorizontal(Grid(), SX, SY) THEN StartY = OrigY + (CellHeight * (SY - 1)) StartX = OrigX + ((SX - 1) * CellLength / 2) ''----- Spiffy little routine to acknowledge a match ----- FOR C = 1 TO 2 FOR J = 0 TO MatchIt IF J < MatchIt AND C = 1 THEN IF Grid(SX + J, SY) < 0 THEN TotalScore = TotalScore + GermScore: Germs = Germs - 1 END IF FOR I = 1 TO MatchIt IF C = 1 THEN LINE (StartX + J, StartY + J)-(StartX + I * CellLength / 2 - J - 1, StartY + CellHeight - 1 - J), 15, B ELSE LINE (StartX + J, StartY + J)-(StartX + I * CellLength / 2 - J - 1, StartY + CellHeight - 1 - J), 0, B END IF NEXT I IF J = 2 AND C = 2 THEN Delay .01 NEXT J Delay .01 NEXT C ''----- End Spiffy routine to acknowledge a match ----- LINE (StartX, StartY)-(StartX + MatchIt * CellLength / 2 - 1, StartY + CellHeight - 1), 0, BF TotalScore = TotalScore + DefaultScore FOR I = 0 TO MatchIt - 1 A = GridJoin(SX + I, SY) GridJoin(SX + I, SY) = 0 ' Unjoin any cells that were previously joined SELECT CASE A CASE 1 '' Left '' In this case, the pill (L|R) becomes a circle (R) '' ^^ deleted part IF I = MatchIt - 1 THEN StartX = OrigX + ((SX + 3) * CellLength / 2 + 3) StartY = OrigY + (CellHeight * (SY - 1)) + 4 CIRCLE (StartX - 3, StartY), 4, 0, 1.7, 4.7, 2.2 CIRCLE (StartX - 2, StartY), 4, 0, 1.7, 4.6, 2.2 GridJoin(SX + I + 1, SY) = 0 END IF CASE 2 '' Right '' In this case, the pill (L|R) becomes a circle (L) '' ^^ deleted part IF I = 0 THEN StartX = OrigX + ((SX - 1) * CellLength / 2 - 3) StartY = OrigY + (CellHeight * (SY - 1)) + 4 CIRCLE (StartX + 2, StartY), 4, 0, 4.5, 1.4, 2.2 CIRCLE (StartX + 1, StartY), 4, 0, 4.5, 1.4, 2.2 GridJoin(SX + I - 1, SY) = 0 END IF CASE 3 '' Up '' In this case, the pill (U/D) becomes a circle (D) '' ^^ deleted part StartX = OrigX + ((SX + I - 1) * CellLength / 2 + 6) StartY = OrigY + (CellHeight * SY) + 1 CIRCLE (StartX, StartY), 6, 0, 0, 3.3, 1 / 3 GridJoin(SX + I, SY + 1) = 0 CASE 4 '' Down '' In this case, the pill (U/D) becomes a circle (U) '' ^^ deleted part StartX = OrigX + ((SX + I - 1) * CellLength / 2 + 6) StartY = OrigY + (CellHeight * (SY - 1)) - 2 CIRCLE (StartX, StartY), 6, 0, 3, 0, 1 / 3 GridJoin(SX + I, SY - 1) = 0 END SELECT Grid(SX + I, SY) = 0 NEXT I Match = True ELSE IF MatchVertical(Grid(), SX, SY) THEN StartY = OrigY + (CellHeight * (SY - 1)) StartX = OrigX + ((SX - 1) * CellLength / 2) ''----- Spiffy little routine to acknowledge a match ----- FOR C = 1 TO 2 IF C = 2 THEN LINE (StartX, StartY)-(StartX + CellLength / 2 - 1, StartY + MatchIt * CellHeight - 1), 15, BF FOR J = 0 TO MatchIt IF J < MatchIt AND C = 1 THEN IF Grid(SX, SY + J) < 0 THEN TotalScore = TotalScore + GermScore: Germs = Germs - 1 END IF FOR I = 1 TO MatchIt IF C = 1 THEN LINE (StartX + J, StartY + J)-(StartX + CellLength / 2 - J - 1, StartY + I * CellHeight - J - 1), 15, B ELSE LINE (StartX + J, StartY + J)-(StartX + CellLength / 2 - J - 1, StartY + I * CellHeight - 1 - J), 0, B END IF NEXT I NEXT J Delay .01 NEXT C ''----- End Spiffy routine to acknowledge a match ----- LINE (StartX, StartY)-(StartX + CellLength / 2 - 1, StartY + MatchIt * CellHeight - 1), 0, BF TotalScore = TotalScore + DefaultScore FOR I = 0 TO MatchIt - 1 Grid(SX, SY + I) = 0 A = GridJoin(SX, SY + I) GridJoin(SX, SY + I) = 0 SELECT CASE A CASE 1 '' Left StartX = OrigX + (SX * CellLength / 2 + 3) StartY = OrigY + (CellHeight * (SY + I - 1)) + 4 CIRCLE (StartX - 3, StartY), 4, 0, 1.7, 4.7, 2.2 CIRCLE (StartX - 2, StartY), 4, 0, 1.7, 4.6, 2.2 GridJoin(SX + 1, SY + I) = 0 CASE 2 '' Right StartX = OrigX + ((SX - 1) * CellLength / 2 - 3) StartY = OrigY + (CellHeight * (SY + I - 1)) + 4 CIRCLE (StartX + 2, StartY), 4, 0, 4.5, 1.4, 2.2 CIRCLE (StartX + 1, StartY), 4, 0, 4.5, 1.4, 2.2 GridJoin(SX - 1, SY + I) = 0 CASE 3 '' Up IF I = MatchIt - 1 THEN StartX = OrigX + ((SX - 1) * CellLength / 2 + 6) StartY = OrigY + (CellHeight * (SY + I)) + 1 CIRCLE (StartX, StartY), 6, 0, 0, 3.3, 1 / 3 GridJoin(SX, SY + I + 1) = 0 END IF CASE 4 '' Down IF I = 0 THEN StartX = OrigX + ((SX - 1) * CellLength / 2 + 6) StartY = OrigY + (CellHeight * (SY - 1)) - 2 CIRCLE (StartX, StartY), 6, 0, 3, 0, 1 / 3 GridJoin(SX, SY - 1) = 0 END IF END SELECT NEXT I Match = True END IF END IF END SUB SUB CheckForSuspension (Grid(), GridJoin(), PillColours(), OrigX, OrigY) '********************************************************************** ' Function: This procedure is called after CheckForMatch. ' It looks for any suspended pills which should be brought ' down due to the elimination of any matches. ' Any suspended pills are brought down one at a time, until ' it hits a surface. 'Author NOTE: Up and Right cases are not required because they can ' never be suspended by the SUB CheckForMatch. ' They can only form half a pill, in which case join=0 would ' accounted for that. ' ie. (L|R) (U/D) ' ^^ ^^ ' These would form a half a pill. '********************************************************************** REDIM Cell(81) FOR Y = Height - 1 TO 1 STEP -1 '' From bottom up X = 0 WHILE X < Cells * 2 X = X + 1 IF (Grid(X, Y) > 0) AND (Grid(X, Y + 1) = 0) THEN SELECT CASE GridJoin(X, Y) CASE 0 REDIM Cell(1 TO 81) StartX = OrigX + ((X - 1) * CellLength / 2) StartY = OrigY + (CellHeight * (Y - 1)) GET (StartX, StartY)-(StartX + CellLength / 2 - 1, StartY + CellHeight - 1), Cell A = Grid(X, Y) FOR I = Y + 1 TO Height IF Grid(X, I) = 0 THEN PUT (StartX, StartY), Cell StartY = OrigY + (CellHeight * (I - 1)) PUT (StartX, StartY), Cell, PSET Grid(X, I - 1) = 0 Grid(X, I) = A ELSE EXIT FOR END IF NEXT I CASE 1 ' Left REDIM Cell(1 TO 81) StartX = OrigX + ((X - 1) * CellLength / 2) StartY = OrigY + (CellHeight * (Y - 1)) GET (StartX, StartY)-(StartX + CellLength - 1, StartY + CellHeight - 1), Cell A = Grid(X, Y) B = Grid(X + 1, Y) FOR I = Y + 1 TO Height IF (Grid(X, I) = 0) AND (Grid(X + 1, I) = 0) THEN PUT (StartX, StartY), Cell StartY = OrigY + (CellHeight * (I - 1)) PUT (StartX, StartY), Cell, PSET Grid(X, I - 1) = 0 Grid(X + 1, I - 1) = 0 GridJoin(X, I - 1) = 0 GridJoin(X + 1, I - 1) = 0 Grid(X, I) = A Grid(X + 1, I) = B GridJoin(X, I) = 1 GridJoin(X + 1, I) = 2 ELSE EXIT FOR END IF NEXT I X = X + 1 CASE 4 ' Down REDIM Cell(1 TO 81) StartX = OrigX + ((X - 1) * CellLength / 2) StartY = OrigY + (CellHeight * (Y - 2)) GET (StartX, StartY)-(StartX + CellLength / 2 - 1, StartY + 2 * CellHeight - 1), Cell A = Grid(X, Y) B = Grid(X, Y - 1) FOR I = Y + 1 TO Height IF Grid(X, I) = 0 THEN PUT (StartX, StartY), Cell StartY = OrigY + (CellHeight * (I - 2)) PUT (StartX, StartY), Cell, PSET Grid(X, I - 2) = 0 GridJoin(X, I - 2) = 0 Grid(X, I) = A Grid(X, I - 1) = B GridJoin(X, I - 1) = 3 GridJoin(X, I) = 4 ELSE EXIT FOR END IF NEXT I END SELECT END IF WEND NEXT Y END SUB SUB Delay (Seconds!) T! = TIMER DO LOOP UNTIL ABS(TIMER - T!) >= Seconds! END SUB SUB DrawBackGround CLS Initial = 0 LINE (Initial, 0)-(XMax, YMax), 4, BF FOR X = Initial TO XMax LINE (X, X - Initial)-(Initial, X - Initial), 1 LINE (XMax - X + Initial, X - Initial)-(XMax, X - Initial), 2 NEXT X END SUB SUB DrawPillHorz (X, Y, PCol1, PCol2, RefCol1, RefCol2) '********************************************************* ' Function: This procedure draws the pills horizontally '********************************************************* Radius = 4 CIRCLE (X + CellLength - (2 * Radius) + 1, Y), Radius, PCol2, 4.5, 1.7, 1.5 CIRCLE (X, Y), Radius, PCol1, 1.7, 4.9, 1.5 LINE (X, Y - Radius)-(X + CellLength / 2 - Radius, Y - Radius), PCol1 LINE (X + CellLength / 2 - Radius + 1, Y - Radius)-(X + CellLength - 2 * Radius, Y - Radius), PCol2 LINE (X, Y + Radius)-(X + CellLength / 2 - Radius, Y + Radius), PCol1 LINE (X + CellLength / 2 - Radius + 1, Y + Radius)-(X + CellLength - 2 * Radius, Y + Radius), PCol2 IF PCol2 <> PCol1 THEN LINE (X + CellLength / 2 - Radius, Y + Radius)-(X + CellLength / 2 - Radius, Y - Radius), PCol1 LINE (X + CellLength / 2 - Radius + 1, Y + Radius)-(X + 1 + CellLength / 2 - Radius, Y - Radius), PCol2 PAINT (X + Radius, Y + 2), PCol1 PAINT (X + CellLength / 2, Y + 2), PCol2 ELSE PAINT (X + 4, Y + 2), PCol1 END IF CIRCLE (X + 2, Y + 1), Radius, RefCol1, 1.2, 3, 1.5 CIRCLE (X + CellLength - (2 * Radius) - 1, Y - 1), Radius, RefCol2, 4.4, 0, 1.5 END SUB SUB DrawPillVert (X, Y, PCol1, PCol2, RefCol1, RefCol2) '********************************************************* ' Function: This procedure draws the pills vertically '********************************************************* Radius = 6 CIRCLE (X + Radius / 2, Y - 1), Radius, PCol1, 0, 3.3, 1 / 2 CIRCLE (X + Radius / 2, Y + 10), Radius, PCol2, 3, 0, 1 / 2 LINE (X - Radius / 2, Y + 1)-(X - 3, Y + 4), PCol1 LINE (X - Radius / 2, Y + 5)-(X - 3, Y + CellHeight - 1), PCol2 LINE (X + 9, Y)-(X + 9, Y + 4), PCol1 LINE (X + 9, Y + 5)-(X + 9, Y + 9), PCol2 IF PCol1 <> PCol2 THEN LINE (X - Radius / 2, Y + 4)-(X + 9, Y + 4), PCol1 LINE (X - Radius / 2, Y + 5)-(X + 9, Y + 5), PCol2 PAINT (X + 2, Y + 2), PCol1 PAINT (X + 2, Y + 7), PCol2 ELSE PAINT (X + 2, Y + 2), PCol1 END IF CIRCLE (X + Radius / 2 + 1, Y), 6, RefCol1, 2.1, 3.2, 1 / 2 CIRCLE (X + Radius / 2 - 1, Y + 9), 6, RefCol2, 5.3, 0, 1 / 2 END SUB SUB DrawTitle (Pill(), PillColours(), Clock()) CurrPill = 16 * 80 + 1 Clock(1) = CurrPill Clock(2) = CurrPill + 80 Clock(3) = CurrPill Clock(4) = CurrPill + 80 ' G PUT (10, YMax - CellHeight * 2), Pill(Clock(1)), PSET PUT (10 + CellLength, YMax - CellHeight * 2), Pill(Clock(1)), PSET PUT (10 + 2 * CellLength, YMax - CellHeight * 2), Pill(Clock(1)), PSET PUT (10, YMax - CellHeight * 3), Pill(Clock(2)), PSET PUT (10, YMax - CellHeight * 5), Pill(Clock(4)), PSET PUT (10 + CellLength * 3, YMax - CellHeight * 3), Pill(Clock(2)), PSET PUT (10 + CellLength * 3, YMax - CellHeight * 5), Pill(Clock(4)), PSET PUT (10 + 2 * CellLength, YMax - CellHeight * 5), Pill(Clock(1)), PSET PUT (10 + CellLength + CellLength / 2, YMax - CellHeight * 5), Pill(Clock(4)), PSET ' E PUT (10, YMax - CellHeight * 7), Pill(Clock(1)), PSET PUT (10 + CellLength, YMax - CellHeight * 7), Pill(Clock(1)), PSET PUT (10 + 2 * CellLength, YMax - CellHeight * 7), Pill(Clock(1)), PSET PUT (10, YMax - CellHeight * 8), Pill(Clock(2)), PSET PUT (10, YMax - CellHeight * 10), Pill(Clock(4)), PSET PUT (10 + CellLength * 3, YMax - CellHeight * 8), Pill(Clock(2)), PSET PUT (10 + CellLength * 3, YMax - CellHeight * 10), Pill(Clock(4)), PSET PUT (10 + CellLength + CellLength / 2, YMax - CellHeight * 9), Pill(Clock(4)), PSET ' R PUT (10 + CellLength / 2, YMax - CellHeight * 12), Pill(Clock(1)), PSET PUT (10 + CellLength + CellLength / 2, YMax - CellHeight * 12), Pill(Clock(1)), PSET PUT (10 + 2 * CellLength + CellLength / 2, YMax - CellHeight * 12), Pill(Clock(1)), PSET PUT (10, YMax - CellHeight * 13), Pill(Clock(2)), PSET PUT (10, YMax - CellHeight * 15), Pill(Clock(4)), PSET PUT (10 + CellLength + CellLength / 2, YMax - CellHeight * 9), Pill(Clock(4)), PSET PUT (10 + 2 * CellLength + CellLength / 2, YMax - CellHeight * 12), Pill(Clock(1)), PSET PUT (10, YMax - CellHeight * 16), Pill(Clock(1)), PSET PUT (10 + CellLength - CellLength / 2, YMax - CellHeight * 16), Pill(Clock(1)), PSET PUT (10 + CellLength + CellLength / 2, YMax - CellHeight * 15), Pill(Clock(2)), PSET PUT (10 + CellLength + CellLength / 2, YMax - CellHeight * 14), Pill(Clock(2)), PSET PUT (10 + 2 * CellLength, YMax - CellHeight * 15), Pill(Clock(1)), PSET PUT (10 + 3 * CellLength, YMax - CellHeight * 16), Pill(Clock(2)), PSET ' M PUT (10 + CellLength / 2, YMax - CellHeight * 18), Pill(Clock(1)), PSET PUT (10 + CellLength + CellLength / 2, YMax - CellHeight * 18), Pill(Clock(1)), PSET PUT (10 + 2 * CellLength + CellLength / 2, YMax - CellHeight * 18), Pill(Clock(1)), PSET PUT (10, YMax - CellHeight * 19), Pill(Clock(2)), PSET PUT (10, YMax - CellHeight * 22), Pill(Clock(4)), PSET PUT (10, YMax - CellHeight * 20), Pill(Clock(1)), PSET PUT (10 + CellLength - CellLength / 2, YMax - CellHeight * 20), Pill(Clock(1)), PSET PUT (10 + CellLength / 2, YMax - CellHeight * 22), Pill(Clock(1)), PSET PUT (10 + CellLength + CellLength / 2, YMax - CellHeight * 22), Pill(Clock(1)), PSET PUT (10 + 2 * CellLength + CellLength / 2, YMax - CellHeight * 22), Pill(Clock(1)), PSET END SUB SUB GetPill (PillColours(), Clock(), Colour1, Colour2) '******************************************************************* ' Function: Returns the pill colour and positions stored in Clock() '******************************************************************* RANDOMIZE TIMER Pill = INT(RND * 6) + 1 SELECT CASE Pill CASE 1 ' Simply Blue CurrPill = 1 '' Since all pills are stored in one Clock(1) = CurrPill '' array Pill(), we have to find each Clock(2) = CurrPill + 80 '' corresponding pill and match it with Clock(3) = CurrPill '' the corresponding colour. Clock(4) = CurrPill + 80 Colour1 = PillColours(1, 1) Colour2 = PillColours(1, 1) CASE 2 ' Simply Red CurrPill = 8 * 80 + 1 '' Position in Pill() where Red is found Clock(1) = CurrPill Clock(2) = CurrPill + 80 Clock(3) = CurrPill Clock(4) = CurrPill + 80 Colour1 = PillColours(2, 1) Colour2 = PillColours(2, 1) CASE 3 ' Simply Yellow CurrPill = 16 * 80 + 1 Clock(1) = CurrPill Clock(2) = CurrPill + 80 Clock(3) = CurrPill Clock(4) = CurrPill + 80 Colour1 = PillColours(3, 1) Colour2 = PillColours(3, 1) CASE 4 ' Blue and Red CurrPill = 2 * 80 + 1 Clock(1) = CurrPill Clock(2) = CurrPill + 80 CurrPill = 6 * 80 + 1 Clock(3) = CurrPill Clock(4) = CurrPill + 80 Colour1 = PillColours(1, 1) Colour2 = PillColours(2, 1) CASE 5 ' Blue and Yellow CurrPill = 4 * 80 + 1 Clock(1) = CurrPill Clock(2) = CurrPill + 80 CurrPill = 12 * 80 + 1 Clock(3) = CurrPill Clock(4) = CurrPill + 80 Colour1 = PillColours(1, 1) Colour2 = PillColours(3, 1) CASE 6 ' Red and Yellow CurrPill = 10 * 80 + 1 Clock(1) = CurrPill Clock(2) = CurrPill + 80 CurrPill = 14 * 80 + 1 Clock(3) = CurrPill Clock(4) = CurrPill + 80 Colour1 = PillColours(2, 1) Colour2 = PillColours(3, 1) END SELECT END SUB SUB InitGrid (Grid(), GridJoin()) FOR I = 1 TO Height FOR J = 1 TO Cells * 2 Grid(J, I) = 0 GridJoin(J, I) = 0 NEXT J NEXT I END SUB SUB InitJoystick (JoyStick() AS JoyType) '************************************************* ' Function: Simple calibration of the joystick. ' No detection routines implemented. '************************************************* PRINT "Joystick Calibration, please wait..." FOR I = 1 TO 10 '' Get normal values (idle state) A = STICK(0) B = STICK(1) IF JoyStick(1).InitialX < A THEN JoyStick(1).InitialX = A IF JoyStick(1).InitialY < B THEN JoyStick(1).InitialY = B NEXT I JoyStick(2).InitialX = JoyStick(1).InitialX - 1 '' To make things more consistent JoyStick(2).InitialY = JoyStick(1).InitialY - 1 '' get two values JoyStick(1).Up = JoyStick(1).InitialY JoyStick(1).Left = JoyStick(1).InitialX WHILE STRIG(0) OR STRIG(1): WEND PRINT "Move joystick to upper left corner then press botton" DO A = STICK(0) '' XCoord B = STICK(1) '' YCoord IF JoyStick(1).Up > B THEN JoyStick(1).Up = B IF JoyStick(1).Left > A THEN JoyStick(1).Left = A LOOP UNTIL STRIG(0) OR STRIG(1) JoyStick(2).Up = JoyStick(1).Up + 1 JoyStick(2).Left = JoyStick(1).Left - 1 PRINT "Move joystick to lower right corner then press botton" WHILE STRIG(0) OR STRIG(1) '' Depressed status WEND DO A = STICK(0) B = STICK(1) IF JoyStick(1).Down < B THEN JoyStick(1).Down = B IF JoyStick(1).Right < A THEN JoyStick(1).Right = A LOOP UNTIL STRIG(0) OR STRIG(1) JoyStick(2).Down = JoyStick(1).Down - 1 JoyStick(2).Right = JoyStick(1).Right - 1 END SUB SUB InitPills (Pill(), PillColours()) '***************************************************************** ' Function: Draws the pills on the screen, then save them in the ' array Pill() '***************************************************************** X = 4: Y = 4: N = 1 FOR I = 1 TO 3 FOR J = 1 TO 3 LINE (0, 0)-(CellLength, CellHeight), 0, BF DrawPillHorz X, Y, PillColours(I, 1), PillColours(J, 1), PillColours(I, 2), PillColours(J, 2) GET (1, 0)-(CellLength, CellHeight - 1), Pill(N) LINE (0, 0)-(CellLength / 2, CellHeight * 2), 0, BF DrawPillVert X, Y, PillColours(I, 1), PillColours(J, 1), PillColours(I, 2), PillColours(J, 2) N = N + 80 GET (1, 0)-(CellLength / 2, CellHeight * 2 - 1), Pill(N) N = N + 80 NEXT J NEXT I END SUB FUNCTION MatchHorizontal% (Grid(), SX, SY) '************************************************************************* ' Function: Scans through the entire grid, looking for a horizontal match. '************************************************************************* Y = 0 WHILE (Y < Height) AND (Count < MatchIt) '' We want to check for any X = 0 '' horizontal matches first, Y = Y + 1 '' starting from the bottom up Count = 0 Last = 0 WHILE (X < Cells * 2) AND (Count < MatchIt) '' Check from left to right X = X + 1 IF Grid(X, Y) <> 0 THEN '' If Not empty, check it out IF Last = ABS(Grid(X, Y)) THEN '' Germs are given negative signs Count = Count + 1 ELSE '' New colour Last = ABS(Grid(X, Y)) '' Store it Count = 1 '' Begin new counter SX = X: SY = Y '' New locations END IF ELSE '' Empty grid Last = 0 '' No colour Count = 1 '' New counter END IF WEND WEND IF Count = MatchIt THEN MatchHorizontal = True ELSE MatchHorizontal = False END FUNCTION FUNCTION MatchVertical% (Grid(), SX, SY) '************************************************************************* ' Function: Scans through the entire grid, looking for a vertical match. '************************************************************************* X = 0 WHILE (X < Cells * 2) AND (Count < MatchIt) '' We want to check for any Y = Height + 1 '' vertical matches X = X + 1 '' starting from the left to right Count = 0 Last = 0 WHILE (Y > 1) AND (Count < MatchIt) '' Check from bottom up Y = Y - 1 IF Grid(X, Y) <> 0 THEN '' If Not empty, check it out IF Last = ABS(Grid(X, Y)) THEN '' Germs are given negative signs Count = Count + 1 SY = Y '' Store current Y Position ELSE '' New colour Last = ABS(Grid(X, Y)) '' Store it Count = 1 '' Begin new counter SX = X: SY = Y '' New locations END IF ELSE '' Empty grid Last = 0 '' No colour Count = 1 '' New counter END IF WEND WEND IF Count = MatchIt THEN MatchVertical = True ELSE MatchVertical = False END FUNCTION SUB RandCycle (Cycle) RANDOMIZE TIMER C = INT(RND * 2) + 1 IF C = 1 THEN Cycle = 1 ELSE Cycle = 3 END SUB SUB RandGerms (Grid(), PillColours(), OrigX, OrigY, Germs, Level) Count = 0 DO RANDOMIZE TIMER X = INT(RND * Cells * 2) + 1 YY = INT(Level * RND) Y = Height - YY IF Grid(X, Y) = 0 THEN C = INT(RND * Colours) + 1 Count = Count + 1 StartX = OrigX + ((X - 1) * CellLength / 2) StartY = OrigY + (CellHeight * (Y - 1)) CIRCLE (StartX + 6, StartY + 2), 4, PillColours(C, 1), 0, 3.3, 1 / 2 CIRCLE (StartX + 6, StartY + CellHeight - 3), 4, PillColours(C, 1), 3, 0, 1 / 2 CIRCLE (StartX + CellLength / 2 - 4, StartY + 4), 4, PillColours(C, 1), 4.5, 1.7, 1.5 CIRCLE (StartX + 3, StartY + 4), 4, PillColours(C, 1), 1.7, 4.9, 1.5 PAINT (StartX + 4, StartY + 2), PillColours(C, 1) PSET (StartX + 4, StartY + 2), 0 PSET (StartX + 3, StartY + 2), 0 PSET (StartX + 8, StartY + 2), 0 PSET (StartX + 9, StartY + 2), 0 CIRCLE (StartX + 6, StartY + 7), 3, 0, 0, 3, 1 / 2 Grid(X, Y) = -PillColours(C, 1) END IF LOOP UNTIL Count = Germs END SUB SUB SetBoundary (StartX, StartY, EndX, EndY, BoundY, BoundXMin, BoundXMax) '***************************************************************** ' Function: To set the boundaries of the playing field '***************************************************************** XMid = XMax / 2 YMid = YMax / 2 StartX = XMid - (CellLength * Cells / 2) EndX = XMid + (CellLength * Cells / 2) StartY = YMid - (CellHeight * Height / 2) EndY = YMid + (CellHeight * Height / 2) BoundXMin = StartX BoundXMax = EndX - CellLength BoundY = EndY - 2 * CellHeight END SUB SUB SetColours (PillColours()) PillColours(1, 1) = 1 '' Pill colour PillColours(1, 2) = 9 '' Reflection colour PillColours(2, 1) = 4 '' Pill colour PillColours(2, 2) = 12 '' . PillColours(3, 1) = 14 '' . PillColours(3, 2) = 15 '' . END SUB