JEU : LE PING

rem ============================================================================
rem            PING
rem         Par Papydall
rem ============================================================================
Run()
end
rem ============================================================================
SUB Run()
    Presentation()
    Init()
    Jeu()

END_SUB
rem ============================================================================
' J'exhibe ici ma science panoramicienne !!!
SUB presentation()
  dim_local i,t$
  full_space 0
  t$ = "Papydall vous propose ... le Ping ... un vrai  casse-tête, ..."
  t$ = t$ + "Bon divertisse ment, avec ... le Ping"
  parler(t$)
  scene3d 1 : color 1, 0,0,0 : 3d_text 1,"PAPYDALL VOUS PROPOSE LE PING" : full_space 1
  3d_color 1,0,0,255 : 3d_position 1,-.5,-.5,1
  for i = 0 to 360 step 2: 3d_x_rotate 1,i : wait 10 : next i
  for i = 1 to .005 step -.005 : 3d_scale 1,i,i,i : wait 10 : next i
  3d_text 2,"!!! UN VRAI CASSE-TETE !!!" : 3d_color 2,255,0,0
  3d_position 2,-.5,-.5,1
  for i = 0 to 360 step 2: 3d_x_rotate 2,i : wait 10 : next i
  for i = 1 to .005 step -.005 : 3d_scale 2,i,i,i : wait 10 : next i
  3d_text 3,"BON DIVERTISSEMENT AVEC LE PING" : 3d_color 3,0,255,0
  3d_position 3,-1.5,-.5,1

  for i = 0 to 500 step 2 : 3d_y_rotate 3,i : 3d_z_rotate 3,i : wait 10 : next i
  for i = 1 to .01 step -.005 : 3d_scale 3,i,i,i : wait 10 : next i
  3d_position 3,-2,.5,1 : 3d_color 3,255,255,0
  for i = .01 to 1 step .005 : 3d_scale 3,i/1.1,i/1.1,i/5 : wait 10 : next i
  
  t$ = "Bon divertissement, avec, Le Ping"
  parler(t$)
  
  wait 1000 : delete 1

END_SUB
rem ============================================================================
' Votre ordinateur vous parle, veuillez être attentif !
SUB parler(tex$)
    dim_local f$,g$
    f$ = "c:\temp\parler.vbs" : ' "C:\windows\temp\parler.vbs"  : A adapter
    g$ = chr$(34)
    FILE_OPEN_WRITE 9999, f$
    file_writeln 9999, "Dim speaks, speech"
    file_writeln 9999, "speaks = " + g$ + tex$ + g$
    file_writeln 9999, "Set speech = CreateObject(" + g$ + "sapi.spvoice" + g$+ ")"
    file_writeln 9999, "speech.Speak speaks"
    FILE_CLOSE 9999
    EXECUTE_WAIT f$ : FILE_DELETE f$
END_SUB
rem ============================================================================

SUB Init()
    label clic
    dim niveau,ligne,colonne,lig,col,i,j,k,w,possible,rouge(12*12)
    width 0 ,100 + screen_x/2 : height 0 , screen_y/2
    
END_SUB
rem ============================================================================
' Je n'aime pas trop les LABEL, alors un seul suffit pour tout traiter !
clic:

    select number_click
       case 2001 : hide 1000 : return
       case 2002 : Quitter() : return
       case 2003 : Autorun(niveau) : return
       case 2004 : Aide() : return
    end_select

    if number_click > 1000 and number_click < 1007
       niveau = right$(caption$(number_click),1)
        ligne = 2*niveau : colonne = 2* niveau
        possible(ligne,colonne)
        if possible > 0
           Ping(ligne,colonne)
        else
          message "Ce Ping est impossible !!!"
        end_if
       return
    end_if
    Identifier_Case(number_click) : Analyser_Situation()

return
rem ============================================================================
' Je joue, tu joues, il/elle joue, nous joueons, vous jouez, ils/elles jouent
SUB Jeu()
    k = 1000
    for i = 1 to 6
        k = k +1 : option k
        top k, 20+i*20 : left k,100
        font_bold k : caption k,"Niveau : " + str$(i) : on_click k,clic
    next i
    mark_on k-3

END_SUB
rem ============================================================================
' Le ping ? c'est quoi ?
SUB Aide()
    dim_local t$,n$
    n$ = chr$(13)
    t$ = "Ce jeu répond au doux nom de PING. Les règles de ce casse-tête sont très simples." + n$
    t$ = t$ + " * Sur un échiquier rectangulaire de L lignes et C colonnes, (Rappel : un carré est aussi une forme rectangulaire !)" + n$
    t$ = t$ + "   sont disposés des pions ayant chacun une face rouge et une face bleue (des pions semblables à ceux de Reversi ou de Othello)" + n$
    t$ = t$ + " * Au départ, tous les pions montrent leur face rouge." +n$
    t$ = t$ + " * Le but du jeu est de retourner tous ces pions pour qu'ils montrent leur autre face bleue en respectant l'unique règle suivante :" +n$
    t$ = t$ + " A chaque fois que vous cliquez sur une case, vous retournez les pions qui l'entourent. Pour une case centrale,il y en a huit :" + n$
    t$ = t$ + " haut, bas, gauche, droite, haut-gauche, haut-droite,bas-gauche et bas-droite." + n$
    t$ = t$ + " Il y en a cinq pour une case sur le bord et trois pour une case dans un coin." + n$
    t$ = t$ + " Le pion de la case cliquée ne sera pas retourné mais le fond de la dite case prendra la couleur verte (pour rappeler au joueur" + n$
    t$ = t$ + " que cette case a été jouée" + n$ + n$
    t$ = t$ + "  ============================================================================ " +n$
    t$ = t$ + "  Le rectangle L x C  possède une solution si et seulement si L et C ne sont pas tous les deux dans un même ensemble Ci" +n$
    t$ = t$ + " Autrement dit, pas de solution pour PING si L et C sont tous les deux dans le même ensemble Ci" + n$
    t$ = t$ + " Les ensembles Ci sont les suivants: " + n$
    t$ = t$ + " C1 = {1, 5, 9,13,...} = {1 + 4k  ; k entier}" + n$
    t$ = t$ + " C2 = {3,11,19,27,...} = {3 + 8k  ; k entier}" + n$
    t$ = t$ + " C3 = {7,23,39,55,...} = {7 + 16k ; k entier}" + n$
    t$ = t$ + " Cn = {2^n - 1, 2^n -1 + 2^(n+1), 2^n - 1 + 2.2^(n+1), ...} = {2^n - 1 + k.2^(n+1); k entier}" + n$
    t$ = t$ + "  ============================================================================ " + n$
    message t$
END_SUB
rem ============================================================================
' Vérifie si le ping possède une solution ou non
' A utiliser si l'on veut définir soi-même les dimensions du PING
sub possible(L,C)
    if (mod(L,4)=1 and mod(C,4)=1) or (mod(L,8)=3 and mod(C,8)= 3) or (mod(L,16)=7 and mod(C,16)=7)
        possible = 0
    else
        possible = 1
    end_if
end_sub
rem ============================================================================
' Le PING en chaire et en os, pardon en ligne et colonne !
SUB ping(ligne,colonne)
    k = 1000
    if object_exists(k) > 0 then command_target_is 0 : delete k
    form k : width k , width(0) : height k , height(0)
    k = k+1000 : container k :parent k,1000 :  top k ,20 : left k,400 : width k,400 : height k,height(0)-100
    k = k + 1 : button k : parent k,k-1 : top k,20 : left k,20  : font_bold k : caption k,"Nouveau": on_click k,clic
    k = k + 1 : button k : parent k,k-2 : top k,20 : left k,100 : font_bold k : caption k,"Quitter": on_click k,clic
    K = k + 1 : button k : parent k,k-3 : top k,20 : left k,180 : font_bold k : caption k,"Autorun": on_click k,clic
    k = k + 1 : button k : parent k,k-4 : top k,20 : left k,260 : font_bold k : caption k,"Aide"   : on_click k,clic

    command_target_is 1000
     w = 250/(max(ligne,colonne))
    for i = 1 to ligne
        for j = 1 to colonne
            k = j + colonne *(i-1) : picture k : on_click k,clic
            width k,w : height k,w : top k ,(w+2)*i : left k, (w+2)*j
            2d_target_is k : 2d_fill_color 255,0,0 : 2d_circle w/2,w/2,w/2-2
            rouge(k) = 1
        next j
    next i
END_SUB
rem ============================================================================
' Déterminer la case cliquée
SUB Identifier_Case(p)
    lig = 1 + int(p/(colonne)) : col = mod(p,ligne)
    if col = 0 then col = colonne : lig = lig - 1
END_SUB
rem ============================================================================
' Répondre aux clicks du joueur
SUB Analyser_Situation()
    i = lig : j = col : k = (i-1)*colonne +j : color k, 0,255,0 : 2d_target_is k
    if rouge(k) = 1 then :2d_fill_color 255,0,0 :else: 2d_fill_color 0,0,255
    2d_circle w/2,w/2,w/2-2

    j = col-1 : if j > 0 then k = (i-1)*colonne +j : inverser(k)
    j = col+1 : if j <= colonne then k = (i-1)*colonne +j : inverser(k)
    i = lig-1
    if i > 0
       k = (i-1)*colonne + col : inverser(k)
       j = col-1 : if j > 0 then k = (i-1)*colonne +j : inverser(k)
       j = col+1 : if j <= colonne then k = (i-1)*colonne +j : inverser(k)
    end_if
    i = lig+1
    if i <= ligne
       k = (i-1)*colonne + col : inverser(k)
       j = col-1 : if j > 0 then k = (i-1)*colonne +j : inverser(k)
       j = col+1 : if j <= colonne then k = (i-1)*colonne +j : inverser(k)
   end_if
   verif_gagne()
END_SUB
rem ============================================================================
' Inverser les vapeurs, pardon inverser les pions !
SUB Inverser(k)
    2d_target_is k
    if rouge(k) = 1 then 2d_fill_color 0,0,255 : else : 2d_fill_color 255,0,0
    2d_circle w/2,w/2,w/2-2 : rouge(k) = 1 - rouge(k) : beep
END_SUB
rem ============================================================================
' Suis-je un champion ?
SUB Verif_Gagne()
    dim_local t$
    for i = 1 to ligne*colonne
        if rouge(i) = 1 then exit_sub
    next i
    t$ ="Bravo ! Vous êtes un grand champion !"
    parler(t$) : message t$
END_SUB
rem ============================================================================
' Montre-moi ce dont tu es capable, comme un grand !
SUB Autorun(niveau)
    dim_local coup$,i,j,k,t$
    select niveau
        case 1 : coup$ = "0401020304"
        case 2 : coup$ = "06010406070912"
        case 3 : coup$ = ""
        case 4 : coup$ = ""
        case 5 : coup$ = ""
        case 6 : coup$ = ""
    end_select
    if niveau < 3
       j = 3
       for i = 1 to val(left$(coup$,2))
           k = val(mid$(coup$,j,2)) : j = j + 2
           Identifier_Case(k) : Analyser_Situation() : wait 1000
       next i
    else
       t$ = "      Pas encore codé !!!" + chr$(13)
       t$ = t$ + "Pour le moment, seuls les niveaux 1 et 2 sont codés" + chr$(13)
       t$ = t$ + "Pour ne pas gâcher le plaisir d'essayer par vous-mêmes, faites un effort." + chr$(13)
       t$ = t$ + " Vous y arriverez !!!" + chr$(13)
       t$ = t$ + "Sinon, changez de niveau 1 ou 2 puis cliquez sur AUTORUN pour voir."
       message t$
    end_if
END_SUB
rem ============================================================================
' J'en ai assez, ça ne m'intéresse plus !
SUB Quitter()
    dim_local t$
    t$ = "Vous êtes sûr que vous voulez quitter ce jeu ?" : parler(t$)
    if message_confirmation_yes_no("Vous êtes sûr que vous voulez quitter ?") = 1
      parler("Au revoir !") : terminate
    end_if
END_SUB
rem ============== F  I  N =====================================================

rem ============================================================================
rem          PING
rem         Par Papydall
rem ============================================================================
Run()
end
rem ============================================================================
SUB Run()
    Presentation()
    Init()
    Jeu()

END_SUB
rem ============================================================================
' J'exhibe ici ma science panoramicienne !!!
SUB presentation()
  dim_local i,t$
  full_space 0
  t$ = "Papydall vous propose ... le Ping ... un vrai  casse-tête, ..."
  t$ = t$ + "Bon divertisse ment, avec ... le Ping"
  parler(t$)
  scene3d 1 : color 1, 0,0,0 : 3d_text 1,"PAPYDALL VOUS PROPOSE LE PING" : full_space 1
  3d_color 1,0,0,255 : 3d_position 1,-.5,-.5,1
  for i = 0 to 360 step 2: 3d_x_rotate 1,i : wait 10 : next i
  for i = 1 to .005 step -.005 : 3d_scale 1,i,i,i : wait 10 : next i
  3d_text 2,"!!! UN VRAI CASSE-TETE !!!" : 3d_color 2,255,0,0
  3d_position 2,-.5,-.5,1
  for i = 0 to 360 step 2: 3d_x_rotate 2,i : wait 10 : next i
  for i = 1 to .005 step -.005 : 3d_scale 2,i,i,i : wait 10 : next i
  3d_text 3,"BON DIVERTISSEMENT AVEC LE PING" : 3d_color 3,0,255,0
  3d_position 3,-1.5,-.5,1

  for i = 0 to 500 step 2 : 3d_y_rotate 3,i : 3d_z_rotate 3,i : wait 10 : next i
  for i = 1 to .01 step -.005 : 3d_scale 3,i,i,i : wait 10 : next i
  3d_position 3,-2,.5,1 : 3d_color 3,255,255,0
  for i = .01 to 1 step .005 : 3d_scale 3,i/1.1,i/1.1,i/5 : wait 10 : next i
  
  t$ = "Bon divertissement, avec, Le Ping"
  parler(t$)
  
  wait 1000 : delete 1

END_SUB
rem ============================================================================
' Votre ordinateur vous parle, veuillez être attentif !
SUB parler(tex$)
    dim_local f$,g$
    f$ = "c:\temp\parler.vbs" : ' A adapter
    g$ = chr$(34)
    FILE_OPEN_WRITE 9999, f$
    file_writeln 9999, "Dim speaks, speech"
    file_writeln 9999, "speaks = " + g$ + tex$ + g$
    file_writeln 9999, "Set speech = CreateObject(" + g$ + "sapi.spvoice" + g$+ ")"
    file_writeln 9999, "speech.Speak speaks"
    FILE_CLOSE 9999
    EXECUTE_WAIT f$ : FILE_DELETE f$
END_SUB
rem ============================================================================

SUB Init()
    label clic
    dim niveau,ligne,colonne,lig,col,i,j,k,w,possible,rouge(12*12),coup,autorun
    width 0 ,100 + screen_x/2 : height 0 , screen_y/2
    
END_SUB
rem ============================================================================
' Je n'aime pas trop les LABEL, alors un seul suffit pour tout traiter !
clic:

    if number_click = 2001 then hide 1000 : return
    if number_click = 2002 then Quitter() : return
    if number_click = 2003 then Autorun(niveau) : return
    if number_click = 2004 then Aide() : return
    if number_click > 1000 and number_click < 1007
       niveau = right$(caption$(number_click),1)
       ligne = 2*niveau : colonne = 2* niveau
       possible(ligne,colonne)
       if possible > 0
          Ping(ligne,colonne)
       else
          message "Ce Ping est impossible !!!"
       end_if
    return
    end_if
    Identifier_Case(number_click) : Analyser_Situation()

return
rem ============================================================================
' Je joue, tu joues, il/elle joue, nous joueons, vous jouez, ils/elles jouent
SUB Jeu()
    k = 1000
    for i = 1 to 6
        k = k +1 : option k
        top k, 20+i*20 : left k,100
        font_bold k : caption k,"Niveau : " + str$(i) : on_click k,clic
    next i
    mark_on k-3

END_SUB
rem ============================================================================
' Le ping ? c'est quoi ?
SUB Aide()
    dim_local t$,n$
    n$ = chr$(13)
    t$ = "Ce jeu répond au doux nom de PING. Les règles de ce casse-tête sont très simples." + n$
    t$ = t$ + " * Sur un échiquier rectangulaire de L lignes et C colonnes, (Rappel : un carré est aussi une forme rectangulaire !)" + n$
    t$ = t$ + "   sont disposés des pions ayant chacun une face rouge et une face bleue (des pions semblables à ceux de Reversi ou de Othello)" + n$
    t$ = t$ + " * Au départ, tous les pions montrent leu face rouge." +n$
    t$ = t$ + " * Le but du jeu est de retourner tous ces pions pour qu'ils montrent leur autre face bleue en respectant l'unique règle suivante :" +n$
    t$ = t$ + " A chaque fois que vous cliquez sur une case, vous retournez les pions qui l'entourent. Pour une case centrale,il y en a huit :" + n$
    t$ = t$ + " haut, bas, gauche, droite, haut-gauche, haut-droite,bas-gauche et bas-droite." + n$
    t$ = t$ + " Il y en a cinq pour une case sur le bord et trois pour une case dans un coin." + n$
    t$ = t$ + " Le pion de la case cliquée ne sera pas retourné mais le fond de la dite case prendra la couleur verte (pour rappeler au joueur" + n$
    t$ = t$ + " que cette case a été jouée" + n$ + n$
    t$ = t$ + "  ============================================================================ " +n$
    t$ = t$ + "  Le rectangle L x C  possède une solution si et seulement si L et C ne sont pas tous les deux dans un même ensemble Ci" +n$
    t$ = t$ + " Autrement dit, pas de solution pour PING si L et C sont tous les deux dans le même ensemble Ci" + n$
    t$ = t$ + " Les ensembles Ci sont les suivants: " + n$
    t$ = t$ + " C1 = {1, 5, 9,13,...} = {1 + 4k  ; k entier}" + n$
    t$ = t$ + " C2 = {3,11,19,27,...} = {3 + 8k  ; k entier}" + n$
    t$ = t$ + " C3 = {7,23,39,55,...} = {7 + 16k ; k entier}" + n$
    t$ = t$ + " Cn = {2^n - 1, 2^n -1 + 2^(n+1), 2^n - 1 + 2.2^(n+1), ...} = {2^n - 1 + k.2^(n+1); k entier}" + n$
    t$ = t$ + "  ============================================================================ " + n$
    message t$
END_SUB
rem ============================================================================
' Vérifie si le ping possède une solution ou non
' A utiliser si l'on veut définir soi-même les dimensions du PING
sub possible(L,C)
    if (mod(L,4)=1 and mod(C,4)=1) or (mod(L,8)=3 and mod(C,8)= 3) or (mod(L,16)=7 and mod(C,16)=7)
        possible = 0
    else
        possible = 1
    end_if
end_sub
rem ============================================================================
' Le PING en chaire et en os, pardon en ligne et colonne !
SUB ping(ligne,colonne)
    k = 1000
    if object_exists(k) > 0 then command_target_is 0 : delete k : coup = 0
    form k : width k , width(0) : height k , height(0)
    k = k+1000 : container k :parent k,1000 :  top k ,20 : left k,400 : width k,400 : height k,height(0)-100
    k = k + 1 : button k : parent k,k-1 : top k,20 : left k,20  : font_bold k : caption k,"Nouveau": on_click k,clic
    k = k + 1 : button k : parent k,k-2 : top k,20 : left k,100 : font_bold k : caption k,"Quitter": on_click k,clic
    K = k + 1 : button k : parent k,k-3 : top k,20 : left k,180 : font_bold k : caption k,"Autorun": autorun = k :  on_click k,clic
    k = k + 1 : button k : parent k,k-4 : top k,20 : left k,260 : font_bold k : caption k,"Aide"   : on_click k,clic

    command_target_is 1000
     w = 250/(max(ligne,colonne))
    for i = 1 to ligne
        for j = 1 to colonne
            k = j + colonne *(i-1) : picture k : on_click k,clic
            width k,w : height k,w : top k ,(w+2)*i : left k, (w+2)*j
            2d_target_is k : 2d_fill_color 255,0,0 : 2d_circle w/2,w/2,w/2-2

            rouge(k) = 1
        next j
    next i
END_SUB
rem ============================================================================
' Déterminer la case cliquée
SUB Identifier_Case(p)
    lig = 1 + int(p/(colonne)) : col = mod(p,ligne)
    if col = 0 then col = colonne : lig = lig - 1

END_SUB
rem ============================================================================
' Répondre aux clicks du joueur
SUB Analyser_Situation()
    i = lig : j = col : k = (i-1)*colonne +j : color k, 0,255,0 : 2d_target_is k
    if rouge(k) = 1 then :2d_fill_color 255,0,0 :else: 2d_fill_color 0,0,255
    2d_circle w/2,w/2,w/2-2

    j = col-1 : if j > 0 then k = (i-1)*colonne +j : inverser(k)
    j = col+1 : if j <= colonne then k = (i-1)*colonne +j : inverser(k)
    i = lig-1
    if i > 0
       k = (i-1)*colonne + col : inverser(k)
       j = col-1 : if j > 0 then k = (i-1)*colonne +j : inverser(k)
       j = col+1 : if j <= colonne then k = (i-1)*colonne +j : inverser(k)
    end_if
    i = lig+1
    if i <= ligne
       k = (i-1)*colonne + col : inverser(k)
       j = col-1 : if j > 0 then k = (i-1)*colonne +j : inverser(k)
       j = col+1 : if j <= colonne then k = (i-1)*colonne +j : inverser(k)
   end_if
   coup = coup + 1 : caption 1000,"Coup N° : " + str$(coup)
   verif_gagne()
END_SUB
rem ============================================================================
' Inverser les vapeurs, pardon inverser les pions !
SUB Inverser(k)
    2d_target_is k
    if rouge(k) = 1 then 2d_fill_color 0,0,255 : else : 2d_fill_color 255,0,0
    2d_circle w/2,w/2,w/2-2 : rouge(k) = 1 - rouge(k) : beep

END_SUB
rem ============================================================================
' Suis-je un champion ?
SUB Verif_Gagne()
    dim_local t$
    for i = 1 to ligne*colonne
        if rouge(i) = 1 then exit_sub
    next i
    inactive autorun
    t$ ="Bravo ! Vous êtes un grand champion !"
    parler(t$) : message t$
END_SUB
rem ============================================================================
' Montre-moi ce dont tu es capable, comme un grand !
SUB Autorun(niveau)
    dim_local coup$,i,j,k,t$

    select niveau
        case 1 : coup$ = "004001002003004"
        
        case 2 : coup$ = "006001004006007009012"
        
        case 3 : coup$ = "016001006008009010011014017020023026027028029031036"
        
        case 4 : coup$ = "032002003006007009010012013015016017019022024026031"
                 coup$ = coup$ + "034039041043046048049050052053055056058059062063"
                
        case 5 : coup$ = "060001003004005006007008010012014017019021024025026027"
                 coup$ = coup$ + "030031032033038039040041043045046048050051053"
                 coup$ = coup$ + "055056058060061062063068069070071074075076077"
                 coup$ = coup$ + "080082084087089091093094095096097098100"

        case 6 : coup$ = "084002005006007008011013014015017018019020022023024"
                 coup$ = coup$ + "026027028030031033034035039041044046"
                 coup$ = coup$ + "049050052057059060061062063066067070071072"
                 coup$ = coup$ + "073074075078079082083084085086088093095096"
                 coup$ = coup$ + "099101104106110111112114115117118119"
                 coup$ = coup$ + "121122123125126127128130131132134137138139140143"

    end_select
    j = 4
    for i = 1 to val(left$(coup$,3))
        k = val(mid$(coup$,j,3)) : j = j + 3
        Identifier_Case(k) : Analyser_Situation() : wait 400
    next i
END_SUB
rem ============================================================================
' J'en ai assez, ça ne m'intéresse plus !
SUB Quitter()
    dim_local t$
    t$ = "Vous êtes sûr que vous voulez quitter ce jeu ?" : parler(t$)
    if message_confirmation_yes_no("Vous êtes sûr que vous voulez quitter ?") = 1
      parler("Au revoir !") : terminate
    end_if
END_SUB
rem ============================================================================