Liberty BASIC Community Forum
« checkers try »

Welcome Guest. Please Login or Register.
Jan 21st, 2018, 6:16pm


Rules|Home|Help|Search|Recent Posts|Notification


« Previous Topic | Next Topic »
Pages: 1  Notify Send Topic Print
 thread  Author  Topic: checkers try  (Read 41 times)
bluatigro
Guru
ImageImageImageImageImage


member is offline

Avatar

cxiu diversas el tio respondas cxiu samvaloras [ thats esperanto for : we are al different therefore we are al equal ]


PM

Gender: Male
Posts: 934
xx checkers try
« Thread started on: Jan 16th, 2018, 06:00am »

version 0.1

it shoot play :
when hit : play random hit
no hit : play random move
til no move left
no human input jet

error :
strange things happen
Code:
dim p(14,14),z$(1000)
global empty,white,black,dan,wal,player
white = 1
black = 2
dan = 4
wal = 8
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
nomainwin
open "dammen 0.1" for graphics as #m
  #m "trapclose [quit]"
  #m "size 6"
  player = 1
  call newgame
  timer 1000 , [timer]
wait
[timer]
    scan
    call drawbord

    q$ = ai$( player )
    if q$ = "no moves" then
      timer 0
      notice "GAME OVER !!"
    end if
    i = val( word$( q$ , 1 ) )
    j = val( word$( q$ , 2 ) )
    i2 = val( word$( q$ , 3 ) )
    j2 = val( word$( q$ , 4 ) )
    p(i2,j2)=p(i,j)
    if abs(i-i2)=2 then
      p((i+i2)/2,(j+j2)/2)=empty
    end if
    p(i,j)=empty
    player = 3 - player

wait
[quit]
  close #m
end
function ai$( kl )
  for i = 0 to 1000
    z$(i) = ""
  next i
  ztel = 0
  q = -1
  if kl = black then q = 1
  for i = 2 to 11
    for j = 2 to 11
      if p(i,j)=(kl and 3) then
        ''look if p can hit
        if (p(i+q,j+q)and 3) then
          if p(i,j)<>p(i+q,j+q) then
            if p(i+q*2,j+q*2)=empty then
              z$(ztel)=str$(i);" ";j;" ";i+q*2;" ";j+q*2;" hit"
              ztel = ztel + 1
            end if
          end if
        end if
        if (p(i-q,j+q)and 3) then
          if p(i,j)<>p(i-q,j+q) then
            if p(i-q*2,j+q*2)=empty then
              z$(ztel)=str$(i);" ";j;" ";i-q*2;" ";j-q*2;" hit"
              ztel = ztel + 1
            end if
          end if
        end if
        if ztel = 0 then
          if p(i+q,j+q)=empty then
            z$(ztel)=str$(i);" ";j;" ";i+q;" ";j+q
            ztel = ztel + 1
          end if
          if p(i-q,j+q)=empty then
            z$(ztel)=str$(i);" ";j;" ";i-q;" ";j+q
            ztel = ztel + 1
          end if
        end if
      end if
    next j
  next i
  if ztel = 0 then
    ai$ = "no moves"
  else
    ai$ = z$(int(rnd(0)*ztel))
  end if
end function
sub newgame
  restore
  for j = 0 to 13
    read q$
    for i = 1 to len( q$ )
      p(i-1,j) = val( mid$( q$ , i , 1 ) )
    next i
  next j
  data "88888888888888"
  data "88888888888888"
  data "88282828282888"
  data "88828282828288"
  data "88282828282888"
  data "88828282828288"
  data "88080808080888"
  data "88808080808088"
  data "88181818181888"
  data "88818181818188"
  data "88181818181888"
  data "88818181818188"
  data "88888888888888"
  data "88888888888888"
end sub
sub rond x , y , r , kl1$ , kl2$
  #m "goto ";x;" ";y
  #m "color ";kl2$
  #m "backcolor ";kl1$
  #m "down"
  #m "circlefilled ";r
  #m "up"
end sub
sub drawbord
  for i = 2 to 11
    for j = 2 to 11
      if (i+j)and 1 then
        #m "color red"
        #m "backcolor red"
      else
        #m "color darkred"
        #m "backcolor darkred"
      end if
      #m "goto ";i*60;" ";j*60
      #m "down"
      #m "boxfilled ";i*60+60;" ";j*60+60
      #m "up"
      select case p(i,j)
        case white
          call rond i * 60 + 30 , j * 60 + 30 , 20 , "white","black"
        case white or dan
          call rond i * 60 + 30 , j * 60 + 30 , 27 , "white","black"
        case black
          call rond i * 60 + 30 , j * 60 + 30 , 20 , "black","white"
        case black or dan
          call rond i * 60 + 30 , j * 60 + 30 , 27 , "black","white"
        case else
      end select
    next j
  next i
end sub
 
User IP Logged

basic's : C64 Simons C128 Amiga Amos quick4.5 Visual5 Visual6 Visual2005 Visual2008 just and last but not least liberty
Pages: 1  Notify Send Topic Print
« Previous Topic | Next Topic »

Rules|Home|Help|Search|Recent Posts|Notification

Donate $6.99 for 50,000 Ad-Free Pageviews!

| |

This forum powered for FREE by Conforums ©
Sign up for your own Free Message Board today!
Terms of Service | Privacy Policy | Conforums Support | Parental Controls