QB64/InForm
QB64/InForm
1
1
Fork 0
mirror of https://github.com/FellippeHeitor/InForm.git synced 2025-01-15 11:59:34 +00:00
Code Issues Releases Wiki Activity
InForm/examples/Mahjong/QB64Mahjong.bas

760 lines
28 KiB
QBasic
Raw Normal View History

Add many examples. Add legacy MessageBox extension
2023-06-24 02:38:56 +00:00
': Mahjong Program by Qwerkey (Richard Notley) 20/09/18 - updated 03/07/20
': This program uses
': InForm - GUI library for QB64 - v1.1
': Fellippe Heitor, 2016-2019 - fellippe@qb64.org - @fellippeheitor
': https://github.com/FellippeHeitor/InForm
': Images from openclipart.org, clker.com, clipartbest.com, clipartkid.com, wpclipart.com, wikipedia, kisspng.com
': Sound Effects from freesfx.co.uk
'-----------------------------------------------------------
DIM SHARED QB64Mahjong AS LONG
DIM SHARED ExitBT AS LONG
DIM SHARED ScoreLB AS LONG
DIM SHARED HighScoreLB AS LONG
DIM SHARED NumberOfTilesLB AS LONG
DIM SHARED Label1LB AS LONG
DIM SHARED NewGameBT AS LONG
DIM SHARED SaveGameBT AS LONG
DIM SHARED ScoringLB AS LONG
DIM SHARED HighScoringLB AS LONG
DIM SHARED TilesRemainingLB AS LONG
DIM SHARED UndoBT AS LONG
DIM SHARED StillBT AS LONG
DIM SHARED Frame1 AS LONG
DIM SHARED Mahjong%(5, 16, 8), Template`(5, 15, 8) 'From Into to Out-Of Screen, Left-to-Right, Top-to-Bottom
DIM SHARED ImType%%(144), TilePic%%(144), ImPos%%(144, 2), MatchComp%%(40), TileSave%(72, 1)
DIM SHARED Innit%%, Score%, HighScore%, TilesRem%, FromSave%%, MahPlay%%, WorldStop%%, CanUndo%%
DIM SHARED Counter&, PrevType%%, Blink%%, MatchesNone%%, EIndex%%, NoHov%, NoSel%, XMouse%, YMouse%
DIM SHARED HoverImg&, SimilarImg&, SelectImg&, EarthIm&, TileIm&(42), BackImg&, Blossom&, Borders&
CONST ScreenX% = 700, ScreenY% = 700, XStep% = 40, YStep% = 57, XOffset% = 5, YOffset% = 5
CONST XOrigin% = 40, YOrigin% = 40, YHalfTile% = 30, XHalfTile% = 20, FrameRate% = 30
': External modules: ---------------------------------------------------------------
'$INCLUDE:'../../InForm/InForm.bi'
'$INCLUDE:'QB64Mahjong.frm'
'$INCLUDE:'MakeBaize.bas'
'$INCLUDE:'QB64Logo.bas'
': Event procedures & Functions: ---------------------------------------------------
FUNCTION HardwareImage& (ImageName&)
HardwareImage& = _COPYIMAGE(ImageName&, 33)
_FREEIMAGE ImageName&
END FUNCTION
FUNCTION SetText$ (T%)
SetText$ = LTRIM$(STR$(T%))
END FUNCTION
SUB __UI_BeforeInit
RANDOMIZE (TIMER)
$EXEICON:'.\QB64Mahjong.ico'
Innit%% = True
'Set Positions Template
FOR S%% = 4 TO 11 '64
FOR R%% = 1 TO 8
Template`(1, S%%, R%%) = True
NEXT R%%
NEXT S%%
FOR S%% = 2 TO 3 '8
FOR R%% = 1 TO 8 STEP 7
Template`(1, S%%, R%%) = True
Template`(1, S%% + 10, R%%) = True
NEXT R%%
NEXT S%%
FOR S%% = 3 TO 12 STEP 9 '8
FOR R%% = 3 TO 6
Template`(1, S%%, R%%) = True
NEXT R%%
NEXT S%%
FOR S%% = 2 TO 13 STEP 11 '4
FOR R%% = 4 TO 5
Template`(1, S%%, R%%) = True
NEXT R%%
NEXT S%%
FOR S%% = 5 TO 10 '36
FOR R%% = 2 TO 7
Template`(2, S%%, R%%) = True
NEXT R%%
NEXT S%%
FOR S%% = 6 TO 9 '16
FOR R%% = 3 TO 6
Template`(3, S%%, R%%) = True
NEXT R%%
NEXT S%%
FOR S%% = 7 TO 8 '4
FOR R%% = 4 TO 5
Template`(4, S%%, R%%) = True
NEXT R%%
NEXT S%%
Template`(1, 1, 4) = True '4 'FIO 4.5 really
Template`(1, 14, 4) = True 'FIO 4.5 really
Template`(1, 15, 4) = True 'FIO 4.5 really
Template`(5, 7, 4) = True 'FIO 7.5, 4.5 really
'Images - all images are hardware accelerated
'Most images are used only in __UI_BeforeUpdateDisplay and therefore could be local and static
'But images are Shared instead
CALL MakeBaize(TempImg&)
BackImg& = HardwareImage&(TempImg&)
TempImg& = _NEWIMAGE(45, 62, 32)
_DEST TempImg&
COLOR _RGB(0, 0, 220), _RGBA(10, 10, 10, 50)
CLS
HoverImg& = HardwareImage&(TempImg&)
TempImg& = _NEWIMAGE(38, 55, 32)
_DEST TempImg&
COLOR _RGBA(0, 150, 0, 200), _RGBA(100, 100, 100, 0)
CLS
LINE (0, 0)-(37, 54), , B
LINE (1, 1)-(36, 53), , B
LINE (2, 2)-(35, 52), , B
SimilarImg& = HardwareImage&(TempImg&)
TempImg& = _NEWIMAGE(38, 55, 32)
_DEST TempImg&
COLOR _RGBA(180, 0, 0, 180), _RGBA(100, 100, 100, 0)
CLS
LINE (0, 0)-(37, 54), , B
LINE (1, 1)-(36, 53), , B
LINE (2, 2)-(35, 52), , B
SelectImg& = HardwareImage&(TempImg&)
TempImg& = _NEWIMAGE(494, 574, 32)
_DEST TempImg&
COLOR _RGB(230, 230, 230), _RGBA(100, 100, 100, 0)
CLS
LINE (369, 0)-(460, 0)
LINE (369, 0)-(369, 46)
LINE (460, 0)-(460, 46)
LINE (369, 46)-(384, 46)
LINE (445, 46)-(460, 46)
LINE (384, 46)-(384, 91)
LINE (445, 46)-(445, 91)
LINE (384, 91)-(445, 91)
LINE (339, 230)-(493, 230)
LINE (339, 230)-(339, 276)
LINE (493, 230)-(493, 276)
LINE (339, 276)-(384, 276)
LINE (445, 276)-(493, 276)
LINE (384, 276)-(384, 321)
LINE (445, 276)-(445, 321)
LINE (384, 321)-(445, 321)
LINE (0, 490)-(308, 490)
LINE (0, 490)-(0, 528)
LINE (308, 490)-(308, 528)
LINE (0, 528)-(123, 528)
LINE (185, 528)-(308, 528)
LINE (123, 528)-(123, 573)
LINE (185, 528)-(185, 573)
LINE (123, 573)-(185, 573)
Borders& = HardwareImage&(TempImg&)
EarthIm& = _LOADIMAGE("Earth.png", 33)
Blossom& = _LOADIMAGE("Plum Blossom.png", 33)
'Character Tiles
FOR N% = 1 TO 9
TileIm&(N%) = _LOADIMAGE("K" + LTRIM$(STR$(N%)) + ".png", 33)
NEXT N%
FOR N% = 1 TO 36
S%% = 1 + CINT((N% - 1) \ 4)
ImType%%(N%) = S%%
TilePic%%(N%) = S%%
NEXT N%
'Bamboo Tiles
FOR N% = 10 TO 18
S%% = N% - 9
TileIm&(N%) = _LOADIMAGE("B" + LTRIM$(STR$(S%%)) + ".png", 33)
NEXT N%
FOR N% = 37 TO 72
S%% = 1 + CINT((N% - 37) \ 4)
ImType%%(N%) = S%% + 9
TilePic%%(N%) = S%% + 9
NEXT N%
'Planet Tiles
FOR N% = 19 TO 27
S%% = N% - 18
TileIm&(N%) = _LOADIMAGE("C" + LTRIM$(STR$(S%%)) + ".png", 33)
NEXT N%
FOR N% = 73 TO 108
S%% = 1 + CINT((N% - 73) \ 4)
ImType%%(N%) = S%% + 18
TilePic%%(N%) = S%% + 18
NEXT N%
'QB64 Tiles
FOR N% = 28 TO 30
S%% = N% - 27
TileIm&(N%) = _LOADIMAGE("D" + LTRIM$(STR$(S%%)) + ".png", 33)
NEXT N%
FOR N% = 109 TO 120
S%% = 1 + CINT((N% - 109) \ 4)
ImType%%(N%) = S%% + 27
TilePic%%(N%) = S%% + 27
NEXT N%
'Wind Tiles
FOR N% = 31 TO 34
S%% = N% - 30
TileIm&(N%) = _LOADIMAGE("W" + LTRIM$(STR$(S%%)) + ".png", 33)
NEXT N%
FOR N% = 121 TO 136
S%% = 1 + CINT((N% - 121) \ 4)
ImType%%(N%) = S%% + 30
TilePic%%(N%) = S%% + 30
NEXT N%
'Flower Tiles
FOR N% = 35 TO 38
S%% = N% - 34
TileIm&(N%) = _LOADIMAGE("F" + LTRIM$(STR$(S%%)) + ".png", 33)
NEXT N%
FOR N% = 137 TO 140
S%% = N% - 136
ImType%%(N%) = 35
TilePic%%(N%) = S%% + 34
NEXT N%
'Nucleotide Tiles
FOR N% = 39 TO 42
S%% = N% - 38
TileIm&(N%) = _LOADIMAGE("S" + LTRIM$(STR$(S%%)) + ".png", 33)
NEXT N%
FOR N% = 141 TO 144
S%% = N% - 140
ImType%%(N%) = 36
TilePic%%(N%) = S%% + 38
NEXT N%
'Load data
FromSave%% = False
IF _FILEEXISTS("mahjong.cfg") THEN
OPEN "mahjong.cfg" FOR INPUT AS #1
INPUT #1, HighScore%
INPUT #1, TilesRem%
IF TilesRem% <> 144 THEN
FromSave%% = True
'Input saved data
INPUT #1, Score%
INPUT #1, Counter&
FOR U%% = 1 TO 15
FOR V%% = 1 TO 8
FOR W%% = 1 TO 5
INPUT #1, Mahjong%(W%%, U%%, V%%)
NEXT W%%
NEXT V%%
NEXT U%%
FOR N% = 1 TO 144
INPUT #1, ImPos%%(N%, 0), ImPos%%(N%, 1), ImPos%%(N%, 2)
NEXT N%
FOR N% = 1 TO 72 - (TilesRem% / 2)
INPUT #1, TileSave%(N%, 1), TileSave%(N%, 0)
NEXT N%
PrevType%% = ImType%%(TileSave%(72 - (TilesRem% / 2), 1))
END IF
CLOSE #1
END IF
END SUB
SUB __UI_OnLoad
_SCREENMOVE 100, 50
Caption(ExitBT) = "Start"
Control(ScoreLB).Hidden = True
Control(ScoringLB).Hidden = True
Control(HighScoreLB).Hidden = True
Control(HighScoringLB).Hidden = True
Control(NumberOfTilesLB).Hidden = True
Control(TilesRemainingLB).Hidden = True
Control(NewGameBT).Disabled = True
Control(SaveGameBT).Disabled = True
Control(UndoBT).Disabled = True
Control(StillBT).Disabled = True
SetFrameRate FrameRate%
SetFocus ExitBT
END SUB
SUB __UI_BeforeUpdateDisplay
'This event occurs at approximately 30 frames per second.
'You can change the update frequency by calling SetFrameRate DesiredRate%
_PUTIMAGE (0, 0), BackImg&
IF Innit%% OR TilesRem% = 0 THEN
_PUTIMAGE (0, 5), Blossom&
ELSEIF TilesRem% <> 0 THEN
'Display In-Play Tiles and Look for Mouse Hover/Select/Match
NoHov% = 0
Matches%% = False
MatchCount% = 0
'Layer 1R
FOR S%% = 15 TO 14 STEP -1
M% = Mahjong%(1, S%%, 4)
IF M% <> 0 THEN
X1% = ((S%% - 1) * XStep%) + XOrigin%
Y1% = (3 * YStep%) + YOrigin% + YHalfTile%
_PUTIMAGE (X1%, Y1%), TileIm&(TilePic%%(M%))
IF M% >= 81 AND M% <= 84 THEN _PUTIMAGE (X1% + 7, Y1% + 18), EarthIm&, , (EIndex%% * 35, 0)-((EIndex%% * 35) + 34, 34)
IF Mahjong%(1, S%% + 1, 4) = 0 THEN
MatchCount% = 1 'Don't need to count for two RHS end tiles on level 1
MatchComp%%(MatchCount%) = ImType%%(M%)
IF M% = NoSel% THEN 'Selected
_PUTIMAGE (X1% + 6, Y1% + 1), SelectImg&
ELSEIF ImType%%(NoSel%) = ImType%%(M%) AND Blink%% THEN 'Matches Selected
_PUTIMAGE (X1% + 6, Y1% + 1), SimilarImg&
END IF
IF XMouse% <= X1% + XStep% + 2 AND XMouse% >= X1% + XOffset% + 3 AND YMouse% >= Y1% + 3 AND YMouse% <= Y1% + YStep% - 3 THEN
NoHov% = M%
_PUTIMAGE (X1%, Y1%), HoverImg&
END IF
END IF
END IF
NEXT S%%
'Layers 1 -4 Look for Hover
FOR W%% = 1 TO 4
UHov% = XMouse% - XOrigin% + XStep% - (XOffset% * W%%)
VHov% = YMouse% - YOrigin% + YStep% + (YOffset% * (W%% - 1))
S%% = UHov% \ XStep%
URem%% = UHov% MOD XStep%
R%% = VHov% \ YStep%
VRem%% = VHov% MOD YStep%
IF S%% >= 2 AND S%% <= 13 AND R%% >= 1 AND R%% <= 8 THEN
'Check for Available AND Not Blocked
M% = Mahjong%(W%%, S%%, R%%)
IF M% <> 0 AND URem%% >= 3 AND URem%% <= XStep% - 3 AND VRem%% >= 3 AND VRem%% <= YStep% - 3 THEN
IF Mahjong%(W%% + 1, S%%, R%%) = 0 AND (Mahjong%(W%%, S%% + 1, R%%) = 0 OR Mahjong%(W%%, S%% - 1, R%%) = 0) THEN NoHov% = M%
END IF
END IF
NEXT W%%
'Layers 1 -4
FOR W%% = 1 TO 4
IF W%% = 1 THEN
UFactor%% = -1
ELSE
UFactor%% = W%%
END IF
FOR S%% = 12 - UFactor%% TO 3 + UFactor%% STEP -1
FOR R%% = W%% TO 9 - W%%
M% = Mahjong%(W%%, S%%, R%%)
IF M% <> 0 THEN
X1% = ((S%% - 1) * XStep%) + XOrigin% + (XOffset% * (W%% - 1))
Y1% = ((R%% - 1) * YStep%) + YOrigin% - (YOffset% * (W%% - 1))
_PUTIMAGE (X1%, Y1%), TileIm&(TilePic%%(M%))
IF M% >= 81 AND M% <= 84 THEN _PUTIMAGE (X1% + 7, Y1% + 18), EarthIm&, , (EIndex%% * 35, 0)-((EIndex%% * 35) + 34, 34)
IF Mahjong%(W%% + 1, S%%, R%%) = 0 AND (Mahjong%(W%%, S%% + 1, R%%) = 0 OR Mahjong%(W%%, S%% - 1, R%%) = 0) THEN
MatchCount% = MatchCount% + 1
IF MatchCount% > 1 THEN
MatchIndex% = 1
WHILE NOT Matches%% AND MatchIndex% <= MatchCount% - 1
IF ImType%%(M%) = MatchComp%%(MatchIndex%) THEN Matches%% = True
MatchIndex% = MatchIndex% + 1
WEND
END IF
MatchComp%%(MatchCount%) = ImType%%(M%)
IF M% = NoSel% THEN 'Selected
_PUTIMAGE (X1% + 6, Y1% + 1), SelectImg&
ELSEIF ImType%%(NoSel%) = ImType%%(M%) AND Blink%% THEN 'Matches Selected
_PUTIMAGE (X1% + 6, Y1% + 1), SimilarImg&
END IF
IF NoHov% = M% THEN _PUTIMAGE (X1%, Y1%), HoverImg&
END IF
END IF
NEXT R%%
NEXT S%%
NEXT W%%
'Layer 1L
M% = Mahjong%(1, 1, 4)
IF M% <> 0 THEN
X1% = XOrigin%
Y1% = (3 * YStep%) + YOrigin% + YHalfTile%
_PUTIMAGE (X1%, Y1%), TileIm&(TilePic%%(M%))
IF M% >= 81 AND M% <= 84 THEN _PUTIMAGE (X1% + 7, Y1% + 18), EarthIm&, , (EIndex%% * 35, 0)-((EIndex%% * 35) + 34, 34)
MatchCount% = MatchCount% + 1
IF MatchCount% > 1 THEN
MatchIndex% = 1
WHILE NOT Matches%% AND MatchIndex% <= MatchCount% - 1
IF ImType%%(M%) = MatchComp%%(MatchIndex%) THEN Matches%% = True
MatchIndex% = MatchIndex% + 1
WEND
END IF
MatchComp%%(MatchCount%) = ImType%%(M%)
IF M% = NoSel% THEN 'Selected
_PUTIMAGE (X1% + 6, Y1% + 1), SelectImg&
ELSEIF ImType%%(NoSel%) = ImType%%(M%) AND Blink%% THEN 'Matches Selected
_PUTIMAGE (X1% + 6, Y1% + 1), SimilarImg&
END IF
IF XMouse% <= X1% + XStep% + 2 AND XMouse% >= X1% + XOffset% + 3 AND YMouse% >= Y1% + 3 AND YMouse% <= Y1% + YStep% - 3 THEN
_PUTIMAGE (X1%, Y1%), HoverImg&
NoHov% = M%
END IF
END IF
'Layer 5
M% = Mahjong%(5, 7, 4)
IF M% <> 0 THEN
X1% = (6 * XStep%) + XOrigin% + (4 * XOffset%) + XHalfTile%
Y1% = (3 * YStep%) + YOrigin% - (4 * YOffset%) + YHalfTile%
_PUTIMAGE (X1%, Y1%), TileIm&(TilePic%%(M%))
IF M% >= 81 AND M% <= 84 THEN _PUTIMAGE (X1% + 7, Y1% + 18), EarthIm&, , (EIndex%% * 35, 0)-((EIndex%% * 35) + 34, 34)
MatchCount% = MatchCount% + 1
IF MatchCount% > 1 THEN
MatchIndex% = 1
WHILE NOT Matches%% AND MatchIndex% <= MatchCount% - 1
IF ImType%%(M%) = MatchComp%%(MatchIndex%) THEN Matches%% = True
MatchIndex% = MatchIndex% + 1
WEND
END IF
MatchComp%%(MatchCount%) = ImType%%(M%)
IF M% = NoSel% THEN 'Selected
_PUTIMAGE (X1% + 6, Y1% + 1), SelectImg&
ELSEIF ImType%%(NoSel%) = ImType%%(M%) AND Blink%% THEN 'Matches Selected
_PUTIMAGE (X1% + 6, Y1% + 1), SimilarImg&
END IF
IF XMouse% <= X1% + XStep% + 2 AND XMouse% >= X1% + XOffset% + 3 AND YMouse% >= Y1% + 3 AND YMouse% <= Y1% + YStep% - 3 THEN
_PUTIMAGE (X1%, Y1%), HoverImg&
NoHov% = M%
END IF
END IF
_PUTIMAGE (197 - 1, 110 - 1), Borders&
IF NOT Matches%% AND MahPlay%% THEN MatchesNone%% = True
END IF
END SUB
SUB __UI_BeforeUnload
'If you set __UI_UnloadSignal = False here you can
'cancel the user's request to close.
END SUB
SUB __UI_Click (id AS LONG)
SELECT CASE id
CASE Frame1
CASE ScoreLB
CASE HighScoreLB
CASE NumberOfTilesLB
CASE Label1LB
CASE ScoringLB
CASE HighScoringLB
CASE TilesRemainingLB
CASE QB64Mahjong
IF NoHov% <> 0 AND MahPlay%% THEN
IF NoSel% = 0 THEN
'First Tile Selected
NoSel% = NoHov%
Control(UndoBT).Disabled = False
ELSE
'Second Tile Selected
IF NoSel% <> NoHov% THEN
'Check for Same Image Yype
IF ImType%%(NoSel%) = ImType%%(NoHov%) THEN
'Matched Pair - Remove Tiles
Mahjong%(ImPos%%(NoSel%, 0), ImPos%%(NoSel%, 1), ImPos%%(NoSel%, 2)) = 0
Mahjong%(ImPos%%(NoHov%, 0), ImPos%%(NoHov%, 1), ImPos%%(NoHov%, 2)) = 0
'Special condition for top layer & left/right edges (offest tiles)
IF ImPos%%(NoSel%, 0) = 5 OR ImPos%%(NoHov%, 0) = 5 THEN
Mahjong%(5, 7, 5) = 0
Mahjong%(5, 8, 5) = 0
Mahjong%(5, 8, 4) = 0
END IF
IF ImPos%%(NoSel%, 1) = 14 OR ImPos%%(NoHov%, 1) = 14 THEN
Mahjong%(1, 14, 5) = 0
END IF
IF ImPos%%(NoSel%, 1) = 1 OR ImPos%%(NoHov%, 1) = 1 THEN
Mahjong%(1, 1, 5) = 0
END IF
TileSave%(73 - (TilesRem% / 2), 1) = NoSel%
TileSave%(73 - (TilesRem% / 2), 0) = NoHov%
TilesRem% = TilesRem% - 2
Score% = Score% + 3
Caption(TilesRemainingLB) = SetText$(TilesRem%)
Caption(ScoringLB) = SetText$(Score%)
Control(NewGameBT).Disabled = False
IF TilesRem% > 0 THEN
Control(SaveGameBT).Disabled = False
Control(UndoBT).Disabled = False
ELSE
Control(SaveGameBT).Disabled = True
Control(UndoBT).Disabled = True
Caption(Label1LB) = "Congratulations"
Control(Label1LB).Hidden = False
Control(StillBT).Disabled = True
END IF
IF ImType%%(NoSel%) = PrevType%% THEN
Score% = Score% + 6
Caption(ScoringLB) = SetText$(Score%)
END IF
PrevType%% = ImType%%(NoSel%)
ELSE 'Not a Match
_SNDPLAYFILE "Beep.ogg", 2, 0.5
END IF
END IF
NoSel% = 0
IF TilesRem% = 144 THEN Control(UndoBT).Disabled = True
END IF
END IF
CASE UndoBT
IF TilesRem% > 0 THEN
IF TilesRem% < 144 AND CanUndo%% AND NoSel% = 0 THEN
'Undo
_SNDPLAYFILE "Undo.ogg", 1, 0.6
One% = TileSave%(72 - (TilesRem% / 2), 1)
Nought% = TileSave%(72 - (TilesRem% / 2), 0)
Mahjong%(ImPos%%(One%, 0), ImPos%%(One%, 1), ImPos%%(One%, 2)) = One%
Mahjong%(ImPos%%(Nought%, 0), ImPos%%(Nought%, 1), ImPos%%(Nought%, 2)) = Nought%
IF ImPos%%(One%, 0) = 5 OR ImPos%%(Nought%, 0) = 5 THEN
Mahjong%(5, 7, 5) = 145
Mahjong%(5, 8, 5) = 145
Mahjong%(5, 8, 4) = 145
END IF
IF ImPos%%(One%, 1) = 14 OR ImPos%%(Nought%, 1) = 14 THEN
Mahjong%(1, 14, 5) = 145
END IF
IF ImPos%%(One%, 1) = 1 OR ImPos%%(Nought%, 1) = 1 THEN
Mahjong%(1, 1, 5) = 145
END IF
TilesRem% = TilesRem% + 2
Score% = Score% - 3
Caption(TilesRemainingLB) = SetText$(TilesRem%)
Caption(ScoringLB) = SetText$(Score%)
IF TilesRem% < 144 THEN
Control(SaveGameBT).Disabled = False
ELSE
Control(SaveGameBT).Disabled = True
END IF
PrevType%% = ImType%%(TileSave%(72 - (TilesRem% / 2), 1))
IF ImType%%(One%) = PrevType%% THEN
Score% = Score% - 6
Caption(ScoringLB) = SetText$(Score%)
END IF
MatchesNone%% = False
Control(Label1LB).Hidden = True
CanUndo%% = False
END IF
NoSel% = 0 ' Undo also removes selection
IF TilesRem% = 144 THEN Control(UndoBT).Disabled = True
END IF
CASE ExitBT
IF Innit%% THEN
CALL DoMahjong
ELSE
MahPlay%% = False
Innit%% = True
TilesRem% = 144 ' Prevents Save at Exit
END IF
CASE NewGameBT
MahPlay%% = False
CASE SaveGameBT
MahPlay%% = False
Innit%% = True
IF TilesRem% = 0 THEN TilesRem% = 144 ' Prevents Save at Exit
CASE StillBT
IF WorldStop%% THEN
Caption(StillBT) = "Still"
WorldStop%% = False
ELSE
Caption(StillBT) = "Spin"
WorldStop%% = True
END IF
END SELECT
END SUB
SUB __UI_MouseEnter (id AS LONG)
END SUB
SUB __UI_MouseLeave (id AS LONG)
END SUB
SUB __UI_FocusIn (id AS LONG)
END SUB
SUB __UI_FocusOut (id AS LONG)
'This event occurs right before a control loses focus.
'To prevent a control from losing focus, set __UI_KeepFocus = True below.
END SUB
SUB __UI_MouseDown (id AS LONG)
END SUB
SUB __UI_MouseUp (id AS LONG)
END SUB
SUB __UI_KeyPress (id AS LONG)
'When this event is fired, __UI_KeyHit will contain the code of the key hit.
'You can change it and even cancel it by making it = 0
END SUB
SUB __UI_TextChanged (id AS LONG)
END SUB
SUB __UI_ValueChanged (id AS LONG)
END SUB
SUB __UI_FormResized
END SUB
SUB DoMahjong
_SNDPLAYFILE "chrysanthemum.ogg", 4, 0.6
Caption(ExitBT) = "Exit"
Control(ScoreLB).Hidden = False
Control(ScoringLB).Hidden = False
Control(HighScoreLB).Hidden = False
Control(HighScoringLB).Hidden = False
Control(NumberOfTilesLB).Hidden = False
Control(TilesRemainingLB).Hidden = False
Innit%% = False
WHILE NOT Innit%%
'Initial Values
IF NOT FromSave%% THEN
'Empty Grid
FOR U%% = 1 TO 15
FOR V%% = 1 TO 8
FOR W%% = 1 TO 5
Mahjong%(W%%, U%%, V%%) = 0
NEXT W%%
NEXT V%%
NEXT U%%
'Randomly Fill Grid
FOR N% = 1 TO 144
Empty%% = True
WHILE Empty%%
URnd%% = 1 + INT(15 * RND)
VRnd%% = 1 + INT(8 * RND)
WRnd%% = 1 + INT(5 * RND)
IF Mahjong%(WRnd%%, URnd%%, VRnd%%) = 0 AND Template`(WRnd%%, URnd%%, VRnd%%) THEN
Mahjong%(WRnd%%, URnd%%, VRnd%%) = N%
ImPos%%(N%, 0) = WRnd%%
ImPos%%(N%, 1) = URnd%%
ImPos%%(N%, 2) = VRnd%%
Empty%% = False
END IF
WEND
NEXT N%
Mahjong%(1, 1, 5) = 145
Mahjong%(1, 14, 5) = 145
Mahjong%(5, 7, 5) = 145
Mahjong%(5, 8, 4) = 145
Mahjong%(5, 8, 5) = 145
TilesRem% = 144
Score% = 0
Counter& = 0
PrevType%% = 0
END IF
MahPlay%% = True
NoSel% = 0
NoHov% = 0
MatchesNone%% = False
MatchBeeped%% = False
ECount%% = 0
EIndex%% = 0
BCount%% = 0
Blink%% = True
CanUndo%% = True
UCount%% = 0
WorldStop%% = False
Control(NewGameBT).Disabled = True
Control(SaveGameBT).Disabled = True
Control(StillBT).Disabled = False
IF FromSave%% THEN
FromSave%% = False
Control(UndoBT).Disabled = False
ELSE
Control(UndoBT).Disabled = True
END IF
Control(Label1LB).Hidden = True
Caption(Label1LB) = "No Matches Available"
Caption(ScoringLB) = SetText$(Score%)
Caption(HighScoringLB) = SetText$(HighScore%)
Caption(TilesRemainingLB) = SetText$(TilesRem%)
WHILE MahPlay%%
_LIMIT 2 * FrameRate%
XMouse% = __UI_MouseLeft: YMouse% = __UI_MouseTop
IF MatchesNone%% THEN
IF NOT MatchBeeped%% THEN
_SNDPLAYFILE "NoMatch.ogg", 3, 0.8
MatchBeeped%% = True
Control(Label1LB).Hidden = False
END IF
ELSE
MatchBeeped%% = False
END IF
IF WorldStop%% THEN
EIndex%% = 8
ELSE
ECount%% = ECount%% + 1
IF ECount%% = 12 THEN
ECount%% = 0
EIndex%% = EIndex%% + 1
IF EIndex%% > 11 THEN EIndex%% = 0
END IF
END IF
BCount%% = BCount%% + 1
IF Blink%% AND BCount%% = 40 THEN
BCount%% = 0
Blink%% = False
ELSEIF NOT Blink%% AND BCount%% = 10 THEN
BCount%% = 0
Blink%% = True
END IF
IF NOT CanUndo%% THEN UCount%% = UCount%% + 1
IF UCount%% = 32 THEN
CanUndo%% = True
UCount%% = 0
END IF
'Following is to adjust score for time in game
Counter& = Counter& + 1
IF Counter& > 33000 AND TilesRem% > 0 THEN
IF Counter& / 1800 = Counter& \ 1800 THEN
IF Score% > 100 THEN
Score% = Score% - 1
Caption(ScoringLB) = SetText$(Score%)
END IF
END IF
END IF
k1$ = INKEY$
IF k1$ <> "" THEN
IF ASC(k1$) = 27 THEN
MahPlay%% = False
Innit%% = True
TilesRem% = 144
END IF
END IF
__UI_DoEvents
WEND
IF Score% > HighScore% THEN HighScore% = Score%
WEND
'Free images
FOR N% = 1 TO 42
_FREEIMAGE TileIm&(N%)
NEXT N%
_FREEIMAGE HoverImg&
_FREEIMAGE SelectImg&
_FREEIMAGE SimilarImg&
_FREEIMAGE EarthIm&
_FREEIMAGE BackImg&
_FREEIMAGE Blossom&
_FREEIMAGE Borders&
'Write Data
OPEN "mahjong.cfg" FOR OUTPUT AS #1
PRINT #1, HighScore%
PRINT #1, TilesRem%
IF TilesRem% < 144 THEN
'Print Save data
PRINT #1, Score%
PRINT #1, Counter&
FOR U%% = 1 TO 15
FOR V%% = 1 TO 8
FOR W%% = 1 TO 5
PRINT #1, Mahjong%(W%%, U%%, V%%),
NEXT W%%
PRINT #1, ""
NEXT V%%
NEXT U%%
FOR N% = 1 TO 144
PRINT #1, ImPos%%(N%, 0), ImPos%%(N%, 1), ImPos%%(N%, 2)
NEXT N%
FOR N% = 1 TO 72 - (TilesRem% / 2)
PRINT #1, TileSave%(N%, 1), TileSave%(N%, 0)
NEXT N%
END IF
CLOSE #1
SYSTEM
END SUB
'$INCLUDE:'../../InForm/InForm.ui'
'$INCLUDE:'../../InForm/xp.uitheme'
Copy permalink