PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Procedure reduce

https://www.purebasic.fr/english/viewtopic.php?t=86944

Page 1 of 1

Procedure reduce

Posted: Tue May 20, 2025 7:40 am
by SPH
Hi,

How would you go about creating a procedure that would reduce the redundant length of this code:

Code: Select all

  If back>0
    back+1
    f5=0 : f6=0
    StartDrawing(ScreenOutput())
    DrawingMode(1)
    DrawingFont(Police4)
    a$="Back "+Str(back_actu)
    DrawText(zoom/2-TextWidth(a$)/2+4,zoom/2-TextHeight(a$)/2+2, a$, RGB(0,0,0))
    DrawText(zoom/2-TextWidth(a$)/2,zoom/2-TextHeight(a$)/2, a$, RGB(200,0,0))
    StopDrawing()
    If back>55
      back=0
    EndIf
  EndIf
  ;;
  If f5>0
    f5+1  
    back=0 : f6=0
    StartDrawing(ScreenOutput())
    DrawingMode(1)
    DrawingFont(Police4)
    a$="Save Game"
    DrawText(zoom/2-TextWidth(a$)/2+4,zoom/2-TextHeight(a$)/2+2, a$, RGB(0,0,0))
    DrawText(zoom/2-TextWidth(a$)/2,zoom/2-TextHeight(a$)/2, a$, RGB(200,0,0))
    StopDrawing()
    If f5>55
      f5=0
    EndIf
  EndIf
  ;;
  If f6>0
    f6+1  
    f5=0 : back=0
    StartDrawing(ScreenOutput())
    DrawingMode(1)
    DrawingFont(Police4)
    a$="Load Game"
    DrawText(zoom/2-TextWidth(a$)/2+4,zoom/2-TextHeight(a$)/2+2, a$, RGB(0,0,0))
    DrawText(zoom/2-TextWidth(a$)/2,zoom/2-TextHeight(a$)/2, a$, RGB(200,0,0))
    StopDrawing()
    If f6>55
      f6=0
    EndIf
  EndIf
  ;;
Thx

Re: Procedure reduce

Posted: Tue May 20, 2025 8:53 am
by NicTheQuick
You mean like this?

Code: Select all

Procedure DrawMenu(text.s)
	Protected textWidth.i, textHeight.i	
	If StartDrawing(ScreenOutput())
		DrawingMode(1)
		DrawingFont(Police4)
		textWidth = TextWidth(text)
		textHeight = TextHeight(text)
		DrawText(zoom / 2 - textWidth / 2 + 4, zoom / 2 - textHeight / 2 + 2, text, RGB(0, 0, 0))
		DrawText(zoom / 2 - textWidth / 2, zoom / 2 - textHeight / 2, text, RGB(200, 0, 0))
		StopDrawing()
	EndIf
EndProcedure

If back > 0
	back + 1
	f5 = 0: f6 = 0
	DrawMenu("Back " + Str(back_actu))
	If back > 55
		back = 0
	EndIf
EndIf
;;
If f5 > 0
	f5 + 1  
	back = 0: f6 = 0
	DrawMenu("Save Game")
	If f5 > 55
		f5 = 0
	EndIf
EndIf
;;
If f6 > 0
	f6 + 1  
	f5 = 0: back = 0
	DrawMenu("Load Game")
	If f6 > 55
		f6 = 0
	EndIf
EndIf
;;
btw: It would be nice if you would use more spaces in your code, especially around operators and after commas.

Re: Procedure reduce

Posted: Tue May 20, 2025 8:55 am
by SPH
Why not ! :idea:

Thx :!:

Re: Procedure reduce

Posted: Tue May 20, 2025 10:53 am
by Demivec
Here is another variation:

Code: Select all

Define _cuti, _counter, a$, tWidth, tHeight
_cuti = 0 ;indicates which state is active: 1 for back, 2 for f5, 3 for f6, 0 = none

If _counter > 0 And _cuti > 0
  Select _cuti
    Case 1: a$ = "Back " + Str(back_actu) ;back
    Case 2: a$ = "Save Game"              ;f5
    Case 3: a$ = "Load Game"              ;f6
  EndSelect
  
  If StartDrawing(ScreenOutput())
    DrawingMode(1)
    DrawingFont(Police4)
    tWidth = (zoom - TextWidth(text)) / 2
    tHeight = (zoom - TextHeight(text)) / 2
    DrawText(tWidth + 4, tHeight + 2, a$, RGB(0, 0, 0))
    DrawText(tWidth, tHeight, a$, RGB(200, 0, 0))
    StopDrawing()

    _counter + 1
    If _counter > 55
      _counter = 0
    EndIf 
  EndIf
EndIf
This variation assumes that the order of consideration doesn't matter for the three redundant code sections and any of them could be executed at the appearance of the initial one and it would be fine. If that isn't true I would go with NicTheQuick's version.

One small explanation of the code is necessary. Instead of three variables, back, f5, or f6 being used only one is used, _cuti to indicate which text feature to draw. _counter maintains the count for whatever feature is current.

Re: Procedure reduce

Posted: Wed May 21, 2025 10:25 pm
by SPH
@Demivec

Your code is very small, and I like it... but it doesn't work.
You'll find the bloat I asked to be reduced at the end of this:

Code: Select all

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;  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=600

rang=4

; 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$, zoom/25 - (rang-4)*1.8)
Police2 = LoadFont(1, a$ , zoom/70);-rang+4)
Police3 = LoadFont(2, a$ , zoom/23);-rang+4)
Police4 = LoadFont(3, a$ , zoom/12);-rang+4)
; Police = LoadFont(0, a$, DesktopUnscaledX(zoom/25)) ; 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

seed.q=Random(65536*32768-1)
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

;;;;;;;;;;;;;;
StartDrawing(ScreenOutput())
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()
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))
  
  ;----------------j'en suis la
  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 stop.b(6)
encore=0
attente=0
fini=0

Dim undo(5,rang+1,rang+1)
undo=0
undo_flag=0
;;;
RandomSeed(seed)
;;;;;;;;;;;;;;;;;;;;;;;;

;-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 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
    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
        ; attente=0 ;  pas au bon endroit
      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
    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
    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
    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 x=1 To 1000
      i=Random(rang-1)+1
      u=Random(rang-1)+1
      If plateau(i,u)=0
        plateau(i,u)=1+Random(Random(1))
        xx=i : yy=u
        xx2=xx : yy2=yy : flash=1
        attente=1
        back=0
        ;Debug "Miracle, G trouvé une place"
        Goto start2
      EndIf
    Next
    ;;;;;;;;
    If plateau(i,u)<>0
      For u=1 To rang
        For i=1 To rang
          If plateau(i,u)=0
            plateau(i,u)=1+Random(Random(1))
            xx=i : yy=u
            xx2=xx : yy2=yy : flash=1
            attente=1
            back=0
            ;Debug "Trouvé un trou"
            Goto start2
          EndIf
        Next
      Next
    EndIf
    ;;;;;;;;;;;;;;
    ;    fini=1
  EndIf
  ;}
  
  
  start2:  ;-start2:
  
  If attente=1
    attente=2
    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
  
  ;;;;;;;;;;;;;;;;;;;;;;;
  
  ; 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.1g - 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_flag)
  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
    StartDrawing(ScreenOutput())
    DrawingMode(1)
    DrawingFont(Police4)
    a$="Back "+Str(back_actu)
    DrawText(zoom/2-TextWidth(a$)/2+4,zoom/2-TextHeight(a$)/2+2, a$, RGB(0,0,0))
    DrawText(zoom/2-TextWidth(a$)/2,zoom/2-TextHeight(a$)/2, a$, RGB(200,0,0))
    StopDrawing()
    If back>55
      back=0
    EndIf
  EndIf
  ;;
  If f5>0
    f5+1  
    back=0 : f6=0
    StartDrawing(ScreenOutput())
    DrawingMode(1)
    DrawingFont(Police4)
    a$="Save Game"
    DrawText(zoom/2-TextWidth(a$)/2+4,zoom/2-TextHeight(a$)/2+2, a$, RGB(0,0,0))
    DrawText(zoom/2-TextWidth(a$)/2,zoom/2-TextHeight(a$)/2, a$, RGB(200,0,0))
    StopDrawing()
    If f5>55
      f5=0
    EndIf
  EndIf
  ;;
  If f6>0
    f6+1  
    f5=0 : back=0
    StartDrawing(ScreenOutput())
    DrawingMode(1)
    DrawingFont(Police4)
    a$="Load Game"
    DrawText(zoom/2-TextWidth(a$)/2+4,zoom/2-TextHeight(a$)/2+2, a$, RGB(0,0,0))
    DrawText(zoom/2-TextWidth(a$)/2,zoom/2-TextHeight(a$)/2, a$, RGB(200,0,0))
    StopDrawing()
    If f6>55
      f6=0
    EndIf
  EndIf
  ;;
  
  FlipBuffers()
  
Until KeyboardPushed(#PB_Key_Escape)
End

Re: Procedure reduce

Posted: Thu May 22, 2025 5:37 am
by pjay
Maybe instead of handling each possible message individually, how about just adding simple message Set() & Draw() functions?

Code: Select all

Structure sMsg : Txt.s : Font.i : Expire.q : EndStructure
Global gameMessage.sMsg

Procedure Message_Set(txt.s, font = 0, dur.f = 1)
  gameMessage\Txt = txt : gameMessage\font = font : gameMessage\Expire = ElapsedMilliseconds() + (1000 * dur)
EndProcedure

Procedure Message_Draw() ; call within your start/stop drawing routine:
  If ElapsedMilliseconds() < gameMessage\Expire And gameMessage\txt <> ""
    DrawingMode(#PB_2DDrawing_Transparent) : DrawingFont(gameMessage\Font)
    DrawText(zoom/2-TextWidth(gameMessage\txt)/2+4,zoom/2-TextHeight(gameMessage\txt)/2+2, gameMessage\txt, RGB(0,0,0))
    DrawText(zoom/2-TextWidth(gameMessage\txt)/2,zoom/2-TextHeight(gameMessage\txt)/2, gameMessage\txt, RGB(200,0,0))
  EndIf
EndProcedure
If you want to display "Back" for half a second, simply use: Message_Set("Back", police4, 0.5)

Here they are added - I was surprised to see they're the only two procedures in your code... :D

Code: Select all

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;  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()

Global zoom = 600

rang=4

; 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$, zoom/25 - (rang-4)*1.8)
Police2 = LoadFont(1, a$ , zoom/70);-rang+4)
Police3 = LoadFont(2, a$ , zoom/23);-rang+4)
Police4 = LoadFont(3, a$ , zoom/12);-rang+4)
; Police = LoadFont(0, a$, DesktopUnscaledX(zoom/25)) ; 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

seed.q=Random(65536*32768-1)
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

;;;;;;;;;;;;;;
StartDrawing(ScreenOutput())
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()
GrabSprite(0,0,0,zoom/rang+1,zoom/rang+1,#PB_Sprite_AlphaBlending)

nb=2

Structure sMsg : Txt.s : Font.i : Expire.q : EndStructure
Global gameMessage.sMsg

Procedure Message_Set(txt.s, font = 0, dur.f = 1)
  gameMessage\Txt = txt : gameMessage\font = font : gameMessage\Expire = ElapsedMilliseconds() + (1000 * dur)
EndProcedure

Procedure Message_Draw()
  If ElapsedMilliseconds() < gameMessage\Expire And gameMessage\txt <> ""
    DrawingMode(#PB_2DDrawing_Transparent|#PB_2DDrawing_AlphaBlend) : DrawingFont(gameMessage\Font)
    DrawText(zoom/2-TextWidth(gameMessage\txt)/2+4,zoom/2-TextHeight(gameMessage\txt)/2+2, gameMessage\txt, RGBA(0,0,0,155))
    DrawText(zoom/2-TextWidth(gameMessage\txt)/2,zoom/2-TextHeight(gameMessage\txt)/2, gameMessage\txt, RGBA(200,0,0,255))
  EndIf
EndProcedure

For i=1 To 16
  nb$=Str(nb)
  
  CreateSprite(i, zoom/rang,zoom/rang, #PB_Sprite_AlphaBlending)
  StartDrawing(SpriteOutput(i))
  
  DrawingMode(1)
  Box(0,0,zoom/rang-1,zoom/rang-1,RGB(188,188,188))
  
  ;----------------j'en suis la
  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 stop.b(6)
encore=0
attente=0
fini=0

Dim undo(5,rang+1,rang+1)
undo=0
undo_flag=0
;;;
RandomSeed(seed)
;;;;;;;;;;;;;;;;;;;;;;;;

;-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 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
    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
        ; attente=0 ;  pas au bon endroit
      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
    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
    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
    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
    Message_Set("Back: " + Str(back_actu), Police4)
    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
    Message_Set("Save Game", Police4) 
    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
    Message_Set("Load Game", Police4) 
    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 x=1 To 1000
      i=Random(rang-1)+1
      u=Random(rang-1)+1
      If plateau(i,u)=0
        plateau(i,u)=1+Random(Random(1))
        xx=i : yy=u
        xx2=xx : yy2=yy : flash=1
        attente=1
        back=0
        ;Debug "Miracle, G trouvé une place"
        Goto start2
      EndIf
    Next
    ;;;;;;;;
    If plateau(i,u)<>0
      For u=1 To rang
        For i=1 To rang
          If plateau(i,u)=0
            plateau(i,u)=1+Random(Random(1))
            xx=i : yy=u
            xx2=xx : yy2=yy : flash=1
            attente=1
            back=0
            ;Debug "Trouvé un trou"
            Goto start2
          EndIf
        Next
      Next
    EndIf
    ;;;;;;;;;;;;;;
    ;    fini=1
  EndIf
  ;}
  
  
  start2:  ;-start2:
  
  If attente=1
    attente=2
    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
  
  ;;;;;;;;;;;;;;;;;;;;;;;
  
  ; 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.1g - 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_flag)
  DrawText(zoom/45+2,zoom+zoom/52+3, scor$, RGB(88,88,40))
  DrawText(zoom/45,zoom+zoom/52,scor$, RGB(177,177,77))
  
  Message_Draw()
  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
  ;}
  ; removed old message code
  ;;
  
  FlipBuffers()
  
Until KeyboardPushed(#PB_Key_Escape)
End

Re: Procedure reduce

Posted: Thu May 22, 2025 12:51 pm
by Demivec
SPH wrote: Wed May 21, 2025 10:25 pm @Demivec

Your code is very small, and I like it... but it doesn't work.
Here is your complete code with the suggested modifications. I made the corresponding changes in the other locations in your code to properly integrate the change and added an enumeration to help clarify things:

Code: Select all

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;  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
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;states for display text actions
Enumeration
  #action_none
  #action_back     ;back
  #action_saveGame ;f5
  #action_loadGame ;f6
EndEnumeration

Define _DispTxtAction, _DTACounter, a$, tWidth, tHeight


InitSprite()
InitKeyboard()
InitMouse()

Define zoom=600, rang=4

; 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$, zoom/25 - (rang-4)*1.8)
Police2 = LoadFont(1, a$ , zoom/70);-rang+4)
Police3 = LoadFont(2, a$ , zoom/23);-rang+4)
Police4 = LoadFont(3, a$ , zoom/12);-rang+4)
; Police = LoadFont(0, a$, DesktopUnscaledX(zoom/25)) ; 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

seed.q=Random(65536*32768-1)
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

;;;;;;;;;;;;;;
StartDrawing(ScreenOutput())
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()
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))
  
  ;----------------j'en suis la
  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 stop.b(6)
encore=0
attente=0
fini=0

Dim undo(5,rang+1,rang+1)
undo=0
undo_flag=0
;;;
RandomSeed(seed)
;;;;;;;;;;;;;;;;;;;;;;;;

;-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 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
    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
        ; attente=0 ;  pas au bon endroit
      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
    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
    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
    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
    _DispTxtAction = #action_back: _DTACounter = 0
    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
    _DispTxtAction = #action_saveGame: _DTACounter = 0
    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
    _DispTxtAction = #action_loadGame: _DTACounter = 0
    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 x=1 To 1000
      i=Random(rang-1)+1
      u=Random(rang-1)+1
      If plateau(i,u)=0
        plateau(i,u)=1+Random(Random(1))
        xx=i : yy=u
        xx2=xx : yy2=yy : flash=1
        attente=1
        _DispTxtAction = #action_none
        ;Debug "Miracle, G trouvé une place"
        Goto start2
      EndIf
    Next
    ;;;;;;;;
    If plateau(i,u)<>0
      For u=1 To rang
        For i=1 To rang
          If plateau(i,u)=0
            plateau(i,u)=1+Random(Random(1))
            xx=i : yy=u
            xx2=xx : yy2=yy : flash=1
            attente=1
            _DispTxtAction = #action_none: _DTACounter = 0
            ;Debug "Trouvé un trou"
            Goto start2
          EndIf
        Next
      Next
    EndIf
    ;;;;;;;;;;;;;;
    ;    fini=1
  EndIf
  ;}
  
  
  start2:  ;-start2:
  
  If attente=1
    attente=2
    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
  
  ;;;;;;;;;;;;;;;;;;;;;;;
  
  ; 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.1g - 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_flag)
  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 _DispTxtAction <> #action_none
    Select _DispTxtAction
      Case #action_back: a$ = "Back " + Str(back_actu) ;back
      Case #action_saveGame: a$ = "Save Game"          ;f5
      Case #action_loadGame: a$ = "Load Game"          ;f6
    EndSelect
    
    If StartDrawing(ScreenOutput())
      DrawingMode(1)
      DrawingFont(Police4)
      tWidth = (zoom - TextWidth(a$)) / 2
      tHeight = (zoom - TextHeight(a$)) / 2
      DrawText(tWidth + 4, tHeight + 2, a$, RGB(0, 0, 0))
      DrawText(tWidth, tHeight, a$, RGB(200, 0, 0))
      StopDrawing()
      
      _DTACounter + 1
      If _DTACounter > 54
        _DispTxtAction = #action_none: _DTACounter = 0
      EndIf 
    EndIf
  EndIf  
  
  
  FlipBuffers()
  
Until KeyboardPushed(#PB_Key_Escape)
End

Re: Procedure reduce

Posted: Thu May 22, 2025 1:15 pm
by SPH
Look how I did it in the meantime:

Code: Select all

  ;;
  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

Re: Procedure reduce

Posted: Thu May 22, 2025 2:11 pm
by Demivec
It is slightly of topic but I have some questions on your preferred coding style.

It would seem you prefer to do rach of the following:
  • Avoiding the declaration of ariables (in any scope)
  • Avoiding the use of constants or enumerations
  • Using subroutines with gosub/return instead of procedures
  • Using goto and labels instead of reorganizing the flow of execution
  • Using short generic variable names
How firm are these rules and how or when did aquire a preference to do things this way?

Any answer you provide would help me shape a better answer to any of your coding questions.

Re: Procedure reduce

Posted: Thu May 22, 2025 2:34 pm
by NicTheQuick
Demivec wrote: Thu May 22, 2025 2:11 pm It would seem you prefer to do rach of the following:
  • Avoiding the declaration of ariables (in any scope)
  • Avoiding the use of constants or enumerations
  • Using subroutines with gosub/return instead of procedures
  • Using goto and labels instead of reorganizing the flow of execution
  • Using short generic variable names
Oh yes, these are all good points that I really don't like in SPHs code aswell.

So please give variables proper names and use Define/Protected/Global/Shared to declare them properly, use EnableExplicit. Use procedures instead of Gosub or Goto. Yes, it works without all of that but noone except you will understand your code properly without modern coding conventions.

Thank you. I already mentioned that in the German forum as well but you didn't answer yet there.

Re: Procedure reduce

Posted: Thu May 22, 2025 3:25 pm
by SPH
I've been coding since MSX (1980) and so I learned a basic basic.
I've kept this way of coding and I'm comfortable with it.
Look at my encryptor's code: http://sph.chez.com/sources/mk3.html
It's completely unreadable, but I understand it and it's finished. So, why change it!!
I like Goto and Gosub/Return.
A basic without these instructions wouldn't be a good basic.

Thanks Fred for the Goto :idea:

Re: Procedure reduce

Posted: Fri May 23, 2025 1:55 pm
by Demivec
SPH wrote: Thu May 22, 2025 3:25 pm I've been coding since MSX (1980) and so I learned a basic basic.
I've kept this way of coding and I'm comfortable with it.
Thank you for answering my questions. I understand, your old shoes are your favorite and they're comfortable even if they have many holes. :)

I recognize your programming roots. One other observed code formatting characteristic of yours that I left out is a lack of spacing in expressions. The use of a$ for any string is a blast from the past. I imagine that you may still be hurting from the lack of line numbers, but would you want to return to using them with the advancements that have been made in this day and age? The truth is that past restrictions or limitations of a language don't have to rule the day when they are later removed. To each his own.

Look at my encryptor's code: http://sph.chez.com/sources/mk3.html
It's completely unreadable, but I understand it and it's finished. So, why change it!!
Someone on this forum had a quote in their signature that I think applies to this. A portion of it reads something like: "The code was hard to write, it should be hard to read. " :)

Even though it can be more difficult to unravel and modify your code I express thanks for the code examples you share, even if they are hard to read.

I like Goto and Gosub/Return.
A basic without these instructions wouldn't be a good basic.

Thanks Fred for the Goto :idea:
I am heartily in agreement with you here. Those elements from BASIC's roots are welcomed to be present. Though I understand their use and appreciate and welcome them, I avoid them like the plague. Like old and worn out shoes I use them only when I have some dirty or messy work to perform. : wink:

Re: Procedure reduce

Posted: Fri May 23, 2025 3:26 pm
by SPH
"I imagine the lack of line numbers still bothers you."
Oh no! I'm glad to be rid of them. I prefer a Goto to a label to a line number.

Re: Procedure reduce

Posted: Fri May 23, 2025 6:28 pm
by Demivec
SPH wrote: Fri May 23, 2025 3:26 pm "I imagine the lack of line numbers still bothers you."
Oh no! I'm glad to be rid of them. I prefer a Goto to a label to a line number.
:lol:
:thumbsup:
Ditto.
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited