''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