''bluatigro 16 may 2015
''domino
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx , winy , pi , cut$
winx = WindowWidth
winy = WindowHeight
cut$ = "|"
global klfore$ , klback$ , scrn.x , h.x
klfore$ = "black black black white white white"
klback$ = "yellow pink cyan blue red green"
button #m.lscrn , "<" , [lscrn] , UL _
, 0 , winy / 2 - 25 , 50 , 50
button #m.rscrn , ">" , [rscrn] , UL _
, winx - 50 , winy / 2 - 25 , 50 , 50
button #m.lh , "<" , [lh] , UL _
, 0 , winy - 200 , 50 , 50
button #m.rh , ">" , [hr] , UL _
, winx - 50 , winy - 200 , 50 , 50
global mem$ , comp$ , human$ , scrn$
nomainwin
open "DOMINO" for graphics as #m
#m "trapclose [quit]"
#m "font Courier_new 30 bold"
call newgame
for i = 0 to winx / 32
call show mem$ , 0
next i
wait
[quit]
close #m
end
sub newgame
mem$ = ""
comp$ = ""
human$ = ""
scrn$ = ""
for a = 1 to 6
for b = 1 to a
mem$ = push$( mem$ , domino$( a , b ) , 1 )
next b
next a
mem$ = shuffle$( mem$ )
end sub
function domino$( a , b )
domino$ = str$( a ) + " " ; b
end function
sub show a$ , q
max = size( a$ )
for i = 1 to max
b$ = word$( a$ , i , cut$ )
a = val( word$( b$ , 1 ) )
b = val( word$( b$ , 2 ) )
if q = 1 then
qx = h.x + i + 2
qy = winy - 100
else
qx = scrn.x + i + 2
qy = winy / 2 - 32
end if
call square qx * 32 , qy - 20 , a
call square qx * 32 , qy + 20 , b
next i
end sub
sub square x , y , no
#m "up"
#m "color " ; word$( klfore$ , no )
#m "backcolor " ; word$( klback$ , no )
#m "goto " ; x + 5 ; " " ; y + 25
#m "down"
#m "\" ; str$( no )
#m "up"
end sub
function push$( stack$ , object$ , l )
if object$ <> cut$ then
if l <> 0 then
push$ = object$ + cut$ + stack$
else
push$ = stack$ + object$ + cut$
''push$ = stack$ + cut$ + object$
end if
else
push$ = stack$
end if
end function
function pop$( stack$ )
''delete last object$
i = instr( stack$ , cut$ )
if stack$ = "" then pop$ = ""
''get right side of stack
pop$ = mid$( stack$ , i + 1 , len( stack$ ) -i )
end function
function top$( stack$ )
''read last object$
i = instr( stack$ , cut$ )
if stack$ = "" then
top$ = ""
else
top$ = mid$( stack$ , 1 , i - 1 ) ' <<<<<<<<
end if
end function
function size( a$ )
result = 0
for i = 1 to len( a$ )
if mid$( a$ , i , 1 ) = cut$ then result = result + 1
next i
size = result
end function
function insertAt$( a$ , item$ , i )
p = 1
result$ = ""
max = size( a$ )
if i < 0 then i = max + 2 - abs( i )
while p < i
result$ = push$( result$ , word$( a$ , p , cut$ ) , false )
p = p + 1
wend
result$ = push$( result$ , item$ , false )
while p <= max
result$ = push$( result$ , word$( a$ , p , cut$ ) , false )
p = p + 1
wend
insertAt$ = result$
end function
function insertSorted$( a$ , item$ , no , isStr )
p = 1
result$ = ""
max = size( a$ )
done = false
while p <= max and not( done )
m$ = word$( a$ , p , cut$ )
mp$ = word$( m$ , no )
ip$ = word$( item$ , no )
result$ = push$( result$ , m$ , false )
if isStr then
if mp$ <= ip$ then
result$ = push$( result$ , item$ , false )
done = true
end if
else
if val( mp$ ) <= val( ip$ ) then
result$ = push$( result$ , item$ , false )
done = true
end if
end if
p = p + 1
wend
while p < max
m$ = word$( a$ , p , cut$ )
result$ = push$( result$ , m$ , false )
p = p + 1
wend
insertSorted$ = result$
end function
function sort$( a$ , no , isStr )
max = size( a$ )
for i = 1 to max
result$ = insertSorted$( result$ , word$( a$ , i , cut$ ) , no , isStr )
next i
sort$ = result$
end function
function remove$( a$ , item$ )
p = 1
result$ = ""
max = size( a$ )
while p <= max
if word$( a$ , p , cut$ ) <> item$ then
result$ = push$( result$ , word$( a$ , p , cut$ ) , false )
end if
p = p + 1
wend
remove$ = result$
end function
function removeAt$( a$ , i )
p = 1
result$ = ""
max = size( a$ )
if i < 0 then i = max + 1 - abs( i )
while p <= max
if p <> i then
result$ = push$( result$ , word$( a$ , p , cut$ ) , false )
end if
p = p + 1
wend
removeAt$ = result$
end function
function reverse$( a$ )
p = 1
max = size( a$ )
while p <= max
result$ = push$( result$ , word$( a$ , p , cut$ ) , true )
p = p + 1
wend
reverse$ = result$
end function
function part$( a$ , b , e )
max = size( a$ )
if b < 0 then b = max + 1 - abs( b )
if e < 0 then e = max + 1 - abs( e )
for i = b to e
r$ = push$( r$ , word$( a$ , i , cut$ ) , false )
next i
part$ = r$
end function
function element( a$ , item$ )
p = instr( cut$ + a$ , cut$ + item$ + cut$ )
element = p > 0
end function
function shuffle$( a$ )
max = size( a$ )
dice = int( rnd( 0 ) * max ) + 1
seed$ = word$( a$ , dice , cut$ )
for i = 2 to max
dice = int( rnd( 0 ) * ( max - i ) ) + 1
p$ = word$( a$ , dice , cut$ )
uit$ = push$( uit$ , p$ , false )
a$ = removeAt$( a$ , dice )
next i
shuffle$ = uit$
end function