'*********************************************************************** ' Q'CRACKER.BAS '*********************************************************************** ' '---------- DECLARATION OF SUBS , FUNCS,CONSTANTS AND GLOBALS DECLARE SUB BUBBLESORT (KEYS, SCORE(), PLYR$()) DECLARE SUB CHECKBLACK (REPLY$(), ATTEMPT$, CODE$()) DECLARE SUB CHECKWHITE (REPLY$(), ATTEMPT$, CODE$()) DECLARE FUNCTION CONTINUE! (XCENT!, YCENT!, XMIN!, YMIN!, YINC!) DECLARE FUNCTION DOUBLECHECK (XMIN, XINC, YCENT) DECLARE SUB FACE (EMOTION, HAPPY(), SAD()) DECLARE SUB GENERATECODE (CODE$()) DECLARE FUNCTION GETINPUT$ (XCENT!, XINC!, YCENT!) DECLARE FUNCTION GETNAME$ () DECLARE SUB GETSMILEY (HAPPY!(), SAD!()) DECLARE FUNCTION RESULT (REPLY$(), YCENT!) DECLARE SUB HELP () DECLARE SUB HIGHSCORES (CORRECT) DECLARE SUB KEYSON () DECLARE SUB KEYSOFF () DECLARE FUNCTION LOOKUP! (KOLOR!) DECLARE SUB MOVELOGO (LOGOTABLE$(), LOGOLEN, STARTIME, LCOLOR) DECLARE SUB RESPOND (TEST$, XCENT!, YCENT!) DECLARE SUB SETUP (XCENT, YCENT, XINC, YINC, XMIN, YMIN, XMAX, YMAX, STARTIME, FASTGUY$) DECLARE SUB SCRAMBLE (REPLY$()) DECLARE SUB SPACEOVERLAY (MARKER, ATTEMPT$) DECLARE FUNCTION SPARKLEPAUSE () DECLARE SUB UNMASK (CODE$(), GOOD) CONST TRUE = 1, FALSE = 0 COMMON SHARED FASTIME ' } SO THAT THESES TIMES WILL REMAIN RECORDED COMMON SHARED CURRENTIME ' } SUCCESSIVE GAMES COMMON SHARED SLOWESTIME ' } COMMON SHARED FASTGUY$ ' COMMON SHARED ERRORNO ' TO COMMUNICATE ERRORS GLOBALLY FASTIME = 999 SLOWESTIME = 999 '************************************************************************** ' HEADER: DATA " Written in Microsoft's Quick-Basic 4.0 " DATA " " DATA " Programmed by ... Andronicus H.G. WillIams A.K.A GUYTEK " DATA " " DATA " email:- guytek@mailexcite.com " DATA " " DATA " It is just a simple game of logic and some initial luck and it wasn't" DATA " meant for graphic appeal, it is just a diversion that originates from" DATA " the original game ` MASTER-MIND ' by I can't remember whom. " DATA " " DATA " So go on , test your I.Q. and ` Knock yourself out !' " '*********************************************************************** '--------------------- HERE I DEFINE MY LOGO LOGO$ = " Q'CRACKER .BAS BY GUYTEK " LOGOLEN = LEN(LOGO$) DIM LOGOTABLE$(LOGOLEN) FOR K = 1 TO LOGOLEN LOGOTABLE$(K) = MID$(LOGO$, K, 1) NEXT K '------------------- DIMENSIONING OF NECESSARY TABLES DIM CODE$(4), REPLY$(4), HAPPY(44), SAD(44) '*********************<<<<<<<<< GAME STARTS >>>>>>>>>********************** GETSMILEY HAPPY(), SAD() ' make a smiley face CLS SCREEN 0 RESTART = SPARKLEPAUSE ' mimic nibbles' sparklepause STARTUP: ' place where we come if they wanna restart DO 'draw the game on another page SETUP XCENT, YCENT, XINC, YINC, XMIN, YMIN, XMAX, YMAX, STARTIME, FASTGUY$ EMOTION = TRUE ' default to happy face FACE EMOTION, HAPPY(), SAD() ' show it GENERATECODE CODE$() ' pick some random color combination LCOLOR = 15 'get the logo moving MOVELOGO LOGOTABLE$(), LOGOLEN, STARTIME, LCOLOR DO ' loop to begin an input sequence DO ' loop while waiting for an input sequence IF TIMER MOD 3 = 0 THEN ' jingle the logo color RANDOMIZE TIMER LCOLOR = INT(15 * RND + 1) END IF 'keep that logo moving MOVELOGO LOGOTABLE$(), LOGOLEN, STARTIME, LCOLOR SURE = FALSE 'default to mean they haven't made an input yet TEST$ = UCASE$(INKEY$) 'collect their input 'check to see if time is up IF TIMER - STARTIME >= 999 THEN EXIT DO 'if it is then exit this loop END IF RESPOND TEST$, XCENT, YCENT ' respond to their input SELECT CASE TEST$ '$ special input meanings CASE IS = CHR$(27) '1 } they escape from the game page KEYSOFF 'switch off the arrowkeys SCREEN 8, , 1, 1 'change the page RESTART = SPARKLEPAUSE ' call sparky IF RESTART = TRUE THEN GOTO STARTUP 'sparky says they wanna restart KEYSON 'were back so switch them back on SCREEN 8, , 0, 0 'restore the game page CASE IS = CHR$(13) '2 } they pressed 'are they sure they chose 'four colors ? SURE = DOUBLECHECK(XMIN, XINC, YCENT) CASE IS = "H" '3 } they pressed KEYSOFF 'so switch off the arrowkeys SCREEN 8, , 1, 1 'change the page HELP 'and give em some help SCREEN 8, , 0, 0 'restore the page KEYSON 'restore the keys END SELECT LOOP WHILE SURE = FALSE 'since they haven't put in four colors, loop 'well they put in four colors so: KEYSOFF '1 } switch off the keys while we analyse CURRENTIME = INT(TIMER - STARTIME) '2 } freeze their time ATTEMPT$ = GETINPUT$(XMIN, XINC, YCENT) '3 } get their input CHECKBLACK REPLY$(), ATTEMPT$, CODE$() '4 } check if they black dots CHECKWHITE REPLY$(), ATTEMPT$, CODE$() '5 } check if they get white dots SCRAMBLE REPLY$() '6 } scramble the reply CORRECT = RESULT(REPLY$(), YCENT) '7 } display results and check to see if code is cracked KEYSON '8 } switch on the keys '9 } check to see if they have more chances MORECHANCES = CONTINUE(XCENT, YCENT, XMIN, YMIN, YINC) 'they have more chances and they didn't crack the code so loop LOOP WHILE MORECHANCES = TRUE AND CORRECT = FALSE 'they have no more chances or they cracked the code KEYSOFF ' switch off the keys 'they cracked the code ? IF CORRECT = TRUE THEN 'they cracked it GOOD = TRUE 'give em a smile, UNMASK CODE$(), GOOD'some good music, the code HIGHSCORES CORRECT 'and chance at the highscores ELSE ' they didn't crack it GOOD = FALSE EMOTION = TRUE FACE EMOTION, HAPPY(), SAD() 'remove smile EMOTION = FALSE 'give em a sad smile, FACE EMOTION, HAPPY(), SAD() 'a dirge, the code UNMASK CODE$(), GOOD 'and let them see HIGHSCORES CORRECT 'the highscores END IF SLEEP 2 LOCATE 3, 32 PRINT " PRESS ANY KEY... " NOW! = TIMER WHILE TIMER - NOW! < 15 AND INKEY$ = "": WEND DUMMY = TRUE CLS SCREEN 0 RESTART = SPARKLEPAUSE LOOP WHILE DUMMY = TRUE END '*********************** TRAPPED KEY ROUTINES ************************** MOVELEFT: SOUND 100, 1 SOUND 500, 1 CIRCLE (XCENT, YCENT), 8, POINT(XCENT, YCENT) 'mask the old indicator XCENT = XCENT - XINC 'update its coordinates IF XCENT < XMIN THEN XCENT = XMAX CIRCLE (XCENT, YCENT), 8, 9 'and display it RETURN MOVERIGHT: SOUND 100, 1 SOUND 500, 1 CIRCLE (XCENT, YCENT), 8, POINT(XCENT, YCENT) 'mask the old indicator XCENT = XCENT + XINC 'update its coordinates IF XCENT > XMAX THEN XCENT = XMIN CIRCLE (XCENT, YCENT), 8, 9 ' and display it RETURN '**************************** ERROR HANDLERS **************************** 'these routines just make the error number accessible to subroutines ' with their own internal error handlers ( I know two are indeed redundant ) FILENOTFOUND: ERRORNO = ERR RESUME NEXT NOSHELL: ERRORNO = ERR RESUME NEXT '******************************** DATA ********************************** KOLORS: 'BLACK,RED,DARK BLUE,PINK,SKY BLUE,GREEN,ORANGE,YELLOW,WHITE DATA 0,4,1,5,11,10,12,14,15 INDICATOR: 'FOR COLOR TABLE DATA "P","I","C","K"," ","A"," ","C","O","L","O","R" GHOSTS: 'FOR SCORE HOLDERS IN CASE SCORE FILE IS DELETED DATA 38,"GUYTEK",38,"ANTH",40,"CARL",41,"KENDELL",50,"JC RADICAL" DATA 57,"QT",75,"KIMMY",100,"SYLVIA",201,"SYKEY",343,"JESSE" '**************<<<<<<<<< END OF Q'CRACKER.BAS >>>>>>>>******************* SUB BUBBLESORT (KEYS, SCORE(), PLYR$()) 'THIS SORTS THE FASTESTIMES BY TIMES FOR PASS = 0 TO KEYS - 1 ' this is the bubble sort routine that ' I understand is very efficient for a FLAG = 0 ' small amount of data FOR PTR = 0 TO KEYS - PASS IF SCORE(PTR) <= SCORE(PTR + 1) THEN GOTO NEXTPTR END IF FLAG = 1 SWAP SCORE(PTR), SCORE(PTR + 1) SWAP PLYR$(PTR), PLYR$(PTR + 1) NEXTPTR: NEXT PTR IF FLAG = 0 THEN EXIT SUB NEXT PASS END SUB SUB CHECKBLACK (REPLY$(), ATTEMPT$, CODE$()) 'Here we check for the correct color and ensure it is in the correct position FOR CHECK = 1 TO 4 REPLY$(CHECK) = "" 'we compare the attempt to the code in string form 'piece by piece IF MID$(ATTEMPT$, CHECK, 1) = CODE$(CHECK) THEN 'it matches in color and position so give em ' a black and remove that attempt code so ' there isn't any ambiguous results from ' further analysis MARKER = CHECK SPACEOVERLAY MARKER, ATTEMPT$ REPLY$(CHECK) = "B" END IF NEXT CHECK END SUB SUB CHECKWHITE (REPLY$(), ATTEMPT$, CODE$()) ' HERE WE TEST FOR JUST THE CORRECT COLOR, NOT THE POSITION FOR CHECK = 1 TO 4 'we make sure that no perfect match was found for this positon IF REPLY$(CHECK) = "" THEN ' we don't care about positons any more so find any ' match POINTDEXTER = INSTR(ATTEMPT$, CODE$(CHECK)) IF POINTDEXTER <> 0 THEN 'a match is found so we give em 'a white and remove that code so 'there isn't any ambiguous results 'from further analysis MARKER = POINTDEXTER SPACEOVERLAY MARKER, ATTEMPT$ REPLY$(CHECK) = "W" END IF END IF NEXT CHECK END SUB FUNCTION CONTINUE (XCENT, YCENT, XMIN, YMIN, YINC) ' HERE WE ENSURE THE PERSON HAS MORE CHANCES CIRCLE (XCENT, YCENT), 8, POINT(XCENT, YCENT) 'cover up last position indicator YCENT = YCENT - YINC IF YCENT = YMIN - YINC THEN ' the person was at the last possible input line ' so they have no more chances CONTINUE = 0 EXIT FUNCTION ELSE ' well they have more chances so play on CONTINUE = 1 END IF XCENT = XMIN ' reset the indicator to the first place holder CIRCLE (XCENT, YCENT), 8, 9 ' show the indicator END FUNCTION FUNCTION DOUBLECHECK (XMIN, XINC, YCENT) ' HERE WE ENSURE THAT THERE HAS BEEN FOUR COLORS CHOSEN IF POINT(XMIN, YCENT) = 7 THEN 'the background color is 7 so we 'check to see if a place holder SURE = 0 'contains this color, if it does 'then they didn't make four choices ELSE SURE = 1 ' default sure to mean that they ' made four choices FOR K = 1 TO 3 IF POINT(XMIN + (XINC * K), YCENT) = 7 THEN 'they didn't make four choices SURE = 0 EXIT FOR ELSE 'default that they did SURE = 1 END IF NEXT K END IF IF SURE = 0 THEN ' they did not make four choices so : BEEP LOCATE 3, 32 COLOR 15 PRINT " NO WAY JOSE` " SLEEP 1 END IF DOUBLECHECK = SURE '( note this sure is internal to this module it is not the ' main module's sure ) END FUNCTION SUB FACE (EMOTION, HAPPY(), SAD()) ' THIS JUST DISPLAYS GUYSMILEY SELECT CASE EMOTION ' depending on the desired emotion ' happy or sad we show the appropriate CASE IS = 1 ' face PUT (312, 4), HAPPY, XOR 'give a happy face CASE IS = 0 PUT (312, 4), SAD, XOR ' give a sad face END SELECT END SUB SUB GENERATECODE (CODE$()) ' THIS GENERATES THE COLOR CODE FOR CODE = 1 TO 4 'we randomly generate numbers based RANDOMIZE TIMER 'on the size of a color lookup table KOLOR = INT(9 * RND + 1) 'which we will use to map the colors. TEMP$ = LTRIM$(RTRIM$(STR$(KOLOR)))' we save it in string form CODE$(CODE) = TEMP$ NEXT CODE END SUB FUNCTION GETINPUT$ (XMIN, XINC, YCENT) 'THIS DETECTS THE CHOSEN COLORS BY PULLING THEM OFF THE SCREEN DIM TEMP(4) TEMP(1) = POINT(XMIN, YCENT) ' we pull the colors off the screen FOR K = 1 TO 3 TEMP(K + 1) = POINT(XMIN + (XINC * K), YCENT) NEXT K ' then we reverse map the colors to FOR KOLOR = 1 TO 9 ' positions in the lookup table ALLOY = LOOKUP(KOLOR) IF ALLOY = TEMP(1) THEN TEMP1$ = LTRIM$(RTRIM$(STR$(KOLOR))) IF ALLOY = TEMP(2) THEN TEMP2$ = LTRIM$(RTRIM$(STR$(KOLOR))) IF ALLOY = TEMP(3) THEN TEMP3$ = LTRIM$(RTRIM$(STR$(KOLOR))) IF ALLOY = TEMP(4) THEN TEMP4$ = LTRIM$(RTRIM$(STR$(KOLOR))) NEXT KOLOR TEMP$ = TEMP1$ + TEMP2$ + TEMP3$ + TEMP4$ ' the input will now be in the form of positons in the color table just like ' the code generated but in string form , just like the code. GETINPUT$ = TEMP$ END FUNCTION FUNCTION GETNAME$ ' GETS THE FASTEST PLAYER CLS ' this is a messy routine but it works UX = 240: LX = UX + 200 ' so far UY = 55: LY = 100 CURX = 35: CURY = 9 NAMELEN = 15 DIM TEXT$(NAMELEN) LINE (UX, UY)-(LX, LY), 9, B LOCATE CURY, CURX COLOR 12 PRINT "ENTER YOUR NAME :" LINY = CURY + 2: LINX = CURX LOCATE LINY, LINX - 1 PRINT ">"; COLOR 15 LINX = LINX + 1 DO WHILE TEST$ = "" TEST$ = INKEY$ LOCATE LINY, LINX PRINT "_" WEND SELECT CASE TEST$ CASE IS = CHR$(27) LINX = CURX TEST$ = "" FOR K = 0 TO NAMELEN LOCATE LINY, LINX + K PRINT " " NEXT K CASE IS = CHR$(8) LOCATE LINY, LINX PRINT " " LINX = LINX - 2 TEST$ = "" CASE IS = CHR$(13) EXIT DO CASE IS < CHR$(32) TEST$ = "" LINX = LINX - 1 CASE IS > CHR$(126) TEST$ = "" LINX = LINX - 1 END SELECT LOCATE LINY, LINX PRINT TEST$ TEXT$(LINX - CURX) = TEST$ TEST$ = "" LINX = LINX + 1 IF LINX < CURX + 1 THEN LINX = CURX + 1 IF LINX > CURX + NAMELEN - 1 THEN LINX = CURX + NAMELEN LOOP WHILE TEST$ <> CHR$(13) FOR K = 0 TO NAMELEN - 1 PLAYER$ = PLAYER$ + TEXT$(K) NEXT K GETNAME$ = PLAYER$ END FUNCTION SUB GETSMILEY (HAPPY(), SAD()) ' THIS JUST CREATES OLD GUYSMILEY SCREEN 8, , 0, 1 CLS SMILEX = 300: SMILEY = 100 SMILECOLOR = 9 FACESIZE = 10 PI = 3.14 CIRCLE (SMILEX, SMILEY), FACESIZE, SMILECOLOR PAINT (SMILEX, SMILEY), SMILECOLOR, SMILECOLOR CIRCLE (SMILEX - 4, SMILEY - 1), 1, 7 CIRCLE (SMILEX - 4 + 8, SMILEY - 1), 1, 7 CIRCLE (SMILEX, SMILEY), FACESIZE - 4, 7, PI * 1.15, 1.85 * PI ' happy smile GET (SMILEX - 13, SMILEY - 5)-(SMILEX + 13, SMILEY + 5), HAPPY CIRCLE (SMILEX, SMILEY), FACESIZE - 4, SMILECOLOR, PI * 1.15, 1.85 * PI CIRCLE (SMILEX, SMILEY + 4), FACESIZE - 4, 7, .2 * PI, .7 * PI ' sad smile ? GET (SMILEX - 13, SMILEY - 5)-(SMILEX + 13, SMILEY + 5), SAD ' hee hee SCREEN 0 END SUB SUB HELP ' ONLINE HELP PAGE = 1 W$ = " <<<<<<< WELCOME TO QCRACKER'S HELP >>>>>>>>" GOSUB NEWPAGE ' well I guess that this routine is ' easily understood WHILE DUMMY = DUMMY ' we just keep on a loopin W$ = " <<<<<<< WELCOME TO QCRACKER'S HELP >>>>>>>>" WHILE TEST$ = "" TEST$ = UCASE$(INKEY$) WEND SELECT CASE TEST$ CASE IS = CHR$(27) ' they don't want help any more EXIT SUB CASE IS = "F" 'we increase the page number 'this isn't a literal page PAGE = PAGE + 1 IF PAGE >= 4 THEN PAGE = 4 GOSUB NEWPAGE CASE IS = "B" 'we decrease the page number 'again these pages are not literal PAGE = PAGE - 1 IF PAGE <= 1 THEN PAGE = 1 GOSUB NEWPAGE END SELECT WEND NEWPAGE: SELECT CASE PAGE ' based on the page numbers we map to differnt subroutines ' giving the idea of different pages CASE IS = 1 GOSUB PAGE1 CASE IS = 2 GOSUB PAGE2 CASE IS = 3 GOSUB PAGE3 CASE IS = 4 GOSUB PAGE4 END SELECT TEST$ = UCASE$(INKEY$) ' for a faster response we test before and after RETURN PAGE1: GOSUB HELPTOP LOCATE 8, 1 PRINT " The object of this game is to logically surmise a color code" PRINT " sequence of four colors randomly generated by the computer." PRINT PRINT " To aid the player in this crack attempt the computer analyses each" PRINT " input sequence and returns a code which will aid the player in" PRINT " his foray." PRINT PRINT " Enter four colors 1 to 9 and then press < enter >. Use the arrow" PRINT " keys to move to a new position ." LOCATE 20, 26 COLOR 12 PRINT "< F > : FOWARD , < ESC > QUIT" COLOR 14 RETURN PAGE2: GOSUB HELPTOP LOCATE 8, 1 PRINT " The return code comprises one or more dots black or white in color :" PRINT PRINT " 1 } A black dot indicates that the player has one color correct and " PRINT " it is also in the correct position." PRINT PRINT " 2 } A white dot indicates that the player has one color that is correct" PRINT " but it is in an incorrect position." PRINT PRINT " // The absence of any dots after an input sequence implies that none of " PRINT " the above conditions apply. //" LOCATE 20, 20 COLOR 12 PRINT "< F > : FOWARD , < B > : BACK , < ESC > QUIT" COLOR 15 RETURN PAGE3: W$ = " <<<<<<< FOR THOSE INTERESTED >>>>>>" GOSUB HELPTOP LOCATE 6, 1 PRINT " This game was supposed to be built by myself a long while ago when " PRINT " errm... ehem... I used to program in GWBASIC ! But to all those" PRINT " who have learnt to crawl before walking they just might be interested" PRINT " in the fact that the reason why it was never completed then was because " PRINT " the routine which correctly analyses the input sequence stumped" PRINT " me badly." PRINT PRINT " It's all about combinations and permutations and even though I'm in a" PRINT " technical institute I cannot admit to loving math.Very soon I " PRINT " realised that the algorithm I had invented to analyse the input sequence " PRINT " resulted in thousands of possible string combinations to cater for" PRINT " using IF THEN ELSE statements ??!! " LOCATE 20, 20 COLOR 12 PRINT "< F > : FOWARD , < B > : BACK , < ESC > QUIT" COLOR 15 RETURN PAGE4: W$ = " <<<<<<< FOR THOSE INTERESTED >>>>>>" GOSUB HELPTOP LOCATE 6, 1 PRINT " Then like all good Ideas that God gives man it came to me while sleeping" PRINT " 'No! I'm not freaky, I just like programming a whole lot.'I had already" PRINT " realised that the condition for a black dot should be analysed first since" PRINT " this would only involve four checks But for the white pick: My word!" PRINT " suppose a black dot had already taken care of one colour 's point in a" PRINT " sequence ,the check for white routine would generate erroneous results since" PRINT " it would detect that colour's position as well!" PRINT PRINT " Did you say use AND and OR ? Talk after You've tried that and it works." PRINT " Then a voice indicated that I should decompose the input sequence after " PRINT " a check for a black dot. Yeah ! Now the check for a white dot routine would" PRINT " never be fooled. That's where the routine `spaceoverlay' comes in." PRINT " SO SIMPLE, SO UNSEEN..." LOCATE 20, 26 COLOR 12 PRINT " < B > : BACK , < ESC > QUIT" COLOR 15 RETURN HELPTOP: ' this just saved me some redundant code CLS COLOR 14 LOCATE 2, 19 PRINT W$ LOCATE 4, 38 COLOR 2 PRINT "PAGE "; PAGE COLOR 15 RETURN END SUB SUB HIGHSCORES (CORRECT) ' THIS JUST DISPLAYS THE FASTEST TIMES NUMPLYRS = 10 ' we hold scores for top 10 players only DIM SCORE(NUMPLYRS), PLYR$(NUMPLYRS) CONST BADFILENAME = 53 HSCFILE$ = "QCRACKER.HSC" ' the name of our score file ERRORNO = 0 ' we default to no error IF CORRECT = 1 AND SLOWESTIME > CURRENTIME THEN ' they fall in the range of the top 10 SLEEP 2 LOCATE 3, 32 PRINT " AND FAST TOO ! " SLEEP 2 FASTIME = CURRENTIME END IF ON ERROR GOTO FILENOTFOUND ' we trap this error in case the score ' file got lost /deleted OPEN HSCFILE$ FOR INPUT AS #1 IF ERRORNO = BADFILENAME THEN ' we switch off the error handler ON ERROR GOTO 0 'the score file was lost/deleted so : ' 1 } we give em some notice SLEEP 2 LOCATE 3, 32 PRINT " SCORE FILE ABSENT." SLEEP 2 ' 2 } and we build a new one based on some ghosts ' my time is for real though ! LOCATE 3, 32 PRINT " CREATING ... " RESTORE GHOSTS OPEN HSCFILE$ FOR OUTPUT AS #1 FOR K = 1 TO 10 READ SCORE(K) READ PLYR$(K) PRINT #1, SCORE(K), PLYR$(K) NEXT K CLOSE #1 ' we are still in the error handler so we open the ' file from here since it didn't open form outside OPEN HSCFILE$ FOR INPUT AS #1 END IF ' outside the handler we don't care from where it was opened PLYR = 0 DO ' read in the scores and players form the file PLYR = PLYR + 1 INPUT #1, SCORE(PLYR), PLYR$(PLYR) LOOP WHILE NOT EOF(1) CLOSE #1 'the fastest player is the first one so : FASTGUY$ = PLYR$(1) FASTIME = SCORE(1) 'the slowest player is the tenth one so : SLOWESTGUY$ = PLYR$(NUMPLYRS) SLOWESTIME = SCORE(NUMPLYRS) IF CORRECT = 1 AND SLOWESTIME > CURRENTIME THEN ' the person who just played was correct and falls in ' the top ten so : SLEEP 2 SCREEN 8, , 1, 1 CLS '1 } find out their name: CURRENTGUY$ = GETNAME$ '2 } map their time and name to their respective tables SCORE(0) = CURRENTIME PLYR$(0) = CURRENTGUY$ '3 } sort the tables BUBBLESORT (NUMPLYRS - 1), SCORE(), PLYR$() '4 } write the sorted data to the score file OPEN HSCFILE$ FOR OUTPUT AS #1 FOR K = 0 TO NUMPLYRS - 1 PRINT #1, SCORE(K), PLYR$(K) NEXT K CLOSE #1 END IF ' this is a quirk based on how I wrote the program ' to ensure that the correct names and scores are ' displayed IF CORRECT = 1 THEN 'the table would have been sorted and the fastest 'players info would begin at this positon in the 'tables PTR = 0 ELSE 'none of the above would have happened ; the person 'would have required no processing so we delay and 'the fastest players info would begin at this positon 'in the tables PTR = 1 SLEEP 2 END IF 'so based on the pointer : FASTGUY$ = PLYR$(PTR) FASTIME = SCORE(PTR) SLOWESTIME = SCORE(NUMPLYRS - PTR) 'and we now finally display the scores and players SCREEN 8, , 1, 1 CLS CURX = 28: CURY = 2 LOCATE CURY, CURX - 10 COLOR 12 PRINT "<<<<<<<<<<<< FASTEST CRACKERS >>>>>>>>>>>" COLOR 15 FOR K = PTR TO NUMPLYRS - CORRECT CURY = CURY + 2 LOCATE CURY, CURX THESCORE$ = RTRIM$(LTRIM$(STR$(SCORE(K)))) IF LEN(THESCORE$) <> 3 THEN THESCORE$ = STRING$(3 - LEN(THESCORE$), 48) + THESCORE$ END IF IF PLYR$(K) = CURRENTGUY$ THEN COLOR 14 PRINT THESCORE$; " SECS ......... "; LTRIM$(PLYR$(K)) COLOR 15 NEXT K LOCATE CURY, CURX - 10 COLOR 11 PRINT "<<<<<<<<<<<< CAN YOU DO BETTER ? >>>>>>>>>" SLEEP 20 SCREEN 8, , 0, 0 END SUB SUB KEYSOFF ' TURN OFF ARROWKEYS ' I guess everyone knows about this DEF SEG = 0 POKE (1047), 64 'the keys were trapped using capslock alone DEF SEG 'I really didn't bother about the former flag status KEY(21) OFF KEY(22) OFF END SUB SUB KEYSON ' DEFINE/REDEFINE ARROWKEYS ' and everyone knows about this : DEF SEG = 0 POKE (1047), 64 ' I'm lazy so I used caps lock alone and didn't DEF SEG ' bother about the former flag status KEY 21, CHR$(&H80 + 64) + CHR$(&H4B)'LEFT KEY 22, CHR$(&H80 + 64) + CHR$(&H4D)'RIGHT ON KEY(21) GOSUB MOVELEFT KEY(21) ON ON KEY(22) GOSUB MOVERIGHT KEY(22) ON END SUB FUNCTION LOOKUP (KOLOR) ' THIS INTERCONVERTS THE NUMBER-KEY WITH THE COLORS RESTORE KOLORS ' this is our versatile time wasting color to sequential DIM KOLORTABLE(9) ' number converter ( seeing that color numbers aren't ' always sequential. FOR K = 1 TO 9 READ KOLORTABLE(K) NEXT K ' we map some sequential number form the number key to a color number in ' the table LOOKUP = KOLORTABLE(KOLOR) END FUNCTION SUB MOVELOGO (LOGOTABLE$(), LOGOLEN, STARTIME, LCOLOR) ' THIS JUST MOVES THE GAME NAME AND DISPLAYS THE TIME TIME = INT(TIMER - STARTIME) IF TIME = 999 THEN EXIT SUB 'they would have passed the limit 'so exit LOGOY = 3: LOGOX = 32 TIMEX = 52 ' here we reshuffle the logo characters to make them move TEMP$ = LOGOTABLE$(1) FOR K = 1 TO LOGOLEN - 1 LOGOTABLE$(K) = LOGOTABLE$(K + 1) NEXT K LOGOTABLE$(LOGOLEN) = TEMP$ ' and we make logo$ to be the new reshuffle' LOGO$ = "" FOR K = 1 TO LOGOLEN - 11 LOGO$ = LOGO$ + LOGOTABLE$(K) NEXT K ' we change the text color to what ever lcolor currently is ' and print the logo COLOR LCOLOR LOCATE LOGOY, LOGOX PRINT LOGO$ 'the time is always white though COLOR 15 LOCATE LOGOY, TIMEX PRINT TIME ' and we waste some time NOW# = TIMER WHILE TIMER - NOW# < .01: WEND END SUB SUB RESPOND (TEST$, XCENT, YCENT) ' THIS GIVES DYNAMIC RESPONSE TO THE NUMBER CODE KEYS KOLOR = VAL(TEST$) IF KOLOR > 0 AND KOLOR < 10 THEN ' they chose a legal number so we map it to a color ' and paint guided by the position indicator PAINT (XCENT, YCENT), LOOKUP(KOLOR), 9 END IF END SUB FUNCTION RESULT (REPLY$(), YCENT) ' THIS ACTUALLY DISPLAYS THE RESULT OF THE PLAYER'S CHOICES CHECK = 0 XMIN = 400 XINC = 10 FOR K = 1 TO 4 IF REPLY$(K) = "B" THEN 'they deserve a black dot and some noise 'and we increment a check PLAY "O 6 B9 G9" CHECK = CHECK + 1 CIRCLE (XMIN + (XINC * K), YCENT), 2, 0 PAINT (XMIN + (XINC * K), YCENT), 0, 0 END IF IF REPLY$(K) = "W" THEN ' they deserve a white dot and some noise PLAY "O 6 B9 G9" CIRCLE (XMIN + (XINC * K), YCENT), 2, 15 PAINT (XMIN + (XINC * K), YCENT), 15, 15 END IF NEXT K IF CHECK = 4 THEN 'they got four black dots indicating a that they 'cracked the code so : RESULT = 1 ELSE ' they didn't cack the code so: RESULT = 0 END IF END FUNCTION SUB SCRAMBLE (REPLY$()) ' SCRAMBLE SO THERE IS NO PATTERN FOR VIEWER ' this makes the game more challenging as they results are now ' scrambled and no assumptions about the postions ca be made ' this is crucial , rem the call to this routine in the main ' module and see FOR K = 1 TO 10 RANDOMIZE TIMER X = INT(4 * RND + 1) Y = INT(4 * RND + 1) SWAP REPLY$(X), REPLY$(Y) NEXT K END SUB SUB SETUP (XCENT, YCENT, XINC, YINC, XMIN, YMIN, XMAX, YMAXT, STARTIME, FASTGUY$) '******************** THIS INITIALISES THE BASIC LAYOUT **************** SCREEN 8, , 1, 1 CLS LOCATE 10, 27 PRINT "INITIALISING PLAYING FIELD" SCREEN 8, , 0, 1 NOW! = TIMER WHILE TIMER - NOW! < 2: WEND '---------------- DEFINTION OF CONSTANTS UPPERX = 150: LOWERX = 500: UPPERY = 0: LOWERY = 190 XDIFF = 30: YDIFF = 3 XINC = 40 YINC = 12 XMIN = 220 XMAX = XMIN + (XINC * 3) YMAX = 175 + 5 YMIN = YMAX - (YINC * 11) XCENT = XMIN YCENT = YMAX '----------------- MAIN STRUCTURE SETUP CLS LINE (UPPERX, UPPERY)-(LOWERX, LOWERY), 9, B PAINT (UPPERX + 5, UPPERY + 2), 7, 9 LINE (UPPERX + XDIFF, UPPERY + YDIFF)-(LOWERX - XDIFF, LOWERY - YDIFF), 9, B LINE (UPPERX, UPPERY)-(UPPERX + XDIFF, UPPERY + YDIFF), 9 LINE (LOWERX, UPPERY)-(LOWERX - XDIFF, UPPERY + YDIFF), 9 LINE (UPPERX, LOWERY)-(UPPERX + XDIFF, LOWERY - YDIFF), 9 LINE (LOWERX, LOWERY)-(LOWERX - XDIFF, LOWERY - YDIFF), 9 LINE (UPPERX + 96, UPPERY + 15)-(LOWERX - 100, UPPERY + 24), 14, B LINE (UPPERX + 257, UPPERY + 15)-(LOWERX - 50, UPPERY + 24), 4, B LINE (UPPERX + 48, UPPERY + 15)-(UPPERX + 90, UPPERY + 24), 4, B PAINT (UPPERX + 99, UPPERY + 18), 0, 14 PAINT (UPPERX + 258, UPPERY + 18), 0, 4 PAINT (UPPERX + 59, UPPERY + 18), 0, 4 '----------------- TEASER SETUP LINE (UPPERX + 112, UPPERY + 31)-(LOWERX - 116, UPPERY + 40), 9, B LOCATE 5, 34 PRINT " ? ? ? ? " FOR K = UPPERX + 113 TO LOWERX - 116 STEP 30 LINE (K, UPPERY + 31)-(K, UPPERY + 40), 9 NEXT K LOCATE 10, 1 COLOR 13 PRINT " FASTEST PLAYER :" LOCATE 12, 1 COLOR 14 PRINT " >" LOCATE 12, 4 IF FASTGUY$ = "" THEN FASTGUY$ = " $ $ $ $ $ $" COLOR 15 PRINT FASTGUY$ LINE (1, 65)-(145, 100), 9, B '---------------- PLACE_HOLDERS SETUP FOR K = YMIN TO YMAX STEP YINC FOR T = XMIN TO XMAX STEP XINC CIRCLE (T, K), 2, 14 NEXT T NEXT K '---------------- RESULT_HOLDERS SETUP FOR K = YMIN TO YMAX STEP YINC FOR T = 1 TO 4 PSET (400 + (10 * T), K), 4 NEXT T NEXT K '------------------ COLOR TABLE SETUP YSTEP = 16 UPPERCX = 570: UPPERCY = 10: LOWERCX = 600: LOWERCY = UPPERCY - YSTEP CURSORX = 67 CURSORY = 1 RESTORE INDICATOR FOR K = 1 TO 12 READ I$ LOCATE 5 + K, CURSORX COLOR K PRINT I$ NEXT K COLOR 15 FOR K = 1 TO 9 CURSORY = CURSORY + 2 LOCATE CURSORY, CURSORX + 11 PRINT K LINE (UPPERCX, UPPERCY + K * YSTEP)-(LOWERCX, LOWERCY + K * YSTEP), 7, B PAINT (UPPERCX + 10, UPPERCY - (YSTEP / 2) + (K * YSTEP)), LOOKUP(K), 7 NEXT K COLOR 2 LOCATE CURSORY + 2, CURSORX PRINT "< H > : HELP" LOCATE CURSORY + 4, CURSORX PRINT "< ESC > : MENU" COLOR 15 '--------------------- DEFINE KEYS KEYSON '------------------- TIME TO GET GOING LOCATE 3, 26 PRINT FASTIME STARTIME = TIMER ' <<<<<<< WARNING ! >>>>>> CIRCLE (XCENT, YCENT), 8, 9 ' <-- this is the position indicator. SCREEN 8, , 0, 0 ' if you ever edit this program ' don't let a color in the color table ' be this color or the color of the ' background : 9 and 7 respectively. ' check for yourself. END SUB SUB SPACEOVERLAY (MARKER, ATTEMPT$) 'THIS PARSES ATTEMPT$ TO ENABLE FURTHER ANALYSIS ' this nifty routine bumps off an input code so as to prevent ' ambiguity from further analysis ' this routine is a tool of the CHECKBLACK and CHECKWHITE subroutines ATTEMPT$ = LEFT$(ATTEMPT$, MARKER - 1) + " " + RIGHT$(ATTEMPT$, 4 - MARKER) END SUB FUNCTION SPARKLEPAUSE ' THIS IS JUST THE INTERFACE CLS CONST SHELLNOTFOUND = 5 XMIN = 3 XMAX = 81 YMIN = 2 YMAX = 23 C$ = " *" '<- these help give the impression that the stars are moving D$ = "* " '<- by using alternation ( I know that isn't a word ) SPARKLE$ = "*" '<- NOSPARKLE$ = " " '<- 'hey you could give it some better music if you want 'I swapped this from HELP MUSIC$ = "o3 L8 E D+ E D+ E o2 B o3 D C L1 o2 A" ' we create the alternating borders FOR K = 1 TO INT((XMAX - XMIN) / 2) A$ = A$ + C$ B$ = B$ + D$ NEXT K ' we begin to display my immitation of nibbles' sparklepause COLOR 14 LOCATE YMIN + 3, XMIN + 24 PRINT " <<<<<< Q'CRACKER.BAS >>>>>>" ' we get the text I stored in the main module and print it YPOINT = YMIN + 4 COLOR 11 RESTORE HEADER FOR K = 1 TO 11 YPOINT = YPOINT + 1 LOCATE YPOINT, XMIN + 3 READ H$ PRINT H$ NEXT K COLOR 15 H$ = "" ' free some memory LOCATE YMAX - 3, XMIN + 2 PRINT " < S >: START, < C >: CONTINUE , < H > : HELP , < D >: DOS , < Q >: QUIT " PLAY "MB X" + VARPTR$(MUSIC$) ' get on your nerves WHILE DUMMY = DUMMY ' just keep a loopin TEST$ = UCASE$(INKEY$) SELECT CASE TEST$ CASE IS = "S" ' they wanna RESTART so alert main ' module SPARKLEPAUSE = 1 EXIT FUNCTION CASE IS = "C" 'well just exit normally because ' they wanna continue A$ = "" B$ = "" C$ = "" D$ = "" SPARKLEPAUSE = 0 EXIT FUNCTION CASE IS = "D" 'this one is tricky CLS 'I did this just in case a guy is on the network 'and his system administrator setup an invalid 'comspec variable so a body can't shell into dos 'like mine did. Trying to change it in memory 'may produce an error so why bother ? Just trap the 'error. ERRORNO = 0 'we reset the error indicator ON ERROR GOTO NOSHELL SHELL ' we attempt to shell IF ERRORNO = SHELLNOTFOUND THEN 'reset the error handler ON ERROR GOTO 0 'can't find the command .com so: CLS K = 1 ' find the non existant compsec variable and give ' some notice DO COMSPEC$ = ENVIRON$(K) IF LEFT$(UCASE$(COMSPEC$), 7) = "COMSPEC" THEN EXIT DO END IF K = K + 1 LOOP WHILE NOT ENVIRON$(K) = "" LOCATE 10, 23 PRINT "ERROR : "; ERRORNO; ">> "; MID$(COMSPEC$, 9); " NOT FOUND." SLEEP 2 END IF ' whether or not we shelled we come here: ' if we shelled then PLEASE DON'T CHANGE ' THE SCREEN MODE ! RESTART = SPARKLEPAUSE SPARKLEPAUSE = RESTART EXIT FUNCTION CASE IS = "Q" 'well they wanna quit so : END CASE IS = CHR$(27) 'ditto END CASE IS = "H" 'we give em some help and some cheek HELP RESTART = SPARKLEPAUSE SPARKLEPAUSE = RESTART EXIT FUNCTION END SELECT 'whew ! while we wait we just be cheerful ! GOSUB SPARKLE 'and waste some time ! NOW# = TIMER WHILE TIMER - NOW < .5: WEND WEND SPARKLE: COLOR 12 IF FLAG = 0 THEN ' we put all masks and borders one way BORDER$ = A$ MASK1$ = NOSPARKLE$ MASK2$ = SPARKLE$ ELSE ' we reverse them all ! BORDER$ = B$ MASK1$ = SPARKLE$ MASK2$ = NOSPARKLE$ END IF ' having done that we now display it : FOR U = 1 TO 2 IF U = 1 THEN XPOINT = XMIN ELSE XPOINT = XMAX - 1 LOCATE YMIN, XMIN PRINT BORDER$ LOCATE YMAX, XMIN PRINT BORDER$ FOR K = YMIN TO YMAX LOCATE K, XPOINT PRINT MASK1$ NEXT K FOR K = YMIN TO YMAX STEP 2 LOCATE K, XPOINT PRINT MASK2$ NEXT K NEXT U IF FLAG = 0 THEN FLAG = 1 ELSE FLAG = 0 COLOR 15 ' change back to good ole white RETURN END FUNCTION SUB UNMASK (CODE$(), GOOD) ' THIS IS THE CODE REVELATION PROCEEDURE LOCATE 3, 32 IF GOOD = 1 THEN 'they cracked the code so celebrate with music and 'a smile : PRINT " YOU GOT IT ! " SLEEP 1 FOR K = 1 TO 4 PAINT (276 - 32 + K * 32, 35), LOOKUP(VAL(CODE$(K))), 9 PLAY "MB O 6 T255 >C9C5" LOCATE 3, 32 PRINT " YOU'RE A GENIUS ! " ELSE ' they failed so mourn with them : PRINT " TOO BAD ! " FOR K = 1 TO 4 PAINT (276 - 32 + K * 32, 35), LOOKUP(VAL(CODE$(K))), 9 PLAY "O 6 T255 >G9