LB Booster
« DOMINO »

Welcome Guest. Please Login or Register.
Apr 1st, 2018, 04:39am



ATTENTION MEMBERS: Conforums will be closing it doors and discontinuing its service on April 15, 2018.
We apologize Conforums does not have any export functions to migrate data.
Ad-Free has been deactivated. Outstanding Ad-Free credits will be reimbursed to respective payment methods.

Thank you Conforums members.
Speed up Liberty BASIC programs by up to ten times!
Compile Liberty BASIC programs to compact, standalone executables!
Overcome many of Liberty BASIC's bugs and limitations!
LB Booster Resources
LB Booster documentation
LB Booster Home Page
LB Booster technical Wiki
Just BASIC forum
BBC BASIC Home Page
Liberty BASIC forum (the original)

« Previous Topic | Next Topic »
Pages: 1  Notify Send Topic Print
 thread  Author  Topic: DOMINO  (Read 261 times)
bluatigro
Full Member
ImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 111
xx DOMINO
« Thread started 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

 
User IP Logged

Pages: 1  Notify Send Topic Print
« Previous Topic | Next Topic »

| |

This forum powered for FREE by Conforums ©
Terms of Service | Privacy Policy | Conforums Support | Parental Controls