Code: Alles auswählen
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;; Jeu de grille 4x4 où il faut regrouper les memes nombres
;;;;;;;;; Codé le 13 et 14 Mai 2025 / PB 6.12 LTS par SPH (France)
;;;;;;;;; F5 : save
;;;;;;;;; F6 : load
;;;;;;;;; Back : reculer (jusqu'a 5 coups)
;;;;;;;;; Flèches de direction
;;;;;;;;; Escape
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
InitSprite()
InitKeyboard()
InitMouse()
zoom=500 ; grosseur du plateau(de 200 à 1000+)
rang=4
; CreateFile(1, GetPathPart(ProgramFilename())+"Magic_4x4.ini") : i=WriteQuad(1,0) : CloseFile(1)
; Ouverture de la fenêtre
OpenWindow(0,0,0,zoom,zoom+zoom/10,"Magic 4x4",#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
If ReadFile(2, GetPathPart(ProgramFilename())+"Magic_4x4.ini")
high.q=ReadQuad(2)
CloseFile(2)
EndIf
xx=-1
randoom=10000;-randoom=10000
Dim seed.q(randoom)
For i=1 To randoom
seed(i)=Random(65536*32768-1)
Next
RandomSeed(33+Random(2)*2)
;;;;Box color
Dim SPH(3,16)
For u=1 To 3
For i=1 To 16
SPH(u,i)=Random(130)+2
Next
Next
;;;;;;;;;;;;;
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 40
Box(i,i,zoom/rang-1-i*2,zoom/rang-1-i*2,RGB(255-i*4,255-i*4,255-i*4))
Next
StopDrawing()
;GrabSprite(0,0,0,zoom/rang+1,zoom/rang+1)
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(1,i)+Random(x/2),SPH(2,i)+Random(y/2),SPH(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))
DrawText(zoom/(rang*2)-TextWidth(nb$)/2,zoom/(rang*2)-TextHeight(nb$)/2, nb$, RGB(255,255,255))
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 stop.b(6)
encore=0
attente=0
fini=0
Dim undo(5,rang+1,rang+1)
undo=0
undo_flag=0
;;;
seed(0)+1;-seed(0)+1
If seed(0)>randoom
seed(0)=1
EndIf
RandomSeed(seed(seed(0)))
;;;;;;;;;;;;;;;;;;;;;;;;
;-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Gestion de la fenêtre et de l'écran
Repeat
Repeat ;- Gestion de la fenêtre
Event = WindowEvent()
Until Event = 0
ClearScreen(RGB(0,30,0))
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
For x=1 To rang
If piece(x)<>0
If piece(x)=piece(x+1) And piece(x)<>16
If piece(x)<>0
plateau(x,u)=piece(x)+1
piece(x+1)=0
EndIf
Else
plateau(x,u)=piece(x)
piece(x)=0
EndIf
EndIf
Next
Else
EndIf
;-Left
For x=1 To rang
If plateau(x,u)=0
plateau(x,u)=plateau(x+1,u)
plateau(x+1,u)=0
EndIf
Next
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
If plateau(i,u)>0
x+1
piece(x+1)=plateau(i,u)
plateau(i,u)=0
EndIf
Next
;;;;;;;;;;;;;;;;;;;;
If x>-1
For x=1 To rang
If piece(x)<>0
If piece(x)=piece(x+1) And piece(x)<>16
If piece(x)<>0
plateau((rang+1)-x,u)=piece(x)+1
piece(x+1)=0
EndIf
Else
plateau((rang+1)-x,u)=piece(x)
piece(x)=0
EndIf
EndIf
Next
EndIf
;-Right
For x=rang To 1 Step-1
If plateau(x,u)=0
plateau(x,u)=plateau(x-1,u)
plateau(x-1,u)=0
EndIf
Next
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
For x=1 To rang
If piece(x)<>0
If piece(x)=piece(x+1) And piece(x)<>16
If piece(x)<>0
plateau(i,x)=piece(x)+1
piece(x+1)=0
EndIf
Else
plateau(i,x)=piece(x)
piece(x)=0
EndIf
EndIf
Next
EndIf
;-Up
For x=1 To rang
If plateau(i,x)=0
plateau(i,x)=plateau(i,x+1)
plateau(i,x+1)=0
EndIf
Next
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
For x=1 To rang
If piece(x)<>0
If piece(x)=piece(x+1); And piece(x)<>16
If piece(x)<>0
plateau(i,(rang+1)-x)=piece(x)+1
piece(x+1)=0
EndIf
Else
plateau(i,(rang+1)-x)=piece(x)
piece(x)=0
EndIf
EndIf
Next
EndIf
;-Down
For x=rang To 1 Step-1
If plateau(i,x)=0
plateau(i,x)=plateau(i,x-1)
plateau(i,x-1)=0
EndIf
Next
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
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
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
f5=1
If CreateFile(0, GetPathPart(ProgramFilename())+"Magic_Save.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_F6) And stop(6)=1
;{
If KeyboardReleased(#PB_Key_F6) And stop(6)=1
stop(6)=0
EndIf
If KeyboardPushed(#PB_Key_F6) And stop(6)=0
stop(6)=1
f6=1
If ReadFile(0, GetPathPart(ProgramFilename())+"Magic_Save.ini") ;- SAUVEGARDE F6
For u=1 To rang
For i=1 To rang
plateau(i,u)=ReadQuad(0)
Next
Next
CloseFile(0)
EndIf
EndIf
;}
;- cherche une PLACE !!!!!!!!!!!!!!!!
;{
xx=-1
If attente=0
; For u=0 To rang+1
; For i=0 To rang+1
; ghost(i,u)=plateau(i,u)
; ; ;;;debug ghost(i,u)
; Next
; Next
;;;debug "==="
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))
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))
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
;}
;;;;;;;;;;;;;;; SCORE
score.q=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)
Else
If flash>0 And flash<50
flash+1
Else
flash=0
xx2=-1
EndIf
If flash%3<2
DisplayTransparentSprite(plateau(x+1,y+1),x*zoom/rang,y*zoom/rang,flash*4+50)
EndIf
EndIf
i=plateau(x+1,y+1)
If i>0
score+Pow(2,i)
EndIf
Next
Next
If ghost>1 ;-ghost>0
;ghost=0;
For y=0 To rang-1
For x=0 To rang-1
If ghost(x+1,y+1)<>0
DisplayTransparentSprite(1000,x*zoom/rang,y*zoom/rang,44) ;-Trainée
EndIf
Next
Next
ghost+1
ghost2/1.3
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
; Dim ghost.q(rang+1,rang+1)
ghost=2
ghost2=14
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
;;;debug plateau(rang,u)
;;;debug ghost(rang,u)
;;;debug "="
For i=1 To rang
;End:End
If ghost(i,u)<>0
x=i
EndIf
Next
;;;debug x
;;;debug"°"
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
;;;debug plateau(rang,u)
;;;debug ghost(rang,u)
;;;debug "="
For i=rang To 1 Step-1
If ghost(i,u)<>0
x=i
EndIf
Next
;;;debug x
;;;debug"°"
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
;;;debug plateau(rang,i)
;;;debug ghost(rang,i)
;;;debug "="
For u=1 To rang
If ghost(i,u)<>0
x=u
EndIf
Next
;;;debug x
;;;debug"°"
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
;;;debug plateau(rang,i)
;;;debug ghost(rang,i)
;;;debug "="
For u=rang To 1 Step-1
If ghost(i,u)<>0
x=u
EndIf
Next
;;;debug x
;;;debug"°"
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
;;
StartDrawing(ScreenOutput())
DrawingMode(1)
DrawingFont(Police2)
vers$="v1.1h - SPH(2025)"
DrawText(zoom-TextWidth(vers$)-10,zoom+zoom/15+1, vers$, RGB(40,40,40))
DrawText(zoom-TextWidth(vers$)-11,zoom+zoom/15, vers$, RGB(99,99,99))
DrawingMode(1)
DrawingFont(Police3)
If high<score : high=score : EndIf
scor$="Score : "+Str(score)+" - (Best : "+Str(high)+") ";+Str(undo); ;;;debug undo(undo_flag,i,u)
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()
If fini>0
fini=0
DisplaySprite(plateau(xx2,yy2),(xx2-1)*zoom/rang,(yy2-1)*zoom/rang)
StartDrawing(ScreenOutput())
DrawingMode(1)
DrawingFont(Police4)
If high<score : high=score : EndIf
;;;
CreateFile(1, GetPathPart(ProgramFilename())+"Magic_4x4.ini") ;- SAUVEGARDE "Magic_4x4.ini"
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
;;
FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape)
End
;;;;;;;;;;;;;;;;;;;;;;;
;;;;; les returns ;;;;;
;;;;;;;;;;;;;;;;;;;;;;;
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
