'So I can quickly add debug text if needed. It's not ON by default.
'$INCLUDE:'Keyboard Library.BI'
'$INCLUDE:'Virtual Keyboard.BI'
'$INCLUDE:'SaveImage.BI'
Repeat_Speed = 0.2 'Global variable in the Virtual Keyboard library which a user can change for repeat speed
'Remove the titlebar if on windows just to keep it prettier
Sub uprint_extra
(ByVal x&
, Byval y&
, Byval chars%&
, Byval length%&
, Byval kern&
, Byval do_render&
, txt_width&
, Byval charpos%&
, charcount&
, Byval colour~&
, Byval max_width&
) QPrintTextType = "ASCII"
TitleScreen
MainMenu
'$INCLUDE:'Virtual Keyboard.BM'
'$INCLUDE:'Keyboard Library.BM'
'$INCLUDE:'SaveImage.BM'
GetLists "Coloring Sheets", Dir(), File()
Image
(i
) = _LoadImage("Coloring Sheets\" + File
(i
), 32) 'Image(i) = _LoadImage(File(i), 32)
choice = 1: Oldmouse = -1
CenterText 25, "Welcome, " + User, f128
_PutImage (300, 175)-(980, 560), Image
(choice
) _PutImage (1230, 300)-(1030, 400), CandyArrow
CenterText 575, "What to color?", f128
scroll = 0
If scroll
= 1 Then k
= 19200 'scroll left in choices If scroll
= -1 Then k
= 20480 'scroll right in choices k = 13 'count it as an enter press unless it's in the arrows
If MY
>= 300 And MY
<= 400 Then 'in the right y area for arrow interaction If MX
>= 50 And MX
<= 250 Then k
= 19200 'in the left arrow box If MX
>= 1030 And MX
<= 1230 Then k
= 20480 'in the right arrow box Case 19200, 18432 'left/up choice = choice - 1
If choice
< 1 Then choice
= ImageLimit
Case 20480, 19712 'right/down choice = choice + 1
If choice
> ImageLimit
Then choice
= 1 MainMenu
Case 32, 13 'SELECT AN IMAGE Oldmouse = MB
kolor(0, 0) = Black: kolor(1, 0) = DarkBlue: kolor(2, 0) = DarkGreen: kolor(3, 0) = DarkCyan
kolor(0, 1) = DarkRed: kolor(1, 1) = DarkMagenta: kolor(2, 1) = GoldenRod: kolor(3, 1) = LightGray
kolor(0, 2) = DimGray: kolor(1, 2) = Blue: kolor(2, 2) = Lime: kolor(3, 2) = Cyan
kolor(0, 3) = Red: kolor(1, 3) = Magenta: kolor(2, 3) = Yellow: kolor(3, 3) = White
kolor(0, 4) = Gold: kolor(1, 4) = Purple: kolor(2, 4) = Pink: kolor(3, 4) = Copper
kolor(0, 5) = Orange: kolor(1, 5) = Maroon: kolor(2, 5) = Salmon: kolor(3, 5) = Tann
'At this point, we should now have our image chosen for coloring.
'Let's draw a simple color interface and place the image on the screen and start playing with it!
R = 128: G = 128: B = 128
Oldmouse = -1
CheckMusic
Line (1001, 0)-(1279, 719), DarkGray
, BF
Line (1010, 25)-Step(257, 25), LightGray
, BF
Line (1010, 60)-Step(257, 25), LightGray
, BF
Line (1010, 95)-Step(257, 25), LightGray
, BF
Line (1020 + 60 * x
, 220 + 60 * y
)-Step(50, 50), kolor
(x
, y
), BF
Line (1010, 590)-Step(120, 50), Green
, BF
Line (1150, 590)-Step(120, 50), Green
, BF
If MX
> 1010 And MX
< 1265 Then 'on a color tile? if MX
>= 1020 + 60 * x
and MX
<= 1070 + 60 * x
and _
MY
>= 220 + 60 * y
and MY
<= 270 + 60 * y
then SC& = SC& + 1
file$
= "Saved Images\Saved Picture" + Str$(SC&
) + ".png" result = SaveImage(file$, 0, 0, 0, 1000, 719)
Oldmouse = MB
beforeexit:
If User
= "" Then User
= "Grinch"
GameLimit = 1 ' Increase game limit and add new games as we go!
Games(1) = "Christmas Color It!"
GameImage
(1) = _LoadImage("The Season to Color.png", 33)
choice = 1: Oldmouse = -1: Oldmouse2 = -1
CenterText 25, "Welcome, " + User, f128
_PutImage (300, 175)-(980, 560), GameImage
(choice
) _PutImage (1230, 300)-(1030, 400), CandyArrow
CenterText 575, "Choose a game", f128
scroll = 0
If scroll
= 1 Then k
= 19200 'scroll left in choices If scroll
= -1 Then k
= 20480 'scroll right in choices k = 13 'count it as an enter press unless it's in the arrows
If MY
>= 300 And MY
<= 400 Then 'in the right y area for arrow interaction If MX
>= 50 And MX
<= 250 Then k
= 19200 'in the left arrow box If MX
>= 1030 And MX
<= 1230 Then k
= 20480 'in the right arrow box Case 19200, 18432 'left/up choice = choice - 1
If choice
< 1 Then choice
= GameLimit
Case 20480, 19712 'right/down choice = choice + 1
If choice
> GameLimit
Then choice
= 1 Case 32, 13 'SELECT A GAME Oldmouse = MB: Oldmouse2 = MB2
beforeexit:
'CREATE YOUR CUSTOM KEYBOARD LAYOUT HERE
My_Keyboard
(0) = CHR$(0) + "27,ESC" + STRING$(2,0) + "15104,F1" + STRING$(2,0) + "15360,F2" + _
My_Keyboard
(1) = "`1234567890-=" + Chr$(0) + "8,BKSP" + Chr$(0) My_Keyboard
(2) = Chr$(0) + "9,TAB" + Chr$(0) + "QWERTYUIOP[]\" My_Keyboard
(3) = Chr$(0) + "100301,caps" + Chr$(0) + "ASDFGHJKL;'" + Chr$(0) + "13,ENTER" + Chr$(0) My_Keyboard
(4) = Chr$(0) + "100304,SHIFT" + Chr$(0) + "ZXCVBNM,./" + Chr$(0) + "100303,SHIFT" + Chr$(0) My_Keyboard
(5) = CHR$(0) + "100306,CTRL" + STRING$(2,0) + "100311,WIN" + STRING$(2,0) + "100308,ALT" + _
font
= _LoadFont("Courbd.ttf", 20, "monospace") 'IF USED ON A KEYBOARD, DON'T FREE THIS FONT font2
= _LoadFont("Courbd.ttf", 64, "monospace") font3
= _LoadFont("Courbd.ttf", 32, "monospace")
Button_Style_Up = Register_Button(50, 50, 50, 150, 150, 150, 8, font, &HFFFFFF00, 0) 'create the styles for our keyboard buttons
Button_Style_Down = Register_Button(150, 150, 150, 110, 110, 110, 8, font, &HFFFFFF00, 0)
FullsizeKB1 = Create_KB(My_Keyboard(), 85, 65, Button_Style_Up, Button_Style_Down) 'and make the keyboard
'REDEFINE MY LOwERCASE KEYS FOR KEYBOARD 2
My_Keyboard
(1) = "~!@#$%^&*()_+" + Chr$(0) + "8,BKSP" + Chr$(0) My_Keyboard
(2) = Chr$(0) + "9,TAB" + Chr$(0) + "qwertyuiop{}|" My_Keyboard
(3) = Chr$(0) + "100301,CAPS" + Chr$(0) + "asdfghjkl:" + Chr$(34) + Chr$(0) + "13,ENTER" + Chr$(0) My_Keyboard
(4) = Chr$(0) + "100304,SHIFT" + Chr$(0) + "zxcvbnm<>?" + Chr$(0) + "100303,SHIFT" + Chr$(0) FullsizeKB2 = Create_KB(My_Keyboard(), 85, 65, Button_Style_Up, Button_Style_Down)
Keyboard_In_Use = FullsizeKB1 'Set the keyboard I'm currently using
'View Print 1 To 20
CheckMusic
Display_KB Keyboard_In_Use, 25, 280, -1 'display the virtual keyboard
QPrintString 25, 32, "NAME" 'show the user generated name
Line (200, 25)-Step(1000, 75), DarkGray
, BF
QPrintString 1200 - QPrintWidth(User), 32, User
k
= _KeyHit 'The library version which reads all the keys for us, not the qb64 _KEYHIT version '(ONLY FOR WINDOWS. LINUX/MAC USERS STILL GET THE SAME OLE BUGGY _KEYHIT FOR NOW. SORRY.)
If k
= 0 Or k
> 900000 Then k
= VK_Keyhit
(Keyboard_In_Use
) 'this checks the virtual keyboard 'If VK_Keydown(32) Then Print "Space held"; 'and here we can check for virtual keys being held down.
Case 100301 'swap keyboards, rather than having a CAPS LOCK key Keyboard_In_Use
= (Keyboard_In_Use
+ 1) Mod 2 _Delay .2 'we need a delay here, as we haven't actually pressed any key on the new keyboard 'so the keys aren't going to have a down timer to stop repeats.. We'd probably change keyboards
'multiple times quickly without it, before we lifted our finger up off the mouse button.
If User
= "" Then User
= "Grinch"
'Confirm entry
choice = -1
text = TextToImage(User + " is correct?", font3, Green, 0&, 1)
_PutImage (325, 150)-(955, 225), text
'make certain our user name always fits nicely in the center CheckMusic
Case 19200, 18432, 20480, 19712: choice
= Not choice
Line (980, 150)-Step(250, 75), DarkGray
, BF
Line (50, 150)-Step(250, 75), DarkGray
, BF
QPrintString 175 - QPrintWidth("YES") / 2, 150, "YES"
QPrintString 1105 - QPrintWidth("NO") / 2, 150, "NO"
User = ""
beforeexit:
If User
= "" Then User
= "Grinch" ChooseGame
restart:
GetLists "Backgrounds", Dir(), File()
count
= count
+ 1: fetch
= Int(Rnd * UBound(File
)) + 1: file$
= "Backgrounds\" + File
(fetch
)
choice = 1: OldMouse = -1: Oldmouse2 = -1
CheckMusic
If MX
>= 400 And MX
<= 880 Then 'mouse is in right row area If MY
>= 75 * i
+ 100 And MY
<= 75 * i
+ 175 Then choice
= i
Case 18432, 19200: choice
= choice
- 1:
If choice
< 1 Then choice
= 5 Case 20480, 19712: choice
= choice
+ 1:
If choice
> 5 Then choice
= 1 NewPlayer
ChooseGame
OldMouse = MB: Oldmouse2 = MB2
beforeexit:
Options(1) = "New Player": Options(2) = "Load Player": Options(3) = "New Game"
Options(4) = "Highscores": Options(5) = "Quit"
CenterText 75 * i + 100, Options(i), f64
CheckMusic
CenterText 250, "Xmas Match", f128
CenterText 375, "by SMcNeill", f64
GetLists "Music", Dir(), File()
If MusicLoaded
< MusicList
And ExtendedTimer
> Delay
Then 'load music files while the user is busy looking at graphics or making choices GetLists "Music", Dir(), File()
MusicLoaded = MusicLoaded + 1
MusicFiles
(MusicLoaded
) = _SndOpen("Music/" + File
(MusicLoaded
)) 'Load one file at a time in the background If MusicLoaded
= MusicList
Then For i
= 2 To MusicList
'shuffle the playlist each time the program starts for variety Swap MusicFiles
(i
), MusicFiles
(Rnd * i
+ 1) Delay = ExtendedTimer + 1 'At most, only load one file per second. Have a delay between loading.
MusicPlaying = MusicPlaying + 1
If MusicPlaying
> MusicList
Then MusicPlaying
= 1 'replay the list all over again, if someone let it go that long! _SndPlay MusicPlaying
'play the new music file
Sub CenterText
(y
, text$
, font
) f
= _Font:
_Font font: pw
= QPrintWidth
(text$
): w
= 1280: x
= (w
- pw
) / 2 QPrintString x
, y
, text$:
_Font f
Sub SafeLoadFont
(font#
) 'Safely loads a font without destroying our current print location and making it revert to the top left corner.
DirCount = 0: FileCount = 0
slash$ = "\"
slash$ = "/"
If Right$(SearchDirectory$
, 1) <> "/" And Right$(SearchDirectory$
, 1) <> "\" Then SearchDirectory$
= SearchDirectory$
+ slash$
length = has_next_entry
get_next_entry nam$, flags, file_size
DirCount = DirCount + 1
DirList(DirCount) = nam$
FileCount = FileCount + 1
FileList(FileCount) = nam$
Else 'This else should never actually trigger close_dir
BreakPoint = ",./- ;:!" 'I consider all these to be valid breakpoints. If you want something else, change them.
If QPrintTextType
= "ASCII" Or QPrintTextType
= "" Then text$
= _Trim$(AnsiTextToUtf8Text$
(temp$
)) Else text$
= temp$
count = -1
'first find the natural length of the line
p = uprintwidth(text$, i, 0)
'IF i < LEN(text$) THEN lineend = i - 1 ELSE
lineend = i
t$
= RTrim$(Left$(text$
, lineend
)) 'at most, our line can't be any longer than what fits the screen. x = 1
clean_exit:
QPrintWidth
= uprintwidth
(out$
, Len(out$
), 0)
QFontHeight = uheight
Sub QPrintString
(x
, y
, text$
) If QPrintTextType
= "ASCII" Or QPrintTextType
= "" Then temp$
= _Trim$(AnsiTextToUtf8Text$
(text$
)) Else temp$
= text$
Dim chi&
, ascii%
, unicode&
, aci%
'--- get ANSI char code, reset Unicode ---
If unicode&
= 0 Then unicode&
= 65533 'replacement character temp$ = temp$ + UnicodeToUtf8Char$(unicode&)
AnsiTextToUtf8Text$ = temp$
'--- option _explicit requirements ---
Dim uc&
, first%
, remain%
, conti%
'--- UTF-8 encoding ---
'--- standard ASCII (0-127) goes as is ---
UnicodeToUtf8Char$
= Chr$(unicode&
) '--- encode the Unicode into UTF-8 notation ---
temp$ = "": uc& = unicode& 'avoid argument side effect
first% = &B10000000: remain% = 63
first%
= &B10000000
Or (first% \
2): remain%
= (remain% \
2) conti%
= &B10000000
Or (uc&
And &B00111111
): uc&
= uc& \
64 temp$
= Chr$(conti%
) + temp$
first%
= (first%
Or uc&
): uc&
= 0 UnicodeToUtf8Char$
= Chr$(first%
) + temp$
'text$ is the text that we wish to transform into an image.
'font& is the handle of the font we want to use.
'fc& is the color of the font we want to use.
'bfc& is the background color of the font.
'Mode 1 is print forwards
'Mode 2 is print backwards
'Mode 3 is print from top to bottom
'Mode 4 is print from bottom up
'Mode 0 got lost somewhere, but it's OK. We check to see if our mode is < 1 or > 4 and compensate automatically if it is to make it one (default).
'print the text lengthwise
'print the text vertically
TextToImage = TextToImage_temp&
'Print text forward
'Print text backwards
temp$ = ""
temp$
= temp$
+ Mid$(text$
, Len(text$
) - i
, 1) 'Print text upwards
'first lets reverse the text, so it's easy to place
temp$ = ""
temp$
= temp$
+ Mid$(text$
, Len(text$
) - i
, 1) 'then put it where it belongs
fx
= (w&
- _PrintWidth(Mid$(temp$
, i
, 1))) / 2 + .99 'This is to center any non-monospaced letters so they look better 'Print text downwards
fx
= (w&
- _PrintWidth(Mid$(text$
, i
, 1))) / 2 + .99 'This is to center any non-monospaced letters so they look better