Puissance 4 en 2D

hide 0
variables()
constantes()
labels()
init()
interface()
show 0
off_mouse_down Scene%
generique()
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%,chxniv%
  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()
  dim_local f$
  if dir_exists("C:\Temp")=0 then dir_make "C:\Temp"
  if dir_exists(Temp$)=1
      dir_change Temp$
      f$=file_find_first$
      if instr(f$,".")>2 : file_delete f$ : end_if
      f$=file_find_next$
      while f$<>"_"
        if instr(f$,".")>2 : file_delete f$ : end_if
        f$=file_find_next$
      end_while
      file_find_close
      dir_change path$
      dir_remove temp$
  end_if
  pause 1000
  dir_make Temp$
  Archiver_on
  Archiver_extract Zip$,Temp$
  Archiver_off
  pause 1000
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$="Nouvelle partie,Capture du plateau,Scores,Aide,Quitter,"
  for i%=1 to 5
      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%<5 : 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$+"fond2.bmp"
  cursor_point scene%
 
  sprite 44
  sprite_file_load 44,Temp$+"generique.bmp"
  sprite_x_position 44,0
  sprite_y_position 44,601
  sprite_x_scale 44,1
  sprite_y_scale 44,1

  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%,150
      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 alphplayer%
      parent alphplayer%,panniv%
      caption alphplayer%,"Sélection du joueur"
      font_name alphplayer%,"Times"
      font_size alphplayer%,10
      font_bold alphplayer%
      font_color alphplayer%,0,0,200
      top alphplayer%,5
      left alphplayer%,int((width(panniv%)-width(alphplayer%))/2)

      combo combplayer%
      parent combplayer%,panniv%
      font_name combplayer%,"Times"
      font_size combplayer%,10
      font_bold combplayer%
      font_color combplayer%,155,0,0
      width combplayer%,width(panniv%)-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
      on_click combplayer%,clic

      button btnsaveplayer%
      parent btnsaveplayer%,panniv%
      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
     
      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%,top(combplayer%)+height(combplayer%)+10
      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%,top(alphniv1%)+height(alphniv1%)+5
      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%,top(alphniv1%)+height(alphniv1%)+5
      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%,top(alphniv1%)+height(alphniv1%)+7
      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
 
  chxniv%=3
  caption alphniv2%,"Difficile"
  file_load nivpict%,Temp$+"PictNiv_"+str$(chxniv%)+".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%,350
      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 4 niveaux de jeu : "+chr$(13)
      a$=a$+chr$(9)+"1 => Facile"+chr$(13)
      a$=a$+chr$(9)+"2 => Moyen"+chr$(13)
      a$=a$+chr$(9)+"3 => Difficile (par défaut)"+chr$(13)
      a$=a$+chr$(9)+"4 => Diabolique"+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

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

clic:
  if number_click = btn1%(1)
      file_load btn1%(1),imgbtn_Over$(1)
      on_mouse_down btn1%(1),ShowImgClic
      InactiveMenuButton(1)
      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%(2)
      file_load btn1%(2),imgbtn_Over$(2)
      on_mouse_down btn1%(2),ShowImgClic
      CapturePlateau()
      return
  end_if

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

  if number_click = btn1%(4)
      file_load btn1%(4),imgbtn_Over$(4)
      on_mouse_down btn1%(4),ShowImgClic
      Aide()
      return
  end_if
 
  if number_click = btn1%(5)
      file_load btn1%(5),imgbtn_Over$(5)
      on_mouse_down btn1%(5),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 = combplayer%
        player$ = item_index$(combplayer%)
        if player$<>""
            color combplayer%,255,255,255
            font_color combplayer%,155,0,0
        end_if
        return
      end_if
     
      if number_click = btnsaveplayer%
        if text$(combplayer%)<>""
            AddNameToPlayerList(text$(combplayer%))
        end_if
        return
      end_if
 
      if number_click = nivplus%
        off_click nivplus%
        if chxniv%<5
            chxniv%=chxniv%+1
            AffichNiv()
        end_if
        on_click nivplus%,clic
        return
      end_if
 
      if number_click = nivmoins%
        off_click nivmoins%
        if chxniv%>1
            chxniv%=chxniv%-1
            AffichNiv()
        end_if
        on_click nivmoins%,clic
        return
      end_if
     
      if number_click = nivok%
        if niveau%=0 : niveau%=3 : end_if
        if Player$=""
            color combplayer%,255,0,0
            font_color combplayer%,255,255,255
            text combplayer%,"Vous devez sélectionner un joueur !"
            return
        else
            hide fniv%
            caption 0,titre$+" { niveau : "+str$(niveau%)+" }"
            DownPionInCase(1,39)
            TourJaune()
        end_if
        return
      end_if
  end_if
 
  if object_exists(fmessage%)=1
      if number_click = messageok%
        hide fmessage%
        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
  file_find_close
  dir_change path$
  dir_remove Temp$
return

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

change:
  if object_exists(fniv%)=1
      if number_change = combplayer%
        color combplayer%,255,255,255
        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 5 : hide Btn1%(x%) : next x%
  p1%=2
  p2%=33
  for i%=1 to 5
      if Xmenu%>p1% and Xmenu%<p2%
        if ymenu%>2 and ymenu%<34
            activebtn%=i%
            show btn1%(i%)
            exit_for
        else
            for x%=1 to 5 : 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()
  dim_local t$,n%,img$
  caption fniv%,str$(chxniv%)
  select chxniv%
  case 1 : t$="Facile"
  case 2 : t$="Moyen"
  case 3 : t$="Difficile"
  case 4 : t$="Diabolique"
  case 5 : t$="Aléatoire"
  end_select
  img$=Temp$+"PictNiv_"+str$(chxniv%)+".bmp"
  file_load nivpict%,img$
  caption alphniv2%,t$
  if chxniv%<5
      niveau%=chxniv%
  else
      n%=0: while n%=0 or n%>4 : n%=rnd(5) : end_while
      niveau%=int(n%)
  end_if
end_sub

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

sub InitGrille()
  sprite 43 : sprite_file_load 43,Temp$+"Grille.bmp" : sprite_position 43,0,-601
  if sprite_exists(44)=1
      if sprite_y_position(44)=0
        while sprite_y_position(44)<>-600
            sprite_y_position 44,sprite_y_position(44)-1
            display
        end_while
        sprite_hide 44
        sprite_y_position 44,601
        sprite_show 44
      end_if
  end_if
  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 5 : show btn2%(i%) : next i%
  else
      for i%=1 to 5 : hide btn2%(i%) : next i%
  end_if
end_sub

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

sub InactiveMenuButton(n%)
  show btn2%(n%)
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 generique()
  while sprite_y_position(44)<>0
      sprite_y_position 44,sprite_y_position(44)-1
      display
  end_while
end_sub

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

hide 0
variables()
constantes()
labels()
init()
interface()
show 0
off_mouse_down Scene%
generique()
Aide()
etatbtn%(4)=1
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%,chxniv%
   dim fin%
   dim xmenu%,ymenu%,etatbtn%(5),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
   label Closefhelp
   label Closefscore
end_sub

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

sub init()
   dim_local f$
   if dir_exists("C:\Temp")=0 then dir_make "C:\Temp"
   if dir_exists(Temp$)=1
      dir_change Temp$
      f$=file_find_first$
      if instr(f$,".")>2 : file_delete f$ : end_if
      f$=file_find_next$
      while f$<>"_"
         if instr(f$,".")>2 : file_delete f$ : end_if
         f$=file_find_next$
      end_while
      file_find_close
      dir_change path$
      dir_remove temp$
   end_if
   pause 1000
   dir_make Temp$
   Archiver_on
   Archiver_extract Zip$,Temp$
   Archiver_off
   pause 1000
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$="Nouvelle partie,Capture du plateau,Scores,Aide,Quitter,"
   for i%=1 to 5
      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%<5 : 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$+"fond2.bmp"
   cursor_point scene%
  
   sprite 44
   sprite_file_load 44,Temp$+"generique.bmp"
   sprite_x_position 44,0
   sprite_y_position 44,601
   sprite_x_scale 44,1
   sprite_y_scale 44,1

   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%,150
      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 alphplayer%
      parent alphplayer%,panniv%
      caption alphplayer%,"Sélection du joueur"
      font_name alphplayer%,"Times"
      font_size alphplayer%,10
      font_bold alphplayer%
      font_color alphplayer%,0,0,200
      top alphplayer%,5
      left alphplayer%,int((width(panniv%)-width(alphplayer%))/2)

      combo combplayer%
      parent combplayer%,panniv%
      font_name combplayer%,"Times"
      font_size combplayer%,10
      font_bold combplayer%
      font_color combplayer%,155,0,0
      width combplayer%,width(panniv%)-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
      on_click combplayer%,clic

      button btnsaveplayer%
      parent btnsaveplayer%,panniv%
      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
      
      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%,top(combplayer%)+height(combplayer%)+10
      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%,top(alphniv1%)+height(alphniv1%)+5
      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%,top(alphniv1%)+height(alphniv1%)+5
      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%,top(alphniv1%)+height(alphniv1%)+7
      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
  
   chxniv%=3
   caption alphniv2%,"Difficile"
   file_load nivpict%,Temp$+"PictNiv_"+str$(chxniv%)+".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%
      on_close fscore%,Closefscore
      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%
      on_close fhelp%,Closefhelp
      border_hide fhelp%
      height fhelp%,350
      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 4 niveaux de jeu : "+chr$(13)
      a$=a$+chr$(9)+"1 => Facile"+chr$(13)
      a$=a$+chr$(9)+"2 => Moyen"+chr$(13)
      a$=a$+chr$(9)+"3 => Difficile (par défaut)"+chr$(13)
      a$=a$+chr$(9)+"4 => Diabolique"+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

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

clic:
   if number_click = btn1%(1)
      file_load btn1%(1),imgbtn_Over$(1)
      on_mouse_down btn1%(1),ShowImgClic
      InactiveMenuButton(1)
      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%(2)
      file_load btn1%(2),imgbtn_Over$(2)
      on_mouse_down btn1%(2),ShowImgClic
      CapturePlateau()
      return
   end_if

   if number_click = btn1%(3)
      file_load btn1%(3),imgbtn_Over$(3)
      on_mouse_down btn1%(3),ShowImgClic
      if etatbtn%(3)=0
         etatbtn%(3)=1
         Score()
      else
         etatbtn%(3)=0
         hide fscore%
      end_if
      return
   end_if

   if number_click = btn1%(4)
      file_load btn1%(4),imgbtn_Over$(4)
      on_mouse_down btn1%(4),ShowImgClic
      if etatbtn%(4)=0
         etatbtn%(4)=1
         Aide()
      else
         etatbtn%(4)=0
         hide fhelp%
      end_if
      return
   end_if
  
   if number_click = btn1%(5)
      file_load btn1%(5),imgbtn_Over$(5)
      on_mouse_down btn1%(5),ShowImgClic
      gosub Close0
      Quitter()
      return
   end_if

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

   if object_exists(fniv%)=1
      if number_click = combplayer%
         player$ = item_index$(combplayer%)
         if player$<>""
            color combplayer%,255,255,255
            font_color combplayer%,155,0,0
         end_if
         return
      end_if
      
      if number_click = btnsaveplayer%
         if text$(combplayer%)<>""
            AddNameToPlayerList(text$(combplayer%))
         end_if
         return
      end_if
  
      if number_click = nivplus%
         off_click nivplus%
         if chxniv%<5
            chxniv%=chxniv%+1
            AffichNiv()
         end_if
         on_click nivplus%,clic
         return
      end_if
  
      if number_click = nivmoins%
         off_click nivmoins%
         if chxniv%>1
            chxniv%=chxniv%-1
            AffichNiv()
         end_if
         on_click nivmoins%,clic
         return
      end_if
      
      if number_click = nivok%
         if niveau%=0 : niveau%=3 : end_if
         if Player$=""
            color combplayer%,255,0,0
            font_color combplayer%,255,255,255
            text combplayer%,"Vous devez sélectionner un joueur !"
            return
         else
            hide fniv%
            caption 0,titre$+" { niveau : "+str$(niveau%)+" }"
            DownPionInCase(1,39)
            TourJaune()
         end_if
         return
      end_if
   end_if
  
   if object_exists(fmessage%)=1
      if number_click = messageok%
         hide fmessage%
         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
   file_find_close
   dir_change path$
   dir_remove Temp$
return

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

Closefhelp:
   etatbtn%(4)=0
return

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

Closefscore:
   etatbtn%(3)=0
return

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

change:
   if object_exists(fniv%)=1
      if number_change = combplayer%
         color combplayer%,255,255,255
         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 5 : hide Btn1%(x%) : next x%
   p1%=2
   p2%=33
   for i%=1 to 5
      if Xmenu%>p1% and Xmenu%<p2%
         if ymenu%>2 and ymenu%<34
            activebtn%=i%
            show btn1%(i%)
            exit_for
         else
            for x%=1 to 5 : 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()
   dim_local t$,n%,img$
   caption fniv%,str$(chxniv%)
   select chxniv%
   case 1 : t$="Facile"
   case 2 : t$="Moyen"
   case 3 : t$="Difficile"
   case 4 : t$="Diabolique"
   case 5 : t$="Aléatoire"
   end_select
   img$=Temp$+"PictNiv_"+str$(chxniv%)+".bmp"
   file_load nivpict%,img$
   caption alphniv2%,t$
   if chxniv%<5
      niveau%=chxniv%
   else
      n%=0: while n%=0 or n%>4 : n%=rnd(5) : end_while
      niveau%=int(n%)
   end_if
end_sub

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

sub InitGrille()
   sprite 43 : sprite_file_load 43,Temp$+"Grille.bmp" : sprite_position 43,0,-601
   if sprite_exists(44)=1
      if sprite_y_position(44)=0
         while sprite_y_position(44)<>-600
            sprite_y_position 44,sprite_y_position(44)-1
            display
         end_while
         sprite_hide 44
         sprite_y_position 44,601
         sprite_show 44
      end_if
   end_if
   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 5 : show btn2%(i%) : next i%
   else
      for i%=1 to 5 : hide btn2%(i%) : next i%
   end_if
end_sub

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

sub InactiveMenuButton(n%)
   show btn2%(n%)
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 generique()
   while sprite_y_position(44)<>0
      sprite_y_position 44,sprite_y_position(44)-1
      display
   end_while
end_sub

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