Magic 4x4

SPH · Message par **SPH** » mer. 14/mai/2025 11:13

Salut,

Je suis fière de vous présenter en PureBasic j'un des jeux qui se trouve dans ma montre électronique.

La règle du jeu est de compacter les chiffres identiques pour obtenir le chiffre additionné. Pour cela, "précipitez" les chiffres vers la gauche, la droite, en haut ou en bas (avec les flèches de direction du clavier). Après votre résultat, un nouveau nombre apparaitra (un "2" ou un "4") et vous devrez renouveler l'opération. Le but est d'avoir un maximum de points à l'écran (la somme additionnée donne votre score).
Escape pour quitter.

Enjoy...

Et postez vos meilleurs résultats.

... et ce n'est pas fni

Sound version 1.3a :
http://xmas.free.fr/jeu/Magic_4x4.exe

==

==

v1.3 (No Sound)
#PB_Key_Back : Possibilité de reculer de 5 coups si on se sent bloqué
F5 : sauvegarde de la partie
F1 : charger la partie sauvegardée par F5

Code : Tout sélectionner

;-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;-;;;;;;;;  Jeu de grille 4x4 où il faut regrouper les memes nombres
;-;;;;;;;;  Codé du 13 au 5 Juin 2025 / PB 6.12 LTS par SPH (France)
;-;;;;;;;;  F5 : save
;-;;;;;;;;  F1 : load
;-;;;;;;;;  Back : reculer (jusqu'a 5 coups)
;-;;;;;;;;  Flèches de direction
;-;;;;;;;;  Escape
version$="V1.3 (No Sound) - SPH(2025)"
;-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

InitSprite()
InitKeyboard()
InitMouse()
InitSound()

; CatchSound(1, ?Music1)
; CatchSound(2, ?Music2)
; CatchSound(3, ?Music3)
; CatchSound(4, ?Music4)
; CatchSound(5, ?Music5)
; CatchSound(6, ?Music6)

randoom=10000;-randoom=10000
Dim seed.q(randoom)
seed(0)=1
For i=1 To randoom
  seed(i)=Random(65536*32768-1)
Next


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
boucle: ;- boucle ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

SPH_X=800
SPH_Y=570

OpenWindow(0, SPH_X, SPH_Y, SPH_X, SPH_Y, "Magic_4x4 - Menu", #PB_Window_MinimizeGadget|#PB_Window_ScreenCentered)

Top = 10



CanvasGadget(666, 10, Top, SPH_X-25, 90)

Top+77
FrameGadget(111, 10, Top+20, SPH_X-25, 70-10, "Taille de la fenêtre de jeu")

For i= 1 To 8
  OptionGadget(3+i, i*92-45, top+28+15, 60, 24, Str(100*i+100)+"x"+Str(100*i+100))
  
Next
SetGadgetState(7, 1)
Top+77

;;;

FrameGadget(112, 10, Top+10, SPH_X-25, 70-10, "Grille")
For i= 1 To 8
  OptionGadget(13+i, i*92-45, top+28+5, 60, 24, Str(i+2)+"x"+Str(i+2))
  
Next
SetGadgetState(15, 1)
Top+77

;;;;

FrameGadget(113, 10, Top, 460, 306, "Couleurs")
;
Dim SPH(11,3,16)

For x=1 To 8
  xx=x*2
  If xx=8
    xx=9
  EndIf
  RandomSeed(xx)
  
  ;;;;Box color
  For u=1 To 3
    For i=1 To 16
      SPH(x,u,i)=Random(130)+2
    Next
  Next
Next x

Gosub rdn

For u=1 To 3
  For i=1 To 16
    SPH(11,u,i)=Random(130)+2
  Next
Next

x=Random(8)+1
For i=1 To 16
  u=i*20+20
  SPH(9,1,i)=u
  SPH(9,2,i)=u
  SPH(9,3,i)=u
  SPH(10,1,i)=SPH(x,1,i)
  SPH(10,2,i)=SPH(x,2,i)
  SPH(10,3,i)=SPH(x,3,i)
Next

For i= 1 To 9
  OptionGadget(21+i, 47, top+4+i*24, 44, 24, "N°"+Str(i))
  
Next
OptionGadget(31, 47, top+4+i*24, 180, 22, "Random (1 à 9)")

OptionGadget(32, 47, top+4+i*24+24, 180, 22, "Random (ALL)")


;
For i= 1 To 9
  CanvasGadget(40+i, 92, top+4+i*24, 351, 20)
  StartDrawing(CanvasOutput(40+i))
  For x=0 To 15
    Box(x*22,0,20,20,RGB(SPH(i,1,x+1)*1.4,SPH(i,2,x+1)*1.4,SPH(i,3,x+1)*1.4))
  Next
  StopDrawing()
Next

SetGadgetState(31, 1)

FrameGadget(114, 486, Top, 300, 90, "Préférences")
ButtonGadget(33, 509,  Top+28, 254, 40, "Sauvegarder les préférences")


FrameGadget(115, 486, Top+100, 300, 206, version$)
CanvasGadget(667, 500, Top+122, 270, 170)

FrameGadget(116, 320, 514, 150, 33, "Merci à VENOM (F9)")

; DeleteFile(GetPathPart(ProgramFilename())+"Magic_Preferences.ini") ;- delete pref
; Debug GetPathPart(ProgramFilename()):End:End ;- load pref
If ReadFile(0, GetPathPart(ProgramFilename())+"Magic_Preferences.ini") ;- load pref
  For i= 1 To 8
    u=ReadByte(0)
    SetGadgetState(i+3, u)
  Next
  For i= 1 To 8
    u=ReadByte(0)
    SetGadgetState(i+13, u)
  Next
  For i= 1 To 11
    u=ReadByte(0)
    SetGadgetState(i+21, u)
  Next
  CloseFile(0)
EndIf

a$="Arial"
Police8 = LoadFont(20, a$, 65);, #PB_Font_Underline) 
Police9 = LoadFont(21, a$, 55, #PB_Font_Underline) 
mag$= "MAGIC 4x4"
mag2$= "JOUER"

If StartDrawing(CanvasOutput(666))
  DrawingMode(#PB_2DDrawing_Transparent)
  DrawingFont(Police8)
  u=TextWidth(mag$)
  DrawText(SPH_X/2-u/2+4,10,mag$,RGB(155,155,155))
  DrawText(SPH_X/2-u/2,10-3,mag$,RGB(96,20,4))
  StopDrawing()
EndIf

Dim titre(SPH_X-26,90)

If StartDrawing(CanvasOutput(666))
  For u=0 To 89
    For i=0 To SPH_X-26
      titre(i,u)=Point(i,u)
    Next
  Next
  StopDrawing()
EndIf

CanvasGadget(666, 10, 10, SPH_X-25, 90)


If StartDrawing(CanvasOutput(667))
  DrawingMode(#PB_2DDrawing_Outlined) 
  For u=0 To 4
    For i=30+u*18 To 35+u*18
      Circle(0,0,i,RGB(33+u*50,33+u*50,255))  
      Circle(269,0,i,RGB(33+u*50,33+u*50,255))  
      Circle(0,169,i,RGB(33+u*50,33+u*50,255))  
      Circle(269,169,i,RGB(33+u*50,33+u*50,255))  
    Next
  Next
  
  DrawingMode(#PB_2DDrawing_Transparent)
  DrawingFont(Police9)
  u=TextWidth(mag2$)
  DrawText(270/2-u/2+4+5,53,mag2$,RGB(155,155,155))
  DrawText(270/2-u/2+5,53-3,mag2$,RGB(155,0,0))
  StopDrawing()
EndIf

Dim jouer(269,169)

If StartDrawing(CanvasOutput(667))
  For u=0 To 169
    For i=0 To 269
      jouer(i,u)=Point(i,u)
    Next
  Next
  StopDrawing()
EndIf

CanvasGadget(667, 500, 363, 270, 170)

For i=1 To 30
  Gosub op_666
  Gosub op_667
Next

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Repeat
  Event = WaitWindowEvent()
  
  Gosub op_666
  
  Gosub op_667
  
  If Event = #PB_Event_Gadget
    
    If EventType() = #PB_EventType_LeftButtonDown Or (EventType() = #PB_EventType_MouseMove And GetGadgetAttribute(666, #PB_Canvas_Buttons) & #PB_Canvas_LeftButton)
      If StartDrawing(CanvasOutput(666))
        x = GetGadgetAttribute(666, #PB_Canvas_MouseX)
        y = GetGadgetAttribute(666, #PB_Canvas_MouseY)
        Circle(X, Y, 10, RGB(Random(255), Random(255), Random(255)))
        StopDrawing()
      EndIf
    EndIf
    ;;;;;;
    
    If EventType() = #PB_EventType_LeftButtonDown Or EventType() = #PB_EventType_MouseMove
      If  GetGadgetAttribute(667, #PB_Canvas_Buttons) & #PB_Canvas_LeftButton
        Goto magic_4x4  
      EndIf
    EndIf
    ;;;;;;
    
    Select EventGadget()
      Case 33 ; save pref
        If CreateFile(0, GetPathPart(ProgramFilename())+"Magic_Preferences.ini") ;- save pref
          For i= 1 To 8
            WriteByte(0,GetGadgetState(i+3))
          Next
          For i= 1 To 8
            WriteByte(0,GetGadgetState(i+13))
          Next
          For i= 1 To 11
            WriteByte(0,GetGadgetState(i+21))
          Next
          CloseFile(0)
        EndIf
    EndSelect
    
  EndIf
  
Until Event = #PB_Event_CloseWindow

End:End


magic_4x4:

; ; ; InitSprite()
; ; ; InitKeyboard()
; ; ; InitMouse()

For i= 1 To 8
  u=GetGadgetState(i+3)
  If u=1
    zoom=100+i*100
    Break
  EndIf
Next

For i= 1 To 8
  u=GetGadgetState(i+13)
  If u=1
    rang=i+2
    Break
  EndIf
  
Next

For i= 1 To 11
  u=GetGadgetState(i+21)
  If u=1
    la_couleur=i
    Break
  EndIf
Next



If la_couleur=10
  la_couleur=Random(8)+1
EndIf
; ; ; 
; ; ; Debug la_couleur
;     CreateFile(1, GetPathPart(ProgramFilename())+"Magic_4x4.ini") : i=WriteQuad(1,0) : CloseFile(1)
titre$=Str(rang)+"x"+Str(rang)
; Ouverture de la fenêtre
OpenWindow(0,0,0,zoom,zoom+zoom/10,"Magic "+titre$,#PB_Window_ScreenCentered);|#PB_Window_SystemMenu)
OpenWindowedScreen(WindowID(0),0,0,zoom,zoom+zoom/10,1,0,0)


a$="Arial"
Police = LoadFont(0, a$, DesktopUnscaledX(zoom/25) - (rang-4)*1.8) ; Correction par Fred
Police2 = LoadFont(1, a$, DesktopUnscaledX(zoom/70))               ; Correction par Fred
Police3 = LoadFont(2, a$, DesktopUnscaledX(zoom/23))               ; Correction par Fred
Police4 = LoadFont(3, a$, DesktopUnscaledX(zoom/12))               ; Correction par Fred

high.q=0
score=0

If ReadFile(2, GetPathPart(ProgramFilename())+"Magic_Score"+titre$+".ini")
  high.q=ReadQuad(2)
  CloseFile(2)
EndIf
xx=-1

Gosub rdn ;-Gosub rdn

;;;;;;;;;;;;;
CreateSprite(0, zoom/rang,zoom/rang)
StartDrawing(SpriteOutput(0))
DrawingMode(1)
Box(0,0,zoom/rang-1,zoom/rang-1,RGB(33,33,33))
Box(2,2,zoom/rang-3,zoom/rang-3,RGB(51,11,11))
StopDrawing()

CreateSprite(1000, zoom/rang,zoom/rang)
StartDrawing(SpriteOutput(1000))
DrawingMode(1)


For i=0 To (zoom/rang)/2
  Box(i,i,zoom/rang-1-i*2,zoom/rang-1-i*2,RGB(255-i*4,255-i*4,255-i*4))
  If i*4>250
    Break
  EndIf
  
Next
StopDrawing()

CreateSprite(1001, zoom/rang,zoom/rang)
StartDrawing(SpriteOutput(1001))
DrawingMode(1)
Box(0,0,zoom/rang,zoom/rang,RGB(255,255,255))
StopDrawing()
;GrabSprite(0,0,0,zoom/rang+1,zoom/rang+1)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

CreateSprite(1002, zoom,zoom/10);-1002
StartDrawing(SpriteOutput(1002))
DrawingMode(1)
DrawingFont(Police2)
Box(0,0,Zoom,zoom,RGB(5,10,20))
DrawText(zoom-TextWidth(version$)-10,zoom/15+1, version$, RGB(40,40,40))
DrawText(zoom-TextWidth(version$)-11,zoom/15, version$, RGB(99,99,99))
StopDrawing()

CreateSprite(1003, zoom,zoom/10);-1003
StartDrawing(SpriteOutput(1003))
DrawingMode(1)
DrawingFont(Police3)
If high<score : high=score : EndIf
scor$="Score : "+Str(score)+" - (Best : "+Str(high)+") "
DrawText(zoom/45+2,zoom/52+3, scor$, RGB(88,88,40))
DrawText(zoom/45,zoom/52,scor$, RGB(177,177,77))
StopDrawing()


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


nb=2

For i=1 To 16
  nb$=Str(nb)
  
  CreateSprite(i, zoom/rang,zoom/rang)
  StartDrawing(SpriteOutput(i))
  
  DrawingMode(1)
  Box(0,0,zoom/rang-1,zoom/rang-1,RGB(188,188,188))
  Box(3,3,zoom/rang-1,zoom/rang-1,RGB(0,18,18))
  LineXY(0,zoom/rang-1,zoom/rang-1,0,RGB(0,18,18))
  LineXY(1,zoom/rang-1,zoom/rang-1,1,RGB(0,18,18))
  LineXY(2,zoom/rang-1,zoom/rang-1,2,RGB(0,18,18))
  
  
  For y=3 To zoom/rang-5
    For x=3 To zoom/rang-5
      Plot(x,y,RGB(SPH(la_couleur,1,i)+Random(x/2),SPH(la_couleur,2,i)+Random(y/2),SPH(la_couleur,3,i)+Random((x+y)/3))) 
    Next
  Next
  
  DrawingFont(Police)
  DrawText(zoom/(rang*2)-TextWidth(nb$)/2+2,zoom/(rang*2)-TextHeight(nb$)/2+2, nb$, RGB(1,1,1))
  If la_couleur=9
    DrawText(zoom/(rang*2)-TextWidth(nb$)/2,zoom/(rang*2)-TextHeight(nb$)/2, nb$, RGB(255,90,90))
  Else
    DrawText(zoom/(rang*2)-TextWidth(nb$)/2,zoom/(rang*2)-TextHeight(nb$)/2, nb$, RGB(255,255,255))
  EndIf
  StopDrawing()
  
  nb*2
Next

;-;;;;;;;;;;;;;;;;;;;;;;;  D E B U T   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

debut:
Dim plateau.q(rang+1,rang+1)
Dim ghost.q(rang+1,rang+1)
Dim eclair.w(rang+1,rang+1)

Dim stop.b(8)
encore=0
attente=0
fini=0
old_score=-1
score=0
F12=-1
p_sound=0
sound5=0
NB_Sound=1000
sound6=NB_Sound
sound10000=0

Dim undo(5,rang+1,rang+1)
undo=0
undo_flag=0
;;;
Gosub rdn ;-Gosub rdn
          ;RandomSeed(seed(seed(0)))
timer=ElapsedMilliseconds()

;;;;;;;;;;;;;;;;;;;;;;;;
;Debug "DEBUT"
;-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Gestion de la fenêtre et de l'écran


Repeat
  Repeat         ;- Gestion de la fenêtre
    Event  = WindowEvent() 
  Until Event = 0
  
  timer=ElapsedMilliseconds()-timer
  clock=timer
  timer=ElapsedMilliseconds()
  
  
  ClearScreen(RGB(5,10,20)) 
  
  ExamineKeyboard()
  
  
  ;-  If KeyboardReleased(#PB_Key_Left) And stop(0)=1
  ;{
  If KeyboardReleased(#PB_Key_Left) And stop(0)=1
    stop(0)=0
  EndIf
  
  If KeyboardPushed(#PB_Key_Left) And stop(0)=0
    attente=0
    LR=1
    For u=1 To rang
      x=-1
      Dim piece(rang+1)
      For i=1 To rang
        If plateau(i,u)>0
          x+1
          piece(x+1)=plateau(i,u)
          plateau(i,u)=0
        EndIf
      Next
      ;;;;;;;;;;;;;;;;;;;;
      If x>-1
        x=1
        y=1
        While piece(x)<>0
          If piece(x)=piece(x+1) And piece(x)<>16
            piece(x)+1
            p_sound+1 ;-p_sound+1
            eclair(y,u)=255
            plateau(y,u)=piece(x)
            x+1
          Else
            plateau(y,u)=piece(x)
          EndIf
          x+1  
          y+1
        Wend
      EndIf
    Next
    
    stop(0)=1
  EndIf
  ;}  
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;-  If KeyboardReleased(#PB_Key_Right) And stop(2)=1
  ;{
  If KeyboardReleased(#PB_Key_Right) And stop(2)=1
    stop(2)=0
  EndIf
  
  If KeyboardPushed(#PB_Key_Right) And stop(2)=0
    attente=0
    LR=2
    For u=1 To rang
      x=-1
      Dim piece(rang+1)
      For i=rang To 1 Step-1
        ;       For i=1 To rang
        If plateau(i,u)>0
          x+1
          piece(x+1)=plateau(i,u)
          plateau(i,u)=0
        EndIf
      Next
      ;;;;;;;;;;;;;;;;;;;;
      If x>-1
        x=1
        y=rang;1
        While piece(x)<>0
          If piece(x)=piece(x+1) And piece(x)<>16
            piece(x)+1
            eclair(y,u)=255
            p_sound+1 ;-p_sound+1
            plateau(y,u)=piece(x)
            x+1
          Else
            plateau(y,u)=piece(x)
          EndIf
          x+1  
          y-1
        Wend
      EndIf
    Next
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    stop(2)=1
  EndIf
  ;}  
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;-If KeyboardReleased(#PB_Key_Up) And stop(1)=1
  ;{
  If KeyboardReleased(#PB_Key_Up) And stop(1)=1
    stop(1)=0
  EndIf
  
  If KeyboardPushed(#PB_Key_Up) And stop(1)=0
    attente=0
    LR=3
    For i=1 To rang
      x=-1
      Dim piece(rang+1)
      For u=1 To rang
        If plateau(i,u)>0
          x+1
          piece(x+1)=plateau(i,u)
          plateau(i,u)=0
        EndIf
      Next
      ;;;;;;;;;;;;;;;;;;;;
      If x>-1
        x=1
        y=1
        While piece(x)<>0
          If piece(x)=piece(x+1) And piece(x)<>16
            piece(x)+1
            p_sound+1 ;-p_sound+1
            eclair(i,y)=255
            plateau(i,y)=piece(x)
            x+1
          Else
            plateau(i,y)=piece(x)
          EndIf
          x+1  
          y+1
        Wend
      EndIf
    Next
    stop(1)=1
  EndIf
  ;}
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  
  ;-If KeyboardReleased(#PB_Key_Down) And stop(3)=1
  ;{
  If KeyboardReleased(#PB_Key_Down) And stop(3)=1
    stop(3)=0
  EndIf
  
  If KeyboardPushed(#PB_Key_Down) And stop(3)=0
    attente=0
    LR=4
    For i=1 To rang
      x=-1
      Dim piece(rang+1)
      For u=rang To 1 Step-1
        If plateau(i,u)>0
          x+1
          piece(x+1)=plateau(i,u)
          plateau(i,u)=0
        EndIf
      Next
      ;;;;;;;;;;;;;;;;;;;;
      If x>-1
        x=1
        y=rang;1
        While piece(x)<>0
          If piece(x)=piece(x+1) And piece(x)<>16
            piece(x)+1
            p_sound+1 ;-p_sound+1
            eclair(i,y)=255
            plateau(i,y)=piece(x)
            x+1
          Else
            plateau(i,y)=piece(x)
          EndIf
          x+1  
          y-1
        Wend
      EndIf
    Next
    stop(3)=1
  EndIf  
  ;} 
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  
  ;-If KeyboardReleased(#PB_Key_Back) And stop(4)=1
  ;{
  If KeyboardReleased(#PB_Key_Back) And stop(4)=1
    stop(4)=0
  EndIf
  
  If KeyboardPushed(#PB_Key_Back) And stop(4)=0
    ;playsound(2,0,50);-play
    
    For u=0 To rang+1
      For i=0 To rang+1
        plateau(i,u)=undo(undo,i,u)
      Next
    Next
    stop(4)=1
    
    undo-1
    If undo=-1
      undo=5
    EndIf
    back=1
    back_actu+1
    back_actu%6
    bak=1
  EndIf
  ;}
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;    
  
  
  ;-If KeyboardReleased(#PB_Key_F5) And stop(5)=1
  ;{
  If KeyboardReleased(#PB_Key_F5) And stop(5)=1
    stop(5)=0
  EndIf
  
  If KeyboardPushed(#PB_Key_F5) And stop(5)=0
    stop(5)=1
    ;playsound(2,0,50);-play
    f5=1    
    If CreateFile(0, GetPathPart(ProgramFilename())+"Magic_Save"+Str(rang)+"x"+Str(rang)+".ini") ;- SAUVEGARDE F5
      For u=1 To rang
        For i=1 To rang
          WriteQuad(0,plateau(i,u))
        Next
      Next
      CloseFile(0)
    EndIf
  EndIf
  ;}
  
  
  
  ;-If KeyboardReleased(#PB_Key_F9) And stop(7)=1
  ;{
  If KeyboardReleased(#PB_Key_F9) And stop(7)=1
    stop(7)=0
  EndIf
  
  If KeyboardPushed(#PB_Key_F9) And stop(7)=0
    stop(7)=1
    ;playsound(2,0,50);-play
    falsam+1
    falsam%3
  EndIf
  ;}
  
  
  ;-If KeyboardReleased(#PB_Key_F12) And stop(8)=1
  ;{
  If KeyboardReleased(#PB_Key_F12) And stop(8)=1
    stop(8)=0
  EndIf
  
  If KeyboardPushed(#PB_Key_F12) And stop(8)=0
    stop(8)=1
    ;playsound(2,0,50);-play
    F12*-1
  EndIf
  ;}
  
  
  
  
  ;-If KeyboardReleased(#PB_Key_F1) And stop(6)=1
  ;{
  If KeyboardReleased(#PB_Key_F1) And stop(6)=1
    stop(6)=0
  EndIf
  
  If KeyboardPushed(#PB_Key_F1) And stop(6)=0
    stop(6)=1
    score=0
    f6=1
    
    skore=0 ;-skore############
    ;playsound(2,0,50);-play
    If ReadFile(0, GetPathPart(ProgramFilename())+"Magic_Save"+Str(rang)+"x"+Str(rang)+".ini") ;- LOAD F1
      For u=1 To rang
        For i=1 To rang
          plateau(i,u)=ReadQuad(0)                
      If plateau(i,u)>0
        skore+Pow(2,plateau(i,u))
      EndIf
        Next
      Next
      CloseFile(0)
      bak=1
    EndIf
    
      
      sound6=NB_Sound

      While skore>sound6
      sound6+NB_Sound
    Wend
    sound10000=0
  EndIf
  ;}
  
  
  ;- cherche une PLACE !!!!!!!!!!!!!!!!
  ;{
  xx=-1
  If attente=0
   ; ;playsound(1,0,50);-play
    
    For x=1 To 1000
      i=Random(rang-1)+1
      u=Random(rang-1)+1
      ;ghost(i,u)=plateau(i,u)
      If plateau(i,u)=0 And attente=0
        plateau(i,u)=1+Random(Random(1))
        ;playsound(1,0,50);-play
        xx=i : yy=u
        xx2=xx : yy2=yy : flash=1
        attente=1
        ghost=1
        back=0
        ;;;;debug "Miracle, G trouvé une place"
      EndIf
    Next
    Goto start2
    ;;;;;;;;
    If plateau(i,u)<>0
      For u=1 To rang
        For i=1 To rang
          If plateau(i,u)=0 And attente=0
            plateau(i,u)=1+Random(Random(1))
            ;playsound(1,0,50);-play
            xx=i : yy=u
            xx2=xx : yy2=yy : flash=1
            attente=1
            ghost=1
            back=0
            ;;;;debug "Trouvé un trou"
          EndIf
        Next
      Next
      ;      Goto start2
    EndIf
    ;;;;;;;;;;;;;;
    ;    fini=1
  EndIf
  ;}
  
  
  start2:  ;-start2:
  
  ;-Save Back
  ;{
  If attente=1
    attente=2
    attente2+1
    
    ;;;;;
    If attente2>1
      attente2=2
    EndIf
    ;;;;;    
    For u=0 To rang+1
      For i=0 To rang+1
        undo(undo_flag,i,u)=plateau(i,u)  
      Next
    Next
    undo=undo_flag-1
    If undo=-1
      undo=5
    EndIf
    back_actu=0 
    undo_flag+1
    undo_flag%6
    ;;;;debug "undo_flag = "+Str(undo_flag)
  EndIf
  ;}
  
  
  If p_sound>0;-If p_sound>0
    p_sound=Pow(2,p_sound)
;    Debug p_sound;Pow(2,p_sound)
    If p_sound>100
      p_sound=100
    EndIf
    ;playsound(3,#PB_Sound_MultiChannel,p_sound)
    p_sound=0
  EndIf
  
  
  ;;;;;;;;;;;;;;; SCORE
  score=0
  For y=0 To rang-1
    For x=0 To rang-1
      If x+1<>xx2 Or y+1<>yy2 
        DisplaySprite(plateau(x+1,y+1),x*zoom/rang,y*zoom/rang)
        If eclair(x+1,y+1)>0
          DisplayTransparentSprite(1001,  x*zoom/rang,y*zoom/rang,eclair(x+1,y+1))
          eclair(x+1,y+1)-8
        EndIf
        
      Else
        If flash>0 And flash<50
          flash+1
        Else
          flash=0
          xx2=-1
        EndIf
        
        If falsam=0
          If flash%3<2
            DisplayTransparentSprite(plateau(x+1,y+1),x*zoom/rang,y*zoom/rang,flash*4+50)
          EndIf
        ElseIf falsam=1
          DisplayTransparentSprite(plateau(x+1,y+1),x*zoom/rang,y*zoom/rang,flash*4+50)
        Else
          If flash%13<8
            DisplayTransparentSprite(plateau(x+1,y+1),x*zoom/rang,y*zoom/rang,flash*4+50)
          EndIf
        EndIf
        
      EndIf
      i=plateau(x+1,y+1)
      If i>0
        score+Pow(2,i)
      EndIf
    Next
  Next
  
  
  If ghost>1 ;-ghost>1
             ;ghost=0;
    For y=0 To rang-1
      For x=0 To rang-1
        If ghost(x+1,y+1)<>0 And bak=0
          DisplayTransparentSprite(1000,x*zoom/rang,y*zoom/rang,88) ;-Trainée
        EndIf
      Next
    Next
    ghost+1
    ghost2/1.6
    ;Debug ghost2
    If bak=1
      bak=0
      ghost=0
      LR=0
    EndIf
    
    If LR<>0 And ghost%ghost2=0 ;-%
                                ;       ;;;debug LR
      If LR=1
        y=0
        For u=1 To rang
          x=0
          For i=rang To 1 Step-1
            If ghost(i,u)<>0 : x=1 : y=1
              ghost(i,u)=0
              Goto stop3
            EndIf
          Next
          stop3:
        Next
        If y=0
          ghost=0
          LR=0
        EndIf
      EndIf
      
      If LR=2
        y=0
        For u=1 To rang
          x=0
          For i=1 To rang; To 1 Step-1
            If ghost(i,u)<>0 : x=1 : y=1
              ghost(i,u)=0
              Goto stop4
            EndIf
          Next
          stop4:
        Next
        If y=0
          ghost=0
          LR=0
        EndIf
      EndIf
      
      If LR=3
        y=0
        For i=1 To rang
          x=0
          For u=rang To 1 Step-1
            If ghost(i,u)<>0 : x=1 : y=1
              ghost(i,u)=0
              Goto stop5
            EndIf
          Next
          stop5:
        Next
        If y=0
          ghost=0
          LR=0
        EndIf
      EndIf
      
      If LR=4
        y=0
        For i=1 To rang
          x=0
          For u=1 To rang; To 1 Step-1
            If ghost(i,u)<>0 : x=1 : y=1
              ghost(i,u)=0
              Goto stop6
            EndIf
          Next
          stop6:
        Next
        If y=0
          ghost=0
          LR=0
        EndIf
      EndIf
      
      
    EndIf
  EndIf
  
  ;;;;;;;;;;;;;;
  
  If ghost=1;-  If ghost=1
    ghost=2
    ghost2=18
    
    For u=0 To rang+1
      For i=0 To rang+1
        ghost(i,u)=undo(undo,i,u)
      Next
    Next
    
    
    ;;;;;;;;;;;
    
    If LR=1
      For u=1 To rang
        x=0
        For i=1 To rang
          If ghost(i,u)<>0
            x=i
          EndIf
        Next
        For y=1 To x
          ghost(y,u)=1000;- bonne trainée
        Next
        
      Next
    EndIf
    
    
    ;;;;;;;;;
    
    If LR=2
      For u=1 To rang
        x=rang+1
        For i=rang To 1 Step-1 
          If ghost(i,u)<>0
            x=i
          EndIf
        Next
        For y=rang To x Step-1
          ghost(y,u)=1000;- bonne trainée
        Next
        
      Next
    EndIf
    
    
    ;;;;;;;;;;
    
    If LR=3
      For i=1 To rang
        x=0
        For u=1 To rang
          If ghost(i,u)<>0
            x=u
          EndIf
        Next
        For y=1 To x
          ghost(i,y)=1000;- bonne trainée
        Next
        
      Next
    EndIf
    
    If LR=4
      For i=1 To rang; To 1 Step-1
        x=rang+1
        For u=rang To 1 Step-1
          If ghost(i,u)<>0
            x=u
          EndIf
        Next
        For y=rang To x Step-1
          ghost(i,y)=1000;- bonne trainée
        Next
      Next
    EndIf
  EndIf
  ;;;;;;;;;;;;;;;;;;;;;;;
  
  ; fini=1
  ;{
  
  nb=0
  For i=1 To rang
    For u=1 To rang
      If plateau(i,u)<>0
        nb+1
      EndIf
    Next
  Next
  
  If nb=rang*rang
    nb=0
    For u=1 To rang
      For i=1 To rang-1
        If plateau(i,u)=plateau(i+1,u) And plateau(i,u)>0 And plateau(i,u)<16
          nb+1
        EndIf
        If plateau(u,i)=plateau(u,i+1) And plateau(u,i)>0 And plateau(u,i)<16
          nb+1
        EndIf
      Next
    Next
    
    If nb=0
      fini=1
    EndIf
    
  EndIf
  ;;
  
  
  If  old_score<>score Or F12=1;-If old_score<>score
    old_score=score
    DisplaySprite(1002,0,zoom);- ???
    
    StartDrawing(ScreenOutput())
    DrawingMode(1)
    DrawingFont(Police3)
    
    If high<=score
      high=score
      If sound5=0 And score>=2000
        sound5=1
        ;playsound(5,0,50);-play5
      EndIf
    EndIf
    
    If score>=10000
      If sound10000=0
        sound10000=1
        ;playsound(5,0,50);-play5
      EndIf
    EndIf
    
    If score>=sound6
      sound6+NB_Sound
      ;playsound(6,0,50);-play6
    EndIf
    
    If F12=-1
      scor$="Score : "+Str(score)+" - (Best : "+Str(high)+") ";+Str(undo)
    Else
      scor$="Loop Timer : "+Str(clock)+" ms"
    EndIf
    
    DrawText(zoom/45+2,zoom+zoom/52+3, scor$, RGB(88,88,40))
    DrawText(zoom/45,zoom+zoom/52,scor$, RGB(177,177,77))
    ;;;
    
    StopDrawing()
    GrabSprite(1003,0,zoom,zoom,zoom/10)
    
  Else
    DisplaySprite(1003,0,zoom)
  EndIf
  
  If fini>0;- If fini>0
    fini=0
    ;playsound(4,0,50);-play

    For i=1 To rang
      For u=1 To rang
        DisplaySprite(plateau(i,u),(i-1)*zoom/rang,(u-1)*zoom/rang)
      Next
    Next
    StartDrawing(ScreenOutput())
    DrawingMode(1)
    DrawingFont(Police4)
    If high<score : high=score : EndIf
    ;;;
    CreateFile(1, GetPathPart(ProgramFilename())+"Magic_Score"+titre$+".ini") ;- SAUVEGARDE
    i=WriteQuad(1,high.q)
    CloseFile(1)
    ;;;
    over$="GAME OVER"
    DrawText(zoom/2-TextWidth(over$)/2-6,zoom/2-TextHeight(over$)/2-7, over$, RGB(0,0,0))
    DrawText(zoom/2-TextWidth(over$)/2,zoom/2-TextHeight(over$)/2, over$, RGB(99,40,40))
    DrawText(zoom/2-TextWidth(over$)/2-5,zoom/2-TextHeight(over$)/2-3, over$, RGB(255,177,77))
    StopDrawing()
    
    ;;;
    FlipBuffers()
    
    Repeat
      Repeat ;- EVENT
        Event  = WindowEvent() 
      Until Event = 0
      ExamineKeyboard()  
    Until KeyboardReleased(#PB_Key_Escape)
    Goto debut
  EndIf
  ;}
  
  ;;
  If back>0
    back+1
    f5=0 : f6=0
    aa$="Back "+Str(back_actu)
    Gosub aff
    If back>55
      back=0
    EndIf
  EndIf
  ;;
  If f5>0
    f5+1  
    back=0 : f6=0
    aa$="Save Game"
    Gosub aff
    If f5>55
      f5=0
    EndIf
  EndIf
  ;;
  If f6>0
    f6+1  
    f5=0 : back=0
    aa$="Load Game"
    Gosub aff
    If f6>55
      f6=0
    EndIf
  EndIf
  ;;
  
  
  ;-Eclair
  For y=0 To rang-1
    For x=0 To rang-1
      If eclair(x+1,y+1)>0
        StartDrawing(ScreenOutput())
        DrawingMode(1)
        DrawingFont(Police)
        u=plateau(x+1,y+1)
        i=Pow(2,u)
        If i>=4 And u>0
          a$=Str(i)
          DrawText(x*zoom/rang+Random(zoom/rang-TextWidth(a$)),y*zoom/rang+Random(zoom/rang-TextHeight(a$)), a$, RGB(0,0,0))
        Else
          eclair(x+1,y+1)=0
        EndIf
        StopDrawing()
      EndIf
    Next
  Next
  ;;;
  ;;;
  
  FlipBuffers()
  
Until KeyboardPushed(#PB_Key_Escape)


If CreateFile(1, GetPathPart(ProgramFilename())+"Magic_Score"+titre$+".ini") ;- SAUVEGARDE
i=WriteQuad(1,high.q)
CloseFile(1)
EndIf

Goto boucle


;-;;;;;;;;;;;;;;;;;;;;;;
;-;;;; les returns ;;;;;
;-;;;;;;;;;;;;;;;;;;;;;;

aff: ;-aff
StartDrawing(ScreenOutput())
DrawingMode(1)
DrawingFont(Police4)
DrawText(zoom/2-TextWidth(aa$)/2+4,zoom/2-TextHeight(aa$)/2+2, aa$, RGB(0,0,0))
DrawText(zoom/2-TextWidth(aa$)/2,zoom/2-TextHeight(aa$)/2, aa$, RGB(200,0,0))
StopDrawing()
Return

rdn: ;-rdn
RandomSeed(seed(seed(0)))
seed(0)+1
If seed(0)>randoom
  seed(0)=1
EndIf
Return

op_666: ;-op_666
If StartDrawing(CanvasOutput(666))
  For x=1 To 50
    i=Random(SPH_X-26)
    u=Random(89)
    Circle(i+Random(Random(Random(Random(30))))-15,u+Random(Random(Random(Random(24))))-12,1+Random(2),titre(i,u))
  Next
  StopDrawing()
EndIf
Return

op_667: ;-op_667
If StartDrawing(CanvasOutput(667))
  For x=1 To 300
    i=Random(268)
    u=Random(168)
    Line(i+Random(Random(Random(Random(24))))-12,u+Random(Random(Random(Random(24))))-12,1+Random(Random(6)),1+Random(Random(6)),jouer(i,u))
  Next
  StopDrawing()
EndIf
Return

;;;;

;;;

; DataSection
;   Music1: 
;   IncludeBinary "d:\Jeux\Magic_4x4\Wav\M1.wav"
;   Music2: 
;   IncludeBinary "d:\Jeux\Magic_4x4\Wav\M2.wav"
;   Music3: 
;   IncludeBinary "d:\Jeux\Magic_4x4\Wav\M3.wav"
;   Music4: 
;   IncludeBinary "d:\Jeux\Magic_4x4\Wav\M4.wav"
;   Music5: 
;   IncludeBinary "d:\Jeux\Magic_4x4\Wav\M5.wav"
;   Music6: 
;   IncludeBinary "d:\Jeux\Magic_4x4\Wav\M6.wav"
; EndDataSection

Micoute · Message par **Micoute** » mer. 14/mai/2025 12:39

Merci du partage SPH, tu as raison d'être fier de ton jeu plaisant à jouer et addictif.

Mindphazer · Message par **Mindphazer** » mer. 14/mai/2025 15:24

Merci du partage
J'arrive péniblement à 588 points

L'usage des goto dans ton code m'a fait revenir à des temps incertains que je pensais révolus

SPH · Message par **SPH** » mer. 14/mai/2025 15:26

Mise a jour 1er post : v1.1a (correction d'un cafouillage qui n'était pas logique et d'un bug proposant toujours la même map)

Je suis sur une amelioration qui donnera de la douceur a l'animation...
Ce sera pour dans quelques jours

ps : les goto me sont très utile car les "Break" ne me conviennent pas toujours...

===

J'arrive à 468 points (Pour l'instant)

568 now

...mais c'est toujours moins que toi...

falsam · Message par **falsam** » jeu. 15/mai/2025 8:53

SPH a écrit : mer. 14/mai/2025 11:13 La notice est à la ligne 5.

Une notice succincte !

;;;;;;;;; Se joue avec les flèches de direction et la touche Escape !! ;;;;;;;;;;;

Des flèches qui font apparaitre des chiffres, des chiffres qui ne changent de place quand je presse une flèche ..... Je n'ai rien compris

Par contre la touche Esc j'ai compris

SPH · Message par **SPH** » jeu. 15/mai/2025 9:09

Vous devez regrouper les mêmes nombres sur une ligne ou une colonne et les fusionner en appuyant sur la flèche correspondante.
Par exemple, si vous avez une ligne : 4 | 4 | 2 | 8,
vous pouvez fusionner les deux « 4 » car ils sont côte à côte. Puisqu'ils sont sur une ligne, appuyez sur gauche ou droite (cela les fusionnera en « 8 »).
En revanche, s'ils sont sur une colonne, appuyez sur HAUT ou BAS.

SPH · Message par **SPH** » jeu. 15/mai/2025 10:26

Par contre, comme vous le voyez sur cette capture, le jeu "ne répond pas". Il y a un bug quelque part. Je verrais ça

venom · Message par **venom** » jeu. 15/mai/2025 10:43

Ah !!! En gros tu as refait le 2048 quoi

J'y ai beaucoup joué quand c'est sortie. Le but "de base" c'est de faire un carré de 2048. Mais tu peux aller plus loin, ou même faire une grille plus grande etc...

@++

SPH · Message par **SPH** » jeu. 15/mai/2025 11:29

Je ne connaissais pas le jeu "2048". J'ai donc donné au mien un autre nom.

Merci pour l'astuce sur Discord : je vais l'essayer pour gagner (actu, mon best score est de pile 1000)

SPH · Message par **SPH** » jeu. 15/mai/2025 13:11

V1.1c (post 1)

Mon prochain challenge sera de faire de l'animation

SPH · Message par **SPH** » ven. 16/mai/2025 16:53

v1.1d (voir post 1)

La version 1.2 contiendra :
- sauvegarde d'une partie en cours
- l'anim complete des deplacements de pieces

SPH · Message par **SPH** » dim. 18/mai/2025 9:10

v1.1e
Possibilité de reculer de 4 coups si on se sent bloqué (#PB_Key_Back)
Apparition de chaque nouvelle piece en clignotant

falsam · Message par **falsam** » lun. 19/mai/2025 10:43

L'esprit 2048 est bien la

■ Fonctionne avec PB 6.20 mais ne fonctionne pas avec PB 6.21

[11 :29 :51] Attente du démarrage du programme...
[11 :29 :51] Type d'exécutable: Windows - x64 (64bit, Unicode)
[11 :29 :51] Exécutable démarré.
[11 :29 :52] [ERREUR] Ligne: 411
[11 :29 :52] [ERREUR] DisplayTransparentSprite(): A sprite should be created with the flag #PB_Sprite_AlphaBlending to use this command.

■ Proposition de fonctionnalité supplémentaires.
- Pouvoir changer les couleurs y compris le fond.
- Pouvoir changer la taille de la grille.

Regarde les couleurs sur le jeu original https://framagames.org/2048originel/index.html

SPH · Message par **SPH** » lun. 19/mai/2025 11:04

Oui oui Falsam, j'ai eu la discution sur le forum anglais : une future option sera obligatoire avec DisplayTransparentSprite.
On m'a répondu qu'il fallait que j'attende la version non beta du prochain PB

Je code actuellement avec PB 5.12 LTS(64)

Mindphazer · Message par **Mindphazer** » lun. 19/mai/2025 13:55

SPH a écrit : lun. 19/mai/2025 11:04 Je code actuellement avec PB 5.12 LTS(64)

5.12 ? Vraiment ?

PureBasic

Magic 4x4

Magic 4x4

Re: Magic 4x4

Re: Magic 4x4

Re: Magic 4x4

Re: Magic 4x4

Re: Magic 4x4

Re: Magic 4x4

Re: Magic 4x4

Re: Magic 4x4

Re: Magic 4x4

Re: Magic 4x4

Re: Magic 4x4

Re: Magic 4x4

Re: Magic 4x4

Re: Magic 4x4