Rem Project: connect four
Rem Created: 1/26/2005 3:48:41 PM
Rem authored by Coding Fodder
Rem ***** Main Source File *****
sync on:sync rate 0
set window title "Connect Four by Daniel Wigton"
dim board(7,5,2)
dim column_importance(7)
dim move_list(18,2)
dim player_name$(2)
global Player_turn
global unit#
global downhold
global difficulty
dim rec_risk(10)
 
setup_board()
sync
ink rgb(255,255,255),rgb(0,0,255)
set cursor 1,1
input "Player 1 Name ",player1$
player_name$(1)=player1$
Print "Select player 2 type"
Print "(1) Human:"
Print "(2) computer:"
Print "(3) Net Player:"
sync
repeat
select inkey$()
   case "1":player_type=1:out=1:endcase
   case "2":player_type=2:player_name$(2)="AI Bob":out=1:endcase
   case "3":player_type=3:out=1:endcase
endselect
until out=1
Rem currently only difficulties 0-2 are supported. use 0 only if you want to play a mindless monkey
difficulty=2
 
DO
   setup_board()
   player_turn=1
   ink rgb(255,255,255),rgb(0,0,255)
   sync
   gosub main
LOOP
 
MAIN:
   turns_taken=0
DO
   inc turns_taken
   if turns_taken>35
      print "Its a tie"
      input "Would you like to play agian? y/n ",ans$
      if ans$="y" or ans$="Y" then return
      sync
      end
      return
   endif
 
   box 0,0,100,screen height(),rgb(0,0,255),rgb(0,0,255),rgb(0,0,255),rgb(0,0,255)
   set cursor 1,1
   print player_name$(player_turn)
   if player_turn=1
      Human_select(1):  REM you may set either player to Human or AI by changing the function call
   else
      AI_select(2)
   endif
   swap_players()
 
   if check_for_winner(1)>0
      Print player_name$(check_for_winner(1))+" Wins"
      input "Would you like to play agian? y/n ",ans$
      if ans$="y" or ans$="Y" then return
      sync
      end
   endif
 
   sync
LOOP
RETURN
 
function AI_select(player)
   lowest_risk=30
   for i=1 to 7
      for j= 1 to 5
         board(i,j,2)=board(i,j,1)
      next j
   next i
   for i=1 to 7
      r_num=1
      prediction(player,i,r_num)
      column_importance(i)=rec_risk(1)
      if column_importance(i)<lowest_risk then lowest_risk=column_importance(i)
      `if column_importance(i)=18
      `   add_chip(player,i)
      `   prediction(player,i,r_num)
      `   plan=rec_risk(1)
      `   if plan=2 then column_importance=17
      `   remove_chip()
      `endif
   next i
 
   randomize timer()
   selection_num=rnd(6)
   counter1=selection_num
   repeat
      inc counter1
      if counter1>7 then counter1=1
      if column_importance(counter1)<=lowest_risk then this=make_play(player,counter1)
   until this=1
 
endfunction
 
REM Prediction is a semi-recursive function. treat with care.
function prediction(player,col,r_num)
   write_risk(r_num,18)                :rem Write_risk and Read_risk are needed because DB does not really support recursion
 
   if r_num>difficulty then exitfunction
 
   if full(col)=1
      write_risk(r_num,31)
      exitfunction
   endif
 
      add_chip(player,col)
      outcome=check_for_winner(2)
      if outcome=player
         write_risk(r_num,1)
         remove_chip()
         exitfunction
      endif
      NoNo=0
      for j=1 to 7
         if full(j)=0
            add_chip(other_player(player),j)
            outcome=check_for_winner(2)
            if outcome=other_player(player)
               write_risk(r_num,28)
               NoNo=1
            else
               if NoNo=0 and r_num<difficulty
                  winning=0
                  losing=0
                  for g=1 to 7
                     prediction(player,g,r_num+1)
                     result=read_risk(r_num+1)
                     if result=1 then inc winning
                     if result>27 then inc losing
                  next g
                  if losing>6 then write_risk(r_num,28-r_num)
                  if winning>r_num then write_risk(r_num,r_num+1)
               endif
            endif
            remove_chip()
         endif
      next j
      remove_chip()
endfunction
 
function write_risk(r_num,value)
   rec_risk(r_num)=value
endfunction
 
function read_risk(r_num)
   out=rec_risk(r_num)
endfunction out
 
function full(column)
   out=0
   if board(column,5,2)>0 then out=1
endfunction out
 
function other_player(player)
   if player=1
      player_other=2
   else
      player_other=1
   endif
endfunction player_other
 
function add_chip(player,column)
   if column>0 and column<8
   for i=1 to 5
      if board(column,i,2)=0
         board(column,i,2)=player
         for j=18 to 2 step -1
            move_list(j,1)=move_list(j-1,1)
            move_list(j,2)=move_list(j-1,2)
         next j
         move_list(1,1)=column
         move_list(1,2)=i
         exitfunction
      endif
   next i
   endif
endfunction
 
function remove_chip()
   board(move_list(1,1),move_list(1,2),2)=0
   for j=1 to 17
      move_list(j,1)=move_list(j+1,1)
      move_list(j,2)=move_list(j+1,2)
   next j
   move_list(18,1)=0
   move_list(18,2)=0
endfunction
 
function check_for_winner(bd)
   for i=1 to 7
      for j=1 to 5
         if board(i,j,bd)>0
            if check_across(board(i,j,bd),i,j,bd)=1 then win=board(i,j,bd)
            if check_down(board(i,j,bd),i,j,bd)=1 then win=board(i,j,bd)
            if check_diagonal_down(board(i,j,bd),i,j,bd)=1 then win=board(i,j,bd)
            if check_diagonal_up(board(i,j,bd),i,j,bd)=1 then win=board(i,j,bd)
         endif
      next j
   next i
endfunction win
 
function check_diagonal_down(player,x,y,bd)
   yup=1
   howmany=1
   for i=x-1 to 1 step -1
      j=y+(x-i)
      if i>0 and j<6
         if board(i,j,bd)=player and yup=1
            inc howmany
         else
            yup=0
         endif
      endif
   next i
 
   yup=1
   for i=x+1 to 7
      j=y+(x-i)
      if i<8 and j>0
         if board(i,j,bd)=player and yup=1
            inc howmany
         else
            yup=0
         endif
      endif
   next i
   if howmany>3 then output=1
endfunction output
 
function check_diagonal_up(player,x,y,bd)
   yup=1
   howmany=1
   for i=x-1 to 1 step -1
      j=y+(i-x)
      if i>0 and j>0
         if board(i,j,bd)=player and yup=1
            inc howmany
         else
            yup=0
         endif
      endif
   next i
 
   yup=1
   for i=x+1 to 7
      j=y+(i-x)
      if i<8 and j<6
         if board(i,j,bd)=player and yup=1
            inc howmany
         else
            yup=0
         endif
      endif
   next i
   if howmany>3 then output=1
endfunction output
 
function check_down(player,x,y,bd)
   yup=1
   howmany=1
   for i=y-1 to 1 step -1
      if i>0
         if board(x,i,bd)=player and yup=1
            inc howmany
         else
            yup=0
         endif
      endif
   next i
 
   yup=1
   for i=y+1 to 5
      if i<6
         if board(x,i,bd)=player and yup=1
            inc howmany
         else
            yup=0
         endif
      endif
   next i
   if howmany>3 then output=1
endfunction output
 
function check_across(player,x,y,bd)
   yup=1
   howmany=1
   for i=x-1 to 1 step -1
      if i>0
         if board(i,y,bd)=player and yup=1
            inc howmany
         else
            yup=0
         endif
      endif
   next i
 
   yup=1
   for i=x+1 to 7
      if i<8
         if board(i,y,bd)=player and yup=1
            inc howmany
         else
            yup=0
         endif
      endif
   next i
   if howmany>3 then output=1
endfunction output
 
function human_select(player)
   curcolumn=1
   repeat
      if leftkey()=1
         lefthold=1
      else
         if lefthold=1
            if curcolumn>1 then dec curcolumn
            lefthold=0
         endif
      endif
 
      if rightkey()=1
         righthold=1
      else
         if righthold=1
            if curcolumn<7 then inc curcolumn
            righthold=0
         endif
      endif
 
      box unit#*2,screen height()-unit#*7,screen width()-unit#*2,screen height()-unit#*6,rgb(0,0,255),rgb(0,0,255),rgb(0,0,255),rgb(0,0,255)
      solid_circle(unit#*(curcolumn+2),screen height()-unit#*6.5,unit#*0.4,rgb(255*(player-2)*(-1),0,0))
      ready=0
 
      if downkey()=1
         downhold=1
      else
         if downhold=1
            column=curcolumn
            if make_play(player_turn,column)=1 then ready=1
            downhold=0
         endif
      endif
 
      sync
   until ready=1
endfunction
 
function swap_players()
   if player_turn=1
      player_turn=2
   else
      player_turn=1
   endif
endfunction
 
function make_play(player,column)
   if column>0 and column<8
   for i=1 to 5
      if board(column,i,1)=0
         board(column,i,1)=player
         solid_circle(unit#*(column+2),unit#*(6-i)+screen height()-unit#*6,unit#*0.4,rgb(255*(player-2)*(-1),0,0))
         exitfunction 1
      endif
   next i
   endif
endfunction 0
 
function setup_board()
   for bdnum=1 to 2
      for i=1 to 7
         for j=1 to 5
            board(i,j,bdnum)=0
         next j
      next i
   next bdnum
   cls
   box 0,0,screen width(),screen height(),rgb(0,0,255),rgb(0,0,255),rgb(0,0,255),rgb(0,0,255)
   unit#=screen width()/12.0
   box unit#*2,screen height()-unit#*6,screen width()-unit#*2,screen height(),rgb(255,255,0),rgb(255,255,0),rgb(255,255,0),rgb(255,255,0)
   for i=1 to 7
      for j=1 to 5
         solid_circle(unit#*(i+2),unit#*j+screen height()-unit#*6,unit#*0.4,rgb(0,0,255))
      next j
   next i
endfunction
 
function solid_circle(x,y,radius,color)
lock pixels
ptr=get pixels pointer()
this=get pixels pitch()
that =bitmap depth()/8
for i=1 to radius*2
   for j=1 to radius*2
      pointer=ptr+((y+j-radius)*this)+(x-radius+i)*that
      if (radius-i)^2+(radius-j)^2<=radius^2 then *pointer=color
   next j
next i
unlock pixels
endfunction