Un petit jeu moin simple qu'il en a l'air

[Micoute]

Dans tous mes programmes je mets toujours :

Code : Tout sélectionner

Global.s Rep$ = GetPathPart(ProgramFilename()) : SetCurrentDirectory(Rep$)

c'est grâce à MLD que j'ai pris ce reflexe, car il m'a dit que j'avais l'habitude de ne travailler que pour moi. Par exemple ça me permet d'écrire :

Code : Tout sélectionner

Global Fichier_Scores.s = Rep$ + "Scores.Json"

[Kwai chang caine]

Cool !!!! Simple et joli
Ca me rappelle ma jeunesse quand il distribuaient ce genre de jeu dans les stations services
En principe c'était avec une image.....et ça me prenait encore plus la tete
Je l'ai pas fini car la patience et moi....
J'ai déjà assez de mal depuis des années, à soigner l'addiction que j'ai prise avec le virus chronophage du 2048 (A cause d'un code PB comme le tiens d'ailleurs )
En tout cas il m'a bien plu, et je te remercie du partage

[SPH]

Le jeu refuse de marcher chez moi (5.72 x64)
J'ai beau cliquer sur une piece pour la mettre dans le trou, rien ne se passe...

[Ar-S]

@sph
Tu as cliqué sur "nouveau jeu" ?
(Merci de t'auto traiter de buse si ce n'est pas le cas ? )

[SPH]

(Merci de t'auto traiter de buse si ce n'est pas le cas ? )

En effet, c'etait le cas.
Ca marche maintenant

Hazard totalement fortuit : j'ai moi meme aussi codé un jeu de poussepousse !! (je l'ai posté)

[MLD]

Merci a vous tous

Je l'ai pas fini car la patience et moi....

Moi aussi il m'énerve

J'ai beau cliquer sur une piece pour la mettre dans le trou, rien ne se passe...

C'est comme avec les dames, il faut une préséance.

[Kwai chang caine]

Moi aussi il m'énerve

[Demivec]

@MLD: Vous devez également corriger la procédure 'control ()'.

Code : Tout sélectionner

;OpenFile(110,"PPscor") ;avant
OpenFile(110, GetTemporaryDirectory() + "PPscor") ;après

Parfois, le puzzle n'est pas résoluble. Voici une vérification de la configuration pour vous assurer qu'elle l'est.

Code : Tout sélectionner

Procedure brasse()
  If dpj = 1
    
    isSolvable = #False
    Repeat
      For i = (ngcm - ngcd) To 1  Step-1
        irnd = Random(27,1)
        Swap Tposc(i,1),Tposc(irnd,1)
        Swap Tposc(i,4),Tposc(irnd,4)
      Next
      
      ;Is puzzle solvable? If (number of tiles) - (number of cycles) is even then puzzle is solvable.
      ;Le puzzle est-il résoluble? Si (le nombre de tuiles) - (le nombre de cycles) est pair alors le puzzle est résoluble.
      ;Johnson & Story (1879) https://www.jstor.org/stable/2369492?seq=1#metadata_info_tab_contents
      tile$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ!" ;possible tiles (doesn't include the blank, i.e 'hole')
      cycleCount = 0
      startCycleElement = 0
      While Trim(tile$) <> ""
        ;get a remaining tile
        startCycleElement$ = ""
        For i = 1 To Len(tile$)
          If Mid(tile$, i, 1) <> " "
            startCycleElement = i
            startCycleElement$ = Chr(Tposc(i, 4))
            Break
          EndIf
        Next
        
        ;Find all tiles in a cycle and remove them.  A cycle starts on one tile
        ;and looks to where that tile should go, then looks to where that tile
        ;goes and so forth until ending up at the original tile.
        ;Trouvez toutes les tuiles dans un cycle et retirez-les. Un cycle commence
        ;sur une tuile et regarde où cette tuile doit aller, puis regarde où va cette
        ;tuile et ainsi de suite jusqu'à ce qu'elle finisse sur la tuile d'origine.
        While startCycleElement <> 0
          nextCycleElement = FindString(tile$, startCycleElement$)
          If nextCycleElement
            ;Remove tile from the possible tiles. ;Retirez la tuile des tuiles possibles.
            ReplaceString(tile$, startCycleElement$, " ", #PB_String_InPlace)
            startCycleElement = nextCycleElement
            startCycleElement$ = Chr(Tposc(startCycleElement, 4))
          Else
            ;End of cycle. ;Fin du cycle.
            cycleCount + 1
            startCycleElement = 0
          EndIf
        Wend
      Wend
      ;If (number of tiles) - (number of cycles) is even then puzzle is solvable.
      ;Si (nombre de tuiles) - (nombre de cycles) est pair alors le puzzle est résoluble.
      If (Len(tile$) - cycleCount) % 2 = 0
        isSolvable = #True
      EndIf
    Until isSolvable
    
  EndIf
  For zz = 1 To (ngcm - ngcd)
    ResizeGadget(Tposc(zz,1),Tposc(zz,2),Tposc(zz,3),#PB_Ignore,#PB_Ignore)
    SetGadgetText(Tposc(zz,1),Chr(Tposc(zz,4)))
  Next 
EndProcedure

[MLD]

@KCC
Je suis désolé

@Devimec

Parfois, le puzzle n'est pas résoluble

Ceci est impossible, c'est une question de temps.

[MLD]

@KCC
Je suis désolé

@Devimec

Parfois, le puzzle n'est pas résoluble

Ceci est impossible, c'est une question de temps.
Pour le fichier dans la procedure control. Merci correction effectuée dans le poste 1

[Demivec]

Ceci est impossible, c'est une question de temps.

Si vous pouvez le faire, dites-moi combien de temps il vous faut pour résoudre ce puzzle.

Code : Tout sélectionner

Procedure brasse()
  If dpj = 1
 ;  For i = (ngcm - ngcd) To 1  Step-1
;           irnd = Random(27,1)
 ;          Swap Tposc(i,1),Tposc(irnd,1)
;           Swap Tposc(i,4),Tposc(irnd,4)
;   Next

    Swap Tposc(26,1),Tposc(27,1)
    Swap Tposc(26,4),Tposc(27,4)
  EndIf
  For zz = 1 To (ngcm - ngcd)
    ResizeGadget(Tposc(zz,1),Tposc(zz,2),Tposc(zz,3),#PB_Ignore,#PB_Ignore)
    SetGadgetText(Tposc(zz,1),Chr(Tposc(zz,4)))
  Next
EndProcedure

[MLD]

@Devimec
c'est la même chose avec n'importe quelle dernière lettre a placer.
Je ne suis pas très doué pour ce jeu. j'ai déjà mis plus de 2 heures pour en finir un.
Mais j'ai vu un jour un jeune (15 ans) en finir un en mois de 5 mm
Comme certains finissais un rubik's cub en moins d'une minute.
Moi, je n'en est jamais finis un seul.
Mais bon courage a vous.
On peu lancer un concours sur le forum
Ce jeu vient de chine et existe depuis très longtemps.
Comme KCC, quand j'étais en culotte courte, ce jeu en plastique faisait fureur dans les cours de récréations.

[Demivec]

@Devimec
c'est la même chose avec n'importe quelle dernière lettre a placer.
Je ne suis pas très doué pour ce jeu. j'ai déjà mis plus de 2 heures pour en finir un.
Mais j'ai vu un jour un jeune (15 ans) en finir un en mois de 5 mm
Comme certains finissais un rubik's cub en moins d'une minute.
Moi, je n'en est jamais finis un seul.
Mais bon courage a vous.
On peu lancer un concours sur le forum
Ce jeu vient de chine et existe depuis très longtemps.
Comme KCC, quand j'étais en culotte courte, ce jeu en plastique faisait fureur dans les cours de récréations.

Si les tuiles sont posées au hasard ou échangées comme vous l'avez fait, la moitié des dispositions possibles ne sont pas résolubles. Si l'agencement des carreaux est créé par glissement, tous sont résolubles (c'est-à-dire en inversant les marches).

Juste pour référence, le puzzle a été "inventé" par Noyes Palmer Chapman, un maître de poste à Canastota, New York, en 1879.

[MLD]

@Devimec
L'invention par Noyes Palmer Chapman est assez contestée. Des jeux chinois apparentés sont bien plus anciens
La résolution avec le carré vide en bas a droite a été démontrée par Preston Jensen en utilisant une fonction heuristique.
Mais il existe une autre solution: Cassé l'écran de son ordi