option base 1
CONST LANDSCAPE = MM.HRes > MM.VRes
const MAX_LEVEL = 10
dim pairs( MAX_LEVEL + LANDSCAPE, MAX_LEVEL + not(LANDSCAPE) ) as integer
dim integer lvl = 1
dim lvlColour as integer
dim lvlTextScale as integer
dim as integer cf=rgb(yellow),ck=RGB(BLUE),cb=RGB(WHITE),ci=rgb(0,128,228),xo=10,yo=10
const gap=4


do 'Forever loop
lvl=lvl + 1
GetLevel
restore LevelConfigData
for i=1 to lvl
read lvlColour,lvlTextScale
next i

if LANDSCAPE then
ny=lvl
nx=ny+1
ELSE
nx=lvl
ny=nx+1
endif

xstep=MM.HRes\nx
ystep=MM.VRes\ny

success%=0

'Populate values array
v$=""
for i=1 to nx*ny/2
v$=v$ + chr$(i) + chr$(i) '11223344....
next i

'Draw boxes and assign values
CLS
for x=1 to nx
for y=1 to ny
rbox gap+(x-1)*xstep,gap+(y-1)*ystep,xstep-gap,ystep-gap,,rgb(white),lvlColour
'Assign random value
p%=int(rnd(1) * len(v$)) + 1
pairs(x,y)= ASC(mid$(v$, p%,1))
' and remove it from list
v$ = left$(v$,p%-1) + mid$(v$,p%+1)
next y
next x

' Game Loop
do
'Get first selection
do
GetTouch
xa=xp\xstep + 1
ya=yp\ystep + 1
loop while pairs(xa,ya)=0 'if 0, already matched
Text gap\2+(xa-.5)*xstep,gap\2+(ya-.5)*ystep,str$(pairs(xa,ya)),cm,1,lvlTextScale,RGB(BLACK),lvlColour

GetTouch
xb=xp\xstep + 1
yb=yp\ystep + 1
if pairs(xb,yb) > 0 then
Text gap\2+(xb-.5)*xstep,gap\2+(yb-.5)*ystep,str$(pairs(xb,yb)),cm,1,lvlTextScale,RGB(BLACK),lvlColour
endif

if pairs(xa,ya) = pairs(xb,yb) and (xa<>xb or ya<>yb) then
success%=success%+1
' register success for this pair
pairs(xa,ya)=0
pairs(xb,yb)=0
ELSE
' show it for half a second
pause 500
'incorrect choice - redraw background for both
rbox gap+(xa-1)*xstep,gap+(ya-1)*ystep,xstep-gap,ystep-gap,,rgb(white),lvlColour
if pairs(xb,yb)>0 then
rbox gap+(xb-1)*xstep,gap+(yb-1)*ystep,xstep-gap,ystep-gap,,rgb(white),lvlColour
endif
endif

loop while success% < nx*ny/2
kup%=0:e%=0
do
if e% then
RBOX 20,150,280,70,14,cb,cb:RBOX 23,153,274,64,11,ck,ck:text 35,160,"YIPPEE!",,1,4,cf,ck
else
RBOX 20,150,280,70,14,cb,cb:RBOX 23,153,274,64,11,cf,cf:text 35,160,"YIPPEE!",,1,4,ck,cf
endif
for i=1 to 30
pause 10
if Touch(x) = -1 then
kup%=1
else
if kup%=1 then
exit do
endif
endif
next i
e%=not(e%)
loop
loop

' ********** SUBROUTINES ************
' Wait for screen touch and Get Touch position into xp and yp
sub GetTouch
xp=0
yp=0
Do
a=Touch(x)
b=Touch(y)
If (a>-1 And (a>xp+10) Or a<xp-10)) Or (b>-1 And (b>yp+10 Or b<yp-10)) Then
If a>-1 And b>-1 Then
'Print a,b
xp=a
yp=b
EndIf
EndIf
Loop while xp=0 or yp=0 or a>-1 or b>-1
end sub

sub GetLevel()
' Returns 0 to exit or 1-MAX_LEVEL as chosen level
cls
local Msg as string

'Foreground, BacKground, Border and Inactive colours,xoffset,yoffset
CLS

'Show level as separate box
'RBOX 55,20,232,70,14,cb,cb:RBOX 58,23,226,64,11,ci,ci:text 60,30," 5 x 6",,1,4,cf,ci
'or show as grouping box
RBOX xo,yo,285,105,14,cb,cb:RBOX xo+3,yo+3,279,99,11,ci,ci

' Up Arrow
RBOX xo+7,yo+7,42,42,12,cb,cb:RBOX xo+9,yo+9,38,38,10,ck,ck
circle xo+28,yo+29,10,1,1,cf,cf:circle xo+23,yo+32,7,1,1,cf,cf:circle xo+33,yo+32,7,1,1,cf,cf:circle xo+28,yo+23,7,1,1,cf,cf:circle xo+18,yo+35,4,1,1,cf,cf:circle xo+38,yo+35,4,1,1,cf,cf:circle xo+28,yo+17,4,1,1,cf,cf
PIXEL xo+20,yo+39,cf:pixel xo+36,yo+39,cf:pixel xo+20,yo+24,cf:pixel xo+36,yo+24,cf:pixel xo+23,yo+19,cf:pixel xo+33,yo+19,cf
'Down arrow
RBOX xo+7,yo+55,42,42,12,cb,cb:RBOX xo+9,yo+57,38,38,10,ck,ck
circle xo+28,yo+75,10,1,1,cf,cf:circle xo+23,yo+72,7,1,1,cf,cf:circle xo+33,yo+72,7,1,1,cf,cf:circle xo+28,yo+81,7,1,1,cf,cf:circle xo+18,yo+69,4,1,1,cf,cf:circle xo+38,yo+69,4,1,1,cf,cf:circle xo+28,yo+87,4,1,1,cf,cf
PIXEL xo+20,yo+65,cf:pixel xo+36,yo+65,cf:pixel xo+20,yo+80,cf:pixel xo+36,yo+80,cf:pixel xo+23,yo+85,cf:pixel xo+33,yo+85,cf

'Go
RBOX 100,150,120,70,14,cb,cb:RBOX 103,153,114,64,11,ck,ck:text 115,160,"GO!",,1,4,cf,ck

do
Msg=" "+str$(lvl)+" x "+str$(lvl+1)
text xo+58,yo+24,Msg,,1,4,cb,ci
GetTouch
if xp>=xo and xp<=50+xo and yp>=yo and yp<=yo+100 then
' this is up or down
if yp<yo+50 then
lvl=lvl-1
if lvl<1 then lvl=1
else
lvl=lvl+1
if lvl>8 then lvl=8
endif
elseif xp>=100 and xp<=220 and yp>=150 and yp<=220 then
' this is GO button
exit do
endif
loop
end sub
'CLS:RBOX 2,6,285,105,14,cb,cb:RBOX 5,9,279,99,11,ck,ck:text 60,30,"Level 5",,1,4,cf,ci:RBOX 9,13,42,42,14,cb,cb:RBOX 11,15,38,38,12,ck,ck:RBOX 9,61,42,42,14,cb,cb:RBOX 11,63,38,38,12,ck,ck


LevelConfigData:
DATA 65535,15 'Cyan (full blue + green
DAta 16711680,8 '9 causes artefacts Red
data 16776960,5 '6 causes artefacts Yellow (Full Red + Green)
data 16711935,3 '4 causes artefacts Magenta (Pink = full red and blue)
data 65280,3 'Green
data 16777215,2 'White
data 255,2 'Blue
' data 16744448,1 'Burnt red
data 8388479,1 ' Bright Green (full Green + 50% red and blue)
' data 8355711,1 ' Grey (50%)
' data 16777087,1 ' Light Brown/orange? (Full Red and Green + 50% blue