'Written In Stone' - Word Puzzle Game by Dav

Samples Gallery & Reference > Games

(1/1)

Qwerkey:
'Written In Stone'

Author: @Dav
Source: qb64.org Forum
URL: https://www.qb64.org/forum/index.php?topic=2434.msg116494#msg116494
Version: 1.1
Tags: [Graphics], [Puzzle]

Description:
It's a word puzzle game. There are 50 well known quotes, scrambled up. Using the mouse you arrange the letters to make the quote. Only letters over and under each other can be swapped (same column), not side by side.

Source Code (given for reference only - you will need to download the .zip file):

--- Code: QB64: ---'================'WRITTEN IN STONE v1.1 by Dav for QB64-GL v1.4'================ 'A Word puzzle game by Dav (My 1st ever game in QB64)'First version coded FEB 1st-13th, 2013 for QB64-SDL.'Updated code MAR 31st, 2020 to work in QB64-GL v1.4. 'There are 50 well know quotes, all scrambled up.'Using mouse, unscramble the letters to make quote.'You can only swap letters in the same column. '======================================================'NOTE: THIS PROGRAM REQUIRES THE "winstone-data"folder' AND ALL OF ITS DATA FILES!'====================================================== DEFINT A-Z DECLARE SUB Credits ()DECLARE SUB DrawRows ()DECLARE SUB HelpScreen (imagehandle&)DECLARE SUB ConfigScreen (imagehandle&)DECLARE SUB GetQuote (quote)DECLARE SUB SelectLetter ()DECLARE SUB SelectQuote ()DECLARE SUB SelectNumber (number$, x, y, image&)DECLARE SUB ButtonShow (ButtonType%, ButtonFile$, x, y)DECLARE SUB StoneRoll (way$, image&, speed!)DECLARE SUB ScrollScreenUp (image&, speed!)DECLARE SUB ScrollScreenDown (image&, speed!)DECLARE SUB ScreenCurtain (way$, left&, right&, speed!)DECLARE SUB ScreenShake (image&, val1, val2, speed!) '=== Shared data SUBs/FUNCs use...DIM SHARED quote, maxquote, row1$, row2$, row3$DIM SHARED OrigRow1$, OrigRow2$, OrigRow3$DIM SHARED selected, selectedcol%, selectedrow%, col%, row%, sel$, sel2$DIM SHARED source$, config$, unsolved, music&, musicflag, sfxflag, timerflagDIM SHARED back& source$ = "winstone-data\" '<<<<<<---- Location of Data files! <<<<<<< 'Set screen, fullscreenSCREEN _NEWIMAGE(1024, 768, 32): _FULLSCREEN _SQUAREPIXELS 'Give it a title....DO: LOOP UNTIL _SCREENEXISTS: _TITLE "Written In Stone v1.1" LOCATE 24, 54: PRINT "Loading Data..." '==================================================================================' LOAD WINSTONE.DAT CONFIG FILE - HOLDS SOUND SETTINGS AND QUOTE INFO'=================================================================================='The config file is simple. It's 53 bytes, holding settings for 50 quotes and'3 for game settings, music, sfx, timer. CHR$(1) for TRUE, CHR$(0) for false.'Byte #1 of CHR$(0) means quote #1 isn't solved. CHR$(1) means it is, and so on... '== these are failsafes in case on config problem musicflag = 1sfxflag = 1timerflag = 1 '== max # of quotes (don't change this...)maxquote = 50 unsolved = 0 'How many quotes are solved OPEN "winstone.dat" FOR BINARY AS #1 '=== IF NO CONFIG FILE, MAKE ONE IF LOF(1) = 0 THEN '=== file not there so make a new dat file '=== mark all quotes unsolved config$ = "" FOR i = 1 TO maxquote v$ = CHR$(0) config$ = config$ + v$ 'all unsolved for now PUT #1, i, v$ unsolved = unsolved + 1 NEXT V2$ = CHR$(1) PUT #1, 51, V2$: config$ = config$ + CHR$(1) PUT #1, 52, V2$: config$ = config$ + CHR$(1) PUT #1, 53, V2$: config$ = config$ + CHR$(1) GOTO loadedconfigEND IF '=== see if file is large enough to read settings'=== if not then make a new fileIF LOF(1) > 0 AND LOF(1) < 53 THEN '(50 quotes & 3 game settings) '=== file must be currupt, so close file, kill it, make new one. CLOSE 1: KILL "winstone.dat": OPEN "winstone.dat" FOR BINARY AS #1 config$ = "" FOR i = 1 TO maxquote v$ = CHR$(0) config$ = config$ + v$ 'all unsolved for now PUT #1, i, v$ unsolved = unsolved + 1 NEXT '=== add music, sfx & timer settings (all 1 by default) V2$ = CHR$(1) PUT #1, 51, V2$: config$ = config$ + CHR$(1) PUT #1, 52, V2$: config$ = config$ + CHR$(1) PUT #1, 53, V2$: config$ = config$ + CHR$(1) GOTO loadedconfigEND IF '==== file must be there and large enough so load data.config$ = ""FOR i = 1 TO maxquote a$ = INPUT$(1, 1) config$ = config$ + a$ IF a$ = CHR$(0) THEN unsolved = unsolved + 1NEXT '=== get game settings nowIF INPUT$(1, 1) = CHR$(0) THEN musicflag = 0: config$ = config$ + CHR$(0)ELSE musicflag = 1: config$ = config$ + CHR$(1)END IFIF INPUT$(1, 1) = CHR$(0) THEN sfxflag = 0: config$ = config$ + CHR$(0)ELSE sfxflag = 1: config$ = config$ + CHR$(1)END IFIF INPUT$(1, 1) = CHR$(0) THEN timerflag = 0: config$ = config$ + CHR$(1)ELSE timerflag = 1: config$ = config$ + CHR$(1) '<<, TIMER ALWAYS 1 for nowEND IF loadedconfig: CLOSE 1 '=== CHEATER COMMAND LINE OPTION. MARKS ALL SOLVEDIF UCASE$(COMMAND$) = "/SOLVE" THEN FOR i = 1 TO maxquote MID$(config$, i, 1) = CHR$(1) NEXT unsolved = 0END IF '===================================================================================================''=================================================================================================== '==== Go ahead and Start music if musicflag on music& = _SNDOPEN(source$ + "sfx\sfx_music.ogg", "VOL,SYNC,LEN,PAUSE")IF musicflag = 1 THEN _SNDLOOP music& '===================================================================================================' OPEN SHARED IMAGE FILES'=================================================================================================== '=== load title page back& = _LOADIMAGE(source$ + "img\paper-title.jpg", 32) '===== load select menu fly in vid frames. DIM SHARED selectframe(0 TO 15) AS LONGFOR t = 0 TO 15 a$ = LTRIM$(STR$(t)) IF LEN(a$) = 2 THEN a$ = "00" + a$ IF LEN(a$) = 1 THEN a$ = "000" + a$ selectframe(t) = _LOADIMAGE(source$ + "vid\sel" + a$ + ".jpg")NEXT '==================================================================================================='=================================================================================================== _DELAY 1 'let screen res change play catch up if needed '=========== drop down screen IF sfxflag = 1 THEN _SNDPLAYFILE source$ + "sfx\sfx_dropdown.mp3"ScrollScreenDown back&, 60 IF sfxflag = 1 THEN _SNDPLAYFILE source$ + "sfx\sfx_boom.mp3"ScreenShake back&, 5, 4, 75 _DELAY 2 '=== Load images for Timer bar (3 colors) timegrn& = _LOADIMAGE(source$ + "img\time_grn2.jpg", 32)timeyel& = _LOADIMAGE(source$ + "img\time_yel2.jpg", 32)timered& = _LOADIMAGE(source$ + "img\time_red2.jpg", 32) '=========titlemenu:'========= '=== Pop in Main Menu on screenIF sfxflag = 1 THEN _SNDPLAYFILE source$ + "sfx\sfx_pop1.mp3" '<< POP soundmenutop& = _LOADIMAGE(source$ + "img\menu_top2.jpg", 32) '<< Get it,_PUTIMAGE (238, 152), menutop&, 0 '<< Set it..._FREEIMAGE menutop& '<< ... and forget it. 'draw bitton as normal firstButtonShow "startbtn.jpg", 565, 335ButtonShow "quitbtn.jpg", 565, 283ButtonShow "help.jpg", 565, 177ButtonShow "config.jpg", 565, 229 '=== get menu choice_MOUSESHOW DO DO WHILE _MOUSEINPUT mx = _MOUSEX: my = _MOUSEY LeftDown = _MOUSEBUTTON(1) '=== highlight buttons if mouse over it IF mx > 565 AND mx < 721 AND my > 335 AND my < 375 THEN ButtonShow "_startbtn.jpg", 565, 335: but1 = 1 ELSE IF but1 = 1 THEN ButtonShow "startbtn.jpg", 565, 335 but1 = 0 END IF END IF IF mx > 565 AND mx < 721 AND my > 283 AND my < 323 THEN ButtonShow "_quitbtn.jpg", 565, 283: but2 = 1 ELSE IF but2 = 1 THEN ButtonShow "quitbtn.jpg", 565, 283 but2 = 0 END IF END IF IF mx > 565 AND mx < 721 AND my > 177 AND my < 217 THEN ButtonShow "_help.jpg", 565, 177: but3 = 1 ELSE IF but3 = 1 THEN ButtonShow "help.jpg", 565, 177 but3 = 0 END IF END IF IF mx > 565 AND mx < 721 AND my > 229 AND my < 269 THEN ButtonShow "_config.jpg", 565, 229: but4 = 1 ELSE IF but4 = 1 THEN ButtonShow "config.jpg", 565, 229 but4 = 0 END IF END IF LOOP IF LeftDown THEN '=== if start button clicked IF mx > 565 AND mx < 721 AND my > 335 AND my < 375 THEN ButtonClick 1, "startbtn.jpg", 565, 335 EXIT DO END IF IF mx > 565 AND mx < 721 AND my > 283 AND my < 323 THEN ButtonClick 1, "quitbtn.jpg", 565, 283 _PUTIMAGE (0, 0), back&, 0 GOTO Quit END IF IF mx > 565 AND mx < 721 AND my > 177 AND my < 217 THEN ButtonClick 1, "help.jpg", 565, 177 _PUTIMAGE (0, 0), back&, 0 _DELAY .25 HelpScreen (back&) _DELAY .25 GOTO titlemenu END IF IF mx > 565 AND mx < 721 AND my > 229 AND my < 269 THEN ButtonClick 1, "config.jpg", 565, 229 _PUTIMAGE (0, 0), back&, 0 _DELAY .25 ConfigScreen (back&) _DELAY .25 GOTO titlemenu END IF END IF IF INKEY$ = CHR$(27) THEN GOTO Quit LOOP _PUTIMAGE (0, 0), back&, 0_DELAY .25 ScrollScreenUp back&, 75 _FREEIMAGE back& '=======================================================================================' START GAME'======================================================================================= quote = 1 'just a safety... RANDOMIZE TIMER SelectQuoteGetQuote (quote) '========NewBoard:'======== '=== scroll down playing board back& = _LOADIMAGE(source$ + "img\board6.jpg", 32) ScrollScreenDown back&, 60 DrawRows _MOUSESHOW TIMER ON '========================================================================================' MAIN GAME LOOP'======================================================================================== Mainloop: starttime! = TIMERpoppy = 0 'flag to not show more than one popup message in a secondrumbleon = 0 'flag for rumble happening _PRINTMODE _KEEPBACKGROUND: COLOR _RGB(115, 115, 115)LOCATE 17, 90: PRINT "Quote:"; quote; "("; LTRIM$(STR$(unsolved)); " to solve)"; DO '=== Catch mouse DO WHILE _MOUSEINPUT mx = _MOUSEX: my = _MOUSEY '=== break up screen in 35x35 grid col% = INT(mx / 35) - 2: row% = INT(my / 35) - 2 LeftDown = _MOUSEBUTTON(1) LOOP IF LeftDown = -1 THEN '=== clicked quote button here... IF mx > 402 AND mx < 558 AND my > 302 AND my < 342 THEN '=== turn off rumble if it was on IF rumbleon = 1 THEN IF sfxflag = 1 THEN IF _SNDPLAYING(rumble&) THEN _SNDSTOP rumble&: _SNDSTOP rumble& END IF END IF ButtonClick 0, "quote.jpg", 403, 302 ScrollScreenUp 0, 60 'scroll up current screen SelectQuote GetQuote (quote) GOTO NewBoard END IF 'Clicked HINT button IF mx > 580 AND mx < 736 AND my > 302 AND my < 342 THEN ButtonClick 0, "hint.jpg", 580, 302 'Find first hint letter here, and select it for user. 'hint letter is first letter in row that doesn't line up with origrow 'Look in 1st row first found = 0 FOR tt = 1 TO LEN(row1$) 'check row1 data H1$ = UCASE$(MID$(row1$, tt, 1)) 'get letter in row1 H2$ = UCASE$(MID$(OrigRow1$, tt, 1)) 'compare with original spot 'If row1$ part needs moved, then mark this IF H1$ <> H2$ THEN hintcol% = tt: hintrow% = 1: found = 1: EXIT FOR END IF NEXT IF found = 0 THEN FOR tt = 1 TO LEN(row2$) 'check row1 data H1$ = UCASE$(MID$(row2$, tt, 1)) 'get letter in row1 H2$ = UCASE$(MID$(OrigRow2$, tt, 1)) 'compare with original spot 'If row2$ part needs moved, then mark this IF H1$ <> H2$ THEN hintcol% = tt: hintrow% = 2: found = 1: EXIT FOR END IF NEXT END IF IF found = 0 THEN FOR tt = 1 TO LEN(row3$) 'check row1 data H1$ = UCASE$(MID$(row3$, tt, 1)) 'get letter in row1 H2$ = UCASE$(MID$(OrigRow3$, tt, 1)) 'compare with original spot 'If row3$ part needs moved, then mark this IF H1$ <> H2$ THEN hintcol% = tt: hintrow% = 3: found = 1: EXIT FOR END IF NEXT END IF IF found = 1 THEN 'flash hint letter FOR fl = 1 TO 3 letter& = _LOADIMAGE(source$ + "fnt2\_" + H1$ + ".jpg", 32) _PUTIMAGE (70 + (hintcol% * 35), 70 + (hintrow% * 35)), letter& _FREEIMAGE letter& _DELAY .15 letter& = _LOADIMAGE(source$ + "fnt2\" + H1$ + ".jpg", 32) _PUTIMAGE (70 + (hintcol% * 35), 70 + (hintrow% * 35)), letter& _FREEIMAGE letter& _DELAY .15 NEXT END IF END IF '=== clicked title menu button here... IF mx > 759 AND mx < 915 AND my > 302 AND my < 342 THEN ESCBail: '=== turn off rumble if it was on IF rumbleon = 1 THEN IF sfxflag = 1 THEN _SNDSTOP rumble& END IF ButtonClick 0, "title.jpg", 759, 302 ScrollScreenUp 0, 75 'scroll up current screen _FREEIMAGE back& 'release board as back& '=== reload title as back& '<<<<<<<<<<<<<< NEED TO CHANGE THIS STUPID WAY back& = _LOADIMAGE(source$ + "img\paper-title.jpg", 32) '=== load slide in sides (left right) left& = _LOADIMAGE(source$ + "\img\paper-title-left.jpg") right& = _LOADIMAGE(source$ + "\img\paper-title-right.jpg") ScreenCurtain "CLOSE", left&, right&, 120 _FREEIMAGE left& _FREEIMAGE right& _PUTIMAGE , back&, 0 _DELAY .25 GOTO titlemenu END IF '===If inbound col & row fields clicked IF col% <= 23 AND col% > 0 AND row% <= 3 AND row% > 0 THEN IF selected = 0 THEN '=== If no letter selected yet, then... '=== Get 1st selected letter on current row SelectLetter ELSE '=== must already but one selected, so... '=== get another selected letter (only on same Col%) '=== then do the swap in rows$, then redraw new placements. '=== if same column (but not same row)...ok IF col% = selectedcol% AND row% <> selectedrow% THEN '=== get 2nd selected letter SELECT CASE row% CASE 1: sel2$ = MID$(row1$, col%, 1) CASE 2: sel2$ = MID$(row2$, col%, 1) CASE 3: sel2$ = MID$(row3$, col%, 1) END SELECT '=== only select if not a space or empty place IF sel2$ <> " " AND sel2$ <> "" THEN '=== load 2st selected letter (highlighted one) letter& = _LOADIMAGE(source$ + "fnt2\_" + sel2$ + ".jpg", 32) _PUTIMAGE (70 + (col% * 35), 70 + (row% * 35)), letter& _FREEIMAGE letter& IF sfxflag = 1 THEN _SNDPLAYFILE source$ + "sfx\sfx_click2.mp3" '=== SWAP LETTER DISPLAY HERE FOR o = 1 TO 2 'load 2nd letter normal letter& = _LOADIMAGE(source$ + "fnt2\" + sel2$ + ".jpg", 32) _PUTIMAGE (70 + (col% * 35), 70 + (row% * 35)), letter& _FREEIMAGE letter& 'load first letter normal letter& = _LOADIMAGE(source$ + "fnt2\" + sel$ + ".jpg", 32) _PUTIMAGE (70 + (col% * 35), 70 + (selectedrow% * 35)), letter& _FREEIMAGE letter& _DELAY .05 'load 2nd letter highlighted letter& = _LOADIMAGE(source$ + "fnt2\_" + sel2$ + ".jpg", 32) _PUTIMAGE (70 + (col% * 35), 70 + (row% * 35)), letter& _FREEIMAGE letter& 'load first letter highlighted letter& = _LOADIMAGE(source$ + "fnt2\_" + sel$ + ".jpg", 32) _PUTIMAGE (70 + (col% * 35), 70 + (selectedrow% * 35)), letter& _FREEIMAGE letter& '_DELAY .02 NEXT _DELAY .2 '=== SWAP LETTERS INTERNALLY HERE 'replace current row letter with 1st sel$ letter SELECT CASE row% CASE 1: MID$(row1$, col%, 1) = sel$ CASE 2: MID$(row2$, col%, 1) = sel$ CASE 3: MID$(row3$, col%, 1) = sel$ END SELECT 'replace 1st select row with curr row letter SELECT CASE selectedrow% CASE 1: MID$(row1$, col%, 1) = sel2$ CASE 2: MID$(row2$, col%, 1) = sel2$ CASE 3: MID$(row3$, col%, 1) = sel2$ END SELECT '=== DONE! Redraw rows''' selected = 0 DrawRows END IF ELSE '=== must be a new column, so '=== un select letters, select this new one... DrawRows '=== fresh look SelectLetter END IF END IF END IF '==== If rows match original, YOU GOT IT!!!! IF row1$ = OrigRow1$ AND row2$ = OrigRow2$ AND row3$ = OrigRow3$ THEN '=== turn off rumble if it was on IF rumbleon = 1 THEN IF sfxflag = 1 THEN IF _SNDPLAYING(rumble&) THEN _SNDSTOP rumble&: _SNDSTOP rumble& END IF END IF IF sfxflag = 1 THEN _SNDPLAYFILE source$ + "sfx\sfx_clap.ogg" '=== Popup a good message rndpop$ = LTRIM$(STR$(FIX((RND * 16) + 1))) 'get 1 of 16 pop& = _LOADIMAGE(source$ + "img\pop-z-" + rndpop$ + ".jpg", 32) _PUTIMAGE (0, 450), pop&, 0: _FREEIMAGE pop& '==== flash letters here... FlashRows _DELAY 1 '=== Mark quote # as solved in config$ data MID$(config$, quote, 1) = CHR$(1) IF unsolved > 0 THEN unsolved = unsolved - 1 'decrease one from unsolved count END IF ScrollScreenUp 0, 60 '=== IF ALL QUOTES SOLVED - WIN - SHOW CREDITS!!! IF unsolved = 0 THEN Credits _AUTODISPLAY back& = _LOADIMAGE(source$ + "img\paper-title.jpg", 32) GOTO Quit END IF '=== if already solved next quote, go to select quote quote = quote + 1 IF MID$(config$, quote, 1) = CHR$(1) THEN SelectQuote '=== if at last quote, then go to select menu IF quote > maxquote THEN SelectQuote END IF '==== next quote , scroll down board again.. back& = _LOADIMAGE(source$ + "img\board6.jpg", 32) ScrollScreenDown back&, 60 GetQuote quote DrawRows GOTO Mainloop END IF END IF '=== update timer stuff here... L = INT(TIMER - starttime!) + 1 'New way to draw timer because hint delay made it skip a draw sometimes FOR V = 0 TO L IF V > 0 AND V <= 34 THEN _PUTIMAGE (88 + (V * 10), 253), timegrn& IF V > 34 AND V <= 49 THEN _PUTIMAGE (88 + (V * 10), 253), timeyel& IF V > 49 THEN _PUTIMAGE (88 + (V * 10), 253), timered& NEXT '============ GET A POPUP here ========================== rndpop$ = LTRIM$(STR$(FIX((RND * 6) + 1))) '======================================================== '=== open pop.... IF L = 2 AND poppy <> L THEN '<<<<<<<< poppy pop& = _LOADIMAGE(source$ + "img\pop-a-" + rndpop$ + ".jpg", 32) _PUTIMAGE (0, 450), pop&, 0: _FREEIMAGE pop& poppy = L '<<<<<<<< poppy END IF IF L = 10 AND poppy <> L THEN pop& = _LOADIMAGE(source$ + "img\pop-b-" + rndpop$ + ".jpg", 32) _PUTIMAGE (0, 450), pop&, 0: _FREEIMAGE pop& poppy = L '<<<<<<<< poppy END IF IF L = 18 AND poppy <> L THEN pop& = _LOADIMAGE(source$ + "img\pop-c-" + rndpop$ + ".jpg", 32) _PUTIMAGE (0, 450), pop&, 0: _FREEIMAGE pop& poppy = L '<<<<<<<< poppy END IF IF L = 26 AND poppy <> L THEN pop& = _LOADIMAGE(source$ + "img\pop-d-" + rndpop$ + ".jpg", 32) _PUTIMAGE (0, 450), pop&, 0: _FREEIMAGE pop& poppy = L '<<<<<<<< poppy END IF '==== yellow.... IF L = 34 AND poppy <> L THEN pop& = _LOADIMAGE(source$ + "img\pop-e-" + rndpop$ + ".jpg", 32) _PUTIMAGE (0, 450), pop&, 0: _FREEIMAGE pop& poppy = L '<<<<<<<< poppy END IF IF L = 41 AND poppy <> L THEN pop& = _LOADIMAGE(source$ + "img\pop-f-" + rndpop$ + ".jpg", 32) _PUTIMAGE (0, 450), pop&, 0: _FREEIMAGE pop& poppy = L '<<<<<<<< poppy END IF '=== red..... IF L = 49 AND poppy <> L THEN pop& = _LOADIMAGE(source$ + "img\pop-g-" + rndpop$ + ".jpg", 32) _PUTIMAGE (0, 450), pop&, 0: _FREEIMAGE pop& poppy = L '<<<<<<<< poppy END IF IF L = 54 AND poppy <> L THEN pop& = _LOADIMAGE(source$ + "img\pop-h-" + rndpop$ + ".jpg", 32) _PUTIMAGE (0, 450), pop&, 0: _FREEIMAGE pop& poppy = L '<<<<<<<< poppy END IF '=== Start rumble is time near end (dooom coming...) IF L > 54 AND rumbleon = 0 THEN '<<<< was 114 rumble& = _SNDOPEN(source$ + "sfx\sfx_rumble2.ogg", "VOL,SYNC,LEN,PAUSE") IF sfxflag = 1 THEN _SNDLOOP rumble& rumbleon = 1 'tag as rumble is playing END IF 'start shaking screen if > 56 or maybe if rumble on IF L > 56 THEN '=== grab current background, shake it _DISPLAY 'curr& = _SCREENIMAGE curr& = _COPYIMAGE(_DISPLAY) _AUTODISPLAY _PUTIMAGE (RND * 3, RND * 3)-(1023, 767), curr&, 0: _DISPLAY _PUTIMAGE , curr&, 0: _DISPLAY END IF '======================================================== IF L = 60 THEN '<<<< 60 seconds and timer is up '=========== Play drop down sound IF sfxflag = 1 THEN _SNDPLAYFILE source$ + "sfx\sfx_dropdown.mp3" '=== drop down screen timesup& = _LOADIMAGE(source$ + "img\paper-timeup.jpg", 32) ScrollScreenDown timesup&, 75 _SNDSTOP rumble& _SNDCLOSE rumble& '=== shake (BOOM) IF sfxflag = 1 THEN _SNDPLAYFILE source$ + "sfx\sfx_boom.mp3" ScreenShake timesup&, 5, 4, 60 _DELAY 1.5 _FREEIMAGE timesup& IF sfxflag = 1 THEN _SNDPLAYFILE source$ + "sfx\sfx_roll.ogg" StoneRoll "RIGHT", 0, 25 '=== do retry quote here, or main menu.... SelectQuote GetQuote quote 'Place board back back& = _LOADIMAGE(source$ + "img\board6.jpg", 32) ScrollScreenDown back&, 60 DrawRows GOTO Mainloop END IF IF INKEY$ = CHR$(27) THEN GOTO ESCBail LOOP Quit: '=================================================================' CLOSE ALL OPENED IMAGE & SOUND FILES, SAVE CONFIG DATA'================================================================= 'free all select frame video image handles first...FOR t = 0 TO 14 _FREEIMAGE selectframe(t)NEXT IF musicflag = 1 THEN _SNDSTOP music& _SNDCLOSE music&END IF IF sfxflag = 1 THEN roll& = _SNDOPEN(source$ + "sfx\sfx_crumble.ogg", "VOL,SYNC,LEN,PAUSE") _SNDPLAY roll&END IF 'Shake the screen a little'=== shake (BOOM)ScreenShake back&, 6, 4, 60 IF sfxflag = 1 THEN _SNDSTOP roll&: _SNDCLOSE roll& _SNDPLAYFILE source$ + "sfx\sfx_slideup.ogg"END IF ScrollScreenUp back&, 60 '===== Save config data OPEN "winstone.dat" FOR OUTPUT AS #1SEEK #1, 1PRINT #1, config$;CLOSE 1 _DELAY 1 '========================= _FREEIMAGE back&_FREEIMAGE timegrn&_FREEIMAGE timeyel&_FREEIMAGE timered& SYSTEM '=================================================================================================================' * * * * * * * * * * * SUBS/FUNCTIONS & OTHER NOTES * * * * * * * * * * * *'================================================================================================================= '================================================================================================================= SUB DrawRows () '== Draws the row1$, row2$, row3$ data to screen. '===draw row1 FOR t = 1 TO LEN(row1$) L$ = UCASE$(MID$(row1$, t, 1)) 'IF L$ = " " THEN L$ = "space" IF L$ <> " " THEN letter& = _LOADIMAGE(source$ + "fnt2\" + L$ + ".jpg", 32) _PUTIMAGE (70 + (t * 35), 105), letter& _FREEIMAGE letter& END IF NEXT '===draw row2 FOR t = 1 TO LEN(row2$) L$ = UCASE$(MID$(row2$, t, 1)) 'IF L$ = " " THEN L$ = "space" IF L$ <> " " THEN letter& = _LOADIMAGE(source$ + "fnt2\" + L$ + ".jpg", 32) _PUTIMAGE (70 + (t * 35), 140), letter& _FREEIMAGE letter& END IF NEXT '===draw row3 FOR t = 1 TO LEN(row3$) L$ = UCASE$(MID$(row3$, t, 1)) 'IF L$ = " " THEN L$ = "space" IF L$ <> " " THEN letter& = _LOADIMAGE(source$ + "fnt2\" + L$ + ".jpg", 32) _PUTIMAGE (70 + (t * 35), 175), letter& _FREEIMAGE letter& END IF NEXT END SUB '================================================================================================================= SUB FlashRows () '=== Animate quote rows for a sec to show solved. FOR flash = 1 TO 6 '===draw row1 highlighted FOR t = 1 TO LEN(row1$) L$ = UCASE$(MID$(row1$, t, 1)) 'IF L$ = " " THEN L$ = "space" IF L$ <> " " THEN letter& = _LOADIMAGE(source$ + "fnt2\_" + L$ + ".jpg", 32) _PUTIMAGE (70 + (t * 35), 105), letter& _FREEIMAGE letter& END IF NEXT '===draw row2 FOR t = 1 TO LEN(row2$) L$ = UCASE$(MID$(row2$, t, 1)) 'IF L$ = " " THEN L$ = "space" IF L$ <> " " THEN letter& = _LOADIMAGE(source$ + "fnt2\_" + L$ + ".jpg", 32) _PUTIMAGE (70 + (t * 35), 140), letter& _FREEIMAGE letter& END IF NEXT '===draw row3 FOR t = 1 TO LEN(row3$) L$ = UCASE$(MID$(row3$, t, 1)) 'IF L$ = " " THEN L$ = "space" IF L$ <> " " THEN letter& = _LOADIMAGE(source$ + "fnt2\_" + L$ + ".jpg", 32) _PUTIMAGE (70 + (t * 35), 175), letter& _FREEIMAGE letter& END IF NEXT _DELAY .15 DrawRows 'Show them normal _DELAY .15 NEXT END SUB '================================================================================================================= SUB SelectLetter () 'gets a selected letter, only if no space... SELECT CASE row% CASE 1: sel$ = MID$(row1$, col%, 1) CASE 2: sel$ = MID$(row2$, col%, 1) CASE 3: sel$ = MID$(row3$, col%, 1) END SELECT '=== dont select if a space or empty place IF sel$ = " " OR sel$ = "" THEN selected = 0 ELSE IF sfxflag = 1 THEN _SNDPLAYFILE source$ + "sfx\sfx_select.ogg" '=== load 1st selected letter (highlighted one) letter& = _LOADIMAGE(source$ + "fnt2\_" + sel$ + ".jpg", 32) _PUTIMAGE (70 + (col% * 35), 70 + (row% * 35)), letter& _FREEIMAGE letter& selected = 1: selectedrow% = row%: selectedcol% = col% END IF '=== select sound '=== time for mouse button to get up _DELAY .3 END SUB '================================================================================================================= SUB HelpScreen (imagehandle&) pic& = _LOADIMAGE(source$ + "\img\helpscreen.jpg") StoneRoll "RIGHT", pic&, 25 IF sfxflag = 1 THEN _SNDSTOP roll& _MOUSESHOW DO '=== Catch mouse DO WHILE _MOUSEINPUT mx = _MOUSEX: my = _MOUSEY LeftDown = _MOUSEBUTTON(1) IF mx > 417 AND mx < 573 AND my > 687 AND my < 727 THEN ButtonShow "_back.jpg", 417, 687 ELSE ButtonShow "back.jpg", 417, 687 END IF LOOP IF LeftDown THEN '=== if back button IF mx > 417 AND mx < 573 AND my > 687 AND my < 727 THEN ButtonClick 1, "back.jpg", 417, 687 EXIT DO END IF END IF LOOP StoneRoll "LEFT", imagehandle&, 25 _FREEIMAGE pic& END SUB '================================================================================================================= SUB ConfigScreen (imagehandle&) pic& = _LOADIMAGE(source$ + "\img\configscreen2.jpg") _DEST pic& '=== Mark setting on screen here. IF musicflag = 1 THEN LINE (451, 252)-(476, 275), _RGB32(0, 255, 0), BF 'ON = green ELSE LINE (585, 252)-(610, 275), _RGB32(0, 255, 0), BF 'OFF = green END IF IF sfxflag = 1 THEN LINE (451, 309)-(476, 332), _RGB32(0, 255, 0), BF 'ON = green ELSE LINE (587, 309)-(612, 332), _RGB32(0, 255, 0), BF 'OFF = green END IF IF timerflag = 1 THEN LINE (451, 369)-(477, 393), _RGB32(0, 255, 0), BF 'ON = green ELSE LINE (588, 370)-(614, 394), _RGB32(0, 255, 0), BF 'OFF = green END IF _DEST 0 IF sfxflag = 1 THEN _SNDPLAYFILE source$ + "sfx\sfx_roll.ogg" StoneRoll "RIGHT", pic&, 25 ConfigTop: _MOUSESHOW DO '=== Catch mouse DO WHILE _MOUSEINPUT mx = _MOUSEX: my = _MOUSEY LeftDown = _MOUSEBUTTON(1) IF mx > 417 AND mx < 573 AND my > 687 AND my < 727 THEN ButtonShow "_back.jpg", 417, 687 ELSE ButtonShow "back.jpg", 417, 687 END IF LOOP IF LeftDown THEN '=== if back button IF mx > 417 AND mx < 573 AND my > 687 AND my < 727 THEN ButtonClick 1, "back.jpg", 417, 687 EXIT DO END IF 'Music ON click IF mx > 451 AND mx < 477 AND my > 252 AND my < 276 THEN musicflag = 1 MID$(config$, 51, 1) = CHR$(1) 'MARK CONFIG SPOT AS MUSIC ON _SNDLOOP music& IF sfxflag = 1 THEN _SNDPLAYFILE source$ + "sfx\sfx_click2.mp3" LINE (451, 252)-(476, 275), _RGB32(0, 255, 0), BF 'ON = green LINE (585, 252)-(610, 275), _RGB32(255, 255, 255), BF 'OFF = white _DELAY .3 END IF 'Music OFF clicked IF mx > 585 AND mx < 610 AND my > 252 AND my < 275 THEN musicflag = 0 MID$(config$, 51, 1) = CHR$(0) 'MARK CONFIG SPOT AS MUSIC OFF _SNDSTOP music& IF sfxflag = 1 THEN _SNDPLAYFILE source$ + "sfx\sfx_click2.mp3" LINE (451, 252)-(476, 275), _RGB32(255, 255, 255), BF 'ON LINE (585, 252)-(610, 275), _RGB32(0, 255, 0), BF 'OFF _DELAY .3 END IF 'SFX ON clicked IF mx > 451 AND mx < 477 AND my > 309 AND my < 333 THEN sfxflag = 1 MID$(config$, 52, 1) = CHR$(1) 'MARK CONFIG SPOT AS SFX ON _SNDPLAYFILE source$ + "sfx\sfx_click2.mp3" LINE (451, 309)-(476, 332), _RGB32(0, 255, 0), BF 'ON LINE (587, 309)-(612, 332), _RGB32(255, 255, 255), BF _DELAY .3 END IF 'SFX OFF clicked IF mx > 587 AND mx < 612 AND my > 309 AND my < 332 THEN sfxflag = 0 MID$(config$, 52, 1) = CHR$(0) 'MARK CONFIG SPOT AS SFX OFF _SNDPLAYFILE source$ + "sfx\sfx_click2.mp3" LINE (451, 309)-(476, 332), _RGB32(255, 255, 255), BF 'ON LINE (587, 309)-(612, 332), _RGB32(0, 255, 0), BF _DELAY .3 END IF 'TIMER OFF CLICKED IF mx > 588 AND mx < 614 AND my > 370 AND my < 394 THEN timerflag = 1 MID$(config$, 53, 1) = CHR$(1) 'MARK CONFIG SPOT AS TIMER ON IF sfxflag = 1 THEN _SNDPLAYFILE source$ + "sfx\sfx_click2.mp3" _DELAY .3 _DISPLAY snapshot& = _COPYIMAGE(_DISPLAY) _AUTODISPLAY timerwimp& = _LOADIMAGE(source$ + "img\timernotice.jpg") _PUTIMAGE (218, 160), timerwimp&, 0 _FREEIMAGE timerwimp& '=== wait for Reply... DO cheese = _MOUSEINPUT mx2 = _MOUSEX: my2 = _MOUSEY LeftDown2 = _MOUSEBUTTON(1) 'hover button IF mx2 > 286 AND mx2 < 717 AND my2 > 466 AND my2 < 520 THEN ButtonShow "_wimp.jpg", 286, 466 IF _MOUSEBUTTON(1) THEN ButtonClick 1, "wimp.jpg", 286, 466 EXIT DO END IF ELSE ButtonShow "wimp.jpg", 286, 466 END IF LOOP _PUTIMAGE , snapshot&, 0 _FREEIMAGE snapshot& GOTO ConfigTop END IF '==== RESET GAME CLICKED IF mx > 369 AND mx < 617 AND my > 585 AND my < 639 THEN ButtonClick 0, "reset.jpg", 369, 585 _DISPLAY snapshot& = _COPYIMAGE(_DISPLAY) _AUTODISPLAY timerwimp& = _LOADIMAGE(source$ + "img\resetnotice.jpg") _PUTIMAGE (276, 160), timerwimp&, 0 _FREEIMAGE timerwimp& '=== Get YES or NO DO cheese = _MOUSEINPUT mx2 = _MOUSEX: my2 = _MOUSEY LeftDown2 = _MOUSEBUTTON(1) 'YES button poll IF mx2 > 318 AND mx2 < 474 AND my2 > 395 AND my2 < 435 THEN ButtonShow "_yes.jpg", 318, 395 IF _MOUSEBUTTON(1) THEN ButtonClick 1, "yes.jpg", 318, 395 '=== RESET CONFIG DATA HERE (ONLY QUOTE STUFF) FOR cc = 1 TO 50 MID$(config$, cc, 1) = CHR$(0) NEXT unsolved = 50 EXIT DO END IF ELSE ButtonShow "yes.jpg", 318, 395 END IF 'NO BUTTON poll IF mx2 > 516 AND mx2 < 672 AND my2 > 395 AND my2 < 435 THEN ButtonShow "_no.jpg", 516, 395 IF _MOUSEBUTTON(1) THEN ButtonClick 1, "no.jpg", 516, 395 EXIT DO END IF ELSE ButtonShow "no.jpg", 516, 395 END IF LOOP _PUTIMAGE , snapshot&, 0 _FREEIMAGE snapshot& GOTO ConfigTop END IF END IF LOOP IF sfxflag = 1 THEN _SNDPLAYFILE source$ + "sfx\sfx_roll.ogg" StoneRoll "LEFT", imagehandle&, 25 _FREEIMAGE pic& END SUB '================================================================================================================= SUB SelectQuote () '=== Brings up Select Quote Menu selectmenu& = _LOADIMAGE(source$ + "img\select.jpg", 32) solvedimg& = _LOADIMAGE(source$ + "img\solved.jpg", 32) '=== Play Select menu fly in vid '======================== FOR t = 15 TO 0 STEP -1 _PUTIMAGE (0, 0), selectframe(t) _LIMIT 40 NEXT _PUTIMAGE , selectmenu&, 0 '======================= _FREEIMAGE selectmenu& 'no need it because we're going to change it so much, just grab background now '=== If quotes have been solved, put solved tag image .. IF MID$(config$, 1, 1) = CHR$(1) THEN _PUTIMAGE (209, 173), solvedimg&, 0 IF MID$(config$, 2, 1) = CHR$(1) THEN _PUTIMAGE (284, 173), solvedimg&, 0 IF MID$(config$, 3, 1) = CHR$(1) THEN _PUTIMAGE (359, 173), solvedimg&, 0 IF MID$(config$, 4, 1) = CHR$(1) THEN _PUTIMAGE (434, 173), solvedimg&, 0 IF MID$(config$, 5, 1) = CHR$(1) THEN _PUTIMAGE (509, 173), solvedimg&, 0 IF MID$(config$, 6, 1) = CHR$(1) THEN _PUTIMAGE (584, 173), solvedimg&, 0 IF MID$(config$, 7, 1) = CHR$(1) THEN _PUTIMAGE (659, 173), solvedimg&, 0 IF MID$(config$, 8, 1) = CHR$(1) THEN _PUTIMAGE (734, 173), solvedimg&, 0 IF MID$(config$, 9, 1) = CHR$(1) THEN _PUTIMAGE (209, 235), solvedimg&, 0 IF MID$(config$, 10, 1) = CHR$(1) THEN _PUTIMAGE (284, 235), solvedimg&, 0 IF MID$(config$, 11, 1) = CHR$(1) THEN _PUTIMAGE (359, 235), solvedimg&, 0 IF MID$(config$, 12, 1) = CHR$(1) THEN _PUTIMAGE (434, 235), solvedimg&, 0 IF MID$(config$, 13, 1) = CHR$(1) THEN _PUTIMAGE (509, 235), solvedimg&, 0 IF MID$(config$, 14, 1) = CHR$(1) THEN _PUTIMAGE (584, 235), solvedimg&, 0 IF MID$(config$, 15, 1) = CHR$(1) THEN _PUTIMAGE (659, 235), solvedimg&, 0 IF MID$(config$, 16, 1) = CHR$(1) THEN _PUTIMAGE (734, 235), solvedimg&, 0 IF MID$(config$, 17, 1) = CHR$(1) THEN _PUTIMAGE (209, 297), solvedimg&, 0 IF MID$(config$, 18, 1) = CHR$(1) THEN _PUTIMAGE (284, 297), solvedimg&, 0 IF MID$(config$, 19, 1) = CHR$(1) THEN _PUTIMAGE (359, 297), solvedimg&, 0 IF MID$(config$, 20, 1) = CHR$(1) THEN _PUTIMAGE (434, 297), solvedimg&, 0 IF MID$(config$, 21, 1) = CHR$(1) THEN _PUTIMAGE (509, 297), solvedimg&, 0 IF MID$(config$, 22, 1) = CHR$(1) THEN _PUTIMAGE (584, 297), solvedimg&, 0 IF MID$(config$, 23, 1) = CHR$(1) THEN _PUTIMAGE (659, 297), solvedimg&, 0 IF MID$(config$, 24, 1) = CHR$(1) THEN _PUTIMAGE (734, 297), solvedimg&, 0 IF MID$(config$, 25, 1) = CHR$(1) THEN _PUTIMAGE (209, 359), solvedimg&, 0 IF MID$(config$, 26, 1) = CHR$(1) THEN _PUTIMAGE (284, 359), solvedimg&, 0 IF MID$(config$, 27, 1) = CHR$(1) THEN _PUTIMAGE (359, 359), solvedimg&, 0 IF MID$(config$, 28, 1) = CHR$(1) THEN _PUTIMAGE (434, 359), solvedimg&, 0 IF MID$(config$, 29, 1) = CHR$(1) THEN _PUTIMAGE (509, 359), solvedimg&, 0 IF MID$(config$, 30, 1) = CHR$(1) THEN _PUTIMAGE (584, 359), solvedimg&, 0 IF MID$(config$, 31, 1) = CHR$(1) THEN _PUTIMAGE (659, 359), solvedimg&, 0 IF MID$(config$, 32, 1) = CHR$(1) THEN _PUTIMAGE (734, 359), solvedimg&, 0 IF MID$(config$, 33, 1) = CHR$(1) THEN _PUTIMAGE (209, 421), solvedimg&, 0 IF MID$(config$, 34, 1) = CHR$(1) THEN _PUTIMAGE (284, 421), solvedimg&, 0 IF MID$(config$, 35, 1) = CHR$(1) THEN _PUTIMAGE (359, 421), solvedimg&, 0 IF MID$(config$, 36, 1) = CHR$(1) THEN _PUTIMAGE (434, 421), solvedimg&, 0 IF MID$(config$, 37, 1) = CHR$(1) THEN _PUTIMAGE (509, 421), solvedimg&, 0 IF MID$(config$, 38, 1) = CHR$(1) THEN _PUTIMAGE (584, 421), solvedimg&, 0 IF MID$(config$, 39, 1) = CHR$(1) THEN _PUTIMAGE (659, 421), solvedimg&, 0 IF MID$(config$, 40, 1) = CHR$(1) THEN _PUTIMAGE (734, 421), solvedimg&, 0 IF MID$(config$, 41, 1) = CHR$(1) THEN _PUTIMAGE (209, 483), solvedimg&, 0 IF MID$(config$, 42, 1) = CHR$(1) THEN _PUTIMAGE (284, 483), solvedimg&, 0 IF MID$(config$, 43, 1) = CHR$(1) THEN _PUTIMAGE (359, 483), solvedimg&, 0 IF MID$(config$, 44, 1) = CHR$(1) THEN _PUTIMAGE (434, 483), solvedimg&, 0 IF MID$(config$, 45, 1) = CHR$(1) THEN _PUTIMAGE (509, 483), solvedimg&, 0 IF MID$(config$, 46, 1) = CHR$(1) THEN _PUTIMAGE (584, 483), solvedimg&, 0 IF MID$(config$, 47, 1) = CHR$(1) THEN _PUTIMAGE (659, 483), solvedimg&, 0 IF MID$(config$, 48, 1) = CHR$(1) THEN _PUTIMAGE (734, 483), solvedimg&, 0 IF MID$(config$, 49, 1) = CHR$(1) THEN _PUTIMAGE (209, 545), solvedimg&, 0 IF MID$(config$, 50, 1) = CHR$(1) THEN _PUTIMAGE (284, 545), solvedimg&, 0 '===load select menu message based on solved # IF unsolved = 0 THEN selectmsg& = _LOADIMAGE(source$ + "img\select-champ.jpg", 32) _PUTIMAGE (376, 547), selectmsg&, 0 ELSE selectmsg& = _LOADIMAGE(source$ + "img\select-msg.jpg", 32) _PUTIMAGE (400, 548), selectmsg&, 0 END IF _FREEIMAGE selectmsg& 'NOW grab screen again as select menu '=== Grab background _DISPLAY selectmenu& = _COPYIMAGE(_DISPLAY) _AUTODISPLAY '=== get menu choice _MOUSESHOW DO '=== Catch mouse DO WHILE _MOUSEINPUT mx = _MOUSEX: my = _MOUSEY: LeftDown = _MOUSEBUTTON(1) LOOP IF LeftDown THEN '== 1 IF mx > 209 AND mx < 277 AND my > 173 AND my < 227 THEN SelectNumber "1", 209, 173, selectmenu&: EXIT DO END IF '== 2 IF mx > 284 AND mx < 353 AND my > 173 AND my < 227 THEN SelectNumber "2", 284, 173, selectmenu&: EXIT DO END IF '== 3 IF mx > 359 AND mx < 428 AND my > 173 AND my < 227 THEN SelectNumber "3", 359, 173, selectmenu&: EXIT DO END IF '== 4 IF mx > 434 AND mx < 503 AND my > 173 AND my < 227 THEN SelectNumber "4", 434, 173, selectmenu&: EXIT DO END IF '== 5 IF mx > 509 AND mx < 578 AND my > 173 AND my < 227 THEN SelectNumber "5", 509, 173, selectmenu&: EXIT DO END IF '== 6 IF mx > 584 AND mx < 652 AND my > 173 AND my < 227 THEN SelectNumber "6", 584, 173, selectmenu&: EXIT DO END IF '== 7 IF mx > 659 AND mx < 727 AND my > 173 AND my < 227 THEN SelectNumber "7", 659, 173, selectmenu&: EXIT DO END IF '== 8 IF mx > 734 AND mx < 803 AND my > 173 AND my < 227 THEN SelectNumber "8", 734, 173, selectmenu&: EXIT DO END IF '== 9 IF mx > 209 AND mx < 278 AND my > 235 AND my < 289 THEN SelectNumber "9", 209, 235, selectmenu&: EXIT DO END IF '== 10 IF mx > 284 AND mx < 353 AND my > 235 AND my < 289 THEN SelectNumber "10", 284, 235, selectmenu&: EXIT DO END IF '== 11 IF mx > 359 AND mx < 428 AND my > 235 AND my < 289 THEN SelectNumber "11", 359, 235, selectmenu&: EXIT DO END IF '== 12 IF mx > 434 AND mx < 503 AND my > 235 AND my < 289 THEN SelectNumber "12", 434, 235, selectmenu&: EXIT DO END IF '== 13 IF mx > 509 AND mx < 578 AND my > 235 AND my < 289 THEN SelectNumber "13", 509, 235, selectmenu&: EXIT DO END IF '=== 14 IF mx > 584 AND mx < 653 AND my > 235 AND my < 289 THEN SelectNumber "14", 584, 235, selectmenu&: EXIT DO END IF '=== 15 IF mx > 659 AND mx < 728 AND my > 235 AND my < 289 THEN SelectNumber "15", 659, 235, selectmenu&: EXIT DO END IF '=== 16 IF mx > 734 AND mx < 803 AND my > 235 AND my < 289 THEN SelectNumber "16", 734, 235, selectmenu&: EXIT DO END IF '=== 17 IF mx > 209 AND mx < 278 AND my > 297 AND my < 351 THEN SelectNumber "17", 209, 297, selectmenu&: EXIT DO END IF '=== 18 IF mx > 284 AND mx < 353 AND my > 297 AND my < 351 THEN SelectNumber "18", 284, 297, selectmenu&: EXIT DO END IF '=== 19 IF mx > 359 AND mx < 428 AND my > 297 AND my < 351 THEN SelectNumber "19", 359, 297, selectmenu&: EXIT DO END IF '=== 20 IF mx > 434 AND mx < 503 AND my > 297 AND my < 351 THEN SelectNumber "20", 434, 297, selectmenu&: EXIT DO END IF '=== 21 IF mx > 509 AND mx < 578 AND my > 297 AND my < 351 THEN SelectNumber "21", 509, 297, selectmenu&: EXIT DO END IF '=== 22 IF mx > 584 AND mx < 653 AND my > 297 AND my < 351 THEN SelectNumber "22", 584, 297, selectmenu&: EXIT DO END IF '=== 23 IF mx > 659 AND mx < 728 AND my > 297 AND my < 351 THEN SelectNumber "23", 659, 297, selectmenu&: EXIT DO END IF '=== 24 IF mx > 734 AND mx < 803 AND my > 297 AND my < 351 THEN SelectNumber "24", 734, 297, selectmenu&: EXIT DO END IF '=== 25 IF mx > 209 AND mx < 278 AND my > 359 AND my < 413 THEN SelectNumber "25", 209, 359, selectmenu&: EXIT DO END IF '=== 26 IF mx > 284 AND mx < 353 AND my > 359 AND my < 413 THEN SelectNumber "26", 284, 359, selectmenu&: EXIT DO END IF '=== 27 IF mx > 359 AND mx < 428 AND my > 359 AND my < 413 THEN SelectNumber "27", 359, 359, selectmenu&: EXIT DO END IF '=== 28 IF mx > 434 AND mx < 503 AND my > 359 AND my < 413 THEN SelectNumber "28", 434, 359, selectmenu&: EXIT DO END IF '=== 29 IF mx > 509 AND mx < 578 AND my > 359 AND my < 413 THEN SelectNumber "29", 509, 359, selectmenu&: EXIT DO END IF '=== 30 IF mx > 584 AND mx < 653 AND my > 359 AND my < 413 THEN SelectNumber "30", 584, 359, selectmenu&: EXIT DO END IF '=== 31 IF mx > 659 AND mx < 728 AND my > 359 AND my < 413 THEN SelectNumber "31", 659, 359, selectmenu&: EXIT DO END IF '=== 32 IF mx > 734 AND mx < 803 AND my > 359 AND my < 413 THEN SelectNumber "32", 734, 359, selectmenu&: EXIT DO END IF '=== 33 IF mx > 209 AND mx < 278 AND my > 421 AND my < 475 THEN SelectNumber "33", 209, 421, selectmenu&: EXIT DO END IF '=== 34 IF mx > 284 AND mx < 353 AND my > 421 AND my < 475 THEN SelectNumber "34", 284, 421, selectmenu&: EXIT DO END IF '=== 35 IF mx > 359 AND mx < 428 AND my > 421 AND my < 475 THEN SelectNumber "35", 359, 421, selectmenu&: EXIT DO END IF '=== 36 IF mx > 434 AND mx < 503 AND my > 421 AND my < 475 THEN SelectNumber "36", 434, 421, selectmenu&: EXIT DO END IF '=== 37 IF mx > 509 AND mx < 578 AND my > 421 AND my < 475 THEN SelectNumber "37", 509, 421, selectmenu&: EXIT DO END IF '=== 38 IF mx > 584 AND mx < 653 AND my > 421 AND my < 475 THEN SelectNumber "38", 584, 421, selectmenu&: EXIT DO END IF '=== 39 IF mx > 659 AND mx < 728 AND my > 421 AND my < 475 THEN SelectNumber "39", 659, 421, selectmenu&: EXIT DO END IF '=== 40 IF mx > 734 AND mx < 803 AND my > 421 AND my < 475 THEN SelectNumber "40", 734, 421, selectmenu&: EXIT DO END IF '=== 41 IF mx > 209 AND mx < 278 AND my > 483 AND my < 537 THEN SelectNumber "41", 209, 483, selectmenu&: EXIT DO END IF '=== 42 IF mx > 284 AND mx < 353 AND my > 483 AND my < 537 THEN SelectNumber "42", 284, 483, selectmenu&: EXIT DO END IF '=== 43 IF mx > 359 AND mx < 428 AND my > 483 AND my < 537 THEN SelectNumber "43", 359, 483, selectmenu&: EXIT DO END IF '=== 44 IF mx > 434 AND mx < 503 AND my > 483 AND my < 537 THEN SelectNumber "44", 434, 483, selectmenu&: EXIT DO END IF '=== 45 IF mx > 509 AND mx < 578 AND my > 483 AND my < 537 THEN SelectNumber "45", 509, 483, selectmenu&: EXIT DO END IF '=== 46 IF mx > 584 AND mx < 653 AND my > 483 AND my < 537 THEN SelectNumber "46", 584, 483, selectmenu&: EXIT DO END IF '=== 47 IF mx > 659 AND mx < 728 AND my > 483 AND my < 537 THEN SelectNumber "47", 659, 483, selectmenu&: EXIT DO END IF '=== 48 IF mx > 734 AND mx < 803 AND my > 483 AND my < 537 THEN SelectNumber "48", 734, 483, selectmenu&: EXIT DO END IF '=== 49 IF mx > 209 AND mx < 278 AND my > 545 AND my < 599 THEN SelectNumber "49", 209, 545, selectmenu&: EXIT DO END IF '=== 50 IF mx > 284 AND mx < 353 AND my > 545 AND my < 599 THEN SelectNumber "50", 284, 545, selectmenu&: EXIT DO END IF END IF LOOP '=== Play select menu again, flying out. '======================== FOR t = 0 TO 15 _PUTIMAGE (0, 0), selectframe(t) _DISPLAY _LIMIT 40 NEXT '======================= _FREEIMAGE selectmenu& _FREEIMAGE solvedimg& END SUB SUB SelectNumber (number$, x, y, image&) IF sfxflag = 1 THEN _SNDPLAYFILE source$ + "sfx\sfx_click.mp3" btn& = _LOADIMAGE(source$ + "num\" + number$ + ".jpg", 32) _PUTIMAGE (x, y), btn&, 0: _FREEIMAGE btn& _DELAY .15: _PUTIMAGE (0, 0), image&, 0: _DELAY .15 quote = VAL(number$)END SUB '================================================================================================================ SUB GetQuote (quote) '=== Gets new quote to solve based on quote value, '=== Sets the Row data... SELECT CASE quote '' QUOTES MUST NOT BE LONGER THAN 23 LETTERS ON ONE ROW '' AND ALL ROWS SHOULD BE SAME LENGTH (PAD WITH SPACES) CASE 1 OrigRow1$ = "GREAT MINDS ": row1$ = OrigRow1$ OrigRow2$ = "THINK ALIKE ": row2$ = OrigRow2$ OrigRow3$ = " ": row3$ = OrigRow3$ CASE 2 OrigRow1$ = "TO ERR IS HUMAN ": row1$ = OrigRow1$ OrigRow2$ = "TO FORGIVE DEVINE": row2$ = OrigRow2$ OrigRow3$ = " ": row3$ = OrigRow3$ CASE 3 OrigRow1$ = "IT AINT OVER TILL ": row1$ = OrigRow1$ OrigRow2$ = "THE FAT LADY SINGS ": row2$ = OrigRow2$ OrigRow3$ = " ": row3$ = OrigRow3$ CASE 4 OrigRow1$ = "A ROLLING STONE ": row1$ = OrigRow1$ OrigRow2$ = "GATHERS NO MOSS ": row2$ = OrigRow2$ OrigRow3$ = " ": row3$ = OrigRow3$ CASE 5 OrigRow1$ = "LAUGHTER IS THE ": row1$ = OrigRow1$ OrigRow2$ = "BEST MEDICINE ": row2$ = OrigRow2$ OrigRow3$ = " ": row3$ = OrigRow3$ CASE 6 OrigRow1$ = "ABSENCE MAKES THE ": row1$ = OrigRow1$ OrigRow2$ = "HEART GROW FONDER ": row2$ = OrigRow2$ OrigRow3$ = " ": row3$ = OrigRow3$ CASE 7 OrigRow1$ = "YOU CANT HAVE YOUR ": row1$ = OrigRow1$ OrigRow2$ = "CAKE AND EAT IT TOO": row2$ = OrigRow2$ OrigRow3$ = " ": row3$ = OrigRow3$ CASE 8 OrigRow1$ = "IF AT FIRST YOU DONT ": row1$ = OrigRow1$ OrigRow2$ = "SUCCEED TRY TRY AGAIN": row2$ = OrigRow2$ OrigRow3$ = " ": row3$ = OrigRow3$ CASE 9 OrigRow1$ = "NECESSITY IS ": row1$ = OrigRow1$ OrigRow2$ = "THE MOTHER OF ": row2$ = OrigRow2$ OrigRow3$ = "INVENTION ": row3$ = OrigRow3$ CASE 10 OrigRow1$ = "CLEANLINESS ": row1$ = OrigRow1$ OrigRow2$ = "IS NEXT TO ": row2$ = OrigRow2$ OrigRow3$ = "GODLINESS": row3$ = OrigRow3$ CASE 11 OrigRow1$ = "THE BIGGER THEY ": row1$ = OrigRow1$ OrigRow2$ = "ARE THE HARDER ": row2$ = OrigRow2$ OrigRow3$ = "THEY FALL ": row3$ = OrigRow3$ CASE 12 OrigRow1$ = "ACTIONS SPEAK ": row1$ = OrigRow1$ OrigRow2$ = "LOUDER THAN ": row2$ = OrigRow2$ OrigRow3$ = "WORDS ": row3$ = OrigRow3$ CASE 13 OrigRow1$ = "A CHAIN IS ONLY ": row1$ = OrigRow1$ OrigRow2$ = "AS STRONG AS ITS ": row2$ = OrigRow2$ OrigRow3$ = "WEAKEST LINK ": row3$ = OrigRow3$ CASE 14 OrigRow1$ = "BIRDS OF A ": row1$ = OrigRow1$ OrigRow2$ = "FEATHER FLOCK ": row2$ = OrigRow2$ OrigRow3$ = "TOGETHER ": row3$ = OrigRow3$ CASE 15 OrigRow1$ = "WHEN THE CATS ": row1$ = OrigRow1$ OrigRow2$ = "AWAY THE MICE ": row2$ = OrigRow2$ OrigRow3$ = "WILL PLAY ": row3$ = OrigRow3$ CASE 16 OrigRow1$ = "A FOOL AND HIS ": row1$ = OrigRow1$ OrigRow2$ = "MONEY ARE SOON ": row2$ = OrigRow2$ OrigRow3$ = "PARTED ": row3$ = OrigRow3$ CASE 17 OrigRow1$ = "NONE SO BLIND ": row1$ = OrigRow1$ OrigRow2$ = "AS THOSE WHO ": row2$ = OrigRow2$ OrigRow3$ = "WILL NOT SEE ": row3$ = OrigRow3$ CASE 18 OrigRow1$ = "YOU CANT JUDGE ": row1$ = OrigRow1$ OrigRow2$ = "A BOOK BY ITS ": row2$ = OrigRow2$ OrigRow3$ = "COVER ": row3$ = OrigRow3$ CASE 19 OrigRow1$ = "DONT PUT ALL ": row1$ = OrigRow1$ OrigRow2$ = "YOUR EGGS IN ": row2$ = OrigRow2$ OrigRow3$ = "ONE BASKET ": row3$ = OrigRow3$ CASE 20 OrigRow1$ = "FOOLS RUSH IN ": row1$ = OrigRow1$ OrigRow2$ = "WHERE ANGELS ": row2$ = OrigRow2$ OrigRow3$ = "FEAR TO TREAD ": row3$ = OrigRow3$ CASE 21 OrigRow1$ = "ALL WORK AND NO ": row1$ = OrigRow1$ OrigRow2$ = "PLAY MAKES JACK ": row2$ = OrigRow2$ OrigRow3$ = "A DULL BOY ": row3$ = OrigRow3$ CASE 22 OrigRow1$ = "OLD SOLDIERS NEVER ": row1$ = OrigRow1$ OrigRow2$ = "DIE THEY SIMPLY ": row2$ = OrigRow2$ OrigRow3$ = "FADE AWAY ": row3$ = OrigRow3$ CASE 23 OrigRow1$ = "DONT COUNT YOUR ": row1$ = OrigRow1$ OrigRow2$ = "CHICKENS BEFORE ": row2$ = OrigRow2$ OrigRow3$ = "THEY ARE HATCHED": row3$ = OrigRow3$ CASE 24 OrigRow1$ = "LIGHTNING NEVER ": row1$ = OrigRow1$ OrigRow2$ = "STRIKES TWICE IN ": row2$ = OrigRow2$ OrigRow3$ = "THE SAME PLACE ": row3$ = OrigRow3$ CASE 25 OrigRow1$ = "AN OUNCE OF PREVENTION": row1$ = OrigRow1$ OrigRow2$ = "IS WORTH A POUND OF": row2$ = OrigRow2$ OrigRow3$ = " CURE ": row3$ = OrigRow3$ CASE 26 OrigRow1$ = "DONT CROSS YOUR ": row1$ = OrigRow1$ OrigRow2$ = "BRIDGES BEFORE ": row2$ = OrigRow2$ OrigRow3$ = "YOU COME TO THEM": row3$ = OrigRow3$ CASE 27 OrigRow1$ = "IT WAS THE LAST ": row1$ = OrigRow1$ OrigRow2$ = "STRAW THAT BROKE ": row2$ = OrigRow2$ OrigRow3$ = "THE CAMELS BACk": row3$ = OrigRow3$ CASE 28 OrigRow1$ = "YOU CAN CATCH MORE ": row1$ = OrigRow1$ OrigRow2$ = "FLIES WITH HONEY ": row2$ = OrigRow2$ OrigRow3$ = "THAN WITH VINEGAR ": row3$ = OrigRow3$ CASE 29 OrigRow1$ = "NEVER PUT OFF UNTIL": row1$ = OrigRow1$ OrigRow2$ = "TOMORROW WHAT YOU ": row2$ = OrigRow2$ OrigRow3$ = "CAN DO TODAY ": row3$ = OrigRow3$ CASE 30 OrigRow1$ = "IF YOU LIE DOWN ": row1$ = OrigRow1$ OrigRow2$ = "WITH DOGS YOU WILL": row2$ = OrigRow2$ OrigRow3$ = "GET UP WITH FLEAS ": row3$ = OrigRow3$ CASE 31 OrigRow1$ = "THOSE WHO LIVE IN ": row1$ = OrigRow1$ OrigRow2$ = "GLASS HOUSES SHOULD": row2$ = OrigRow2$ OrigRow3$ = "NOT THROW STONES ": row3$ = OrigRow3$ CASE 32 OrigRow1$ = " NECESSITY IS A HARD": row1$ = OrigRow1$ OrigRow2$ = "NURSE BUT SHE RAISES": row2$ = OrigRow2$ OrigRow3$ = "STRONG CHILDREN ": row3$ = OrigRow3$ CASE 33 OrigRow1$ = "IT IS BETTER TO BE ": row1$ = OrigRow1$ OrigRow2$ = "GREEN AND GROWING ": row2$ = OrigRow2$ OrigRow3$ = "THAN RIPE AND ROTTEN": row3$ = OrigRow3$ CASE 34 OrigRow1$ = "HE WHO FIGHTS AND ": row1$ = OrigRow1$ OrigRow2$ = "RUNS AWAY MAY LIVE ": row2$ = OrigRow2$ OrigRow3$ = "TO FIGHT ANOTHER DAY": row3$ = OrigRow3$ CASE 35 OrigRow1$ = "YOU CAN LEAD A HORSE": row1$ = OrigRow1$ OrigRow2$ = "TO WATER BUT YOU ": row2$ = OrigRow2$ OrigRow3$ = "CANT MAKE HIM DRINK ": row3$ = OrigRow3$ CASE 36 OrigRow1$ = "THE GRASS IS ALWAYS": row1$ = OrigRow1$ OrigRow2$ = "GREENER ON THE OTHER": row2$ = OrigRow2$ OrigRow3$ = "SIDE OF THE FENCE ": row3$ = OrigRow3$ CASE 37 OrigRow1$ = "THOSE WHO DO NOT ": row1$ = OrigRow1$ OrigRow2$ = "LEARN FROM HISTORY ARE": row2$ = OrigRow2$ OrigRow3$ = "DOOMED TO REPEAT IT ": row3$ = OrigRow3$ CASE 38 OrigRow1$ = "BETTER TO HAVE LOVED ": row1$ = OrigRow1$ OrigRow2$ = "AND LOST THAN NEVER ": row2$ = OrigRow2$ OrigRow3$ = "TO HAVE LOVED AT ALL ": row3$ = OrigRow3$ CASE 39 OrigRow1$ = "LAUGH AND THE WORLD ": row1$ = OrigRow1$ OrigRow2$ = " LAUGHS WITH YOU WEEP ": row2$ = OrigRow2$ OrigRow3$ = " AND YOU WEEP ALONE ": row3$ = OrigRow3$ CASE 40 OrigRow1$ = "OH WHAT A TANGLED WEB ": row1$ = OrigRow1$ OrigRow2$ = "WE WEAVE WHEN FIRST WE ": row2$ = OrigRow2$ OrigRow3$ = "PRACTICE TO DECEIVE ": row3$ = OrigRow3$ CASE 41 OrigRow1$ = "IF YOU DONT KNOW WHERE ": row1$ = OrigRow1$ OrigRow2$ = "YOURE GOING THEN THE ": row2$ = OrigRow2$ OrigRow3$ = "JOURNEYS NEVER ENDING ": row3$ = OrigRow3$ CASE 42 OrigRow1$ = "ANSWER TO THE ULTIMATE ": row1$ = OrigRow1$ OrigRow2$ = "QUESTION OF LIFE THE ": row2$ = OrigRow2$ OrigRow3$ = "UNIVERSE AND EVERYTHING": row3$ = OrigRow3$ CASE 43 OrigRow1$ = "FOOL ME ONCE SHAME ON ": row1$ = OrigRow1$ OrigRow2$ = "YOU FOOL ME TWICE ": row2$ = OrigRow2$ OrigRow3$ = " SHAME ON ME ": row3$ = OrigRow3$ CASE 44 OrigRow1$ = "A BROKEN FRIENDSHIP ": row1$ = OrigRow1$ OrigRow2$ = "MAY BE SOLDERED BUT ": row2$ = OrigRow2$ OrigRow3$ = "WILL NEVER BE SOUND ": row3$ = OrigRow3$ CASE 45 OrigRow1$ = "IF YOU CANNOT HAVE THE": row1$ = OrigRow1$ OrigRow2$ = "BEST THEN MAKE THE ": row2$ = OrigRow2$ OrigRow3$ = "BEST OF WHAT YOU HAVE ": row3$ = OrigRow3$ CASE 46 OrigRow1$ = "HE WHO SAYS WHAT HE ": row1$ = OrigRow1$ OrigRow2$ = "LIKES SHALL HEAR WHAT": row2$ = OrigRow2$ OrigRow3$ = " HE DOESNT LIKE ": row3$ = OrigRow3$ CASE 47 OrigRow1$ = "HE THAT HAS A GREAT ": row1$ = OrigRow1$ OrigRow2$ = "NOSE THINKS EVERYBODY": row2$ = OrigRow2$ OrigRow3$ = "IS SPEAKING OF IT ": row3$ = OrigRow3$ CASE 48 OrigRow1$ = "HE THAT WOULD HAVE ": row1$ = OrigRow1$ OrigRow2$ = "EGGS MUST ENDURE THE ": row2$ = OrigRow2$ OrigRow3$ = "CRACKLING OF THE HENS": row3$ = OrigRow3$ CASE 49 OrigRow1$ = "A FRIEND IS SOMEONE": row1$ = OrigRow1$ OrigRow2$ = "KNOWS ALL ABOUT YOU ": row2$ = OrigRow2$ OrigRow3$ = " AND STILL LOVES YOU": row3$ = OrigRow3$ CASE 50 OrigRow1$ = "A MAN OF WORDS AND ": row1$ = OrigRow1$ OrigRow2$ = "NOT DEEDS IS LIKE A ": row2$ = OrigRow2$ OrigRow3$ = "GARDEN FULL OF WEEDS": row3$ = OrigRow3$ 'failsafe... CASE ELSE OrigRow1$ = "TO ERR IS HUMAN ": row1$ = OrigRow1$ OrigRow2$ = "TO FORGIVE DEVINE": row2$ = OrigRow2$ OrigRow3$ = " ": row3$ = OrigRow3$ END SELECT remix: 'maybe make tag to set if 1&2 were not swapped, swap 1&3, if no space.? '=== Randomly Mix up the letters in rows FOR t = 1 TO LEN(row1$) '=== mix up row 1 with 2 r1$ = MID$(row1$, t, 1) r2$ = MID$(row2$, t, 1) '=== Only swap 1 & 2 when no space present IF r1$ <> " " AND r2$ <> " " THEN IF INT(RND * 2) = 1 THEN MID$(row1$, t, 1) = r2$ MID$(row2$, t, 1) = r1$ END IF END IF '=== mix up row 2 with 3 r2$ = MID$(row2$, t, 1) r3$ = MID$(row3$, t, 1) '=== Only swap 2 &3 when no space present IF r2$ <> " " AND r3$ <> " " THEN IF INT(RND * 2) = 1 THEN MID$(row2$, t, 1) = r3$ MID$(row3$, t, 1) = r2$ END IF END IF NEXT '=== just in case no mixing occurred (happens once in a blue moon).. IF OrigRow1$ = row1$ AND OrigRow2$ = row2$ THEN GOTO remix END SUB '=================================================================================================='=================================================================================================== '======================================================================================' ScrollScreenDown'====================================================================================== SUB ScrollScreenDown (image&, speed!) '=== This SUB Scrolls Down a previously opened image. '=== image& = previously opened image handle to use. '=== THE IMAGE MUST BE PREVIOUSLY OPENED OR AN ERROR WILL OCCUR! '=== speed& = Value for the _LIMIT. FOR y = -767 TO 0 STEP 25 _PUTIMAGE (0, y), image&, 0 _DISPLAY _LIMIT speed! NEXT _PUTIMAGE , image&, 0 'make sure it's centered _DISPLAY _AUTODISPLAY END SUB '======================================================================================' ScrollScreenUp'====================================================================================== SUB ScrollScreenUp (image&, speed!) '=== This SUB Scrolls the screen UP out of sight. '=== image& = previously opened image handle to use. '=== THE IMAGE MUST BE PREVIOUSLY OPENED OR AN ERROR WILL OCCUR! '=== speed! = Value for the _LIMIT. '=== NOTE: If image& value is 0, then scrolls up the current screen. usecurrent = 0 IF image& = 0 OR image& > -1 THEN 'image& = _SCREENIMAGE image& = _COPYIMAGE(_DISPLAY) usecurrent = 1 END IF rev = 767 FOR y = 0 TO -767 STEP -25 _PUTIMAGE (0, y), image&, 0: _DISPLAY LINE (0, rev - 25)-(1023, rev), _RGB32(0, 0, 0), BF rev = rev - 25 _LIMIT speed! NEXT IF usecurrent = 1 THEN _FREEIMAGE image& _AUTODISPLAY END SUB '======================================================================================' StoneRoll'====================================================================================== SUB StoneRoll (way$, image&, speed!) '=== The SUB rolls a stone column sequence left or right. '=== An optional image& can be given to drag along from behind. '=== way$: "LEFT" = Roll left. "RIGHT" = Roll right. '=== image& = Optional Previously opened imagehandle to drag in. '=== speed! = Value for the _LIMIT. (I think in fps) '=== Load the stone column image sequence below.... REDIM rollframe(0 TO 5) AS LONG FOR t = 0 TO 5: a$ = LTRIM$(STR$(t)) IF LEN(a$) = 2 THEN a$ = "00" + a$ IF LEN(a$) = 1 THEN a$ = "000" + a$ rollframe(t) = _LOADIMAGE(source$ + "vid\roll" + a$ + ".jpg") NEXT IF sfxflag = 1 THEN roll& = _SNDOPEN(source$ + "sfx\sfx_roll.ogg", "VOL,SYNC,LEN,PAUSE") _SNDPLAY roll& END IF '=== choose what to do... SELECT CASE UCASE$(way$) CASE "RIGHT" x = -135 DO FOR t = 0 TO 5 STEP 1 a$ = LTRIM$(STR$(t)) IF LEN(a$) = 2 THEN a$ = "00" + a$ IF LEN(a$) = 1 THEN a$ = "000" + a$ _PUTIMAGE (x, 0), rollframe(t), 0 _DISPLAY IF image& <> 0 THEN IF x > 1024 THEN _PUTIMAGE (0, RND * 2), image&, 0 ELSE _PUTIMAGE (x - 1024, RND * 2), image&, 0 END IF _DISPLAY ELSE LINE (x - 20, 0)-(x, 768), _RGB32(0, 0, 0), BF END IF x = x + 20 _LIMIT speed! '_AUTODISPLAY NEXT LOOP UNTIL x > 1024 + 135 CASE "LEFT" x = 1024 DO FOR t = 5 TO 0 STEP -1 a$ = LTRIM$(STR$(t)) IF LEN(a$) = 2 THEN a$ = "00" + a$ IF LEN(a$) = 1 THEN a$ = "000" + a$ _PUTIMAGE (x, 0), rollframe(t), 0 _DISPLAY IF image& <> 0 THEN IF x > -135 THEN _PUTIMAGE (x + 135, RND * 2), image&, 0 ELSE _PUTIMAGE (0, RND * 2), image&, 0 END IF _DISPLAY ELSE LINE (x + 135, 0)-(1023, 767), _RGB32(0, 0, 0), BF END IF x = x - 20 _LIMIT speed! '_AUTODISPLAY NEXT LOOP UNTIL x < -135 END SELECT '== center screen if image given IF image& <> 0 THEN _PUTIMAGE , image&, 0 _DISPLAY END IF IF sfxflag = 1 THEN _SNDSTOP roll& _SNDCLOSE roll& END IF '=== free up used image handles FOR t = 0 TO 5 _FREEIMAGE rollframe(t) NEXT _AUTODISPLAY END SUB '================================================================================== SUB ScreenCurtain (way$, left&, right&, speed!) '=== This opened and closes the screen like a curtain. '=== It uses two previously opened images which are just '=== the screen split into a left & right side. '=== way$: "OPEN" = open curtain, "CLOSE" = Close it '=== speed! = Value for the _LIMIT SELECT CASE UCASE$(way$) CASE "CLOSE" IF sfxflag = 1 THEN roll& = _SNDOPEN(source$ + "sfx\sfx_roll.ogg", "VOL,SYNC,LEN,PAUSE") _SNDPLAY roll& END IF x2 = 1024 FOR x = -511 TO 0 STEP 4 'The y is randoming shaked up 'for a dragging effect _PUTIMAGE (x, RND * 2), left&, 0: _PUTIMAGE (x2, RND * 2), right&, 0: x2 = x2 - 4 _LIMIT speed! NEXT '=== make sure image is centered _PUTIMAGE (0, 0), left&, 0: _PUTIMAGE (513, 0), right&, 0: _DISPLAY _AUTODISPLAY IF sfxflag = 1 THEN _SNDSTOP roll&: _SNDCLOSE roll& _SNDPLAYFILE source$ + "sfx\sfx_boom.mp3" END IF '=== A little shake to show joining ScreenShake 0, 4, 3, 60 CASE "OPEN" x2 = 513 FOR x = 0 TO -512 STEP -5 CLS _PUTIMAGE (x, RND * 2), left&, 0: _PUTIMAGE (x2, RND * 2), right&, 0: _DISPLAY x2 = x2 + 5 _LIMIT speed! NEXT _AUTODISPLAY: CLS 'Clear the screen END SELECT END SUB '======================================================================================' ScreenShake'====================================================================================== SUB ScreenShake (image&, val1, val2, speed!) '=== This SUB shakes the current screen '=== image& = previously image handle to use. '=== val1 = first loop (x) '=== val2 = second loop (y) '=== speed! = Value for the _LIMIT '=== NOTE: Ifimage& = 0 then uses current screen. usecurrent = 0 IF image& = 0 OR image& > -1 THEN image& = _COPYIMAGE(_DISPLAY) usecurrent = 1 END IF FOR g = val1 TO 1 STEP -1 FOR S = 1 TO val2 _PUTIMAGE (RND * (S * g), RND * (S * g))-(1023, 767), image&, 0 _DISPLAY _LIMIT speed! _AUTODISPLAY NEXT NEXT '=== center screen after shaking _PUTIMAGE , image&, 0 _DISPLAY IF usecurrent = 1 THEN _FREEIMAGE image& _AUTODISPLAY END SUB '======================================================================================'====================================================================================== SUB Credits () left& = _LOADIMAGE(source$ + "img\paper-title-left.jpg") right& = _LOADIMAGE(source$ + "img\paper-title-right.jpg") IF _SNDPLAYING(music&) THEN _SNDSTOP music& IF sfxflag = 1 THEN _SNDPLAYFILE source$ + "sfx\sfx_roll.ogg" ScreenCurtain "CLOSE", left&, right&, 60 _FREEIMAGE left& _FREEIMAGE right& _DELAY .15 '=== load crumble frame numbers... DIM framenum(0 TO 14) AS LONG FOR t = 0 TO 14 a$ = LTRIM$(STR$(t)) IF LEN(a$) = 2 THEN a$ = "00" + a$ IF LEN(a$) = 1 THEN a$ = "000" + a$ framenum(t) = _LOADIMAGE(source$ + "vid\crum" + a$ + ".jpg") NEXT '=== start crumble sound IF sfxflag = 1 THEN _SNDPLAYFILE source$ + "sfx\sfx_crumble.ogg" '=== BIG Shake FOR b = 1 TO 2 ScreenShake 0, 6, 5, 60 NEXT 'CRUMLE!!!! FOR t = 0 TO 14 _PUTIMAGE (0, 0), framenum(t) _LIMIT 15 'IF INKEY$ <> "" THEN EXIT DO NEXT CLS 'WASH OUT!!!! FOR t = 0 TO 255 STEP 6 LINE (0, 0)-(1023, 767), _RGB32(t, t, t), BF _LIMIT 50 NEXT FOR t = 255 TO 0 STEP -4 LINE (0, 0)-(1023, 767), _RGB32(t, t, t), BF _LIMIT 50 NEXT CLS IF sfxflag = 1 THEN _SNDPLAYFILE source$ + "sfx\sfx_fanfare.ogg" _DELAY 2 'free all image handles... FOR t = 0 TO 14 _FREEIMAGE framenum(t) NEXT creditmusic& = _SNDOPEN(source$ + "sfx\credits.ogg") IF musicflag = 1 THEN _SNDLOOP creditmusic& pic& = _LOADIMAGE(source$ + "\img\win.jpg") y = -768 DO CLS _PUTIMAGE (0, 0), pic&, 0, (0, y)-(1024, y + 768) y = y + 1: IF y > 5672 THEN EXIT DO 'or y = 0 to start over IF INKEY$ <> "" THEN EXIT DO x1 = RND * 1024: y1 = RND * 768 LINE (x1, y1)-(x1 + 12, y1 + 1), _RGB32(115, 115, 115), BF 'across LINE (x1 + 6, y1 - 6)-(x1 + 7, y1 + 6), _RGB32(115, 115, 115), BF 'down FOR p = 1 TO 1000 PSET (RND * 1024, RND * 768), _RGB32(115, 115, 115) NEXT _LIMIT 50 _DISPLAY LOOP _FREEIMAGE pic& IF _SNDPLAYING(creditmusic&) THEN _SNDSTOP creditmusic& _SNDCLOSE creditmusic& END SUB '======================================================================================'====================================================================================== SUB ButtonShow (ButtonFile$, x, y) btn& = _LOADIMAGE(source$ + "img\" + ButtonFile$, 32) _PUTIMAGE (x, y), btn&, 0 '_DISPLAY: _AUTODISPLAY _FREEIMAGE btn&END SUB '======================================================================================'====================================================================================== SUB ButtonClick (ButtonType%, ButtonFile$, x, y) '=== ButtonType% is if a hover highlighted button on not. IF sfxflag = 1 THEN _SNDPLAYFILE source$ + "sfx\sfx_click.mp3" IF ButtonType% = 0 THEN ButtonShow "_" + ButtonFile$, x, y: _DELAY .15 ButtonShow ButtonFile$, x, y: _DELAY .15 ELSE ButtonShow ButtonFile$, x, y: _DELAY .15 ButtonShow "_" + ButtonFile$, x, y: _DELAY .15 ButtonShow ButtonFile$, x, y END IF END SUB

Navigation

[0] Message Index

Go to full version