Les courses de toutous pantouflards

rem ' Courses de toutous pantouflards
  dim a , b , i , j : rem Variables provisoires numériques
  dim a$ : rem Variables provisoires alphanumériques
  dim cr , cg , cb : rem Couleurs du fond d`écran
  dim ct : rem Cagnotte
  dim ig : rem Indicateur de Gagnant
  dim dt(7) : rem Distance de chacun des Toutous
  dim pv : rem Paramètre de Vitesse
  dim rd : rem Résultat dans le Désordre
  dim ro : rem Résultat dans l`Ordre
  dim rt(7) : rem Rang de chacun des Toutous
  dim to(3) : rem Tiercé Obtenu
  dim tp(3) : rem Tiercé Parié
  dim tp$ : rem Titre du Programme
  dim zz(7) : rem Paramètre du bilan de compétences
  label aide , gains , go , idem , ligne , pan , vite
  cr=color_pixel_red(0,10,10)
  cg=color_pixel_green(0,10,10)
  cb=color_pixel_blue(0,10,10)
  tp$=" Courses de toutous pantouflards"
 
rem form0
  width 0,1350
  height 0,660
  caption 0,tp$
 
rem Numéros (1 à 7)
  for i=1 to 7
      alpha i
        left i,7
        top i,(i-1)*60+20
        font_bold i
        font_size i,14
        caption i,i
  next i

picture 8 : rem ligne d`arrivée
  left 8,35
  width 8,4
  height 8,430
  color 8,cr,cg,cb
  2d_target_is 8
  2d_line 1,1,1,430
 
rem Toutous (10 à 40)
  for i=1 to 7
      alpha (i-1)*5+10
        left (i-1)*5+10,1270
        top (i-1)*5+10,(i-1)*60
        font_size (i-1)*5+10,50
        font_name (i-1)*5+10,"Webdings"
        caption (i-1)*5+10,chr$(245)
  next i
  font_color 10,180,180,180
  font_color 15,255,0,0
  font_color 20,0,255,0
  font_color 25,0,0,0
  font_color 30,255,180,0
  font_color 35,0,200,255
  font_color 40,255,160,255
 
picture 50 : rem Ligne de départ
  left 50,1270
  width 50,4
  height 50,430
  color 50,cr,cg,cb
  2d_target_is 50
  2d_line 1,1,1,430

button 60 : rem Bouton double flèches vers la gauche
  left 60,1200
  top 60,450
  width 60,120
  height 60,120
  font_size 60,70
  font_name 60,"Wingdings 3"
  caption 60,chr$(72)
  on_click 60,pan
  inactive 60

alpha 65 : rem Affichage de l`indication d`arrivée
  left 65,2
  top 65,435
  font_bold 65
  font_size 65,12
  font_color 65,255,0,0
  caption 65,"Arrivée"
  on_click 65,vite

button 70 : rem Bouton flèche vers la droite et butée
  left 70,100
  top 70,450
  width 70,120
  height 70,120
  font_size 70,70
  font_name 70,"Wingdings 3"
  caption 70,chr$(42)
  on_click 70,ligne

button 75 : rem Bouton d`aide
  left 75,300
  top 75,450
  width 75,120
  height 75,120
  font_size 75,70
  font_name 75,"Webdings"
  caption 75,chr$(105)
  on_click 75,aide

alpha 80 : rem Indication Faites vos jeux
  left 80,500
  top 80,440
  font_bold 80
  font_size 80,24
  caption 80,"Faites vos jeux"

rem Boîtes de tiercé (85 à 95)
  for i=1 to 3
      combo (i-1)*5+85
        left (i-1)*5+85,i*80+423
        top (i-1)*5+85,485
        width (i-1)*5+85,60
        height (i-1)*5+85,60
        font_size (i-1)*5+85,24
        for j=1 to 7
            item_add (i-1)*5+85,j
        next j
        on_click (i-1)*5+85,go
        on_change (i-1)*5+85,go
  next i

rem Résultats (100 to 110)
  for i=1 to 3
      alpha (i-1)*5+100
        left (i-1)*5+100,i*80+427
        top (i-1)*5+100,540
        font_bold (i-1)*5+100
        font_size (i-1)*5+100,24
  next i
 
alpha 120 : rem Indication Combien
  left 120,750
  top 120,440
  font_bold 120
  font_size 120,24
  caption 120,"Combien"
 
spin 125 : rem Choix de la somme à miser
  left 125,760
  top 125,485
  width 125,110
  height 125,80
  font_size 125,30
  on_change 125,go

alpha 130 : rem Indication Euros
  left 130,880
  top 130,485
  font_size 130,30
  caption 130,"€"

alpha 135 : rem Indication Vos gains
  left 135,970
  top 135,440
  font_bold 135
  font_size 135,24
  caption 135,"Vos gains"
 
alpha 140 : rem Affichage des gains
  left 140,990
  top 140,480
  font_size 140,14
  font_color 140,255,0,0

alpha 145 : rem Indication Cagnotte
  left 145,970
  top 145,510
  font_bold 145
  font_size 145,24
  caption 145,"Cagnotte"
 
alpha 150 : rem Affichage de la cagnotte
  left 150,990
  top 150,550
  font_size 150,14
  font_color 150,255,0,0
  caption 150,"0 €"

rem Affichage des numéros d`arrivée (155 à 165)
  for i=1 to 3
      alpha (i-1)*5+155
        left (i-1)*5+155,i*80+411
        top (i-1)*5+155,518
        caption (i-1)*5+155,str$(i)+"°"
  next i

button 170 : rem Bouton idem
  left 170,740
  top 170,550
  width 170,150
  height 170,50
  font_bold 170
  font_size 170,20
  caption 170,"Idem"
  on_click 170,idem
  inactive 170

alpha 175 : rem Affichage des mauvaises nouvelles et du score de vérification
  left 175,10
  top 175,580
  font_size 175,12
  font_color 175,255,0,0

end

aide: : rem Affichage de l`aide
  application_title "Qui sont ces toutous rondouillards ?"
  a$="Sur conseil de leur vétérinaire, les mémères qui ont des toutous"+chr$(13)
  a$=a$+"gras et replets, ont décidé de leur faire faire un peu de sport."+chr$(13)
  a$=a$+"Aussi ont-elles organisé des courses destinées à savoir qui, de"+chr$(13)
  a$=a$+"leurs différents cabots rondouillards, sera le héros du jour."+chr$(13)
  a$=a$+"Pour votre bonheur, des spéculateurs ont monté un système"+chr$(13)
  a$=a$+"de paris, qui risque de vous faire gagner beaucoup d'argent."+chr$(13)
  a$=a$+"Mais il y a aussi un détail, c'est que les toutous à ces mémères"+chr$(13)
  a$=a$+"ne sont pas des flèches et s'arrêtent souvent pour flairer une"+chr$(13)
  a$=a$+"touffe d'herbe, faire un petit pipi, se gratter une pupuce..."+chr$(13)
  a$=a$+"C'est probablement ce qui donne au jeu un petit côté addictif."+chr$(13)
  a$=a$+"Ah, et ne vous étonnez pas de la couleur de certains, vous savez"+chr$(13)
  a$=a$+"qu'il est maintenant très tendance de faire teindre son chien."+chr$(13)
  a$=a$+"Faites vite votre tiercé et apprenez à distinguer, parmi tous"+chr$(13)
  a$=a$+"ces toutous pantouflards, les champions et les tocards !"+chr$(13)
  a$=a$+"Sans compter que vous allez peut-être devenir millionnaire..."+chr$(13)
  a$=a$+"Allez, pour les toutous rondouillards et pantouflards, hip hip hip..."
  message a$
return

gains: : rem Calcul et affichage des gains et de l`état de la cagnotte
  ro=0 : rd=0 : a=0
  for i=1 to 3
      if tp(i)=to(i)
        ro=ro+1
      end_if
  next i
  for i=1 to 3
      for j=1 to 3
        if tp(i)=to(j)
            rd=rd+1
        end_if
      next j
  next i
  if rd=1
      a=1
  end_if
  if rd=2
      a=val(text$(125))
  end_if
  if ro=1
      a=val(text$(125))*2+int(rnd(10))
  end_if
  if ro=2
      a=val(text$(125))*int(rnd(30))+21
  end_if
  if rd=3
      a=val(text$(125))*int(rnd(800))+201
  end_if
  if ro=3
      a=val(text$(125))*int(rnd(8000))+2001
  end_if
  ct=ct-val(text$(125))+a
  caption 140,str$(a)+" €"
  caption 150,str$(ct)+" €"
  a$="" : b=0
  a=int(rnd(100))
  if a/20=int(a/20)
      a$="Le percepteur vous a prélevé "
      if ct>0
        b=int(rnd(ct))+100000
        if b<20000
            b=int(rnd(3000))+15000
        end_if
      else
        b=int(rnd(120000))+200000
      end_if
      ct=ct-b
      a$=a$+str$(b)
      a$=a$+"€ pour taxe spéciale sur les spéculations cynophiles"
  end_if
  if a/7=int(a/7) and b=0 and ct>1000000
      a$="Le Trésor Public vous a prélevé "
      b=int(rnd(300000))+1000000
      ct=ct-b
      a$=a$+str$(b)
      a$=a$+"€ d'impôt sur les grandes fortunes"
  end_if
  if a=10 or a=30
      a$="Votre taxe d'habitation est arrivée à échéance. "
      a$=a$+"Le centre des impôts vous a prélevé "
      b=int(rnd(500))+1900
      ct=ct-b
      a$=a$+str$(b)+"€"
  end_if
  if (a=99 or a=11 or ct>10000000) and ct>0
      a$="Votre compte a été entièrement vidé "
      a$=a$+"(probablement par des pirates informatiques)"
      ct=0
  end_if
  if a=22 or a=33
      a$="Vos impôts sur le revenu de "
      if ct>500000
        b=int((ct*75)/100)
      else
        b=200000+int(rnd(100000))
      end_if
      ct=ct-b
      a$=a$+str$(b)+"€ ont été prélevés"
  end_if
  if a=13 or a=39 and ct>100000
      a$="La taxe de solidarité sur les hauts revenus vous a prélevée : "
      b=int((ct*80)/100)+int(rnd(50000))
      ct=ct-b
      a$=a$+str$(b)+"€"
  end_if
  if a$="" and a/5=int(a/5)
      a$="Votre droit de participation à la course, qui se monte à "
      b=2
      ct=ct-b
      a$=a$+str$(b)+"€, a été renouvelé"
  end_if
  font_color 175,255,0,0
  caption 175,a$
  caption 150,str$(ct)+" €"
return

go: : rem Activation du bouton de départ selon les indications entrées
  inactive 60
  if numeric(text$(125))=1
      a=val(text$(125))
      if a>0 and a=int(a)
        if numeric(text$(85))=1 and numeric(text$(90))=1 and numeric(text$(95))=1
            if text$(85)<>"" and text$(90)<>"" and text$(95)<>""
              a=val(text$(85))
              if a>0 and a<8 and a=int(a)
                  a=val(text$(90))
                  if a>0 and a<8 and a=int(a)
                    a=val(text$(95))
                    if a>0 and a<8 and a=int(a)
                        if text$(85)<>text$(90) and text$(85)<>text$(95) and text$(90)<>text$(95)
                          active 60
                        end_if
                    end_if
                  end_if
              end_if
            end_if
        end_if
      end_if
  end_if
return

idem: : rem Répétition du même pari
  for i=1 to 3
      text (i-1)*5+85,tp(i)
  next i
  active 60
return

ligne: : rem Tout le monde se remet en ligne
  for i=1 to 7
      left (i-1)*5+10,1270
  next i
  show 50
  if text$(85)<>"" and text$(90)<>"" and text$(95)<>""
      active 170
  end_if
  for i=85 to 95 step 5
      text i,""
      caption i+15,""
  next i
  caption 140,""
  for i=85 to 95 step 5
      active i
  next i
  active 125
return

pan: : rem Déclanchement du départ
  inactive 60
  for i=85 to 95 step 5
      inactive i
  next i
  inactive 125
  midi_on
      midi_instrument 127
      midi_volume 127
      midi_play 66,6
  midi_off
  hide 50
  ig=0
  while ig=0
      a=int(rnd(7))+1
      left (a-1)*5+10,left((a-1)*5+10)-25
      if pv=0
        wait 100
      end_if
      for i=10 to 40 step 5
        if left(i)<30
            ig=1
        end_if
      next i
  end_while
  beep
  a=0 : b=0
  for i=1 to 7
      dt(i)=left((i-1)*5+10)
      rt(i)=i
  next i
  for i=1 to 6
      for j=1 to 6
        if dt(j)=>dt(j+1)
            a=dt(j) : b=rt(j)
            dt(j)=dt(j+1) : rt(j)=rt(j+1)
            dt(j+1)=a : rt(j+1)=b
        end_if
      next j
  next i
  for i=100 to 110 step 5
      caption i,rt((i-95)/5)
  next i
  left ((val(caption$(105))-1)*5+10),left((val(caption$(105))-1)*5+10)-15
  left ((val(caption$(110))-1)*5+10),left((val(caption$(110))-1)*5+10)-10
  for i=1 to 3
      tp(i)=val(text$((i-1)*5+85))
      to(i)=val(caption$((i-1)*5+100))
  next i
  gosub gains
  a=(val(caption$(105))-1)*5+10
  b=(val(caption$(110))-1)*5+10
  if left(a)>45 or left(b)>45
      for i=left(b) to 50 step -25
        if left(a)>45
            left a,left(a)-25
        end_if
        if left(b)>45
            left b,left(b)-25
        end_if
        if a<40 and b<40 and left(40)>200
            left 40,left(40)+25
        end_if
        if pv=0
            wait 100
        end_if
      next i
  end_if
  for i=1 to 7
      if rt(1)=i
        zz(i)=zz(i)+1
      end_if
  next i
  a$="Bilan des compétences de chacun des toutous : "
  for i=1 to 7
      a$=a$+str$(zz(i))
      if i<7
        a$=a$+"-"
      end_if
  next i
  if caption$(175)=""
      font_color 175,0,0,255
      caption 175,a$
  end_if
  inactive 170
return

vite: : rem Affichage de la vitesse (cliquer sur « Arrivée »)
  if pv=0
      pv=1
      caption 0," Stéroïdes injectés"
      beep
  else
      pv=0
      caption 0,tp$
  end_if
return

rem ' Vérif-rnd
  dim a , i, j , t, a$ : rem Variables quelconques
  dim m : rem Maximum du test
  dim zz(7) : rem Nombre de fois où le chiffre de 1 à 7 est sorti
  m=25000

t = 1
for i=1 to m
  if t = 1 then tirage_m1()
  if t = 2 then tirage_m3()
  t=t+1 : if t > 2 then t=1
  zz(a)=zz(a)+1          : ' Inscription de ce nombre dans l'une des 7 listes
  ' caption 0,str$(t) + ":" + str$(a) : wait 200
  caption 0,str$(i)+"/"+str$(m)                : ' Affichage de la progression
next i
for i=1 to 7
  a$=a$+str$(int((zz(i)/m)*100))+"% ---"    : ' Inscription des résultats en %
next i
caption 0,a$
end

sub tirage_m1()
    a=int(rnd(7))+1                  : ' Tirage au sort d'un nombre de 1 à 7
end_sub

sub tirage_m3()
    a=7 - int(rnd(7))                : ' Tirage au sort d'un nombre de 1 à 7
end_sub