PureColorLines

Advanced game related topics
User avatar
Mindphazer
Enthusiast
Enthusiast
Posts: 523
Joined: Mon Sep 10, 2012 10:41 am
Location: Savoie

PureColorLines

Post by Mindphazer »

Hello everyone,
I (with a little help from my new friend ChatGPT) had fun recreating an old game from the 90s: “color lines.”
The game is played on a 9x9 board.
The goal of the game is to create lines of at least 5 balls of the same color.
Each turn, 3 colored balls appear in empty spaces.
You move a ball by selecting it, then indicating the space you want it to go to, if there is a clear path between the two spaces.
When you line up 5 or more balls of the same color in a straight line (horizontal, vertical, or diagonal), they disappear and you earn points.
After each non-winning move, 3 new balls appear in random positions.
The game ends when the grid is completely filled and it is no longer possible to move a ball.
The more balls in the line, the more points you earn.
You also earn more points if you create an intersection of two lines of the same color.

The game was mainly developed on MacOS, but also works on Windows (and possibly Linux).
It -should- be fully DPI aware.

Have fun!

Code: Select all

; ┌──────────────────────────────────────────────────────────────────────────┐
; │  _____                 _____      _            _      _                  │         
; │ |  __ \               / ____|    | |          | |    (_)                 │
; │ | |__) |   _ _ __ ___| |     ___ | | ___  _ __| |     _ _ __   ___  ___  │
; │ |  ___/ | | | '__/ _ \ |    / _ \| |/ _ \| '__| |    | | '_ \ / _ \/ __| │
; │ | |   | |_| | | |  __/ |___| (_) | | (_) | |  | |____| | | | |  __/\__ \ │
; │ |_|    \__,_|_|  \___|\_____\___/|_|\___/|_|  |______|_|_| |_|\___||___/ │
; │                                                                          │                                                                                                                                                 │
; │                                                                          │
; │                         Code by Mindphazer                               │
; │                                                                          │
; │                          v 1.1.0 (c) 2026                                │
; │                                                                          │
; └──────────────────────────────────────────────────────────────────────────┘ 

; ================== CONSTANTES ==================
#GRID_SIZE = 9
#CELL_SIZE = 48
#MARGIN    = 10
#NB_COLORS = 7
#NEW_BALLS = 3

#MOVE_STEP_DURATION = 50
#REMOVE_DURATION = 200
#TIMER_ANIM = 1

#Version = "1.1.0"

Enumeration
  #MainWindow
  #MainCanvas
  #NewGame
  #QuitGame
  #KeyESC
  #MainMenu
EndEnumeration

Enumeration #PB_Event_FirstCustomValue
  #Event_TerminateRequested
EndEnumeration


Structure Cell
  color.i
EndStructure


Global Dim Grid.Cell(#GRID_SIZE - 1, #GRID_SIZE - 1)

Global Dim Colors(#NB_COLORS)

Colors(1) = RGB(255, 85, 85)
Colors(2) = RGB(80, 250, 120)
Colors(3) = RGB(90, 170, 255)
Colors(4) = RGB(255, 210, 90)
Colors(5) = RGB(190, 130, 255)
Colors(6) = RGB(80, 220, 210)
Colors(7) = RGB(255, 150, 60)

#BALL_RADIUS     = #CELL_SIZE / 2 - 6
#BALL_IMG_SIZE   = (#BALL_RADIUS + 10) * 2
#COULEUR_GRILLE  = $A0A0A0
#COULEUR_PLATEAU = $787878
#COULEUR_JEU     = $505050
#SCORE_POPUP_DURATION = 800

Global Dim BallImage(#NB_COLORS)
Global Dim NextBalls(#NEW_BALLS - 1)

Global SelectedX = -1, SelectedY = -1, HoverX = -1, HoverY = -1
Global Score = 0
Global HighScore
Global NewHiscore = #False
Global HighScoreFile$ = GetHomeDirectory() + "ColorLinesHigh.fic"
CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
  Global ScoreFont      = LoadFont(#PB_Any, "Arial", 28, #PB_Font_Bold)
  Global EndFont        = LoadFont(#PB_Any, "Arial", 42, #PB_Font_Bold)
  Global PopupFont      = LoadFont(#PB_Any, "Arial", 20, #PB_Font_Bold)
  Global ButtonFont     = LoadFont(#PB_Any, "Gill Sans MT", 20)
CompilerElse
  Global ScoreFont      = LoadFont(#PB_Any, "Arial", 20 , #PB_Font_Bold)
  Global EndFont        = LoadFont(#PB_Any, "Arial", 28, #PB_Font_Bold)
  Global PopupFont      = LoadFont(#PB_Any, "Arial", 12, #PB_Font_Bold)
  Global ButtonFont     = LoadFont(#PB_Any, "Gill Sans MT", 14)
CompilerEndIf
Global PulsePhase.f = 0.0
Global PulseSpeed.f = 0.12 
Global RemoveCount = 0
Global ScorePopupActive = 0
Global ScorePopupValue = 0
Global ScorePopupX.f, ScorePopupY.f
Global ScorePopupStartTime

Global GameOver = 0
Global ReplayX, ReplayY, ReplayW, ReplayH
Global RemovedLineCount
Global RemovedBallCount
Global PerfectLine

; ================== BFS ==================
Global Dim Visited(#GRID_SIZE - 1,#GRID_SIZE - 1)
Global Dim ParentX(#GRID_SIZE - 1,#GRID_SIZE - 1)
Global Dim ParentY(#GRID_SIZE - 1,#GRID_SIZE - 1)
Global Dim QueueX(#GRID_SIZE * #GRID_SIZE)
Global Dim QueueY(#GRID_SIZE * #GRID_SIZE)
Global Dim PathX(1)
Global Dim PathY(1)

Global AnimatingMove = 0
Global AnimColor
Global AnimX.f, AnimY.f
Global AnimX1.f, AnimY1.f, AnimX2.f, AnimY2.f
Global MoveStep, MoveStepStart

Global Removing = 0
Global RemoveStart
Global Dim RemoveMask(#GRID_SIZE - 1, #GRID_SIZE - 1)

Structure Bouton
  X.i
  Y.i
  Length.i
  Height.i
  Libelle.s
  BackColor.i
EndStructure
Global NewMap GadgetB.Bouton()

CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
  Prototype Proto_AppShouldTerminate(Object, Selector, Sender)
  DeclareC AppShouldTerminate(Object, Selector, Sender)

  Global AppDelegate, AppShouldTerminate_.Proto_AppShouldTerminate

  AppDelegate = CocoaMessage(0, CocoaMessage(0, 0, "NSApplication sharedApplication"), "delegate")
  AppShouldTerminate_ = class_replaceMethod_(CocoaMessage(0, AppDelegate, "class"),
                                           sel_registerName_("applicationShouldTerminate:"), 
                                           @AppShouldTerminate(), "v@:@")

  ProcedureC AppShouldTerminate(Object, Selector, Sender)
    PostEvent(#Event_TerminateRequested)
    If AppShouldTerminate_
      ProcedureReturn AppShouldTerminate_(Object, Selector, Sender)
    EndIf

  EndProcedure  
CompilerEndIf

Procedure Min(a, b)
  If a < b
    ProcedureReturn a
  Else
    ProcedureReturn b
  EndIf
EndProcedure

Procedure Max(a, b)
  If a > b
    ProcedureReturn a
  Else
    ProcedureReturn b
  EndIf
EndProcedure


Procedure RGBtoHSL(color, *h.Float, *s.Float, *l.Float)
  ; by ChatGPT
  Protected r.f = Red(color)   / 255.0
  Protected g.f = Green(color) / 255.0
  Protected b.f = Blue(color)  / 255.0

  Protected max.f = r
  If g > max : max = g : EndIf
  If b > max : max = b : EndIf

  Protected min.f = r
  If g < min : min = g : EndIf
  If b < min : min = b : EndIf

  Protected d.f = max - min
  *l\f = (max + min) / 2.0

  If d = 0
    *h\f = 0
    *s\f = 0
  Else
    If *l\f < 0.5
      *s\f = d / (max + min)
    Else
      *s\f = d / (2.0 - max - min)
    EndIf

    If max = r
      *h\f = (g - b) / d + (Bool(g < b) * 6)
    ElseIf max = g
      *h\f = (b - r) / d + 2
    Else
      *h\f = (r - g) / d + 4
    EndIf

    *h\f / 6.0
  EndIf
EndProcedure


Procedure.f HueToRGB(p.f, q.f, t.f)
  ; by ChatGPT
  If t < 0 : t + 1 : EndIf
  If t > 1 : t - 1 : EndIf

  If t < 1.0/6.0 : ProcedureReturn p + (q - p) * 6 * t : EndIf
  If t < 1.0/2.0 : ProcedureReturn q : EndIf
  If t < 2.0/3.0 : ProcedureReturn p + (q - p) * (2.0/3.0 - t) * 6 : EndIf
  ProcedureReturn p
EndProcedure

Procedure HSLtoRGB(h.f, s.f, l.f)
  Protected r.f, g.f, b.f
  If s = 0
    r = l : g = l : b = l
  Else
    Protected q.f
    If l < 0.5
      q = l * (1 + s)
    Else
      q = l + s - l * s
    EndIf
    Protected p.f = 2 * l - q
    r = HueToRGB(p, q, h + 1.0/3.0)
    g = HueToRGB(p, q, h)
    b = HueToRGB(p, q, h - 1.0/3.0)
  EndIf
  ProcedureReturn RGB(r * 255, g * 255, b * 255)
EndProcedure


Procedure AdjustBrightness(color, amount)
  ; by ChatGPT
  ; amount : -100 --> +100
  Protected h.f, s.f, l.f
  RGBtoHSL(color, @h, @s, @l)
  l + amount / 100.0
  If l < 0 : l = 0 : EndIf
  If l > 1 : l = 1 : EndIf
  ProcedureReturn HSLtoRGB(h, s, l)
EndProcedure


Procedure RedrawButton(Gadget, Mode = 0)
  Protected Key.s, Contour, Interieur
  Key = Str(Gadget)
  If StartDrawing(CanvasOutput(Gadget))
    If Mode = 0
      Interieur = AdjustBrightness(GadgetB(Key)\BackColor, 15)
      Contour = GadgetB(Key)\BackColor
    Else
      Interieur = GadgetB(Key)\BackColor ;$C9FFC4
      Contour = AdjustBrightness(GadgetB(Key)\BackColor, -15)
    EndIf 
    DrawingMode(#PB_2DDrawing_Gradient)
    BackColor(Contour)
    FrontColor(AdjustBrightness(Contour, 25))
    LinearGradient(0, 0, OutputWidth(), OutputHeight())
    Box(0, 0, OutputWidth(), OutputHeight(), Contour)
    
    BackColor(Interieur)
    FrontColor(AdjustBrightness(Interieur, 25))
    LinearGradient(DesktopScaledX(1), DesktopScaledY(1), OutputWidth() - DesktopScaledX(2), OutputHeight() - DesktopScaledY(2))
    Box(DesktopScaledX(1), DesktopScaledY(1), OutputWidth() - DesktopScaledX(2), OutputHeight() - DesktopScaledY(2))
    DrawingMode(#PB_2DDrawing_Transparent)
    DrawingFont(FontID(ButtonFont))
    DrawText(DesktopScaledX(GadgetB(Key)\Length * 0.5) - (TextWidth(GadgetB(Key)\Libelle) * 0.5) + Mode, DesktopScaledY(GadgetB(Key)\Height * 0.5) - (TextHeight(GadgetB(Key)\Libelle) * 0.5) + Mode, GadgetB(Key)\Libelle, $222222)
    StopDrawing()
  EndIf
EndProcedure

Procedure Button(Gadget, Xb, Yb, L, H, Texte.s, Couleur = $D7ED9F)
  Protected Key.s
  If CanvasGadget(Gadget, Xb, Yb, L, H)
    Key = Str(Gadget)
    AddMapElement(GadgetB(), Str(Gadget))
    GadgetB(Key)\X         = Xb
    GadgetB(Key)\Y         = Yb
    GadgetB(Key)\Length    = L 
    GadgetB(Key)\Height    = H
    GadgetB(Key)\Libelle   = Texte
    GadgetB(key)\BackColor = Couleur
    RedrawButton(Gadget, 1)
  EndIf
EndProcedure


Procedure HasFreeCells()
  Protected x,y
  For y = 0 To #GRID_SIZE - 1
    For x = 0 To #GRID_SIZE - 1
      If Grid(x,y)\color = 0
        ProcedureReturn #True
      EndIf
    Next
  Next
  ProcedureReturn #False
EndProcedure


Procedure CreateBallImage(Size, color)
  ; By ChatGPT
  Protected img = CreateImage(#PB_Any, DesktopScaledX(size), DesktopScaledY(size), 32, #PB_Image_Transparent)
  Protected cx.f = size / 2
  Protected cy.f = size / 2
  Protected r.f  = size / 2 - 4
  Protected cr = Red(color)
  Protected cg = Green(color)
  Protected cb = Blue(color)

  If StartVectorDrawing(ImageVectorOutput(img))
    ; =========================
    ; BILLE DE BASE (PLEINE)
    ; =========================
    VectorSourceColor(RGBA(cr, cg, cb, 210))
    AddPathCircle(DesktopScaledX(cx), DesktopScaledY(cy), DesktopScaledX(r))
    FillPath()

    ; =========================
    ; REFLET PRINCIPAL
    ; =========================
    VectorSourceCircularGradient(DesktopScaledX(cx - 5), DesktopScaledY(cy - 5), DesktopScaledX(r * 0.9))
    VectorSourceGradientColor(RGBA(255, 255, 255, 120), 0.0)
    VectorSourceGradientColor(RGBA(255, 255, 255, 0), 1.0)

    AddPathCircle(DesktopScaledX(cx), DesktopScaledY(cy), DesktopScaledX(r))
    FillPath()

    ; =========================
    ; POINT DE BRILLANCE
    ; =========================
    VectorSourceColor(RGBA(255, 255, 255, 110))
    AddPathCircle(DesktopScaledX(cx - 6), DesktopScaledY(cy - 6), DesktopScaledX(r * 0.22))
    FillPath()

    ; =========================
    ; CONTOUR FIN
    ; =========================
    VectorSourceColor(RGBA(255, 255, 255, 80))
    AddPathCircle(DesktopScaledX(cx), DesktopScaledY(cy), DesktopScaledX(r))
    StrokePath(1.1)

    StopVectorDrawing()
  EndIf
  ProcedureReturn img
EndProcedure

Procedure GenerateNextBalls()
  Protected i
  For i = 0 To #NEW_BALLS - 1
    NextBalls(i) = Random(#NB_COLORS - 1) + 1
  Next
EndProcedure

Procedure AddRandomBalls()
  Protected i, x, y
  For i = 0 To #NEW_BALLS - 1
    If HasFreeCells() = 0
      GameOver = 1
      ProcedureReturn
    EndIf
    
    Repeat
      x = Random(#GRID_SIZE - 1)
      y = Random(#GRID_SIZE - 1)
    Until Grid(x,y)\color = 0
    Grid(x,y)\color = NextBalls(i)
  Next
  GenerateNextBalls()
EndProcedure

Procedure ResetGame()
  Protected x, y
  For y = 0 To #GRID_SIZE - 1
    For x = 0 To #GRID_SIZE - 1
      Grid(x,y)\color = 0
    Next
  Next
  Score = 0
  GameOver = 0
  SelectedX = -1 : SelectedY = -1
  AnimatingMove = 0
  Removing = 0
  GenerateNextBalls()
  AddRandomBalls()
EndProcedure


; ================== BFS AVEC CHEMIN ==================
Procedure PathFind(sx, sy, tx, ty)
  Protected head, tail, x, y, nx, ny, i, saved, px, py, steps

  saved = Grid(sx, sy)\color
  Grid(sx, sy)\color = 0

  FillMemory(@Visited(0, 0), #GRID_SIZE * #GRID_SIZE * SizeOf(Integer), 0)
  FillMemory(@ParentX(0, 0), #GRID_SIZE * #GRID_SIZE * SizeOf(Integer), -1)
  FillMemory(@ParentY(0, 0), #GRID_SIZE * #GRID_SIZE * SizeOf(Integer), -1)

  head=0 : tail=0
  QueueX(0) = sx : QueueY(0) = sy
  Visited(sx, sy) = 1 

  While head <= tail
    x = QueueX(head) 
    y = QueueY(head) 
    head + 1
    If x = tx And y = ty
      steps = 0
      px = tx : py = ty
      ReDim PathX(0) : ReDim PathY(0)
      While px <> -1
        ReDim PathX(steps) : ReDim PathY(steps)
        PathX(steps) = px : PathY(steps) = py
        steps + 1
        nx = ParentX(px, py) : ny = ParentY(px, py)
        px = nx : py = ny
      Wend
      For i = 0 To steps/2 - 1
        Swap PathX(i), PathX(steps - 1 - i)
        Swap PathY(i), PathY(steps - 1 - i)
      Next
      Grid(sx,sy)\color = saved
      ProcedureReturn #True
    EndIf

    For i = 0 To 3
      Select i
        Case 0 : nx = x + 1 : ny = y
        Case 1 : nx = x - 1 : ny = y
        Case 2 : nx = x : ny = y + 1
        Case 3 : nx = x : ny = y - 1
      EndSelect
      If nx >= 0 And nx < #GRID_SIZE And ny >= 0 And ny < #GRID_SIZE
        If Visited(nx, ny) = 0 And Grid(nx, ny)\color = 0
          Visited(nx, ny) = 1
          ParentX(nx, ny) = x : ParentY(nx, ny) = y
          tail + 1
          QueueX(tail) = nx : QueueY(tail) = ny
        EndIf
      EndIf
    Next
  Wend
  Grid(sx, sy)\color = saved
  ProcedureReturn #False
EndProcedure

; ================== LIGNES ==================

Procedure DetectLines()
  Protected x,y,c,i,count,found
  Protected dx,dy
  Protected sx, sy, n

  RemovedLineCount = 0
  RemovedBallCount = 0
  found = 0

  FillMemory(@RemoveMask(0,0), #GRID_SIZE * #GRID_SIZE * SizeOf(Integer), 0)

  Dim dirX(3)
  Dim dirY(3)
  dirX(0)=1  : dirY(0)=0   ; horizontal
  dirX(1)=0  : dirY(1)=1   ; vertical
  dirX(2)=1  : dirY(2)=1   ; diag \
  dirX(3)=1  : dirY(3)=-1  ; diag /

  For y = 0 To #GRID_SIZE - 1
    For x = 0 To #GRID_SIZE - 1

      c = Grid(x,y)\color
      If c = 0 : Continue : EndIf

      For i = 0 To 3
        dx = dirX(i)
        dy = dirY(i)

        ; évite de détecter la même ligne deux fois
        If x-dx >= 0 And x-dx < #GRID_SIZE And y-dy >= 0 And y-dy < #GRID_SIZE
          If Grid(x-dx, y-dy)\color = c
            Continue
          EndIf
        EndIf

        count = 1

        While x + dx*count >= 0 And x + dx*count < #GRID_SIZE And
              y + dy*count >= 0 And y + dy*count < #GRID_SIZE And
              Grid(x + dx*count, y + dy*count)\color = c
          count + 1
        Wend

        If count >= 5
          found = 1
          RemovedLineCount + 1
          ; marquage des billes
          For n = 0 To count-1
            RemoveMask(x + dx*n, y + dy*n) = 1
          Next
        EndIf

      Next
    Next
  Next

  ; calcul du nombre de billes supprimées + centre popup
  If found
    Removing = 1
    RemoveStart = ElapsedMilliseconds()

    sx = 0 : sy = 0 : n = 0

    For y = 0 To #GRID_SIZE - 1
      For x = 0 To #GRID_SIZE - 1
        If RemoveMask(x,y)
          RemovedBallCount + 1
          sx + x
          sy + y
          n + 1
        EndIf
      Next
    Next

    If n > 0
      ScorePopupX = #MARGIN + (sx / n) * #CELL_SIZE + #CELL_SIZE / 2
      ScorePopupY = #MARGIN + (sy / n) * #CELL_SIZE + #CELL_SIZE / 2
    EndIf
  EndIf
  ProcedureReturn found
EndProcedure


Procedure StartMove(tx, ty)
  If Not PathFind(SelectedX, SelectedY, tx, ty)
    SelectedX = -1 : SelectedY = -1 : ProcedureReturn
  EndIf
  AnimColor = Grid(SelectedX, SelectedY)\color
  Grid(SelectedX, SelectedY)\color = 0
  MoveStep = 1
  MoveStepStart = ElapsedMilliseconds()
  AnimatingMove = 1
  AnimX1 = #MARGIN + PathX(0) * #CELL_SIZE + #CELL_SIZE / 2
  AnimY1 = #MARGIN + PathY(0) * #CELL_SIZE + #CELL_SIZE / 2
  AnimX2 = #MARGIN + PathX(1) * #CELL_SIZE + #CELL_SIZE / 2
  AnimY2 = #MARGIN + PathY(1) * #CELL_SIZE + #CELL_SIZE / 2
EndProcedure

Procedure UpdateMove()
  Protected t.f
  If AnimatingMove = 0 : ProcedureReturn : EndIf

  t = (ElapsedMilliseconds() - MoveStepStart) / #MOVE_STEP_DURATION
  If t > 1 : t = 1 : EndIf
  AnimX = AnimX1 + (AnimX2 - AnimX1) * t
  AnimY = AnimY1 + (AnimY2 - AnimY1) * t

  If t = 1
    MoveStep + 1
    If MoveStep > ArraySize(PathX())
      AnimatingMove = 0
      Grid(PathX(ArraySize(PathX())), PathY(ArraySize(PathY())))\color = AnimColor
      If DetectLines() = 0
        If HasFreeCells() = 0
         GameOver = 1
        Else
          AddRandomBalls()
          If HasFreeCells() = 0
            GameOver = 1
          Else
            DetectLines()
          EndIf
        EndIf
      EndIf
    Else
      AnimX1 = AnimX2 : AnimY1 = AnimY2
      AnimX2 = #MARGIN + PathX(MoveStep) * #CELL_SIZE + #CELL_SIZE / 2
      AnimY2 = #MARGIN + PathY(MoveStep) * #CELL_SIZE + #CELL_SIZE / 2
      MoveStepStart = ElapsedMilliseconds()
    EndIf
  EndIf
EndProcedure


Procedure DrawBallCached(x, y, colorIndex)
  DrawingMode(#PB_2DDrawing_AlphaBlend)
  ;DrawAlphaImage(ImageID(BallImage(colorIndex)), DesktopScaledX(x - #BALL_IMG_SIZE/2), DesktopScaledY(y - #BALL_IMG_SIZE/2))
  DrawImage(ImageID(BallImage(colorIndex)), DesktopScaledX(x), DesktopScaledY(y))
  DrawingMode(#PB_2DDrawing_Default)
EndProcedure

Procedure CenterText(x, y, l, h, Text$, Color = $FFFFFF, Shadow = $333333)
  Protected xt, yt
  xt = x + (l / 2)
  yt = y + (h / 2)
  DrawText(DesktopScaledX(xt + 1) - (TextWidth(Text$) / 2), DesktopScaledY(yt + 1) - (TextHeight(Text$) / 2), Text$, Shadow)
  DrawText(DesktopScaledX(xt) - (TextWidth(Text$) / 2), DesktopScaledY(yt) - (TextHeight(Text$) / 2), Text$, Color)
EndProcedure

Procedure GameOver()
  Protected HighScoreFile
  DrawingMode(#PB_2DDrawing_AlphaBlend)
  Box(0, 0, OutputWidth(), OutputHeight(), RGBA(0, 0, 0, 160))
  DrawingMode(#PB_2DDrawing_Transparent)
  DrawingFont(FontID(EndFont))
  CenterText(0, 0, #GRID_SIZE * #CELL_SIZE + 2 * #MARGIN, DesktopUnscaledY(OutputHeight()), "GAME OVER", RGBA(255, 80, 80, 255), RGBA(30, 30, 30, 255))
  If NewHiscore = #True
    HighScoreFile = OpenFile(#PB_Any, HighScoreFile$)
    If HighScoreFile
      WriteStringN(HighScoreFile, Str(Score))
      CloseFile(HighScoreFile)
    EndIf
  EndIf  
EndProcedure

Procedure Scores()
  Protected x
  DrawingMode(#PB_2DDrawing_AlphaBlend)
  RoundBox(DesktopScaledX(#GRID_SIZE * #CELL_SIZE + 2 * #MARGIN + 10), DesktopScaledY(180), DesktopScaledX(130), DesktopScaledY(30), DesktopScaledX(5), DesktopScaledY(5), RGBA(255, 255, 255, 20))
  RoundBox(DesktopScaledX(#GRID_SIZE * #CELL_SIZE + 2 * #MARGIN + 10), DesktopScaledY(250), DesktopScaledX(130), DesktopScaledY(30) ,DesktopScaledX(5), DesktopScaledY(5), RGBA(255, 255, 255, 20))
  RoundBox(DesktopScaledX(#GRID_SIZE * #CELL_SIZE + 2 * #MARGIN + 10), DesktopScaledY(400), DesktopScaledX(130), DesktopScaledY(30), DesktopScaledX(5), DesktopScaledY(5), RGBA(255, 255, 255, 20))
  DrawingMode(#PB_2DDrawing_Transparent)
  DrawingFont(FontID(ButtonFont))
  CenterText(#GRID_SIZE * #CELL_SIZE + 2 * #MARGIN + 10, 155, 130, 30, "Score")
  CenterText(#GRID_SIZE * #CELL_SIZE + 2 * #MARGIN + 10, 225, 130, 30, "Best")
  CenterText(#GRID_SIZE * #CELL_SIZE + 2 * #MARGIN + 10, 375, 130, 30, "Next")
  DrawingFont(FontID(scoreFont))
  CenterText(#GRID_SIZE * #CELL_SIZE + 2 * #MARGIN + 10, 180, 130, 30, RSet(Str(Score), 4, "0"), $2BDA34)
  CenterText(#GRID_SIZE * #CELL_SIZE + 2 * #MARGIN + 10, 250, 130, 30, RSet(Str(HighScore), 4, "0"), $2B81F0)
  DrawingMode(#PB_2DDrawing_AlphaBlend)
  For x = 0 To #NEW_BALLS - 1
     DrawImage(ImageID(BallImage(NextBalls(x))), DesktopScaledX(#GRID_SIZE * #CELL_SIZE + 2 * #MARGIN + 30 + (30 * x)), DesktopScaledY(401), DesktopScaledX(28), DesktopScaledY(28))
  Next
EndProcedure

Procedure Encadre(x, y , x1, y1, Color = #Yellow)
  For i = 0  To DesktopScaledX(1)  
    LineXY(DesktopScaledX(x) + i, DesktopScaledY(y) + i, DesktopScaledX(x1) - i, DesktopScaledY(y) + i, Color)
    LineXY(DesktopScaledX(x1) - i, DesktopScaledY(y) + i, DesktopScaledX(x1 )- i, DesktopScaledY(y1) - i, Color)
    LineXY(DesktopScaledX(x1) - i, DesktopScaledY(y1) - i, DesktopScaledX(x) + i, DesktopScaledY(y1) - i, Color)
    LineXY(DesktopScaledX(x) + i, DesktopScaledY(y1) - i, DesktopScaledX(x) + i, DesktopScaledY(y) + i, Color)
  Next i
EndProcedure


Procedure DrawGrid()
  Protected x, y, cx, cy, r, t.f, L, H
  StartDrawing(CanvasOutput(#MainCanvas))
  Box(0, 0, OutputWidth(), OutputHeight(), #COULEUR_JEU)
  D = AdjustBrightness(#COULEUR_PLATEAU, 10)
  For y = 0 To #GRID_SIZE - 1
    For x = 0 To #GRID_SIZE - 1
      cx = #MARGIN + x * #CELL_SIZE
      cy = #MARGIN + y * #CELL_SIZE
      Box(DesktopScaledX(cx), DesktopScaledY(cy), DesktopScaledX(#CELL_SIZE), DesktopScaledY(#CELL_SIZE), #COULEUR_GRILLE)
      DrawingMode(#PB_2DDrawing_Gradient)
      BackColor(#COULEUR_PLATEAU)
      FrontColor(D)
      LinearGradient(DesktopScaledX(cx + 1), DesktopScaledY(cy + 1), DesktopScaledX(cx + #CELL_SIZE - 2), DesktopScaledY(cy + #CELL_SIZE -2))
      Box(DesktopScaledX(cx + 1), DesktopScaledY(cy + 1), DesktopScaledX(#CELL_SIZE - 2), DesktopScaledY(#CELL_SIZE - 2), #COULEUR_PLATEAU)
      DrawingMode(#PB_2DDrawing_Default)
      If x = HoverX And y = HoverY
        Encadre(cx + 1, cy + 1, #CELL_SIZE + cx - 2, #CELL_SIZE + cy - 2, #Yellow)
      EndIf
      If Grid(x, y)\color
        ; === Halo de sélection ===
        If x = SelectedX And y = SelectedY
          DrawingMode(#PB_2DDrawing_AlphaBlend)
          Protected pulse.f
          pulse = Sin(PulsePhase) + 1   ; 0 → 1
          Box(DesktopScaledX(cx + (pulse * 4)), DesktopScaledY(cy + (pulse * 4)), DesktopScaledX(#CELL_SIZE - (pulse * 8)), DesktopScaledY(#CELL_SIZE - (pulse * 8)), RGBA(210, 220, 20, 250 - (pulse * 100)))
        EndIf
        DrawBallCached(cx, cy, Grid(x,y)\color)
      EndIf
    Next
  Next

  If AnimatingMove
    DrawBallCached(AnimX - #CELL_SIZE / 2, AnimY - #CELL_SIZE / 2, AnimColor)
  EndIf

  If Removing
    t = (ElapsedMilliseconds() - RemoveStart) / #REMOVE_DURATION
    If t > 1 : t = 1 : EndIf
    For y = 0 To #GRID_SIZE - 1
      For x = 0 To #GRID_SIZE - 1
        If RemoveMask(x, y)
          r = (#CELL_SIZE / 2 - 6) * (1 - t)
          Circle(DesktopScaledX(#MARGIN + x * #CELL_SIZE + #CELL_SIZE / 2), DesktopScaledY(#MARGIN + y * #CELL_SIZE + #CELL_SIZE / 2), DesktopScaledX(r), Colors(Grid(x, y)\color))
          If t = 1
            Grid(x, y)\color = 0
            RemoveCount + 1
          EndIf
        EndIf
      Next
    Next
    If t = 1
      ScorePopupValue = RemoveCount * RemoveCount
      If RemoveCount = #GRID_SIZE And RemovedLineCount = 1
        ScorePopupValue + 100
        PerfectLine = #True
      EndIf
      
      Score + (ScorePopupValue * RemovedLineCount)
      ScorePopupStartTime = ElapsedMilliseconds()
      ScorePopupActive = 1
      Removing = 0 
      RemoveCount = 0
    EndIf
  EndIf
  ;RemovedLineCount = 2
  ;PerfectLine = #True
  If ScorePopupActive
    Protected alpha, yOffset.f
    t = (ElapsedMilliseconds() - ScorePopupStartTime) / #SCORE_POPUP_DURATION
    If t > 1
      ScorePopupActive = 0
      PerfectLine = #False
    Else
      yOffset = -20 * t
      alpha = 255 * (1 - t)
      PopupScore$ = "+" + Str(ScorePopupValue)
      Combo$      = "Combo x" + Str(RemovedLineCount)
      
      DrawingMode(#PB_2DDrawing_Transparent | #PB_2DDrawing_AlphaBlend)
      DrawingFont(FontID(PopupFont))
      L = TextWidth(Combo$)
      H = TextHeight(Combo$)
      CenterText(ScorePopupX, ScorePopupY + yOffset, DesktopUnscaledX(L), DesktopUnscaledY(H), PopupScore$, RGBA(255, 215, 0, alpha), RGBA(0, 0, 0, alpha))
      If RemovedLineCount > 1
        If ScorePopupX < 0 : ScorePopupX = 0 : EndIf
        ;CenterText(ScorePopupX, ScorePopupY + yOffset + DesktopUnscaledY(TextHeight(PopupScore$)), DesktopUnscaledX(L), DesktopUnscaledY(H), Combo$, RGBA(255, 215, 0, alpha), RGBA(0, 0, 0, alpha))
        CenterText(ScorePopupX, ScorePopupY + yOffset + DesktopUnscaledY(TextHeight(PopupScore$)), DesktopUnscaledX(L), DesktopUnscaledY(H), Combo$, RGBA(208, 117, 211, alpha), RGBA(0, 0, 0, alpha))
      EndIf
      If PerfectLine
        CenterText(ScorePopupX, ScorePopupY + yOffset + DesktopUnscaledY(TextHeight(PopupScore$)), DesktopUnscaledX(L), DesktopUnscaledY(H), "Line +100", RGBA(208, 117, 211, alpha), RGBA(0, 0, 0, alpha))
      EndIf
    EndIf
  EndIf

  If Score > HighScore
    NewHiscore = #True
    HighScore = Score
  EndIf
  Scores()
  If GameOver
    GameOver()  
  EndIf
  StopDrawing()
EndProcedure

Procedure InitBallImages()
  Protected i
  For i = 1 To #NB_COLORS
    BallImage(i) = CreateBallImage(#CELL_SIZE, Colors(i))
  Next
EndProcedure

Procedure NewGame()
  If GameOver = 0
    If MessageRequester("Question", "Do you want to restart the game ?", #PB_MessageRequester_YesNo | #PB_MessageRequester_Warning) = #PB_MessageRequester_Yes
      ResetGame()
    EndIf
  Else
    ResetGame()
  EndIf
EndProcedure


Procedure TimerHandle()
  PulsePhase + PulseSpeed
  If PulsePhase > 2 * #PI
    PulsePhase - 2 * #PI
  EndIf
  UpdateMove()
  DrawGrid()
EndProcedure

Procedure HandleCanvasEvents()
  GadgetID = EventGadget()
  Select EventType()
    Case #PB_EventType_LeftClick
      Select GadgetID
        Case #QuitGame : PostEvent(#PB_Event_CloseWindow, #MainWindow, #Null) 
        Case #NewGame : NewGame()
      EndSelect   
    Case #PB_EventType_MouseEnter
      SetGadgetAttribute(GadgetID, #PB_Canvas_Cursor, #PB_Cursor_Hand)
      RedrawButton(GadgetID, 0)
    Case #PB_EventType_MouseLeave
      SetGadgetAttribute(GadgetID, #PB_Canvas_Cursor, #PB_Cursor_Default)
      RedrawButton(GadgetID, 1)   
    EndSelect
EndProcedure
  
Procedure MenuEvents()
  Select EventMenu()
    CompilerIf #PB_Compiler_OS = #PB_OS_MacOS   
      Case #PB_Menu_About      
      Case #PB_Menu_Preferences
      Case #PB_Menu_Quit
        PostEvent(#PB_Event_CloseWindow, #MainWindow, #Null)      
    CompilerEndIf
  Case #KeyESC
    NewGame()
  EndSelect
EndProcedure


OpenWindow(#MainWindow, 0, 0, #GRID_SIZE * #CELL_SIZE + 2 * #MARGIN + 160, #GRID_SIZE * #CELL_SIZE + 20, "Pure ColorLines - v " + #Version + "  -  by Mindphazer", #PB_Window_ScreenCentered | #PB_Window_SystemMenu | #PB_Window_MinimizeGadget)
CanvasGadget(#MainCanvas, 0, 0, WindowWidth(#MainWindow), WindowHeight(#MainWindow), #PB_Canvas_Container)
Button(#NewGame, #GRID_SIZE * #CELL_SIZE + 2 * #MARGIN + 10, 20, 130, 30, "New Game", $BFBF3F)
Button(#QuitGame, #GRID_SIZE * #CELL_SIZE + 2 * #MARGIN + 10, 60, 130, 30, "Quit Game", $4096F1)
AddWindowTimer(#MainWindow, #TIMER_ANIM, 10)
HighScoreFile = ReadFile(#PB_Any, HighScoreFile$)
If HighScoreFile
  HighScore = Val(ReadString(HighScoreFile))
  CloseFile(HighScoreFile)
EndIf
AddKeyboardShortcut(#MainWindow, #PB_Shortcut_Escape, #KeyESC)
CreateImageMenu(#MainMenu, WindowID(#MainWindow))
CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
  MenuItem(#PB_Menu_About, "")
  MenuItem(#PB_Menu_Preferences, "")
  MenuItem(#PB_Menu_Quit, "")
CompilerEndIf
    
BindEvent(#PB_Event_Menu, @MenuEvents(), #MainWindow)
BindEvent(#PB_Event_Timer, @TimerHandle())
BindGadgetEvent(#QuitGame, @HandleCanvasEvents())
BindGadgetEvent(#NewGame, @HandleCanvasEvents())

InitBallImages()
GenerateNextBalls()
AddRandomBalls()

Repeat
  Event = WaitWindowEvent()
  Select Event
    Case #PB_Event_CloseWindow, #Event_TerminateRequested
      If GameOver = 0
        If MessageRequester("Warning", "You have a game in progress." + #CRLF$ + "Are  you sure you want to leave ?", #PB_MessageRequester_YesNo) = #PB_MessageRequester_Yes
          Quit = #True
        EndIf
      Else
        Quit = #True
      EndIf
    Case #PB_Event_Gadget
      If EventGadget() = #MainCanvas
        mx = Round((GetGadgetAttribute(#MainCanvas, #PB_Canvas_MouseX) - DesktopScaledX(#MARGIN)) / DesktopScaledX(#CELL_SIZE), #PB_Round_Down)
        my = Round((GetGadgetAttribute(#MainCanvas, #PB_Canvas_MouseY) - DesktopScaledY(#MARGIN)) / DesktopScaledY(#CELL_SIZE), #PB_Round_Down)
        If EventType() = #PB_EventType_LeftClick And AnimatingMove = 0 And Removing = 0
          ;mx = Round((GetGadgetAttribute(#MainCanvas, #PB_Canvas_MouseX) - DesktopScaledX(#MARGIN)) / DesktopScaledX(#CELL_SIZE), #PB_Round_Down)
          ;my = Round((GetGadgetAttribute(#MainCanvas, #PB_Canvas_MouseY) - DesktopScaledY(#MARGIN)) / DesktopScaledY(#CELL_SIZE), #PB_Round_Down)
          If mx >= 0 And mx < #GRID_SIZE And my >= 0 And my < #GRID_SIZE
            If Grid(mx, my)\color And SelectedX = -1
              SelectedX = mx 
              SelectedY = my
            ElseIf Grid(mx, my)\color = 0 And SelectedX <> -1
              StartMove(mx, my)
              SelectedX = -1 : SelectedY = -1
            Else
              SelectedX = -1 : SelectedY = -1
            EndIf
          EndIf
        Else
          ;mx = Round((GetGadgetAttribute(#MainCanvas, #PB_Canvas_MouseX) - DesktopScaledX(#MARGIN)) / DesktopScaledX(#CELL_SIZE), #PB_Round_Down)
          ;my = Round((GetGadgetAttribute(#MainCanvas, #PB_Canvas_MouseY) - DesktopScaledY(#MARGIN)) / DesktopScaledY(#CELL_SIZE), #PB_Round_Down)
          If mx >= 0 And mx < #GRID_SIZE And my >= 0 And my < #GRID_SIZE
            HoverX = mx
            HoverY = my
          Else
            HoverX = -1 : HoverY = -1
          EndIf
        EndIf
      EndIf
  EndSelect
Until Quit = #True
MacBook Pro 16" M4 Pro - 24 Gb - MacOS 26.1 - Iphone 17 Pro Max - iPad at home
...and unfortunately... Windows at work...
miso
Enthusiast
Enthusiast
Posts: 629
Joined: Sat Oct 21, 2023 4:06 pm
Location: Hungary

Re: PureColorLines

Post by miso »

Pretty fun, thanks. As I'm stupid, I scored 386 points for first try. :) Tested on Win10.
User avatar
Mindphazer
Enthusiast
Enthusiast
Posts: 523
Joined: Mon Sep 10, 2012 10:41 am
Location: Savoie

Re: PureColorLines

Post by Mindphazer »

Thanks miso
I'm also a dumb, i hardly score more than 400 points :D
MacBook Pro 16" M4 Pro - 24 Gb - MacOS 26.1 - Iphone 17 Pro Max - iPad at home
...and unfortunately... Windows at work...
BarryG
Addict
Addict
Posts: 4301
Joined: Thu Apr 18, 2019 8:17 am

Re: PureColorLines

Post by BarryG »

Nice game. :)
User avatar
Mindphazer
Enthusiast
Enthusiast
Posts: 523
Joined: Mon Sep 10, 2012 10:41 am
Location: Savoie

Re: PureColorLines

Post by Mindphazer »

Thank you BarryG !
MacBook Pro 16" M4 Pro - 24 Gb - MacOS 26.1 - Iphone 17 Pro Max - iPad at home
...and unfortunately... Windows at work...
User avatar
moulder61
Enthusiast
Enthusiast
Posts: 214
Joined: Sun Sep 19, 2021 6:16 pm
Location: U.K.

Re: PureColorLines

Post by moulder61 »

@Mindphazer

It works nicely on Linux using the latest 6.30 (Ubuntu 24.04 - x64) release.

I managed 583 first try. :shock:

Probably won't play it much but I'll definitely be looking at the code to see how you did it? :wink:

Nice job. Thanks. :D

Moulder.
"If it ain't broke, fix it until it is!

This message is brought to you thanks to SenselessComments.com

My PB stuff for Linux: "https://u.pcloud.link/publink/show?code ... z3MR0T3jyV
User avatar
Mindphazer
Enthusiast
Enthusiast
Posts: 523
Joined: Mon Sep 10, 2012 10:41 am
Location: Savoie

Re: PureColorLines

Post by Mindphazer »

Hi moulder
Glad to know it works on Linux, thanks for the feedback ! :wink:
MacBook Pro 16" M4 Pro - 24 Gb - MacOS 26.1 - Iphone 17 Pro Max - iPad at home
...and unfortunately... Windows at work...
User avatar
minimy
Addict
Addict
Posts: 816
Joined: Mon Jul 08, 2013 8:43 pm
Location: off world

Re: PureColorLines

Post by minimy »

Very nice game, very fun!
I'm embarrassed to put my score here :lol:
Thanks for share Mindphazer.
If translation=Error: reply="Sorry, Im Spanish": Endif
User avatar
Mindphazer
Enthusiast
Enthusiast
Posts: 523
Joined: Mon Sep 10, 2012 10:41 am
Location: Savoie

Re: PureColorLines

Post by Mindphazer »

Thanks a lot minimy
Don't feel embarrassed :lol:
MacBook Pro 16" M4 Pro - 24 Gb - MacOS 26.1 - Iphone 17 Pro Max - iPad at home
...and unfortunately... Windows at work...
User avatar
ChrisR
Addict
Addict
Posts: 1536
Joined: Sun Jan 08, 2017 10:27 pm
Location: France

Re: PureColorLines

Post by ChrisR »

A nice, simple, and fun little game, thanks MindphazerGPT :)
It would be interesting to know how Chat GPT really helped you and all the work you had to do by yourself and to correct it.

Image
User avatar
Mindphazer
Enthusiast
Enthusiast
Posts: 523
Joined: Mon Sep 10, 2012 10:41 am
Location: Savoie

Re: PureColorLines

Post by Mindphazer »

Haha
ChatGPT helped me with the adjustbrightness() procedures, the createballimage() procedure too, because i didn't really know how to render a ball correctly. It took me a lot of tries to get a correct (to me) result
and also the pathfind procedure comes from ChatGPT, i didn't succeed in converting in Purebasic the BFS – Breadth First Search algorithm...
MacBook Pro 16" M4 Pro - 24 Gb - MacOS 26.1 - Iphone 17 Pro Max - iPad at home
...and unfortunately... Windows at work...
AZJIO
Addict
Addict
Posts: 2252
Joined: Sun May 14, 2017 1:48 am

Re: PureColorLines

Post by AZJIO »

Mindphazer wrote: Tue Jan 13, 2026 12:19 pm and possibly Linux
Yes, it works, I've built a package for Linux. I also built in 2 languages.

Code: Select all

Define UserIntLang

CompilerSelect #PB_Compiler_OS
	CompilerCase #PB_OS_Windows
		Define *Lang
		If OpenLibrary(0, "kernel32.dll")
			*Lang = GetFunction(0, "GetUserDefaultUILanguage")
			If *Lang And CallFunctionFast(*Lang) = 1049 ; ru
				UserIntLang = 1
			EndIf
			CloseLibrary(0)
		EndIf
	CompilerCase #PB_OS_Linux
		If ExamineEnvironmentVariables()
			While NextEnvironmentVariable()
				If Left(EnvironmentVariableName(), 4) = "LANG" And Left(EnvironmentVariableValue(), 2) = "ru"
					UserIntLang = 1
					Break
				EndIf
			Wend
		EndIf
CompilerEndSelect

#CountStrLang = 14
Global Dim Lng.s(#CountStrLang)
Lng(1) = "GAME OVER"
Lng(2) = "Score"
Lng(3) = "Best"
Lng(4) = "Next"
Lng(5) = "Combo x"
Lng(6) = "Line +100"
Lng(7) = "Question"
Lng(8) = "Do you want to restart the game?"
Lng(9) = "  -  by Mindphazer"
Lng(10) = "New Game"
Lng(11) = "Quit Game"
Lng(12) = "Warning"
Lng(13) = "You have a game in progress."
Lng(14) = "Are  you sure you want to leave ?"

If UserIntLang = 1
	Lng(1) = "ИГРА ОКОНЧЕНА"
	Lng(2) = "Счёт"
	Lng(3) = "Лучший"
	Lng(4) = "Следующие"
	Lng(5) = "Комбинация x"
	Lng(6) = "Линия +100"
	Lng(7) = "Вопрос"
	Lng(8) = "Вы хотите перезапустить игру?"
	Lng(9) = " - от Mindphazer"
	Lng(10) = "Новая игра"
	Lng(11) = "Выйти"
	Lng(12) = "Предупреждение"
	Lng(13) = "Вы в процессе игры"
	Lng(14) = "Вы уверены, что хотите завершить игру?"
EndIf
Post Reply