LB Booster
Programming >> BASIC code examples >> DOMINO
http://lbb.conforums.com/index.cgi?board=code&action=display&num=1431950004

DOMINO
Post by bluatigro on May 16th, 2015, 1:07pm

this is the beginning of a try at domino

it isnt ready jet

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