Puissance 4 en 2D

hide 0
variables()
constantes()
labels()
init()
interface()
show 0
off_mouse_down Scene%
Aide()
end

' ==============================================================================
' DECLARATION DES VARIABLES
' ==============================================================================

sub variables()
  dim no%
  dim EtatPion%(42):' soit 0 soit Caz%
  dim ColorPion$(42): ' de 1 à 24 => R , de 25 à 42 => J
  dim Nbcaz% : Nbcaz%=42
  dim EtatCase%(Nbcaz%):' soit EtatPion%(?) soit 0 (vide)
  dim Pos_X%(Nbcaz%),Pos_Y%(Nbcaz%),Col%(Nbcaz%),Lig%(Nbcaz%)
  dim a$,n%,nsp%,Caz%,ncz%,Pion%,x%,y%,cl%,tour%,niveau%
  dim fin%
  dim xmenu%,ymenu%,etatbtn%(6),activebtn%,p1%,p2%,i%
  dim player$,FirstGame%
  dim NbGridLine%
end_sub

' ==============================================================================
' DECLARATION DES CONSTANTES
' ==============================================================================

sub constantes()
  dim_local i%
 
'  dossier racine
  dim path$ : path$=dir_current$
  if right$(path$,1)="\" : path$=left$(path$,len(path$)-1) : end_if
  path$ = path$+"\"
 
'  dossier temporaire
  dim Temp$ : Temp$="C:\Temp\Puissance4_temp\"
 
'  fichiers
  dim Listplayer$ : Listplayer$=path$+"Players.ini"
  dim ScoreFile$  : ScoreFile$=path$+"Scores.inf"
  dim Zip$        : Zip$=path$+"Images.zip"
 
'  fichiers images
  dim imgbtn_over$(6)
  for i%=1 to 6 : imgbtn_over$(i%)=Temp$+"BtnPict_"+str$(i%)+"2.bmp"  : next i%
  dim imgbtn_click$(6)
  for i%=1 to 6 : imgbtn_click$(i%)=Temp$+"BtnPict_"+str$(i%)+"3.bmp"  : next i%
  dim imgbtn_inactive$(6)
  for i%=1 to 6 : imgbtn_inactive$(i%)=Temp$+"BtnPict_"+str$(i%)+"4.bmp" : next i%
 
'  nom du jeu
  dim titre$  : titre$="Puissance 4 "
  application_title titre$

'  objets
'  form 0
  dim Dlist1%  : no%=no%+1 : Dlist1%=no%
  dim Dlist2%  : no%=no%+1 : Dlist2%=no%
  dim panmenu% : no%=no%+1 : panmenu%=no%
  dim pictmenu%: no%=no%+1 : pictmenu%=no%
  dim btn1%(6) : for i%=1 to 6 : no%=no%+1 : btn1%(i%)=no% : next i%
  dim btn2%(6) : for i%=1 to 6 : no%=no%+1 : btn2%(i%)=no% : next i%
  dim alphmess%: no%=no%+1 : alphmess%=no%
  dim panscene%: no%=no%+1 : panscene%=no%
  dim Scene%  : no%=no%+1 : Scene%=no%
'  form choix du niveau
  dim fniv%    : no%=no%+1 : fniv%=no%
  dim panniv%  : no%=no%+1 : panniv%=no%
  dim nivplus% : no%=no%+1 : nivplus%=no%
  dim nivmoins%: no%=no%+1 : nivmoins%=no%
  dim nivpict% : no%=no%+1 : nivpict%=no%
  dim alphniv1%: no%=no%+1 : alphniv1%=no%
  dim alphniv2%: no%=no%+1 : alphniv2%=no%
  dim nivok%  : no%=no%+1 : nivok%=no%
'  form visualisation des scores
  dim fscore%    : no%=no%+1 : fscore%=no%
  dim panscore%  : no%=no%+1 : panscore%=no%
  dim TableScore% : no%=no%+1 : TableScore%=no%
'  form visualisation de l' aide
  dim fhelp%    : no%=no%+1 : fhelp%=no%
  dim panhelp%  : no%=no%+1 : panhelp%=no%
  dim alphhelp% : no%=no%+1 : alphhelp%=no%
  dim alphhelp2%: no%=no%+1 : alphhelp2%=no%
  dim helpok%  : no%=no%+1 : helpok%=no%
'  form visualisation du message Gagné/Perdu
  dim fmessage%    : no%=no%+1 : fmessage%  =no%
  dim panmessage%  : no%=no%+1 : panmessage% =no%
  dim pictmessage% : no%=no%+1 : pictmessage%=no%
  dim alphmessage% : no%=no%+1 : alphmessage%=no%
  dim messageok%  : no%=no%+1 : messageok%  =no%
'  form selection/enregistrement d' un joueur
  dim fselplayer%    : no%=no%+1 : fselplayer%    =no%
  dim panplayer%    : no%=no%+1 : panplayer%    =no%
  dim alphplayer%    : no%=no%+1 : alphplayer%    =no%
  dim combplayer%    : no%=no%+1 : combplayer%    =no%
  dim btnsaveplayer% : no%=no%+1 : btnsaveplayer% =no%
  dim btnvalplayer%  : no%=no%+1 : btnvalplayer%  =no%
'  boites de dialogue
  dim Sdial%    : no%=no%+1 : Sdial%=no%
end_sub

' ==============================================================================
' DECLARARTION DES LABELS
' ==============================================================================

sub labels()
  label clic
  label clicscene
  label change
  label SelectButton
  label ShowImgClic
  label Close0
end_sub

' ==============================================================================
' INITIALISATIONS
' ==============================================================================

sub init()
  if dir_exists("C:\Temp")=0 then dir_make "C:\Temp"
  if dir_exists(Temp$)=0 then dir_make Temp$
  if file_exists(Temp$+"BtnPict_12.bmp")=0
      Archiver_on
      Archiver_extract Zip$,Temp$
      Archiver_off
  end_if
end_sub

' ------------------------------------------------------------------------------

sub InitCazs()
  dim_local c%,l%,lx%,ly%,cz%
  lx%=-101:ly%=-100
  for l%=1 to 6
      ly%=ly%+100
      for c%=1 to 7
        cz%=cz%+1 : lx%=lx%+100
        EtatCase%(cz%)=0 : Pos_X%(cz%)=lx% : Pos_Y%(cz%)=ly% : Col%(cz%)=c% : Lig%(cz%)=l%
      next c%
      lx%=-101
  next l%
end_sub

' ==============================================================================
' INTERFACE
' ==============================================================================

sub interface()
  dim_local i%,l%,h$

  height 0,710
  width 0,750
  top 0,(screen_y-height(0))/2
  left 0,(screen_x-width(0))/2
  color 0,248,223,188
  caption 0,"Puissance 4"
  on_close 0,Close0
 
  panel panmenu%
  height panmenu%,38
  width panmenu%,width_client(0)-10
  top panmenu%,5
  left panmenu%,5
  color panmenu%,240,205,152

  picture pictmenu%
  parent pictmenu%,panmenu%
  height pictmenu%,36
  width pictmenu%,196
  top pictmenu%,1
  left pictmenu%,1
  file_load pictmenu%,Temp$+"fdmenu.bmp"
  on_mouse_move pictmenu%,SelectButton

  create_hide
 
  l%=2
  h$="Joueur,Nouvelle partie,Capture du plateau,Scores,Aide,Quitter,"
  for i%=1 to 6
      picture btn1%(i%)
      parent btn1%(i%),panmenu%
      height btn1%(i%),32
      width btn1%(i%),32
      top btn1%(i%),top(pictmenu%)+2
      left btn1%(i%),l%
      file_load btn1%(i%),imgbtn_Over$(i%)
      cursor_point btn1%(i%)
      on_mouse_down btn1%(i%),ShowImgClic
      on_click btn1%(i%),Clic
      hint btn1%(i%),left$(h$,instr(h$,",")-1)
      if i%<6 : h$=right$(h$,len(h$)-instr(h$,",")) : end_if
 
      picture btn2%(i%)
      parent btn2%(i%),panmenu%
      height btn2%(i%),32
      width btn2%(i%),32
      top btn2%(i%),top(pictmenu%)+2
      left btn2%(i%),l%
      file_load btn2%(i%),imgbtn_inactive$(i%)
     
      l%=l%+32
  next i%
 
  create_show
 
  alpha alphmess%
  parent alphmess%,panmenu%
  font_name alphmess%,"Times"
  font_size alphmess%,12
  font_color alphmess%,0,0,200
  font_bold alphmess%
  top alphmess%,int((height(panmenu%)-height(alphmess%))/2)
  left alphmess%,width(panmenu%)-width(alphmess%)-10

  panel panscene%
  height panscene%,height_client(0)-height(panmenu%)-15
  width panscene%,width_client(0)-10
  top panscene%,top(panmenu%)+height(panmenu%)+5
  left panscene%,5
  color panscene%,240,205,152

  scene2d scene%
  parent scene%,panscene%
  height scene%,600
  width scene%,700
  top scene%,int((height(panscene%)-height(scene%))/2)
  left scene%,int((width(panscene%)-width(scene%))/2)
  file_load scene%,Temp$+"fond.bmp"
  cursor_point scene%

  InitCazs()
  InitPions()
 
  dlist dlist1%
  dlist dlist2%
  if file_exists(ScoreFile$)=1 : file_load dlist2%,ScoreFile$ : end_if
end_sub

' ------------------------------------------------------------------------------

sub Choixniv()
  if object_exists(fniv%)=1
      show fniv%
  else
      form Fniv%
      border_hide fniv%
      height Fniv%,95
      width Fniv%,300
      top Fniv%,(screen_y-height(Fniv%))/2
      left Fniv%,(screen_x-width(Fniv%))/2
      caption Fniv%,"Niveau du jeu"
     
      panel panniv%
      parent panniv%,fniv%
      full_space panniv%
      color panniv%,240,205,152
     
      alpha alphniv1%
      parent alphniv1%,panniv%
      caption alphniv1%,"Niveau de jeu"
      font_name alphniv1%,"Times"
      font_size alphniv1%,10
      font_color alphniv1%,0,0,200
      font_bold alphniv1%
      top alphniv1%,5
      left alphniv1%,int((width(panniv%)-width(alphniv1%))/2)

      button nivplus%
      parent nivplus%,panniv%
      font_name nivplus%,"Webdings"
      caption nivplus%,"5"
      font_size nivplus%,10
      width nivplus%,22
      height nivplus%,22
      top nivplus%,25
      left nivplus%,10
      cursor_point nivplus%
      on_click nivplus%,clic
     
      button nivmoins%
      parent nivmoins%,panniv%
      font_name nivmoins%,"Webdings"
      caption nivmoins%,"6"
      font_size nivmoins%,10
      width nivmoins%,22
      height nivmoins%,22
      top nivmoins%,25
      left nivmoins%,left(nivplus%)+width(nivplus%)+5
      cursor_point nivmoins%
      on_click nivmoins%,clic

      alpha alphniv2%
      parent alphniv2%,panniv%
      font_name alphniv2%,"Times"
      font_size alphniv2%,14
      font_color alphniv2%,155,0,0
      top alphniv2%,27
      left alphniv2%,left(nivmoins%)+width(nivmoins%)+5
     
      picture nivpict%
      parent nivpict%,panniv%
      height nivpict%,50
      width nivpict%,50
      top nivpict%,top(alphniv2%)+height(alphniv2%)
      left nivpict%,int((width(panniv%)-width(nivpict%))/2)
     
      button nivok%
      parent nivok%,panniv%
      height nivok%,22
      width nivok%,22
      top nivok%,height(panniv%)-27
      left nivok%,width(panniv%)-27
      font_name nivok%,"wingdings"
      font_size nivok%,8
      caption nivok%,chr$(232)
      cursor_point nivok%
      on_click nivok%,clic
      hint nivok%,"Commencer la partie"
  end_if
 
  niveau%=3
  caption alphniv2%,"Difficile"
  file_load nivpict%,Temp$+"PictNiv_3.bmp"
end_sub

' ------------------------------------------------------------------------------

sub Score()
  dim_local i%,Ett$,E$,x%,it$,
  Ett$="Joueur,Parties,Gagnées,Nulles,Perdues,% Victoires,% Nulles,% Perdues,"
 
  if object_exists(fscore%)=1
      show fscore%
      grid_clear TableScore%,NbGridLine%,8
      for i%=1 to 8
        E$=left$(Ett$,instr(Ett$,",")-1)
        if i%<8
            Ett$=right$(Ett$,len(Ett$)-instr(Ett$,","))
        end_if
        grid_write TableScore%,1,i%,E$
      next i%
  else
      form fscore%
      height fscore%,350
      width fscore%,630
      top fscore%,(screen_y-height(fscore%))/2
      left fscore%,(screen_x-width(fscore%))/2
      caption fscore%,"Scores"
     
      panel panscore%
      parent panscore%,fscore%
      full_space panscore%
      color panscore%,240,205,152
     
      grid TableScore%
      parent TableScore%,panscore%
      height TableScore%,height(panscore%)-10
      width TableScore%,width(panscore%)-10
      top TableScore%,5
      left TableScore%,5
      font_name TableScore%,"Arial"
      color TableScore%,248,223,166
     
      grid_column TableScore%,8
      grid_column_fixed TableScore%,0
      grid_column_width TableScore%,60
      grid_one_column_width TableScore%,1,150

      grid_row TableScore%,2
      grid_row_fixed TableScore%,1
      NbGridLine%=2

      for i%=1 to 8
        E$=left$(Ett$,instr(Ett$,",")-1)
        if i%<8
            Ett$=right$(Ett$,len(Ett$)-instr(Ett$,","))
        end_if
        grid_write TableScore%,1,i%,E$
      next i%
  end_if
 
  if count(dlist2%)>0
      grid_row TableScore%,count(dlist2%)+1
      NbGridLine%=count(dlist2%)+1

      for i%=1 to count(dlist2%)
        it$=item_read$(dlist2%,i%)
        for x%=1 to 8
            E$=left$(it$,instr(it$,",")-1)
            grid_write TableScore%,i%+1,x%,E$
            if i%<8
              it$=right$(it$,len(it$)-instr(it$,","))
            end_if
        next x%
      next i%
  end_if
end_sub

' ------------------------------------------------------------------------------

sub Aide()
  dim_local a$

  if object_exists(fhelp%)=1
      show fhelp%
  else
      form fhelp%
      border_hide fhelp%
      height fhelp%,250
      width fhelp%,630
      top fhelp%,(screen_y-height(fhelp%))/2
      left fhelp%,(screen_x-width(fhelp%))/2

      panel panhelp%
      parent panhelp%,fhelp%
      full_space panhelp%
      color panhelp%,240,205,152
     
      a$="Règles du jeu PUISSANCE 4"+chr$(13)+chr$(13)

      alpha alphhelp%
      parent alphhelp%,panhelp%
      caption alphhelp%,a$
      font_name alphhelp%,"Times"
      font_size alphhelp%,12
      font_color alphhelp%,0,0,200
      font_bold alphhelp%
      font_underline alphhelp%
      top alphhelp%,10
      left alphhelp%,int((width(panhelp%)-width(alphhelp%))/2)

      a$="Votre couleur de pion est jaune, les rouges sont pilotés par l'ordinateur."+chr$(13)
      a$=a$+"Le but du jeu est d'aligner 4 pions en horizontal, vertical ou diagonal."+chr$(13)
      a$=a$+"Vous disposez de 3 niveaux de jeu : "+chr$(13)
      a$=a$+"    1 => Facile  *  2 => Moyen  *  3 => difficile * 4 => Super Difficile . (3 => par défaut)"+chr$(13)
      a$=a$+"Plus le niveau est élevé, moins il y a de possibilités que l'ordinateur se trompe."+chr$(13)+chr$(13)
      a$=a$+"Pour jouer: cliquez dans une colonne après que le pion rouge soit en place."+chr$(13)

      alpha alphhelp2%
      parent alphhelp2%,panhelp%
      caption alphhelp2%,a$
      font_name alphhelp2%,"Times"
      font_size alphhelp2%,12
      font_color alphhelp2%,155,0,0
      font_bold alphhelp2%
      top alphhelp2%,top(alphhelp%)+height(alphhelp%)
      left alphhelp2%,10
     
      button helpok%
      parent helpok%,panhelp%
      width helpok%,120
      caption helpok%,"Fermer"
      font_name helpok%,"Times"
      font_size helpok%,10
      font_bold helpok%
      top helpok%,height(panhelp%)-height(helpok%)-5
      left helpok%,int((width(panhelp%)-width(helpok%))/2)
      cursor_point helpok%
      on_click helpok%,clic
  end_if
end_sub

' ------------------------------------------------------------------------------

sub FormMessage(typ%)
  dim_local img$,a$
 
  if object_exists(fmessage%)=1
      show fmessage%
  else
      form fmessage%
      border_hide fmessage%
      height fmessage%,110
      width fmessage%,400
      top fmessage%,(screen_y-height(fmessage%))/2
      left fmessage%,(screen_x-width(fmessage%))/2
     
      panel panmessage%
      parent panmessage%,fmessage%
      full_space panmessage%
      color panmessage%,240,205,152
     
      picture pictmessage%
      parent pictmessage%,panmessage%
      height pictmessage%,100
      width pictmessage%,100
      top pictmessage%,10
      left pictmessage%,10
     
      alpha alphmessage%
      parent alphmessage%,panmessage%
      font_name alphmessage%,"Times"
      font_size alphmessage%,12
      font_color alphmessage%,155,0,0
      font_bold alphmessage%
     
      button messageok%
      parent messageok%,panmessage%
      font_name messageok%,"Times"
      font_size messageok%,10
      font_bold messageok%
      caption messageok%,"Ok"
      top messageok%,height(panmessage%)-height(messageok%)-5
      left messageok%,int((width(panmessage%)-width(messageok%))/2)
      on_click messageok%,clic
      cursor_point messageok%
  end_if
 
  if typ%=1
      a$="Bravo ! Vous avez gagné cette partie"
      img$=Temp$+"Gagne.bmp"
  end_if
  if typ%=2
      a$="Dommage ! Vous avez perdu cette partie"
      img$=Temp$+"Perdu.bmp"
  end_if
  if typ%=3
      a$="Match nul !"
      img$=Temp$+"MatchNul.bmp"
  end_if
  caption alphmessage%,a$
  top alphmessage%,int((height(panmessage%)-height(alphmessage%))/2)
  left alphmessage%,left(pictmessage%)+width(pictmessage%)+5
  file_load pictmessage%,img$
end_sub

' ------------------------------------------------------------------------------

sub FormSelPlayer()
  if object_exists(fselplayer%)=1
      show fselplayer%
  else
      form fselplayer%
      border_hide fselplayer%
      height fselplayer%,85
      width fselplayer%,350
      top fselplayer%,(screen_y-height(fselplayer%))/2
      left fselplayer%,(screen_x-width(fselplayer%))/2
     
      font_name fselplayer%,"Times"
      font_size fselplayer%,10
      font_bold fselplayer%
     
      panel panplayer%
      parent panplayer%,fselplayer%
      full_space panplayer%
      color panplayer%,240,205,152
     
      alpha alphplayer%
      parent alphplayer%,panplayer%
      caption alphplayer%,"Sélection du joueur"
      font_color alphplayer%,0,0,200
      top alphplayer%,5
      left alphplayer%,int((width(panplayer%)-width(alphplayer%))/2)
     
      combo combplayer%
      parent combplayer%,panplayer%
      font_color combplayer%,155,0,0
      width combplayer%,width(panplayer%)-37
      top combplayer%,top(alphplayer%)+height(alphplayer%)+5
      left combplayer%,5

      if file_exists(Listplayer$)=1
        file_load combplayer%,Listplayer$
        font_color combplayer%,155,0,0
      else
        text combplayer%,"== Entrez vôtre nom de joueur et enregistrez le =>"
        font_color combplayer%,150,150,150
      end_if
      cursor_point combplayer%
      on_change combplayer%,change
     
      button btnsaveplayer%
      parent btnsaveplayer%,panplayer%
      font_name btnsaveplayer%,"Wingdings"
      font_size btnsaveplayer%,12
      height btnsaveplayer%,22
      width btnsaveplayer%,22
      top btnsaveplayer%,top(combplayer%)
      left btnsaveplayer%,left(combplayer%)+width(combplayer%)+5
      caption btnsaveplayer%,"<"
      cursor_point btnsaveplayer%
      on_click btnsaveplayer%,clic
     
      button btnvalplayer%
      parent btnvalplayer%,panplayer%
      caption btnvalplayer%,"valider"
      top btnvalplayer%,top(combplayer%)+height(combplayer%)+5
      left btnvalplayer%,int((width(panplayer%)-width(btnvalplayer%))/2)
      cursor_point btnvalplayer%
      on_click btnvalplayer%,clic
     
  end_if
end_sub

' ==============================================================================
' MENUS
' ==============================================================================

clic:
  if number_click = btn1%(1)
      file_load btn1%(1),imgbtn_Over$(1)
      on_mouse_down btn1%(1),ShowImgClic
      FormSelPlayer()
      return
  end_if

  if number_click = btn1%(2)
      file_load btn1%(2),imgbtn_Over$(2)
      on_mouse_down btn1%(2),ShowImgClic
      if Player$=""
        caption alphmess%,"Vous devez sélectionner un joueur !"
        trigger_click btn1%(1)
        caption alphmess%,""
        return
      end_if
      if FirstGame%=0
        FirstGame%=1
        InitGrille()
        Choixniv()
      else
        ReInitPions()
        clear dlist1%
        fin%=0
        tour%=0
        InitCazs()
        InitPions()
        off_mouse_down Scene%
        InitGrille()
        Choixniv()
      end_if
      return
  end_if

  if number_click = btn1%(3)
      file_load btn1%(3),imgbtn_Over$(3)
      on_mouse_down btn1%(3),ShowImgClic
      CapturePlateau()
      return
  end_if

  if number_click = btn1%(4)
      file_load btn1%(4),imgbtn_Over$(4)
      on_mouse_down btn1%(4),ShowImgClic
      Score()
      return
  end_if

  if number_click = btn1%(5)
      file_load btn1%(5),imgbtn_Over$(5)
      on_mouse_down btn1%(5),ShowImgClic
      Aide()
      return
  end_if
 
  if number_click = btn1%(6)
      file_load btn1%(6),imgbtn_Over$(6)
      on_mouse_down btn1%(6),ShowImgClic
      gosub Close0
      Quitter()
      return
  end_if

  if object_exists(fhelp%)=1
      if number_click = helpok%
        hide fhelp%
        return
      end_if
  end_if

  if object_exists(fniv%)=1
      if number_click = nivplus%
        if niveau%<5
            niveau%=niveau%+1
            AffichNiv(niveau%)
        end_if
        return
      end_if
 
      if number_click = nivmoins%
        if niveau%>1
            niveau%=niveau%-1
            AffichNiv(niveau%)
        end_if
        return
      end_if
     
      if number_click = nivok%
        if niveau%=0 : niveau%=3 : end_if
        hide fniv%
        caption 0,titre$+" { niveau : "+str$(niveau%)+" }"
        DownPionInCase(1,39)
        TourJaune()
        return
      end_if
  end_if
 
  if object_exists(fmessage%)=1
      if number_click = messageok%
        hide fmessage%
        return
      end_if
  end_if
 
  if object_exists(fselplayer%)=1
      if number_click = btnsaveplayer%
        if text$(combplayer%)<>""
            AddNameToPlayerList(text$(combplayer%))
        end_if
        return
      end_if
     
      if number_click = btnvalplayer%
        if text$(combplayer%)<>""
            Player$ = text$(combplayer%)
            caption alphmess%,"Joueur : "+player$
            left alphmess%,width(panmenu%)-width(alphmess%)-10
        end_if
        hide fselplayer%
        return
      end_if
  end_if
return

' ------------------------------------------------------------------------------

ClicScene:
    x%=mouse_x_position(scene%) : y%=mouse_y_position(scene%)
    RetourneColonne(x%,y%):' cl%
    if cl%=0 then message "Vous devez cliquez dans une colonne" : return
    OFF_MOUSE_DOWN scene%
    SearchFirstOpenCase(cl%):' Caz%
    ' faire une vérif reste caz
    if Caz%=0 then message "Vous avez cliqué dans une colonne Pleine ! recommencez !" : TourJaune() : return
    SearhFirstOpenPion("J"):' Pion% de la couleur
    ' message "Pion="+str$(Pion%)+" EtatPion%="+str$(EtatPion%(Pion%))
    if Pion%=0 then message "Pion%=0" : stop : terminate
    DownPionInCase(pion%,Caz%):' mise à jour Etat de la case et Etat du pion
    if tour%>6
      ControleVictoires("J")
    end_if
    caz%=0 : TourRouge()
return

' ------------------------------------------------------------------------------

Close0:
  dir_change Temp$
  a$=file_find_first$
  if instr(a$,".")>2 : file_delete a$ : end_if
  a$=file_find_next$
  while a$<>"_"
      if instr(a$,".")>2 : file_delete a$ : end_if
      a$=file_find_next$
  end_while
  dir_change path$
  dir_remove Temp$
return

' ------------------------------------------------------------------------------

change:
  if object_exists(fselplayer%)=1
      if number_change = combplayer%
        font_color combplayer%,155,0,0
        return
      end_if
  end_if
return

' ------------------------------------------------------------------------------

SelectButton:
  off_mouse_move pictmenu%
  xmenu% = mouse_x_position(pictmenu%)
  ymenu% = mouse_y_position(pictmenu%)
  for x%=1 to 6 : hide Btn1%(x%) : next x%
  p1%=2
  p2%=33
  for i%=1 to 6
      if Xmenu%>p1% and Xmenu%<p2%
        if ymenu%>2 and ymenu%<34
            activebtn%=i%
            show btn1%(i%)
            exit_for
        else
            for x%=1 to 6 : hide Btn1%(x%) : next x%
        end_if
      end_if
      p1%=p2%-1
      p2%=p2%+32
  next i%
  on_mouse_move pictmenu%,SelectButton
return

' ------------------------------------------------------------------------------

ShowImgClic:
  off_mouse_down btn1%(activebtn%)
  file_load btn1%(activebtn%),imgbtn_click$(activebtn%)
return

' ==============================================================================
' PROCEDURES
' ==============================================================================

sub AffichNiv(p%)
  dim_local t$,n%,img$
  select p%
  case 1 : t$="Facile"
  case 2 : t$="Moyen"
  case 3 : t$="Difficile"
  case 4 : t$="Diabolique"
  case 5
      t$="Aléatoire"
      n%=0: while n%=0 or n%>5 : n%=rnd(6) : end_while
      niveau%=int(n%)
  end_select
  img$=Temp$+"PictNiv_"+str$(p%)+".bmp"
  file_load nivpict%,img$
  caption alphniv2%,t$
end_sub

' ------------------------------------------------------------------------------

sub InitGrille()
  sprite 43 : sprite_file_load 43,Temp$+"Grille.bmp" : sprite_position 43,0,-601
  for i%=1 to 601
      sprite_y_position 43,sprite_y_position(43)+1
  next i%
end_sub

' ------------------------------------------------------------------------------

sub InitPions()
  dim_local p%,lx%,ly%
  lx%=-101 : ly%=-101
  sprite_create_hide
  for p%=1 to 21
      EtatPion%(p%)=0
      ColorPion$(p%)="R"
      sprite p%
      sprite_file_load p%,Temp$+"rouge.bmp"
      sprite_position p%,lx%,ly%
  next p%
  for p%=22 to 42
      EtatPion%(p%)=0
      ColorPion$(p%)="J"
      sprite p%
      sprite_file_load p%,Temp$+"jaune.bmp"
      sprite_position p%,lx%,ly%
  next p%
  sprite_show_all
  sprite_create_show
end_sub

' ------------------------------------------------------------------------------
' JEU IA
' ------------------------------------------------------------------------------

sub TourRouge()
  dim_local i%,nv%
  if fin%=1 : exit_sub : end_if
  ' niveau%
  if niveau%=1 then nv%=10
  if niveau%=2 then nv%=14
  if niveau%=3 then nv%=20
  if niveau%=4 then nv%=2
  n%=0: while n%=0 or n%>nv% : n%=rnd(nv%+1) : end_while
  if niveau%=1
      if n%=10 or n%=9 or n%=8 or n%=7 or n%=5 or n%=3 or n%=2 or n%=1 : n%=1 : else : n%=2 : end_if
  end_if
  if niveau%=2
      if n%=14 or n%=13 or n%=12 or n%=10 or n%=9 or n%=8 or n%=7 or n%=6 or n%=5 or n%=4 or n%=2 or n%=1 : n%=1 : else : n%=2 : end_if
  end_if
  if niveau%=3
      if n%=20 or n%=19 or n%=18 or n%=16 or n%=15 or n%=14 or n%=13 or n%=12 or n%=11 or n%=10 or n%=9 or n%=8 or n%=7 or n%=6 or n%=5 or n%=4 or n%=2 or n%=1 : n%=1 : else : n%=2 : end_if
  end_if
  if niveau%=4
      n%=1
  end_if

  Caz%=0
  if n%=1 then SearchFirstOpenCase(cl%):' Caz%
  if n%=2
    ' recherche une autre colonne qui ne soit pas pleine
      for i%=1 to 7
        if i%<>cl%
            ControleColonne(i%):' Caz%
            If Caz%=0
              SearchFirstOpenCase(cl%):' Caz%
            else
              exit_for
            end_if
        end_if
      next i%
  end_if
  n%=0
  if Caz%<>0
      SearhFirstOpenPion("R"):' Pion% de la couleur
      DownPionInCase(pion%,Caz%)
  else
      SearchRearFirstOpenCase()
      if Caz%=0 then message "Caz%=0" : stop : terminate
      SearhFirstOpenPion("R"):' Pion% de la couleur
      DownPionInCase(pion%,Caz%)
  end_if
  Caz%=0
  if tour%>6
      ControleVictoires("R")
  end_if
  TourJaune()
end_sub

' ------------------------------------------------------------------------------

sub ControleColonne(co%)
    dim_local li%,cz%
    for li%=1 to 6
        for cz%=1 to 42
            if Col%(cz%)=co% and Lig%(cz%)=li%
              if EtatCase%(cz%)=0 then Caz%=cz%
            end_if
        next cz%
    next li%
end_sub

' ------------------------------------------------------------------------------
' JEU JOUEUR
' ------------------------------------------------------------------------------

sub TourJaune()
    if fin%=1 : exit_sub : end_if
    caz%=0 : ON_MOUSE_DOWN scene%,ClicScene
end_sub

' ------------------------------------------------------------------------------
' CONTROLE VICTOIRE
' ------------------------------------------------------------------------------

sub ControleVictoires(Couleur$)
    Dim_local cz%,li%,co%,nb%
    clear Dlist1%
  ' 1) contrôle Horizontale
    for li%=1 to 6
        for co%=1 to 4
            RetourneCase(co%,li%):' ncz%
            if EtatCase%(ncz%)<>0
              Pion%=EtatCase%(ncz%)
              if ColorPion$(Pion%)=Couleur$
                  item_add Dlist1%,ncz%
                    for nb%=1 to 3
                        ncz%=ncz%+1
                        if EtatCase%(ncz%)<>0
                          Pion%=EtatCase%(ncz%)
                          if ColorPion$(Pion%)=Couleur$
                              item_add Dlist1%,ncz%
                          end_if
                        end_if
                    next nb%
                    if count(Dlist1%)>3 and Couleur$="J"
                      VictoireJ()
                      ActiveInactiveMenu(0)
                      exit_sub
                    end_if
                    if count(Dlist1%)>3 and Couleur$="R"
                      VictoireR()
                      ActiveInactiveMenu(0)
                      exit_sub
                    end_if
                    if count(Dlist1%)<4 then clear Dlist1% :' exit_for
              end_if
            end_if
        next co%
    next li%
    if count(Dlist1%)<4
    ' 2) contrôle Verticale
      clear Dlist1%
      for co%=1 to 7
          for li%=1 to 3
              RetourneCase(co%,li%):' ncz%
              if EtatCase%(ncz%)<>0
                  Pion%=EtatCase%(ncz%)
                  if ColorPion$(Pion%)=Couleur$
                    item_add Dlist1%,ncz%
                      for nb%=1 to 3
                          ncz%=ncz%+7
                          if EtatCase%(ncz%)<>0
                              Pion%=EtatCase%(ncz%)
                              if ColorPion$(Pion%)=Couleur$
                                item_add Dlist1%,ncz%
                              end_if
                          end_if
                      next nb%
                      if count(Dlist1%)>3 and Couleur$="J"
                          VictoireJ()
                          ActiveInactiveMenu(0)
                          exit_sub
                      end_if
                      if count(Dlist1%)>3 and Couleur$="R"
                          VictoireR()
                          ActiveInactiveMenu(0)
                          exit_sub
                      end_if
                      if count(Dlist1%)<4 then clear Dlist1% :' exit_for
                  end_if
              end_if
          next li%
      next co%
    end_if
    if count(Dlist1%)<4
    ' 3) contrôle Diagonale => droite
      clear Dlist1%
      for co%=1 to 4
          for li%=1 to 3
              RetourneCase(co%,li%):' ncz%
              if EtatCase%(ncz%)<>0
                  Pion%=EtatCase%(ncz%)
                  if ColorPion$(Pion%)=Couleur$
                    item_add Dlist1%,ncz%
                      for nb%=1 to 3
                          ncz%=ncz%+8
                          if EtatCase%(ncz%)<>0
                              Pion%=EtatCase%(ncz%)
                              if ColorPion$(Pion%)=Couleur$
                                item_add Dlist1%,ncz%
                              end_if
                          end_if
                      next nb%
                      if count(Dlist1%)>3 and Couleur$="J"
                          VictoireJ()
                          ActiveInactiveMenu(0)
                          exit_sub
                      end_if
                      if count(Dlist1%)>3 and Couleur$="R"
                          VictoireR()
                          ActiveInactiveMenu(0)
                          exit_sub
                      end_if
                      if count(Dlist1%)<4 then clear Dlist1% :' exit_for
                  end_if
              end_if
          next li%
      next co%
    end_if
    if count(Dlist1%)<4
    ' 3) contrôle Diagonale => gauche
      clear Dlist1%
      for co%=4 to 7
          for li%=1 to 3
              RetourneCase(co%,li%):' ncz%
              if EtatCase%(ncz%)<>0
                  Pion%=EtatCase%(ncz%)
                  if ColorPion$(Pion%)=Couleur$
                    item_add Dlist1%,ncz%
                      for nb%=1 to 3
                          ncz%=ncz%+6
                          if EtatCase%(ncz%)<>0
                              Pion%=EtatCase%(ncz%)
                              if ColorPion$(Pion%)=Couleur$
                                item_add Dlist1%,ncz%
                              end_if
                          end_if
                      next nb%
                      if count(Dlist1%)>3 and Couleur$="J"
                          VictoireJ()
                          ActiveInactiveMenu(0)
                          exit_sub
                      end_if
                      if count(Dlist1%)>3 and Couleur$="R"
                          VictoireR()
                          ActiveInactiveMenu(0)
                          exit_sub
                      end_if
                      if count(Dlist1%)<4 then clear Dlist1% :' exit_for
                  end_if
              end_if
          next li%
      next co%
    end_if
end_sub

' ------------------------------------------------------------------------------

sub RetourneCase(column%,line%)
    dim_local cz% : ncz%=0
    for cz%=1 to Nbcaz%
        if col%(cz%)=column% and lig%(cz%)=line% then ncz%=cz% : exit_for
    next cz%
end_sub

' ------------------------------------------------------------------------------

sub DownPionInCase(Numpion%,NumCaz%)
    if Numpion%>41
      FormMessage(3)
      fin%=1
      ActiveInactiveMenu(0)
      SaveScore(2)
      exit_sub
    end_if
    if EtatPion%(Numpion%)<>0 then message "Pion déjà joué" : stop : terminate
    if EtatCase%(NumCaz%)<>0 then message "Cette case n'est pas libre =>"+str$(NumCaz%)+" Etat="+str$(EtatCase%(NumCaz%)) : stop : terminate
    tour%=tour%+1
    dim_local i%,lx%,ly%
    lx%=Pos_X%(NumCaz%) : ly%=Pos_Y%(NumCaz%)
    for i%=-101 to ly% step 2
        sprite_position Numpion%,lx%,i%+1
    next i%
    EtatPion%(Numpion%)=NumCaz%
    EtatCase%(NumCaz%)=Numpion%
' message "Case="+str$(NumCaz%)+" Etat="+str$(EtatCase%(NumCaz%))+" / Pion="+str$(Numpion%)+" EtatPion="+str$(EtatPion%(Numpion%))
end_sub

' ------------------------------------------------------------------------------

sub SearhFirstOpenPion(CouleurPion$)
    dim_local p% : Pion%=0
    for p%=1 to 42
        if CouleurPion$=ColorPion$(p%)
          if EtatPion%(p%)=0 then Pion%=p% : exit_for
        end_if
    next p%
end_sub

' ------------------------------------------------------------------------------

sub SearchFirstOpenCase(colonne%)
    dim_local cz% : Caz%=0
    for cz%=42 to 1 step -1
        if Col%(cz%)=colonne%
          if EtatCase%(cz%)=0 then Caz%=cz% : exit_for
        end_if
    next cz%
end_sub

' ------------------------------------------------------------------------------

sub SearchRearFirstOpenCase()
    dim_local cz% : Caz%=0
    for cz%=42 to 1 step -1
        if EtatCase%(cz%)=0 then Caz%=cz% : exit_for
    next cz%
end_sub

' ------------------------------------------------------------------------------

sub RetourneColonne(lx%,ly%)
    dim_local minix%,maxix%,i%
    cl%=0 : minix%=4 : maxix%=94
    for i%=1 to 7
        if lx%>minix% and lx%<maxix% then cl%=i% : exit_for
        minix%=minix%+100 : maxix%=maxix%+100
    next i%
end_sub

' ------------------------------------------------------------------------------

sub VictoireJ()
    dim_local cz%,c%
    for c%=1 to count(Dlist1%)
        a$=item_read$(Dlist1%,c%)
        cz%=val(a$)
        Pion%=EtatCase%(cz%)
        sprite_file_load Pion%,Temp$+"jauneV.bmp"
        sprite_position Pion%,Pos_X%(cz%),Pos_Y%(cz%)
        pause 500
    next c%
    fin%=1
    FormMessage(1)
    SaveScore(1)
end_sub

' ------------------------------------------------------------------------------

sub VictoireR()
    dim_local cz%,c%
    for c%=1 to count(Dlist1%)
        a$=item_read$(Dlist1%,c%)
        cz%=val(a$)
        Pion%=EtatCase%(cz%)
        sprite_file_load Pion%,Temp$+"RougeV.bmp"
        sprite_position Pion%,Pos_X%(cz%),Pos_Y%(cz%)
        pause 500
    next c%
    fin%=1
    FormMessage(2)
    SaveScore(3)
end_sub

' ------------------------------------------------------------------------------

sub ActiveInactiveMenu(etat%)
  dim_local i%
  if etat%=1
      for i%=1 to 6 : show btn2%(i%) : next i%
  else
      for i%=1 to 6 : hide btn2%(i%) : next i%
  end_if
end_sub

' ------------------------------------------------------------------------------

sub CapturePlateau()
  dim_local f$

  open_dialog Sdial%
  dir_dialog Sdial%,":\"
  filter Sdial%,"*.bmp|*.bmp"
  f$=file_name$(Sdial%)
  delete Sdial%
 
  if f$<>"_"
      if left$(f$,4)<>".bmp" : f$=f$+".bmp" : end_if
      snapshot scene%,f$
  end_if
  dir_change path$
end_sub

' ------------------------------------------------------------------------------

sub AddNameToPlayerList(n$)
  dim_local i%,p%

  if n$<>""
      if count(combplayer%)>0
        for i%= 1 to count(combplayer%)
            if item_read$(combplayer%,i%)=n$
              p%=1
              exit_for
            end_if
        next i%
      end_if
      if p%=0
        item_add combplayer%,n$
        item_select combplayer%,count(combplayer%)
        file_save combplayer%,Listplayer$
      end_if
  end_if
end_sub

' ------------------------------------------------------------------------------

sub ReInitPions()
    dim_local p%
    sprite_delete_all
    for p%=1 to 42
      EtatPion%(p%)=0
    next p%
end_sub

' ------------------------------------------------------------------------------

sub SaveScore(S%)
  dim_local i%,p%,p$,sc$(8),it$
 
'  recherche de la ligne du joueur
  if count(dlist2%)>0
      for i%=1 to count(dlist2%)
        it$=item_read$(dlist2%,i%)
        p$=left$(it$,instr(it$,",")-1)
        if p$=player$
            p%=i%
            exit_for
        end_if
      next i%
  end_if
'  recup des infos score si joueur déjà enregistré
  if p%>0
      it$= item_read$(dlist2%,p%)
      for i%=1 to 8
        sc$(i%)= left$(it$,instr(it$,",")-1)
        if i%<8
            it$=right$(it$,len(it$)-instr(it$,","))
        end_if
      next i%
  end_if
'  modifications des infos
  sc$(1)=player$
  if p%>0 : sc$(2)=str$(val(sc$(2))+1) : else : sc$(2)="1" : end_if
  if S%=1 : if p%>0 : sc$(3)=str$(val(sc$(3))+1) : else : sc$(3)="1" : end_if : end_if
  if S%=2 : if p%>0 : sc$(4)=str$(val(sc$(4))+1) : else : sc$(4)="1" : end_if : end_if
  if S%=3 : if p%>0 : sc$(5)=str$(val(sc$(5))+1) : else : sc$(5)="1" : end_if : end_if

  if sc$(3)="" : sc$(3)="0" : end_if
  if sc$(3)<>"0"
      CalcPrct(val(sc$(3)),val(sc$(2))): sc$(6)= str$(prct%)
  end_if
 
  if sc$(4)="" : sc$(4)="0" : end_if
  if sc$(4)<>"0"
      CalcPrct(val(sc$(4)),val(sc$(2))): sc$(7)= str$(prct%)
  end_if
 
  if sc$(5)="" : sc$(5)="0" : end_if
  if sc$(5)<>"0"
      CalcPrct(val(sc$(5)),val(sc$(2))): sc$(8)= str$(prct%)
  end_if
 
'  inscription des infos
  it$=""
  for i%=1 to 8
      if sc$(i%)="" : sc$(i%)="0" : end_if
      it$=it$+sc$(i%)+","
  next i%
  if p%>0
      item_delete dlist2%,p%
      item_insert dlist2%,p%,it$
  else
      item_add dlist2%,it$
  end_if
'  sauvegarde des scores
  file_save dlist2%,ScoreFile$
end_sub

' ------------------------------------------------------------------------------

sub CalcPrct(a%,b%)
  if variable("prct%")= 0 then dim prct%
  prct%=int(a%*(100/b%))
end_sub

' ------------------------------------------------------------------------------
sub Quitter()
  Terminate
end_sub