'                           *****************  
'                           **   YAHTZEE   **  
'                           *****************  
'
'                             Juillet  1992  
'
'                          par PENNANEACH Yann 
'
Dim PTS(19,1),DE(5),DE2(5)
Global TUR,J,PTS(),DE(),DE2(),TEST,C,C1,ZERO,ZWIDTH,NJOUEURS
INIT
JEU
FIN
' initialisation 
Procedure INIT
   ' ouverture des écrans 
   Screen Open 0,320,20,2,Hires : Curs Off 
   Screen Open 1,640,256,16,Hires
   Screen Hide 1
   Flash Off : Curs Off : Wait Vbl 
   Limit Mouse 
   Cls 0
   ' Affichage du titre 
   YAHTZEE
   ' Affichage du tableau 
   TABLEAU
   ' Fixe les couleurs
   COULEURS
   ' initialisation des variables 
   ' demande le nombre de joueurs 
   Screen 0
   Print At(0,0)+"Nombre de joueurs (1 ou 2) ?"
   Repeat 
      NJOUEURS=Val(Inkey$)-1
   Until NJOUEURS=0 or NJOUEURS=1
   Screen To Front 1
   Screen Show 1
   Screen Close 0
   For I=0 To 19
      For J=0 To 1
         PTS(I,J)=-1
      Next J
   Next I
   ZWIDTH=630
   ' si 1 joueur, on efface le 2eme 
   If NJOUEURS=0 Then Ink 0 : Bar 531,42 To 631,242 : ZWIDTH=530
   ' affiche le score 
   SCORE[0]
   If NJOUEURS=1 Then SCORE[1]
End Proc
' boucle du jeu
Procedure JEU
   ' boucle principale (13 tours de jeu)
   For TUR=1 To 13
      ' chaque joueur à son tour 
      For J=0 To NJOUEURS
         For Z=0 To 5
            DE(Z)=0
         Next Z
         ' affiche le joueur
         INVERSE[J]
         N=0
         ' trois tirages
         Repeat 
            TUT=True
            Inc N
            CLTIRAGE
            Ink N,0
            Text 85,45,Str$(N)+"e lancé"
            ' tirage et affichage des dés
            For I=1 To 5
               DE2(I)=DE(I)
               If DE(I)=0
                  DE(I)=Rnd(5)+1
                  AFFICHE_DE[I]
                  TUT=False
               End If 
            Next I
            ' choisir les dés à garder 
            If TUT=False and N<>3
               CHOISIR_DES
            Else 
               For Z=1 To 5
                  Ink 0 : Box 16,Z*35+28 To 74,Z*35+58
               Next Z
            End If 
         Until TUT=True or N=3
         CLTIRAGE
         For I=1 To 5
            If DE(I)=0
               DE(I)=DE2(I)
            End If 
         Next I
         ' choix du marquage et affichage du score
         CHOISIR_CASE[J]
         SCORE[J]
         INVERSE[J]
      Next J
   Next TUR
End Proc
' affiche le joueur gagnant
Procedure FIN
   ' compare les scores et affiche le gagnant 
   Ink 0
   Bar 0,50 To 289,250
   If PTS(19,0)>PTS(19,1)
      J1$="Joueur 1"
      J2$="Joueur 2"
   Else 
      J1$="Joueur 2"
      J2$="Joueur 1"
   End If 
   Ink 3
   Text 10,100,"Joueur gagnant :"+J1$
   Ink 11
   Text 10,120,"Joueur perdant :"+J2$
   ' attend qu'un bouton soit pressée 
   Repeat 
   Until Mouse Key
End Proc
' affiche les rubriques et le tableau
Procedure TABLEAU
   Restore RUBRIQUES
   For I=1 To 19
      Read A$
      Ink 2,0
      Text 300,I*10+50,A$
      Ink 13
      Draw 290,I*10+42 To 630,I*10+42
   Next I
   Draw 290,242 To 630,242
   Box 430,42 To 530,242
   Box 290,42 To 630,242
   Ink 1
   Text 450,50,"Joueur 1"
   Text 550,50,"Joueur 2"
   RUBRIQUES:
   Data "AS","DEUX","TROIS","QUATRE","CINQ","SIX","TOTAL","PRIME","Total supérieur",""
   Data "BRELAN","CARRE","FULL","PETITE SUITE","GRANDE SUITE","YAHTZEE","CHANCE"
   Data "Total inférieur","Total général"
End Proc
' affichage du titre 
Procedure YAHTZEE
   Ink 14
   Text 230,100,"YAHTZEE"
   For J=92 To 100
      ' dégradé de couleurs
      Ink J-89
      For I=230 To 286
         ' si c'est un point, on l'agrandit 
         If Point(I,J)=14
            Bar(I-150)*3,(J-90)*3 To(I-150)*3+2,(J-90)*3+2
         End If 
      Next I
   Next J
   Ink 0
   Bar 230,92 To 400,127
End Proc
' fixe les couleurs
Procedure COULEURS
   For I=3 To 11
      Colour I,(18-I)*256+(I-3)
   Next I
   Colour 0,$20
   Colour 12,$999
   Colour 2,$AFA
   Colour 1,$FA5
   Colour 15,$900
   Colour 14,$CC0
   Colour 13,$DDD
End Proc
' inverse le joueur J
Procedure INVERSE[J]
   Gr Writing 2
   Bar 431+J*100,43 To 529+J*100,51
   Gr Writing 0
End Proc
' affiche le score du joueur J 
Procedure SCORE[J]
   For I=1 To 19
      If I<>10
         A$=Str$(PTS(I,J))
         ' si pas encore utilisé, on affiche un tiret 
         If A$="-1"
            A$="-"
         End If 
         Ink 0
         Bar 431+J*100,I*10+43 To 529+J*100,I*10+51
         Ink 12,0
         Text 480+J*100-Len(A$)*4,I*10+50,A$
      End If 
   Next I
End Proc
' affiche le dé de chiffre DE  
Procedure AFFICHE_DE[DE]
   Ink 13
   Bar 20,DE*35+30 To 70,DE*35+56
   Ink 0
   If DE(DE)=1 or DE(DE)=3 or DE(DE)=5
      Circle 45,DE*35+43,2
   End If 
   If DE(DE)<>1
      Circle 26,DE*35+33,2
      Circle 64,DE*35+53,2
   End If 
   If DE(DE)>3
      Circle 26,DE*35+53,2
      Circle 64,DE*35+33,2
   End If 
   If DE(DE)=6
      Circle 26,DE*35+43,2
      Circle 64,DE*35+43,2
   End If 
End Proc
' choix des dés à garder 
Procedure CHOISIR_DES
   For I=1 To 5
      If DE2(I)=0
         Ink 0
      Else 
         Ink 2
      End If 
      Box 16,I*35+28 To 74,I*35+58
   Next I
   For Z=1 To 5
      Swap DE(Z),DE2(Z)
   Next Z
   Ink 0
   Bar 75,135 To 289,170
   Ink 1
   Text 82,146,"Choisir les dés à garder"
   Text 82,155,"  (Bouton droit : Fin)"
   Repeat 
      X=X Screen(X Mouse) : Y=Y Screen(Y Mouse) : K=Mouse Click
      If X>15 and X<75 and Y>60 and Y<236 and K=1
         D=Int((Y-61)/35)+1
         If DE(D)=0
            Ink 2
            DE(D)=DE2(D)
         Else 
            Ink 0
            DE(D)=0
         End If 
         Box 16,D*35+28 To 74,D*35+58
      End If 
   Until K=2
End Proc
' choix de la case du marquage 
Procedure CHOISIR_CASE[J]
   C1=0
   Ink 0
   Bar 75,135 To 289,170
   Ink 1
   Text 82,146,"Choisir la case de marque"
   Text 82,155,"(Bouton gauche : Valide)"
   ZERO=False
   ' teste les combinaison pour savoir si une possibilité existe
   Z=True
   For C=1 To 19
      TESTE
      If TEST=True
         Z=False
      End If 
   Next C
   ' si pas de possibilité, on place un 0 
   If Z=True
      Text 82,164,"     Placez votre 0"
      ZERO=True
   Else 
      ZERO=False
   End If 
   ' on attend le choix de la case
   Repeat 
      X=X Screen(X Mouse) : Y=Y Screen(Y Mouse) : K=Mouse Click
      If X>290 and X<ZWIDTH and((Y>52 and Y<112) or(Y>152 and Y<222))
         C=Int((Y-42)/10)
         ' teste si la case est disponible
         TESTE
      Else 
         Gr Writing 2
         If C1<>0
            Bar 291,C1*10+43 To 430,C1*10+51
         End If 
         Gr Writing 0
         C1=0
      End If 
   Until K=1 and C1<>0
   Gr Writing 2
   Bar 291,C1*10+43 To 430,C1*10+51
   Gr Writing 0
   ' calcule le score de la case choisie
   If ZERO=False
      If C>0 and C<7
         CH[C]
         PTS(C,J)=C*Param
      Else If C=11 or C=12 or C=17
            PTS(C,J)=0
            For I=1 To 5
               Add PTS(C,J),DE(I)
            Next I
         Else If C=13
               PTS(C,J)=25
            Else If C=14
                  PTS(C,J)=30
               Else If C=15
                     PTS(C,J)=40
                  Else If C=16
                        PTS(C,J)=50
                     End If 
                  End If 
               End If 
            End If 
         End If 
      End If 
   Else 
      ' c'est un zéro
      PTS(C,J)=0
   End If 
   ' calcule le total supérieur 
   PTS(7,J)=0
   PTS(18,J)=0
   For I=1 To 6
      If PTS(I,J)>0
         Add PTS(7,J),PTS(I,J)
      End If 
   Next I
   ' si total supérieur > 62, on ajoute le bonus
   If PTS(7,J)=>63
      PTS(8,J)=35
   Else 
      PTS(8,J)=0
   End If 
   PTS(9,J)=PTS(7,J)+PTS(8,J)
   ' calcul le total inférieur
   For I=11 To 17
      If PTS(I,J)>0
         Add PTS(18,J),PTS(I,J)
      End If 
   Next I
   PTS(19,J)=PTS(9,J)+PTS(18,J)
End Proc
' effectue les tests pour savoir si la case C est utilisable 
Procedure TESTE
   TEST=False
   If C=>1 and C<=6
      CH[C]
      If Param>0
         TEST=True
      End If 
   End If 
   If C=11
      For I=1 To 6
         CH[I]
         If Param>2
            TEST=True
         End If 
      Next I
   End If 
   If C=12
      For I=1 To 6
         CH[I]
         If Param>3
            TEST=True
         End If 
      Next I
   End If 
   If C=13
      For I=1 To 6
         CH[I]
         If Param>2
            For II=1 To 6
               CH[II]
               If II<>I and Param>1
                  TEST=True
               End If 
            Next II
         End If 
      Next I
   End If 
   If C=14
      CH[1] : CH1=Param : CH[2] : CH2=Param : CH[3] : CH3=Param
      CH[4] : CH4=Param : CH[5] : CH5=Param : CH[6] : CH6=Param
      If CH3>0 and CH4>0
         If(CH1>0 and CH2>0) or(CH2>0 and CH5>0) or(CH5>0 and CH6>0)
            TEST=True
         End If 
      End If 
   End If 
   If C=15
      CH[1] : CH1=Param : CH[2] : CH2=Param : CH[3] : CH3=Param
      CH[4] : CH4=Param : CH[5] : CH5=Param : CH[6] : CH6=Param
      If CH2>0 and CH3>0 and CH4>0 and CH5>0 and(CH1>0 or CH6>0)
         TEST=True
      End If 
   End If 
   If C=16
      For I=1 To 6
         CH[I]
         If Param>4
            TEST=True
         End If 
      Next I
   End If 
   If C=17
      TEST=True
   End If 
   If(TEST=True or ZERO=True) and PTS(C,J)=-1
      If C<>C1
         Gr Writing 2
         If C1<>0
            Bar 291,C1*10+43 To 430,C1*10+51
         End If 
         Bar 291,C*10+43 To 430,C*10+51
         Gr Writing 0
      End If 
      C1=C
      TEST=True
   Else 
      Gr Writing 2
      If C1<>0
         Bar 291,C1*10+43 To 430,C1*10+51
      End If 
      Gr Writing 0
      C1=0
      TEST=False
   End If 
End Proc
' cherche le chiffre N parmis les dés et renvoie le numéro du dé 
Procedure CH[N]
   NBR=0
   For I=1 To 5
      If DE(I)=N
         Inc NBR
      End If 
   Next I
End Proc[NBR]
' efface numéro lancé  
Procedure CLTIRAGE
   Ink 0
   Bar 85,38 To 185,48
End Proc