Public Class Board
    Inherits System.Windows.Forms.Form

    Const XbyX = 4
    Const XSize = 60

    Private Empty As New Panel
    Private Tiles As New List(Of Tile)
    Private Moves As Integer

    Public Sub New()
        Me.Text = XbyX ^ 2 - 1 & " Puzzle Game"
        Me.ClientSize = New Size(XbyX * XSize, XbyX * XSize)
        Me.FormBorderStyle = FormBorderStyle.FixedToolWindow
        Restart()
    End Sub

    Public Sub Restart()
        Dim Start As List(Of Integer) = MakeCompleteable(GetRandamStartOrder())

        Empty.SetBounds(((XbyX ^ 2 - 1) Mod XbyX) * XSize, ((XbyX ^ 2 - 1) \ XbyX) * XSize, XSize, XSize)

        Me.Moves = 0
        Me.Tiles.Clear()
        Me.Controls.Clear()
        For No = 0 To XbyX ^ 2 - 2
            Dim Tile As New Tile
            Tile.Text = Start(No)
            Tile.Board = Me
            Tile.SetBounds((No Mod XbyX) * XSize, (No \ XbyX) * XSize, XSize, XSize)
            Me.Tiles.Add(Tile)
            Me.Controls.Add(Tile)
        Next

    End Sub

    Public Sub IsComplete()
        Me.Moves += 1
        If Empty.Left = ((XbyX ^ 2 - 1) Mod XbyX) * XSize AndAlso Empty.Top = ((XbyX ^ 2 - 1) \ XbyX) * XSize Then
            Me.Tiles.Sort()
            For x = 1 To XbyX ^ 2 - 1
                If Not Tiles(x - 1).Text = x Then
                    Exit Sub
                End If
            Next
            MsgBox($"Completed in {Me.Moves} Moves!", MsgBoxStyle.Information, "Winner")
            Restart()
        End If
    End Sub

    Public Class Tile
        Inherits Button
        Implements IComparable(Of Tile)
        Public Board As Board
        Private Sub Tile_Click(sender As Object, e As EventArgs) Handles Me.Click
            With Board.Empty
                If Me.Left = .Left AndAlso (Me.Top + Me.Height = .Top OrElse .Top + .Height = Me.Top) Then
                    Swap()
                ElseIf Me.Top = .Top AndAlso (Me.Left + Me.Width = .Left OrElse .Left + .Width = Me.Left) Then
                    Swap()
                End If
            End With
        End Sub
        Private Sub Swap()
            Dim p = Board.Empty.Location
            Board.Empty.Location = Me.Location
            Me.Location = p
            Board.IsComplete()
        End Sub
        Public Function CompareTo(other As Tile) As Integer Implements IComparable(Of Tile).CompareTo
            Dim Result = Me.Top.CompareTo(other.Top)
            If Result = 0 Then
                Return Me.Left.CompareTo(other.Left)
            End If
            Return Result
        End Function
    End Class

    Public Function GetRandamStartOrder() As List(Of Integer)
        Dim List As New List(Of Integer)
        Dim Random As New Random()
        Do While List.Count < XbyX ^ 2 - 1
            Dim Value As Integer = Random.Next(1, XbyX ^ 2)
            If Not List.Contains(Value) Then
                List.Add(Value)
            End If
        Loop
        Return List
    End Function

    Public Function MakeCompleteable(List As List(Of Integer)) As List(Of Integer)
        'ToDo
        Return List
    End Function

End Class


/* ------------------------------------------------------------------------------------------------------

                                               Copyright (c) 2004 - Gal Zsolt (CalmoSoft)

   ------------------------------------------------------------------------------------------------------ */

implement playDialog
    open core, vpiDomains, vpiOldDomains, resourceIdentifiers

    facts
        thisWin : vpiDomains::windowHandle := erroneous.

    clauses
        show(Parent):-
            _ = vpi::winCreateDynDialog(Parent, controlList, eventHandler, gui_api::lNull).

/* ------------------------------------------------------------------------------------------------------ */

    predicates
        eventHandler : vpiDomains::ehandler.
    clauses
        eventHandler(Win, Event) = Result :-
            Result = generatedEventHandler(Win, Event).

/* ------------------------------------------------------------------------------------------------------ */

    predicates
        onDestroy : vpiOldDomains::destroyHandler.
    clauses
        onDestroy() = vpiOldDomains::defaultHandling() :-
            thisWin := erroneous.

/* ------------------------------------------------------------------------------------------------------ */

    predicates
        onControlCancel : vpiOldDomains::controlHandler.
    clauses
        onControlCancel(_Ctrl, _CtrlType, _CtrlWin, _CtrlInfo) = vpiOldDomains::handled(gui_api::rNull) :-
            file::save("game.dba",gameDB),
            retractall(table(_,_)),
            retractall(gameplay(_,_)),
            retractall(empty_cell(_)),
            retractall(cell(_,_)),
            retractall(cellnr(_,_)),
            retractall(good(_,_,_)),
            vpi::winDestroy(thisWin).

/* ------------------------------------------------------------------------------------------------------ */

 predicates
        onUpdate : vpiOldDomains::updateHandler.
    clauses
        onUpdate(Rectangle) = vpiOldDomains::defaultHandling():-
            vpi::winClear( thisWin,Rectangle,0x808040),
            !.

/* ------------------------------------------------------------------------------------------------------ */

    class facts - gameDB
        table:(integer,string).
        gameplay:(integer,integer).
        empty_cell:(integer).

    class facts
        cell:(integer,vpiDomains::windowHandle).
        cellnr:(integer,integer).

/* ------------------------------------------------------------------------------------------------------ */

    class facts
        step_nr:integer:=0.

    predicates
        onCreate : vpiOldDomains::createHandler.
    clauses
        onCreate(_CreationData) = vpiOldDomains::defaultHandling():-
            retractall(table(_,_)),
            retractall(gameplay(_,_)),
            retractall(empty_cell(_)),
            retractall(cell(_,_)),
            retractall(cellnr(_,_)),
            retractall(good(_,_,_)),

            scrollbars_init(),
            cellhandle_init(),
            empty:=16,
            good_cell(0),
            table_save(),
            step_nr:=0,
            fail.
        onCreate(_CreationData) = vpiOldDomains::defaultHandling().

/* ------------------------------------------------------------------------------------------------------ */

    facts
        vsbarr : vpiDomains::windowHandle := erroneous.
        vsbarl : vpiDomains::windowHandle := erroneous.
        hsbart : vpiDomains::windowHandle := erroneous.
        hsbarb : vpiDomains::windowHandle := erroneous.

    predicates
        scrollbars_init:().
    clauses
        scrollbars_init():-
            vsbarr := vpi::winGetCtlHandle(thisWin,idc_sbvr),
            vsbarl := vpi::winGetCtlHandle(thisWin,idc_sbvl),
            hsbart := vpi::winGetCtlHandle(thisWin,idc_sbht),
            hsbarb := vpi::winGetCtlHandle(thisWin,idc_sbhb),

            vpi::winSetScrollRange(vsbarr,sb_Ctl,1,4),
            vpi::winSetScrollProportion(vsbarr,sb_Ctl,1),
            vpi::winSetScrollPos(vsbarr,sb_Ctl,4),

            vpi::winSetScrollRange(vsbarl,sb_Ctl,1,4),
            vpi::winSetScrollProportion(vsbarl,sb_Ctl,1),
            vpi::winSetScrollPos(vsbarl,sb_Ctl,4),

            vpi::winSetScrollRange(hsbart,sb_Ctl,1,4),
            vpi::winSetScrollProportion(hsbart,sb_Ctl,1),
            vpi::winSetScrollPos(hsbart,sb_Ctl,4),

            vpi::winSetScrollRange(hsbarb,sb_Ctl,1,4),
            vpi::winSetScrollProportion(hsbarb,sb_Ctl,1),
            vpi::winSetScrollPos(hsbarb,sb_Ctl,4).

/* ------------------------------------------------------------------------------------------------------ */

    class facts
        cell1 : vpiDomains::windowHandle := erroneous.
        cell2 : vpiDomains::windowHandle := erroneous.
        cell3 : vpiDomains::windowHandle := erroneous.
        cell4 : vpiDomains::windowHandle := erroneous.
        cell5 : vpiDomains::windowHandle := erroneous.
        cell6 : vpiDomains::windowHandle := erroneous.
        cell7 : vpiDomains::windowHandle := erroneous.
        cell8 : vpiDomains::windowHandle := erroneous.
        cell9 : vpiDomains::windowHandle := erroneous.
        cell10 : vpiDomains::windowHandle := erroneous.
        cell11 : vpiDomains::windowHandle := erroneous.
        cell12 : vpiDomains::windowHandle := erroneous.
        cell13 : vpiDomains::windowHandle := erroneous.
        cell14 : vpiDomains::windowHandle := erroneous.
        cell15 : vpiDomains::windowHandle := erroneous.
        cell16 : vpiDomains::windowHandle := erroneous.

    predicates
        cell_handle:().
    clauses
        cell_handle():-
            cell1:=vpi::winGetCtlHandle(thisWin,idc_cell1),
            cell2:=vpi::winGetCtlHandle(thisWin,idc_cell2),
            cell3:=vpi::winGetCtlHandle(thisWin,idc_cell3),
            cell4:=vpi::winGetCtlHandle(thisWin,idc_cell4),
            cell5:=vpi::winGetCtlHandle(thisWin,idc_cell5),
            cell6:=vpi::winGetCtlHandle(thisWin,idc_cell6),
            cell7:=vpi::winGetCtlHandle(thisWin,idc_cell7),
            cell8:=vpi::winGetCtlHandle(thisWin,idc_cell8),
            cell9:=vpi::winGetCtlHandle(thisWin,idc_cell9),
            cell10:=vpi::winGetCtlHandle(thisWin,idc_cell10),
            cell11:=vpi::winGetCtlHandle(thisWin,idc_cell11),
            cell12:=vpi::winGetCtlHandle(thisWin,idc_cell12),
            cell13:=vpi::winGetCtlHandle(thisWin,idc_cell13),
            cell14:=vpi::winGetCtlHandle(thisWin,idc_cell14),
            cell15:=vpi::winGetCtlHandle(thisWin,idc_cell15),
            cell16:=vpi::winGetCtlHandle(thisWin,idc_cell16).

/* ------------------------------------------------------------------------------------------------------ */

    predicates
        cellhandle_init:().
    clauses
        cellhandle_init():-
            retractall(cell(_,_)),
            cell_handle(),

            assert(cell(1,cell1)),
            assert(cell(2,cell2)),
            assert(cell(3,cell3)),
            assert(cell(4,cell4)),
            assert(cell(5,cell5)),
            assert(cell(6,cell6)),
            assert(cell(7,cell7)),
            assert(cell(8,cell8)),
            assert(cell(9,cell9)),
            assert(cell(10,cell10)),
            assert(cell(11,cell11)),
            assert(cell(12,cell12)),
            assert(cell(13,cell13)),
            assert(cell(14,cell14)),
            assert(cell(15,cell15)),
            assert(cell(16,cell16)).

/* ------------------------------------------------------------------------------------------------------ */

    class facts
        good_nr:integer:=0.
        good:(integer,integer,integer) nondeterm.
        empty:integer:=16.

    predicates
        good_cell:(integer) multi.
    clauses
        good_cell(16):-!.
        good_cell(Number):-
            NumberNew = Number+1,
            good_nr:=0,
            good_above(NumberNew),                    % movable cells above empty cell
            good_before(NumberNew),                    % movable cells before empty cell
            good_after(NumberNew),                       % movable cells after empty cell
            good_under(NumberNew),                      % movable cells under empty cell
            assert(cellnr(NumberNew,good_nr)),       % number of movable cells around the empty cell
            good_cell(NumberNew).

/* ------------------------------------------------------------------------------------------------------ */

    predicates
        good_above:(integer).
    clauses
        good_above(Number):-
            Number > 4,                                             % movable cells above empty cell
            good_nr:= good_nr+1,
            assert(good(Number,good_nr,Number-4)),
            fail.
        good_above(_).

/* ------------------------------------------------------------------------------------------------------ */

    predicates
        good_before:(integer).
    clauses
        good_before(Number):-
            (Number mod 4) <> 1,                               % movable cells before empty cell
            good_nr:= good_nr+1,
            assert(good(Number,good_nr,Number-1)),
            fail.
        good_before(_).

/* ------------------------------------------------------------------------------------------------------ */

    predicates
        good_after:(integer).
    clauses
        good_after(Number):-
            (Number mod 4) > 0,                                   % movable cells after empty cell
            good_nr:= good_nr+1,
            assert(good(Number,good_nr,Number+1)),
            fail.
        good_after(_).

/* ------------------------------------------------------------------------------------------------------ */

    predicates
        good_under:(integer).
    clauses
        good_under(Number):-
            Number < 13,                                               % movable cells under empty cell
            good_nr:= good_nr+1,
            assert(good(Number,good_nr,Number+4)),
            fail.
        good_under(_).

/* ------------------------------------------------------------------------------------------------------ */

    predicates
        cell_click:(integer).

    clauses
        cell_click(NrCell):-
            good(empty,_,NrCell),
            cell(empty,EmptyHandle),
            cell(NrCell,NrCellHandle),
            EmptyNr = vpi::winGetText(NrCellHandle),
            vpi::winSetText(EmptyHandle,EmptyNr),
            vpi::winSetText(NrCellHandle,""),
            empty:=NrCell,
            step_nr := step_nr + 1,
            Bingo = vpi::winGetCtlHandle(thisWin,idc_bingo),
            vpi::winSetText(  Bingo, ""),
            vpi::winSetState(Bingo,[wsf_Invisible]),
            bingo(),

            % VerVal = uncheckedConvert(integer, math::floor((empty-1)/4)+1),
            % HorVal = uncheckedConvert(integer, math::floor((empty-1) mod 4)+1),

            VerVal = math::floor((empty-1)/4)+1,
            HorVal = math::floor((empty-1) mod 4)+1,

            vpi::winSetScrollPos(vsbarr,sb_Ctl,VerVal),
            vpi::winSetScrollPos(vsbarl,sb_Ctl,VerVal),
            vpi::winSetScrollPos(hsbart,sb_Ctl,HorVal),
            vpi::winSetScrollPos(hsbarb,sb_Ctl,HorVal),

            Step = vpi::winGetCtlHandle(thisWin,idc_step),
            vpi::winSetText(Step,toString(step_nr)),

            assert(gameplay(step_nr,NrCell)),

            fail.
        cell_click(_).

/* ------------------------------------------------------------------------------------------------------ */

    predicates
        cell_click_play:(integer).

    clauses
        cell_click_play(NrCell):-
            good(empty,_,NrCell),
            cell(empty,EmptyHandle),
            cell(NrCell,NrCellHandle),
            EmptyNr = vpi::winGetText(NrCellHandle),
            vpi::winSetText(EmptyHandle,EmptyNr),
            vpi::winSetText(NrCellHandle,""),
            empty:=NrCell,
            Bingo = vpi::winGetCtlHandle(thisWin,idc_bingo),
            vpi::winSetText(Bingo, ""),
            vpi::winSetState(Bingo,[wsf_Invisible]),
            bingo(),

            % VerVal = uncheckedConvert(integer,math::floor((empty-1)/4)+1),
            % HorVal = uncheckedConvert(integer,math::floor((empty-1) mod 4)+1),

            VerVal = math::floor((empty-1)/4)+1,
            HorVal = math::floor((empty-1) mod 4)+1,

            vpi::winSetScrollPos(vsbarr,sb_Ctl,VerVal),
            vpi::winSetScrollPos(vsbarl,sb_Ctl,VerVal),
            vpi::winSetScrollPos(hsbart,sb_Ctl,HorVal),
            vpi::winSetScrollPos(hsbarb,sb_Ctl,HorVal),

            programControl::sleep(1000),

            fail.
        cell_click_play(_).

/* ------------------------------------------------------------------------------------------------------ */

    predicates
        onControlmix : vpiOldDomains::controlHandler.
    clauses
        onControlmix(_CtrlID, _CtrlType, _CtrlWin, _CtrlInfo) = vpiOldDomains::handled(gui_api::rNull):-
            step_nr:=0,
            cell_reset(),
            mix_cells(0),
            Play = vpi::winGetCtlHandle(thisWin,idc_play),
            vpi::winSetState(Play,[wsf_Disabled]),
            Bingo = vpi::winGetCtlHandle(thisWin,idc_bingo),
            vpi::winSetText(Bingo, ""),
            vpi::winSetState(Bingo,[wsf_Invisible]),
            step_nr:=0,
            Step = vpi::winGetCtlHandle(thisWin,idc_step),
            vpi::winSetText(Step,toString(step_nr)),
            table_save(),
            retractall(gameplay(_,_)),
            fail.

        onControlmix(_CtrlID, _CtrlType, _CtrlWin, _CtrlInfo) = vpiOldDomains::handled(gui_api::rNull).

/* ------------------------------------------------------------------------------------------------------ */

    class facts
        rand_nr:integer:=0.
        mix_nr:integer:=300.

    predicates
        mix_cells:(integer) multi.

    clauses
        mix_cells(mix_nr):-!.
        mix_cells(Number):-
            NumberNew = Number+1,
            cellnr(empty,CellNr),
            RandomNr = (math::random(1315) mod CellNr) + 1,
            rand_nr := RandomNr,
            good(empty,rand_nr, I),
            cell_click(I),
            mix_cells(NumberNew).
        mix_cells(_).

/* ------------------------------------------------------------------------------------------------------ */

    predicates
        table_save:().
    clauses
        table_save():-
            retractall(table(_,_)),
            retractall(empty_cell(_)),
            assert(empty_cell(empty)),

            assert(table(1,vpi::winGetText(cell1))),
            assert(table(2,vpi::winGetText(cell2))),
            assert(table(3,vpi::winGetText(cell3))),
            assert(table(4,vpi::winGetText(cell4))),
            assert(table(5,vpi::winGetText(cell5))),
            assert(table(6,vpi::winGetText(cell6))),
            assert(table(7,vpi::winGetText(cell7))),
            assert(table(8,vpi::winGetText(cell8))),
            assert(table(9,vpi::winGetText(cell9))),
            assert(table(10,vpi::winGetText(cell10))),
            assert(table(11,vpi::winGetText(cell11))),
            assert(table(12,vpi::winGetText(cell12))),
            assert(table(13,vpi::winGetText(cell13))),
            assert(table(14,vpi::winGetText(cell14))),
            assert(table(15,vpi::winGetText(cell15))),
            assert(table(16,vpi::winGetText(cell16))).

/* ------------------------------------------------------------------------------------------------------ */

    predicates
        onControlreset : vpiOldDomains::controlHandler.
    clauses
        onControlreset(_CtrlID, _CtrlType, _CtrlWin, _CtrlInfo) = vpiOldDomains::handled(gui_api::rNull):-
                              cell_reset().

/* ------------------------------------------------------------------------------------------------------ */
    predicates
        cell_reset:().
    clauses
        cell_reset():-
            vpi::winSetText(cell1,"1"),
            vpi::winSetText(cell2,"2"),
            vpi::winSetText(cell3,"3"),
            vpi::winSetText(cell4,"4"),
            vpi::winSetText(cell5,"5"),
            vpi::winSetText(cell6,"6"),
            vpi::winSetText(cell7,"7"),
            vpi::winSetText(cell8,"8"),
            vpi::winSetText(cell9,"9"),
            vpi::winSetText(cell10,"10"),
            vpi::winSetText(cell11,"11"),
            vpi::winSetText(cell12,"12"),
            vpi::winSetText(cell13,"13"),
            vpi::winSetText(cell14,"14"),
            vpi::winSetText(cell15,"15"),
            vpi::winSetText(cell16,""),

            vpi::winSetScrollPos(vsbarr,sb_Ctl,4),
            vpi::winSetScrollPos(vsbarl,sb_Ctl,4),
            vpi::winSetScrollPos(hsbart,sb_Ctl,4),
            vpi::winSetScrollPos(hsbarb,sb_Ctl,4),

            empty:=16,
            step_nr:=0,
            Step = vpi::winGetCtlHandle(thisWin,idc_step),
            vpi::winSetText(Step,toString(step_nr)),
            Bingo = vpi::winGetCtlHandle(thisWin,idc_bingo),
            vpi::winSetText(Bingo, ""),
            vpi::winSetState(Bingo,[wsf_Invisible]),
            Play = vpi::winGetCtlHandle(thisWin,idc_play),
            vpi::winSetState(Play,[wsf_Disabled]),
            retractall(gameplay(_,_)),
            table_save().

/* ------------------------------------------------------------------------------------------------------ */

    predicates
        bingo:().

    clauses
        bingo():-
            toString(1) = vpi::winGetText(cell1),
            toString(2) = vpi::winGetText(cell2),
            toString(3) = vpi::winGetText(cell3),
            toString(4) = vpi::winGetText(cell4),
            toString(5) = vpi::winGetText(cell5),
            toString(6) = vpi::winGetText(cell6),
            toString(7) = vpi::winGetText(cell7),
            toString(8) = vpi::winGetText(cell8),
            toString(9) = vpi::winGetText(cell9),
            toString(10) = vpi::winGetText(cell10),
            toString(11) = vpi::winGetText(cell11),
            toString(12) = vpi::winGetText(cell12),
            toString(13) = vpi::winGetText(cell13),
            toString(14) = vpi::winGetText(cell14),
            toString(15) = vpi::winGetText(cell15),
            "" = vpi::winGetText(cell16),

            Bingo = vpi::winGetCtlHandle(thisWin,idc_bingo),
            vpi::winSetState(Bingo,[wsf_Visible]),
            vpi::winSetText(Bingo, "BINGO !"),

            Step = vpi::winGetCtlHandle(thisWin,idc_step),
            vpi::winSetText(Step,toString(step_nr)),

            fail.
 bingo().

/* ------------------------------------------------------------------------------------------------------ */

    facts
        fileName:string:="".

    predicates
        onControlsave : vpiOldDomains::controlHandler.
    clauses
        onControlsave(_CtrlID, _CtrlType, _CtrlWin, _CtrlInfo) = vpiOldDomains::handled(gui_api::rNull):-
            try
            	FileName = vpiCommonDialogs::getFileName(fileName, ["All files", "*.game"], "Save game as", [dlgfn_Save], "", _)
            catch _ do
            	fail
            end try,
            !,
            file::save(FileName,gameDB).

        onControlsave(_CtrlID, _CtrlType, _CtrlWin, _CtrlInfo)= vpiOldDomains::handled(gui_api::rNull).

/* ------------------------------------------------------------------------------------------------------ */

    predicates
        onControlopen : vpiOldDomains::controlHandler.
    clauses
        onControlopen(_CtrlID, _CtrlType, _CtrlWin, _CtrlInfo) = vpiOldDomains::handled(gui_api::rNull):-
            try
            	FileName = vpiCommonDialogs::getFileName("game_", ["All files", "*.game"], "Open game file", [], "", _)
            catch _ do
            	fail
            end try,
            !,
            retractall(table(_,_)),
            retractall(gameplay(_,_)),
            retractall(empty_cell(_)),
            file::consult(FileName,gameDB),
            play_display(),
            Play = vpi::winGetCtlHandle(thisWin,idc_play),
            vpi::winSetState(Play,[wsf_Enabled]),
            Bingo = vpi::winGetCtlHandle(thisWin,idc_bingo),
            vpi::winSetState(Bingo,[wsf_Invisible]),
            vpi::winSetText(Bingo, ""),
            step_nr:=0,
            Step = vpi::winGetCtlHandle(thisWin,idc_step),
            vpi::winSetText(Step,toString(step_nr)).

        onControlopen(_CtrlID, _CtrlType, _CtrlWin, _CtrlInfo) = vpiOldDomains::handled(gui_api::rNull).

/* ------------------------------------------------------------------------------------------------------ */

    predicates
        play_display:().
    clauses
        play_display():-

            table(1,Cell1),
            table(2,Cell2),
            table(3,Cell3),
            table(4,Cell4),
            table(5,Cell5),
            table(6,Cell6),
            table(7,Cell7),
            table(8,Cell8),
            table(9,Cell9),
            table(10,Cell10),
            table(11,Cell11),
            table(12,Cell12),
            table(13,Cell13),
            table(14,Cell14),
            table(15,Cell15),
            table(16,Cell16),

            vpi::winSetText(cell1,Cell1),
            vpi::winSetText(cell2,Cell2),
            vpi::winSetText(cell3,Cell3),
            vpi::winSetText(cell4,Cell4),
            vpi::winSetText(cell5,Cell5),
            vpi::winSetText(cell6,Cell6),
            vpi::winSetText(cell7,Cell7),
            vpi::winSetText(cell8,Cell8),
            vpi::winSetText(cell9,Cell9),
            vpi::winSetText(cell10,Cell10),
            vpi::winSetText(cell11,Cell11),
            vpi::winSetText(cell12,Cell12),
            vpi::winSetText(cell13,Cell13),
            vpi::winSetText(cell14,Cell14),
            vpi::winSetText(cell15,Cell15),
            vpi::winSetText(cell16,Cell16),

            empty_cell(Empty_Cell),
            empty:=Empty_Cell,

            fail.
        play_display().

/* ------------------------------------------------------------------------------------------------------ */

    predicates
        onControlplay : vpiOldDomains::controlHandler.
    clauses

        onControlplay(_CtrlID, _CtrlType, _CtrlWin, _CtrlInfo) = vpiOldDomains::handled(gui_api::rNull):-
            Play = vpi::winGetCtlHandle(thisWin,idc_play),
            vpi::winSetState(Play,[wsf_Disabled]),
            gameplay(Nr,Nr_cell),
            cell_click_play(Nr_cell),
            Step = vpi::winGetCtlHandle(thisWin,idc_step),
            vpi::winSetText(Step,toString(Nr)),
            fail.

        onControlplay(_CtrlID, _CtrlType, _CtrlWin, _CtrlInfo) = vpiOldDomains::handled(gui_api::rNull).

/* ------------------------------------------------------------------------------------------------------ */

    predicates
        onControlsbvr : vpiOldDomains::controlHandler.               % Sets the right vertical scrollbar
    clauses
        onControlsbvr(_CtrlID, _CtrlType, _CtrlWin,scroll(sc_LineDown,_)) = vpiOldDomains::handled(gui_api::rNull):-
            Sbarvalr = vpi::winGetScrollPos(vsbarr,sb_Ctl)+1,
            Sbarvalr < 5,
            cell_click(empty+4),
            vpi::winSetScrollPos(vsbarr,sb_Ctl, Sbarvalr),
            vpi::winSetScrollPos(vsbarl,sb_Ctl, Sbarvalr),
            fail.

        onControlsbvr(_CtrlID, _CtrlType, _CtrlWin,scroll(sc_LineUp,_)) = vpiOldDomains::handled(gui_api::rNull):-
            Sbarvalr = vpi::winGetScrollPos(vsbarr,sb_Ctl)-1,
            Sbarvalr > 0,
            cell_click(empty-4),
            vpi::winSetScrollPos(vsbarr,sb_Ctl, Sbarvalr),
            vpi::winSetScrollPos(vsbarl,sb_Ctl, Sbarvalr),
            fail.

        onControlsbvr(_CtrlID, _CtrlType, _CtrlWin, _CtrlInfo) = vpiOldDomains::handled(gui_api::rNull).

/* ------------------------------------------------------------------------------------------------------ */

    predicates
        onControlsbvl : vpiOldDomains::controlHandler.                  % Sets the left vertical scrollbar
    clauses
        onControlsbvl(_CtrlID, _CtrlType, _CtrlWin,scroll(sc_LineDown,_)) = vpiOldDomains::handled(gui_api::rNull):-
            Sbarvall = vpi::winGetScrollPos(vsbarl,sb_Ctl)+1,
            Sbarvall < 5,
            cell_click(empty+4),
            vpi::winSetScrollPos(vsbarl,sb_Ctl, Sbarvall),
            vpi::winSetScrollPos(vsbarr,sb_Ctl, Sbarvall),
            fail.

        onControlsbvl(_CtrlID, _CtrlType, _CtrlWin,scroll(sc_LineUp,_)) = vpiOldDomains::handled(gui_api::rNull):-
            Sbarvall = vpi::winGetScrollPos(vsbarl,sb_Ctl)-1,
            Sbarvall > 0,
            cell_click(empty-4),
            vpi::winSetScrollPos(vsbarl,sb_Ctl, Sbarvall),
            vpi::winSetScrollPos(vsbarr,sb_Ctl, Sbarvall),
            fail.

        onControlsbvl(_CtrlID, _CtrlType, _CtrlWin, _CtrlInfo) = vpiOldDomains::handled(gui_api::rNull).

/* ------------------------------------------------------------------------------------------------------ */

    predicates
        onControlsbht : vpiOldDomains::controlHandler.             % Sets the top horizontal scrollbar
    clauses
        onControlsbht(_CtrlID, _CtrlType, _CtrlWin,scroll(sc_LineDown,_)) = vpiOldDomains::handled(gui_api::rNull):-
            Sbarvalt = vpi::winGetScrollPos(hsbart,sb_Ctl)+1,
            Sbarvalt < 5,
            cell_click(empty+1),
            vpi::winSetScrollPos(hsbart,sb_Ctl, Sbarvalt),
            vpi::winSetScrollPos(hsbarb,sb_Ctl, Sbarvalt),
            fail.

        onControlsbht(_CtrlID, _CtrlType, _CtrlWin,scroll(sc_LineUp,_)) = vpiOldDomains::handled(gui_api::rNull):-
            Sbarvalt = vpi::winGetScrollPos(hsbart,sb_Ctl)-1,
            Sbarvalt > 0,
            cell_click(empty-1),
            vpi::winSetScrollPos(hsbart,sb_Ctl, Sbarvalt),
            vpi::winSetScrollPos(hsbarb,sb_Ctl, Sbarvalt),
            fail.

        onControlsbht(_CtrlID, _CtrlType, _CtrlWin, _CtrlInfo) = vpiOldDomains::handled(gui_api::rNull).

/* ------------------------------------------------------------------------------------------------------ */

    predicates
        onControlsbhb : vpiOldDomains::controlHandler.       % Sets the bottom horizontal scrollbar
    clauses
        onControlsbhb(_CtrlID, _CtrlType, _CtrlWin,scroll(sc_LineDown,_)) = vpiOldDomains::handled(gui_api::rNull):-
            Sbarvalb = vpi::winGetScrollPos(hsbarb,sb_Ctl)+1,
            Sbarvalb < 5,
            cell_click(empty+1),
            vpi::winSetScrollPos(hsbarb,sb_Ctl, Sbarvalb),
            vpi::winSetScrollPos(hsbart,sb_Ctl, Sbarvalb),
            fail.

        onControlsbhb(_CtrlID, _CtrlType, _CtrlWin,scroll(sc_LineUp,_)) = vpiOldDomains::handled(gui_api::rNull):-
            Sbarvalb = vpi::winGetScrollPos(hsbarb,sb_Ctl)-1,
            Sbarvalb > 0,
            cell_click(empty-1),
            vpi::winSetScrollPos(hsbarb,sb_Ctl, Sbarvalb),
            vpi::winSetScrollPos(hsbart,sb_Ctl, Sbarvalb),
            fail.

        onControlsbhb(_CtrlID, _CtrlType, _CtrlWin, _CtrlInfo) = vpiOldDomains::handled(gui_api::rNull).

/* ------------------------------------------------------------------------------------------------------ */

    predicates
        onControlcell1 : vpiOldDomains::controlHandler.
    clauses
        onControlcell1(_CtrlID, _CtrlType, _CtrlWin, _CtrlInfo) = vpiOldDomains::handled(gui_api::rNull):-
            cell_click(1).

/* ------------------------------------------------------------------------------------------------------ */

    predicates
        onControlcell2 : vpiOldDomains::controlHandler.
    clauses
        onControlcell2(_CtrlID, _CtrlType, _CtrlWin, _CtrlInfo) = vpiOldDomains::handled(gui_api::rNull):-
            cell_click(2).

/* ------------------------------------------------------------------------------------------------------ */

    predicates
        onControlcell3 : vpiOldDomains::controlHandler.
    clauses
        onControlcell3(_CtrlID, _CtrlType, _CtrlWin, _CtrlInfo) = vpiOldDomains::handled(gui_api::rNull):-
            cell_click(3).

/* ------------------------------------------------------------------------------------------------------ */

    predicates
        onControlcell4 : vpiOldDomains::controlHandler.
    clauses
        onControlcell4(_CtrlID, _CtrlType, _CtrlWin, _CtrlInfo) = vpiOldDomains::handled(gui_api::rNull):-
            cell_click(4).

/* ------------------------------------------------------------------------------------------------------ */

    predicates
        onControlcell5 : vpiOldDomains::controlHandler.
    clauses
        onControlcell5(_CtrlID, _CtrlType, _CtrlWin, _CtrlInfo) = vpiOldDomains::handled(gui_api::rNull):-
            cell_click(5).

/* ------------------------------------------------------------------------------------------------------ */

    predicates
        onControlcell6 : vpiOldDomains::controlHandler.
    clauses
        onControlcell6(_CtrlID, _CtrlType, _CtrlWin, _CtrlInfo) = vpiOldDomains::handled(gui_api::rNull):-
            cell_click(6).

/* ------------------------------------------------------------------------------------------------------ */

    predicates
        onControlcell7 : vpiOldDomains::controlHandler.
    clauses
        onControlcell7(_CtrlID, _CtrlType, _CtrlWin, _CtrlInfo) = vpiOldDomains::handled(gui_api::rNull):-
            cell_click(7).

/* ------------------------------------------------------------------------------------------------------ */

    predicates
        onControlcell8 : vpiOldDomains::controlHandler.
    clauses
        onControlcell8(_CtrlID, _CtrlType, _CtrlWin, _CtrlInfo) = vpiOldDomains::handled(gui_api::rNull):-
            cell_click(8).

/* ------------------------------------------------------------------------------------------------------ */

    predicates
        onControlcell9 : vpiOldDomains::controlHandler.
    clauses
        onControlcell9(_CtrlID, _CtrlType, _CtrlWin, _CtrlInfo) = vpiOldDomains::handled(gui_api::rNull):-
            cell_click(9).

/* ------------------------------------------------------------------------------------------------------ */

    predicates
        onControlcell10 : vpiOldDomains::controlHandler.
    clauses
        onControlcell10(_CtrlID, _CtrlType, _CtrlWin, _CtrlInfo) = vpiOldDomains::handled(gui_api::rNull):-
            cell_click(10).

/* ------------------------------------------------------------------------------------------------------ */

    predicates
        onControlcell11 : vpiOldDomains::controlHandler.
    clauses
        onControlcell11(_CtrlID, _CtrlType, _CtrlWin, _CtrlInfo) = vpiOldDomains::handled(gui_api::rNull):-
            cell_click(11).

/* ------------------------------------------------------------------------------------------------------ */

    predicates
        onControlcell12 : vpiOldDomains::controlHandler.
    clauses
        onControlcell12(_CtrlID, _CtrlType, _CtrlWin, _CtrlInfo) = vpiOldDomains::handled(gui_api::rNull):-
            cell_click(12).

/* ------------------------------------------------------------------------------------------------------ */

    predicates
        onControlcell13 : vpiOldDomains::controlHandler.
    clauses
        onControlcell13(_CtrlID, _CtrlType, _CtrlWin, _CtrlInfo) = vpiOldDomains::handled(gui_api::rNull):-
            cell_click(13).

/* ------------------------------------------------------------------------------------------------------ */

    predicates
        onControlcell14 : vpiOldDomains::controlHandler.
    clauses
        onControlcell14(_CtrlID, _CtrlType, _CtrlWin, _CtrlInfo) = vpiOldDomains::handled(gui_api::rNull):-
            cell_click(14).

/* ------------------------------------------------------------------------------------------------------ */

    predicates
        onControlcell15 : vpiOldDomains::controlHandler.
    clauses
        onControlcell15(_CtrlID, _CtrlType, _CtrlWin, _CtrlInfo) = vpiOldDomains::handled(gui_api::rNull):-
            cell_click(15).

/* ------------------------------------------------------------------------------------------------------ */

    predicates
        onControlcell16 : vpiOldDomains::controlHandler.
    clauses
        onControlcell16(_CtrlID, _CtrlType, _CtrlWin, _CtrlInfo) = vpiOldDomains::handled(gui_api::rNull):-
            cell_click(16).

/* ------------------------------------------------------------------------------------------------------ */

    % This code is maintained by the VDE do not update it manually, 22:12:35-14.3.2004
    constants
        dialogType : vpiDomains::wintype = wd_Modal.
        title : string = "playDialog".
        rectangle : vpiDomains::rct = rct(200,40,359,263).
        dialogFlags : vpiDomains::wsflags = [wsf_Close,wsf_TitleBar].
        dialogFont = "MS Sans Serif".
        dialogFontSize = 8.

    constants
        controlList : vpiDomains::windef_list =
            [
            dlgFont(wdef(dialogType, rectangle, title, u_DlgBase),
                    dialogFont, dialogFontSize, dialogFlags),
            ctl(wdef(wc_PushButton,rct(40,166,67,178),"&Mix",u_DlgBase),idc_mix,[wsf_Group,wsf_TabStop]),
            ctl(wdef(wc_PushButton,rct(67,166,94,178),"&Reset",u_DlgBase),idc_reset,[wsf_Group,wsf_TabStop]),
            ctl(wdef(wc_PushButton,rct(40,178,67,190),"&Save",u_DlgBase),idc_save,[wsf_Group,wsf_TabStop]),
            ctl(wdef(wc_PushButton,rct(94,178,121,190),"&Open",u_DlgBase),idc_open,[wsf_Group,wsf_TabStop]),
            ctl(wdef(wc_PushButton,rct(40,190,121,202),"&Play",u_DlgBase),idc_play,[wsf_Group,wsf_TabStop,wsf_Disabled]),
            ctl(wdef(wc_PushButton,rct(94,166,121,178),"&Exit",u_DlgBase),idc_cancel,[wsf_Group,wsf_TabStop]),
            ctl(wdef(wc_PushButton,rct(40,40,60,60),"1",u_DlgBase),idc_cell1,[wsf_Group]),
            ctl(wdef(wc_PushButton,rct(60,40,80,60),"2",u_DlgBase),idc_cell2,[wsf_Group]),
            ctl(wdef(wc_PushButton,rct(80,40,100,60),"3",u_DlgBase),idc_cell3,[wsf_Group]),
            ctl(wdef(wc_PushButton,rct(100,40,120,60),"4",u_DlgBase),idc_cell4,[wsf_Group]),
            ctl(wdef(wc_PushButton,rct(40,60,60,80),"5",u_DlgBase),idc_cell5,[wsf_Group]),
            ctl(wdef(wc_PushButton,rct(60,60,80,80),"6",u_DlgBase),idc_cell6,[wsf_Group]),
            ctl(wdef(wc_PushButton,rct(80,60,100,80),"7",u_DlgBase),idc_cell7,[wsf_Group]),
            ctl(wdef(wc_PushButton,rct(100,60,120,80),"8",u_DlgBase),idc_cell8,[wsf_Group]),
            ctl(wdef(wc_PushButton,rct(40,80,60,100),"9",u_DlgBase),idc_cell9,[wsf_Group]),
            ctl(wdef(wc_PushButton,rct(60,80,80,100),"10",u_DlgBase),idc_cell10,[wsf_Group]),
            ctl(wdef(wc_PushButton,rct(80,80,100,100),"11",u_DlgBase),idc_cell11,[wsf_Group]),
            ctl(wdef(wc_PushButton,rct(100,80,120,100),"12",u_DlgBase),idc_cell12,[wsf_Group]),
            ctl(wdef(wc_PushButton,rct(40,100,60,120),"13",u_DlgBase),idc_cell13,[wsf_Group]),
            ctl(wdef(wc_PushButton,rct(60,100,80,120),"14",u_DlgBase),idc_cell14,[wsf_Group]),
            ctl(wdef(wc_PushButton,rct(80,100,100,120),"15",u_DlgBase),idc_cell15,[wsf_Group]),
            ctl(wdef(wc_PushButton,rct(100,100,120,120),"",u_DlgBase),idc_cell16,[wsf_Group]),
            ctl(wdef(wc_HScroll,rct(30,18,130,30),"",u_DlgBase),idc_sbht,[]),
            ctl(wdef(wc_VScroll,rct(130,30,142,130),"",u_DlgBase),idc_sbvr,[]),
            ctl(wdef(wc_HScroll,rct(30,130,130,142),"",u_DlgBase),idc_sbhb,[]),
            ctl(wdef(wc_VScroll,rct(18,30,30,130),"",u_DlgBase),idc_sbvl,[]),
            ctl(wdef(wc_PushButton,rct(67,178,94,190),"",u_DlgBase),idc_step,[wsf_Group]),
            ctl(wdef(wc_PushButton,rct(40,154,121,166),"",u_DlgBase),idc_bingo,[wsf_Group,wsf_Invisible])
            ].

    predicates
        generatedEventHandler : vpiDomains::ehandler.
    clauses
        generatedEventHandler(Win, e_create(_)) = _ :-
            thisWin := Win,
            fail.
        generatedEventHandler(_Win, e_Create(CreationData)) = Result :-
            handled(Result) = onCreate(CreationData).
        generatedEventHandler(_Win, e_Update(Rectangle)) = Result :-
            handled(Result) = onUpdate(Rectangle).
        generatedEventHandler(_Win, e_Control(idc_cancel, CtrlType, CtrlWin, CtlInfo)) = Result :-
            handled(Result) = onControlCancel(idc_cancel, CtrlType, CtrlWin, CtlInfo).
        generatedEventHandler(_Win, e_Control(idc_mix, CtrlType, CtrlWin, CtlInfo)) = Result :-
            handled(Result) = onControlmix(idc_mix, CtrlType, CtrlWin, CtlInfo).
        generatedEventHandler(_Win, e_Control(idc_reset, CtrlType, CtrlWin, CtlInfo)) = Result :-
            handled(Result) = onControlreset(idc_reset, CtrlType, CtrlWin, CtlInfo).
        generatedEventHandler(_Win, e_Control(idc_sbvr, CtrlType, CtrlWin, CtlInfo)) = Result :-
            handled(Result) = onControlsbvr(idc_sbvr, CtrlType, CtrlWin, CtlInfo).
        generatedEventHandler(_Win, e_Control(idc_sbvl, CtrlType, CtrlWin, CtlInfo)) = Result :-
            handled(Result) = onControlsbvl(idc_sbvl, CtrlType, CtrlWin, CtlInfo).
        generatedEventHandler(_Win, e_Control(idc_sbhb, CtrlType, CtrlWin, CtlInfo)) = Result :-
            handled(Result) = onControlsbhb(idc_sbhb, CtrlType, CtrlWin, CtlInfo).
        generatedEventHandler(_Win, e_Control(idc_sbht, CtrlType, CtrlWin, CtlInfo)) = Result :-
            handled(Result) = onControlsbht(idc_sbht, CtrlType, CtrlWin, CtlInfo).
        generatedEventHandler(_Win, e_Control(idc_save, CtrlType, CtrlWin, CtlInfo)) = Result :-
            handled(Result) = onControlsave(idc_save, CtrlType, CtrlWin, CtlInfo).
        generatedEventHandler(_Win, e_Control(idc_open, CtrlType, CtrlWin, CtlInfo)) = Result :-
            handled(Result) = onControlopen(idc_open, CtrlType, CtrlWin, CtlInfo).
        generatedEventHandler(_Win, e_Control(idc_play, CtrlType, CtrlWin, CtlInfo)) = Result :-
            handled(Result) = onControlplay(idc_play, CtrlType, CtrlWin, CtlInfo).
        generatedEventHandler(_Win, e_Control(idc_cell1, CtrlType, CtrlWin, CtlInfo)) = Result :-
            handled(Result) = onControlcell1(idc_cell1, CtrlType, CtrlWin, CtlInfo).
        generatedEventHandler(_Win, e_Control(idc_cell10, CtrlType, CtrlWin, CtlInfo)) = Result :-
            handled(Result) = onControlcell10(idc_cell10, CtrlType, CtrlWin, CtlInfo).
        generatedEventHandler(_Win, e_Control(idc_cell11, CtrlType, CtrlWin, CtlInfo)) = Result :-
            handled(Result) = onControlcell11(idc_cell11, CtrlType, CtrlWin, CtlInfo).
        generatedEventHandler(_Win, e_Control(idc_cell12, CtrlType, CtrlWin, CtlInfo)) = Result :-
            handled(Result) = onControlcell12(idc_cell12, CtrlType, CtrlWin, CtlInfo).
        generatedEventHandler(_Win, e_Control(idc_cell13, CtrlType, CtrlWin, CtlInfo)) = Result :-
            handled(Result) = onControlcell13(idc_cell13, CtrlType, CtrlWin, CtlInfo).
        generatedEventHandler(_Win, e_Control(idc_cell14, CtrlType, CtrlWin, CtlInfo)) = Result :-
            handled(Result) = onControlcell14(idc_cell14, CtrlType, CtrlWin, CtlInfo).
        generatedEventHandler(_Win, e_Control(idc_cell15, CtrlType, CtrlWin, CtlInfo)) = Result :-
            handled(Result) = onControlcell15(idc_cell15, CtrlType, CtrlWin, CtlInfo).
        generatedEventHandler(_Win, e_Control(idc_cell16, CtrlType, CtrlWin, CtlInfo)) = Result :-
            handled(Result) = onControlcell16(idc_cell16, CtrlType, CtrlWin, CtlInfo).
        generatedEventHandler(_Win, e_Control(idc_cell2, CtrlType, CtrlWin, CtlInfo)) = Result :-
            handled(Result) = onControlcell2(idc_cell2, CtrlType, CtrlWin, CtlInfo).
        generatedEventHandler(_Win, e_Control(idc_cell3, CtrlType, CtrlWin, CtlInfo)) = Result :-
            handled(Result) = onControlcell3(idc_cell3, CtrlType, CtrlWin, CtlInfo).
        generatedEventHandler(_Win, e_Control(idc_cell4, CtrlType, CtrlWin, CtlInfo)) = Result :-
            handled(Result) = onControlcell4(idc_cell4, CtrlType, CtrlWin, CtlInfo).
        generatedEventHandler(_Win, e_Control(idc_cell5, CtrlType, CtrlWin, CtlInfo)) = Result :-
            handled(Result) = onControlcell5(idc_cell5, CtrlType, CtrlWin, CtlInfo).
        generatedEventHandler(_Win, e_Control(idc_cell6, CtrlType, CtrlWin, CtlInfo)) = Result :-
            handled(Result) = onControlcell6(idc_cell6, CtrlType, CtrlWin, CtlInfo).
        generatedEventHandler(_Win, e_Control(idc_cell7, CtrlType, CtrlWin, CtlInfo)) = Result :-
            handled(Result) = onControlcell7(idc_cell7, CtrlType, CtrlWin, CtlInfo).
        generatedEventHandler(_Win, e_Control(idc_cell8, CtrlType, CtrlWin, CtlInfo)) = Result :-
            handled(Result) = onControlcell8(idc_cell8, CtrlType, CtrlWin, CtlInfo).
        generatedEventHandler(_Win, e_Control(idc_cell9, CtrlType, CtrlWin, CtlInfo)) = Result :-
            handled(Result) = onControlcell9(idc_cell9, CtrlType, CtrlWin, CtlInfo).
        generatedEventHandler(_Win, e_Destroy()) = Result :-
            handled(Result) = onDestroy().
    % end of automatic code
end implement playDialog


'----------------15 game-------------------------------------
'WARNING: this script uses ANSI escape codes to position items on console so
'it won't work in Windows from XP to 8.1 where Microsoft removed ANSI support...
'Windows 10, 11 or 98 are ok!!!

option explicit
const maxshuffle=100 'level

dim ans0:ans0=chr(27)&"["
dim anscls:anscls=ans0 & "2J"

dim dirs:dirs=array(6,-1,-6,1)
dim a:a=array(-1,-1,-1,-1,-1,-1,_
              -1, 1, 2, 3, 4,-1,_
              -1, 5, 6, 7, 8,-1,_
              -1, 9,10,11,12,-1,_
              -1,13,14,15, 0,-1,_
              -1,-1,-1,-1,-1,-1)
dim b(35)
dim pos0
dim s:s=Array("W+Enter: up   Z+Enter: down  A+Enter: left   S+Enter right ",_
              "Bad move!!                                                 ",_
	      "You did it! Another game? [y/n]+Enter                      ",_
	      "Bye!                                                       ")

do
  shuffle
  draw
  toxy 10,1,s(0)
  do
   if usr(wait()) then
     draw
     toxy 10,1,s(0)
   else
     toxy 10,1,s(1)
   end if
  loop until checkend
  toxy 10,1,s(2)
loop until wait()="n"
toxy 10,1,s(3)

function wait():
 toxy 11,1,"":
 wait=left(lcase(wscript.stdin.readline),1):
end function

sub toxy(x,y,s)
 wscript.StdOut.Write ans0 & x & ";" & y & "H"& " "& s
end sub

sub draw
  dim i,j
  wscript.stdout.write anscls
  for i=0 to 3 'row
    for j=0 to 3  'col
      toxy (j*2)+2,(i*3)+3,iif(b(j*6+i+7)<>0,b(j*6+i+7)," ")
    next
  next
  toxy 10,1,""
end sub

function checkend
  dim i
  for i=0 to ubound(a)
   if (b(i)<>a(i)) then checkend=false : exit function
  next
  checkend=true
end function

function move(d)
 dim p1
 p1=pos0+d
 if b(p1) <>-1 then
    b(pos0)=b(p1):
    b(p1)=0:
    pos0=p1:
    move=true
 else
   move=false
 end if
end function

sub shuffle
  dim cnt,r,i
   randomize timer
   for i=0 to ubound(a):b(i)=a(i):next
   pos0=28
   cnt=0
   do
     r=int(rnd*4)
     if move(dirs(r))=true then cnt=cnt+1
   loop until cnt=maxshuffle
end sub

function iif(a,b,c): if a then iif=b else iif=c end if:end function

function usr(a)
  dim d
  select case lcase(a)
  case "w" :d=-6
  case "z" :d=6
  case "a" :d=-1
  case "s" :d=1
  end select
  usr= move(d)
end function


import "random" for Random
import "/dynamic" for Enum
import "/ioutil" for Input
import "/fmt" for Fmt

var Move = Enum.create("Move", ["up", "down", "right", "left"])

var Rand = Random.new()
var RandMove = Fn.new { Rand.int(4) }

var SolvedBoard = [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 0]

var AreEqual = Fn.new { |l1, l2|
    if (l1.count != l2.count) return false
    for (i in 0...l1.count) {
        if (l1[i] != l2[i]) return false
    }
    return true
}

class Puzzle {
    construct new() {
        _board = SolvedBoard.toList
        _empty = 15 // _board[empty] == 0
        _moves = 0
        _quit  = false
        // Could make this configurable, 10 == easy, 50 == normal, 100 == hard
        shuffle(50)
    }

    shuffle(moves) {
        // we use some number of random moves to "shuffle" the board
        var i = 0
        while (i < moves || AreEqual.call(_board, SolvedBoard)) {
            if (doMove(RandMove.call())) i = i + 1
        }
    }

    isValidMove(m) {
        if (m == Move.up)    return [_empty - 4, (_empty/4).floor > 0]
        if (m == Move.down)  return [_empty + 4, (_empty/4).floor < 3]
        if (m == Move.right) return [_empty + 1, _empty % 4 < 3]
        if (m == Move.left)  return [_empty - 1, _empty % 4 > 0]
        Fiber.abort("not reached")
    }

    doMove(m) {
        var i = _empty
        var res = isValidMove(m)
        var j  = res[0]
        var ok = res[1]
        if (ok) {
            _board.swap(i, j)
            _empty = j
            _moves = _moves + 1
        }
        return ok
    }

    play() {
        var instructions = """
Please enter "U", "D", "L", or "R" to move the empty cell
up, down, left, or right. You can also enter "Q" to quit.
Upper or lowercase is accepted and only the first character
is important (i.e. you may enter "up" if you like).
"""
        System.print(instructions)
        System.write("\nStarting board:")
        while (!AreEqual.call(_board, SolvedBoard) && !_quit) {
            System.print("\n%(this)")
            playOneMove()
        }
        if (AreEqual.call(_board, SolvedBoard)) {
            System.print("\n%(this)")
            System.print("You solved the puzzle in %(_moves) moves.")
        }
    }

    playOneMove() {
        while (true) {
            var s = Input.option("Enter move #%(_moves + 1) (U, D, L, R or Q): ", "UuDdLlRrQq")
            var m
            if (s == "U" || s == "u") {
                m = Move.up
            } else if (s == "D" || s == "d") {
                m = Move.down
            } else if (s == "L" || s == "l") {
                m = Move.left
            } else if (s == "R" || s == "r") {
                m = Move.right
            } else if (s == "Q" || s == "q") {
                System.print("Quiting after %(_moves).")
                _quit = true
                return
            }
            if (!doMove(m)) {
                System.print("That is not a valid move at the moment.")
                continue
            }
            return
        }
    }

    toString {
        var buf = ""
        var i = 0
        for (c in _board) {
            if (c == 0) {
                buf = buf + "  ."
            } else {
                buf = buf + Fmt.swrite("$3d", c)
            }
            if (i % 4 == 3) buf = buf + "\n"
            i = i + 1
        }
        return buf
    }
}

var p = Puzzle.new()
p.play()


        ; Puzzle15 by grosged (march 2019)
        ; How to play ?.. Just press one of the arrow keys then [enter] to valid
        ; ( press [Ctrl+C] to escape )

        segment	.data
check:	db	"1   2   3   4",10,"  5   6   7   8",10,"  9  10  11  12",10," 13  14  1"
puzzle:	db	27,"c",10,"  1   2   3   4",10,"  5   6   7   8",10,"  9  10  11  12",10," 13  14  15    ",10,10
	db	" Direction ?",13
	db	" Well done !  ",10,10
inKey:	dw	0,0,0,0

	segment	.text
	global	_start

_start:	mov	rax,100
	syscall
	mov	rcx,rax
	shr	rcx,3
	and	rcx,255
	and	rax,31
	lea	rsi,[_start+rax]
	mov	rbx,15

Mixing:	push	rcx
	mov	di,word[rsi+rcx*2]
	mov	rcx,8
quatre:	mov	ax,di
	shr	di,2
	and	ax,3
	add	ax,65
	call	SWAPPIN
	loop	quatre
	pop	rcx
	loop	Mixing
	cmp	cx,ax

MainLp:	mov	rdx,80
Succes:	lea	rsi,[puzzle]
	mov	rdi,1
	mov	rax,1
End?:	syscall
	mov	rax,60
	je	End?
	mov	rdx,8
	lea	rsi,[inKey]
	mov	rdi,0
	mov	rax,0
	syscall
	mov	al,byte [rsi+rax-2]
	call	SWAPPIN
	lea 	rsi,[check]
	lea	rdi,[puzzle+5]
	mov	rcx,7
	repe	cmpsq
	jne	MainLp
	mov	rdx,95
	jmp	Succes

SWAPPIN:mov	rdx,rbx
	cmp	al,"A"
	jne	NotUp
	add	rbx,4
	cmp	rbx,16
	cmovae	rbx,rdx
NotUp:	cmp	al,"B"
	jne	NotDwn
	sub	rbx,4
	cmovc	rbx,rdx
NotDwn:	cmp	al,"C"
	jne	NotLft
	test	rbx,3
	jz	Endcll
	dec	rbx
NotLft:	cmp	al,"D"
	jne	Endcll
	inc	rbx
	test	rbx,3
	cmovz	rbx,rdx
Endcll:	mov	ax,"  "
	xchg	ax,word[puzzle+4+rbx*4]
	mov	word[puzzle+4+rdx*4],ax
	ret


PROGRAM "fifteenpuzzlegame"
VERSION "0.0001"

IMPORT "xst"

DECLARE FUNCTION Entry()
INTERNAL FUNCTION PrintPuzzle(d%[])
INTERNAL FUNCTION IntroAndLevel(shCnt%[])
INTERNAL FUNCTION BuildBoard(d%[], shCnt%[], level%)
INTERNAL FUNCTION IsMoveValid(d%[], piece%, piecePos%, emptyPos%)
INTERNAL FUNCTION IsPuzzleComplete(d%[])
INTERNAL FUNCTION PiecePosition(d%[], piece%)

' Pseudo-random number generator
' Based on the rand, srand functions from Kernighan & Ritchie's book
' 'The C Programming Language'
DECLARE FUNCTION Rand()
DECLARE FUNCTION SRand(seed%%)

FUNCTION Entry()
  DIM d%[15]
  DIM shCnt%[2]
  BuildBoard(@d%[], @shCnt%[], IntroAndLevel(@shCnt%[]))
  PrintPuzzle(@d%[])
  DO
    x% = SSHORT(INLINE$("To move a piece, enter its number: "))
    DO WHILE IsMoveValid(@d%[], x%, @y%, @z%) = 0
      PRINT "Wrong move."
      PrintPuzzle(@d%[])
      x% = SSHORT(INLINE$("To move a piece, enter its number: "))
    LOOP
    d%[z% - 1] = x%
    d%[y% - 1] = 0
    PrintPuzzle(@d%[])
  LOOP UNTIL IsPuzzleComplete(@d%[])
  PRINT "YOU WON!"
END FUNCTION

FUNCTION PrintPuzzle(d%[])
  DIM ds$[15] ' Board pieces
  FOR p%% = 0 TO 15
    IF d%[p%%] = 0 THEN
      ds$[p%%] = "     "
    ELSE
      ds$[p%%] = FORMAT$("###  ", d%[p%%])
    END IF
  NEXT p%%
  PRINT "+-----+-----+-----+-----+"
  PRINT "|"; ds$[0]; "|"; ds$[1]; "|"; ds$[2]; "|"; ds$[3]; "|"
  PRINT "+-----+-----+-----+-----+"
  PRINT "|"; ds$[4]; "|"; ds$[5]; "|"; ds$[6]; "|"; ds$[7]; "|"
  PRINT "+-----+-----+-----+-----+"
  PRINT "|"; ds$[8]; "|"; ds$[9]; "|"; ds$[10]; "|"; ds$[11]; "|"
  PRINT "+-----+-----+-----+-----+"
  PRINT "|"; ds$[12]; "|"; ds$[13]; "|"; ds$[14]; "|"; ds$[15]; "|"
  PRINT "+-----+-----+-----+-----+"
END FUNCTION

FUNCTION IntroAndLevel(shCnt%[])
  XstClearConsole()
  shCnt%[0] = 10
  shCnt%[1] = 50
  shCnt%[2] = 100
  PRINT "15 PUZZLE GAME"
  PRINT
  PRINT
  PRINT "Please enter level of difficulty,"
  DO
    level% = SSHORT(INLINE$("1 (easy), 2 (medium) or 3 (hard): "))
  LOOP UNTIL (level% >= 1) && (level% <= 3)
END FUNCTION level%

FUNCTION BuildBoard(d%[], shCnt%[], level%)
  ' Set pieces in correct order first
  FOR p%% = 1 TO 15
    d%[p%% - 1] = p%%
  NEXT p%%
  d%[15] = 0 ' 0 = empty piece/slot
  z% = 16 ' z% = empty position
  PRINT
  PRINT "Shuffling pieces";
  XstGetSystemTime (@msec)
  SRand(INT(msec) MOD 32768)
  FOR n% = 1 TO shCnt%[level% - 1]
    PRINT ".";
    DO
      x% = INT(Rand() / 32768.0 * 4.0) + 1
      PRINT x%
      SELECT CASE x%
        CASE 1:
          r% = z% - 4
        CASE 2:
          r% = z% + 4
        CASE 3:
          IF (z% - 1) MOD 4 <> 0 THEN
            r% = z% - 1
          END IF
        CASE 4:
          IF z% MOD 4 <> 0 THEN
            r% = z% + 1
          END IF
      END SELECT
    LOOP UNTIL (r% >= 1) && (r% <= 16)
    d%[z% - 1] = d%[r% - 1]
    z% = r%
    d%[z% - 1] = 0
  NEXT n%
  XstClearConsole()
END FUNCTION

FUNCTION IsMoveValid(d%[], piece%, piecePos%, emptyPos%)
  mv% = 0
  IF (piece% >= 1) && (piece% <= 15) THEN
    piecePos% = PiecePosition(@d%[], piece%)
    emptyPos% = PiecePosition(@d%[], 0)
    ' Check if empty piece is above, below, left or right to piece
    IF (piecePos% - 4 = emptyPos%) || (piecePos% + 4 = emptyPos%) || ((piecePos% - 1 = emptyPos%) && (emptyPos% MOD 4 <> 0)) || ((piecePos% + 1 = emptyPos%) && (piecePos% MOD 4 <> 0)) THEN
      mv% = 1
    END IF
  END IF
END FUNCTION mv%

FUNCTION PiecePosition(d%[], piece%)
  p%% = 0
  DO WHILE d%[p%%] <> piece%
    INC p%%
    IF p%% > 15 THEN
      PRINT "UH OH!"
      QUIT(1)
    END IF
  LOOP
END FUNCTION p%% + 1

FUNCTION IsPuzzleComplete(d%[])
  pc% = 0
  p%% = 1
  DO WHILE (p%% < 16) && (d%[p%% - 1] = p%%)
    INC p%%
  LOOP
  IF p%% = 16 THEN
    pc% = 1
  END IF
END FUNCTION pc%

' Return pseudo-random integer on 0..32767
FUNCTION Rand()
  #next&& = #next&& * 1103515245 + 12345
END FUNCTION USHORT(#next&& / 65536) MOD 32768

' Set seed for Rand()
FUNCTION SRand(seed%%)
  #next&& = seed%%
END FUNCTION

END PROGRAM


int Box, Hole, I;
[Box:= [^ ,^F,^E,^D,    \starting configuration
        ^C,^B,^A,^9,    \slide digits into ascending order
        ^8,^7,^6,^5,    \with blank in lower-right corner
        ^4,^3,^2,^1];
Hole:= 0;               \index for hole position
loop    [Clear;         \erase screen and move to start
        for I:= 0 to 15 do \show puzzle
                [ChOut(0, Box(I));  ChOut(0, ^ );
                if (I & 3) = 3 then CrLf(0)];
        case ChIn(1) of                 \get move
          $1B:  quit;                   \Esc
          $48:  if Hole < 12 then       \UpArrow scan code
                        [Box(Hole):= Box(Hole+4);
                        Hole:= Hole+4;
                        Box(Hole):= ^ ];
          $50:  if Hole > 3 then        \DnArrow
                        [Box(Hole):= Box(Hole-4);
                        Hole:= Hole-4;
                        Box(Hole):= ^ ];
          $4B:  if (Hole & 3) < 3 then  \LfArrow
                        [Box(Hole):= Box(Hole+1);
                        Hole:= Hole+1;
                        Box(Hole):= ^ ];
          $4D:  if (Hole & 3) > 0 then  \RtArrow
                        [Box(Hole):= Box(Hole-1);
                        Hole:= Hole-1;
                        Box(Hole):= ^ ]
        other   [];     \ignore 0 scan code prefix etc.
        ];
]


dx = 4 : dy = 4 : dxy = dx * dy
dim grid(dx, dy)

dim t(dxy)

for x = 1 to dx
	for y = 1 to dy
		fin = false
		repeat
			i = int(ran(dxy) + 1)
			if t(i) = 0 then
				t(i) = 1
				fin = true
				if i < dxy then
					grid(x, y) = i
				else
					ex = x : ey = y
				end if
			end if
		until(fin = true)
	next y
next x

drawTable()

repeat
	moveTile()
	drawTable()
until(finish())

print "\n\n\nNumber of movements: ",mov,"\nEnd\n"

sub finish()
	local x, y, v

	for y = 1 to dy
		for x = 1 to dx
			v = v + 1
			if (v < dxy) and (grid(x, y) <> v) return false
		next x
	next y
	return true
end sub

sub moveTile()
	local direction$

	direction$ = inkey$

	switch direction$
		case "up": if (ey + 1) < (dy + 1) then grid(ex, ey) = grid(ex, ey + 1) : ey = ey + 1  end if : break
		case "down": if (ey - 1) > 0 then grid(ex, ey) = grid(ex, ey - 1) : ey = ey - 1  end if : break
		case "right": if (ex - 1) > 0 then grid(ex, ey) = grid(ex - 1, ey) : ex = ex - 1  end if : break
		case "left": if (ex + 1) < (dx + 1) then grid(ex, ey) = grid(ex + 1, ey) : ex = ex + 1  end if : break
		default: return : break
	end switch
	mov = mov + 1
	grid(ex, ey) = 0
end sub

sub drawTable()
	local x, y

	clear screen

	print "   Use the cursor keys"

	for x = 1 to dx
		for y = 1 to dy
			print at(x * 3, y * 2);
			if grid(x, y) then
				print color("yellow","magenta") grid(x, y) using "##"
			else
				print "  "
			end if
		next y
	next x
end sub


/* ARM assembly AARCH64 Raspberry PI 3B */
/*  program 2048_64.s   */

/*******************************************/
/* Constantes file                         */
/*******************************************/
/* for this file see task include a file in language AArch64 assembly*/
.include "../includeConstantesARM64.inc"
.equ SIZE,       4
.equ TOTAL,      2048
.equ BUFFERSIZE, 80

.equ KEYSIZE,    8
.equ IOCTL,     0x1D  // Linux syscall
.equ SIGACTION, 0x86  // Linux syscall
.equ SYSPOLL,   0x16  // Linux syscall
.equ CREATPOLL, 0x14  // Linux syscall
.equ CTLPOLL,   0x15  // Linux syscall

.equ TCGETS,    0x5401
.equ TCSETS,    0x5402
.equ ICANON,    2
.equ ECHO,     10
.equ POLLIN,    1
.equ EPOLL_CTL_ADD,    1

.equ SIGINT,   2      // Issued if the user sends an interrupt signal (Ctrl + C)
.equ SIGQUIT,  3      // Issued if the user sends a quit signal (Ctrl + D)
.equ SIGTERM, 15      // Software termination signal (sent by kill by default)
.equ SIGTTOU, 22

/*******************************************/
/* Structures                               */
/********************************************/
/* structure termios see doc linux*/
    .struct  0
term_c_iflag:                    // input modes
    .struct  term_c_iflag + 4
term_c_oflag:                    // output modes
    .struct  term_c_oflag + 4
term_c_cflag:                    // control modes
    .struct  term_c_cflag + 4
term_c_lflag:                    // local modes
    .struct  term_c_lflag + 4
term_c_cc:                       // special characters
    .struct  term_c_cc + 40      // see length if necessary
term_fin:

/* structure sigaction see doc linux */
    .struct  0
sa_handler:
    .struct  sa_handler + 8
sa_mask:
    .struct  sa_mask + 8
sa_flags:
    .struct  sa_flags + 8
sa_sigaction:
    .struct  sa_sigaction + 8
sa_fin:

/* structure poll see doc linux */
    .struct  0
poll_event:                        //  events mask
    .struct  poll_event + 8
poll_fd:                           // events returned
    .struct  poll_fd  + 8
poll_fin:
/*********************************/
/* Initialized data              */
/*********************************/
.data
szMessOK:           .asciz "Bravo !! You win. \n"
szMessNotOK:        .asciz "You lost !! \n"
szMessNewGame:      .asciz "New game (y/n) ? \n"
szMessErreur:       .asciz "Error detected.\n"
szMessErrInitTerm:  .asciz "Error terminal init.\n"
szMessErrInitPoll:  .asciz "Error poll init.\n"
szMessErreurKey:    .asciz "Error read key.\n"
szMessErr:          .asciz    "Error code hexa : @ décimal : @ \n"
szCarriageReturn:   .asciz "\n"
szMess0:            .asciz "      "
szMess2:            .asciz "   2  "
szMess4:            .asciz "   4  "
szMess8:            .asciz "   8  "
szMess16:           .asciz "  16  "
szMess32:           .asciz "  32  "
szMess64:           .asciz "  64  "
szMess128:          .asciz " 128  "
szMess256:          .asciz " 256  "
szMess512:          .asciz " 512  "
szMess1024:         .asciz " 1024 "
szMess2048:         .asciz " 2048 "
szCleax1:           .byte 0x1B
                    .byte 'c'           // other console clear
                    .byte 0

szLineH:            .asciz "-----------------------------\n"
szLineV:            .asciz "|"
szLineVT:           .asciz "|      |      |      |      |\n"
.align 4
qGraine:            .quad 123456
/*********************************/
/* UnInitialized data            */
/*********************************/
.bss
.align 4
sZoneConv:      .skip 24
sBuffer:        .skip BUFFERSIZE
qTbCase:        .skip 8 * SIZE * SIZE
qEnd:           .skip 8                        // 0 loop  1 = end loop
qTouche:        .skip KEYSIZE                  // value key pressed
stOldtio:       .skip term_fin                 // old terminal state
stCurtio:       .skip term_fin                 // current terminal state
stSigAction:    .skip sa_fin                   // area signal structure
stSigAction1:   .skip sa_fin
stSigAction2:   .skip sa_fin
stSigAction3:   .skip sa_fin
stPoll1:        .skip poll_fin                 // area poll structure
stPoll2:        .skip poll_fin
stevents:       .skip 16
/*********************************/
/*  code section                 */
/*********************************/
.text
.global main
main:                                // entry of program
    mov x0,#0
    bl initTerm                      // terminal init
    cmp x0,0                         // error ?
    blt 100f
    bl initPoll                      // epoll instance init
    cmp x0,0
    blt 99f
    mov x22,x0                        // save epfd
1:                                    // begin game loop
    ldr x0,qAdrszCleax1
    bl affichageMess
    bl razTable
2:
    bl addDigit
    cmp x0,#-1
    beq 5f                            // end game
    bl displayGame
3:
    mov x0,x22
    bl waitKey
    cmp x0,0
    beq 3b
    bl readKey
    cmp x0,#-1
    beq 99f                          // error
    bl keyMove
    cmp x0,#0
    beq 3b                            // no change -> loop
    cmp x0,#2                         // last addition = 2048 ?
    beq 4f
    cmp x0,#-1                        // quit ?
    bne 2b                            // loop

    b 10f
4:                                    // last addition = 2048
    ldr x0,qAdrszMessOK
    bl affichageMess
    b 10f
5:                                    // display message no solution
    ldr x0,qAdrszMessNotOK
    bl affichageMess

10:                                   // display new game ?
    ldr x0,qAdrszCarriageReturn
    bl affichageMess
    ldr x0,qAdrszMessNewGame
    bl affichageMess
11:
    mov x0,x22
    bl waitKey
    cmp x0,0
    beq 11b
    bl readKey
    ldr x0,qAdrqTouche
    ldrb w0,[x0]
    cmp w0,#'y'
    beq 1b
    cmp w0,#'Y'
    beq 1b
99:
    bl restauTerm                     // terminal restaur
100:                                  // standard end of the program
    mov x0, #0                        // return code
    mov x8, #EXIT                     // request to exit program
    svc #0                            // perform the system call

qAdrszCarriageReturn:     .quad szCarriageReturn
qAdrszMessNotOK:          .quad szMessNotOK
qAdrszMessOK:             .quad szMessOK
qAdrszMessNewGame:        .quad szMessNewGame
qAdrsZoneConv:            .quad sZoneConv
qAdrszCleax1:             .quad szCleax1
qAdrszMessErrInitTerm:    .quad szMessErrInitTerm
qAdrszMessErrInitPoll:    .quad szMessErrInitPoll
qAdrszMessErreurKey:      .quad szMessErreurKey
qAdrstOldtio:             .quad stOldtio
qAdrstCurtio:             .quad stCurtio
qAdrstSigAction:          .quad stSigAction
qAdrstSigAction1:         .quad stSigAction1
qAdrSIG_IGN:              .quad 1
qAdrqEnd:                 .quad qEnd
qAdrqTouche:              .quad qTouche
qAdrstevents:             .quad stevents
/******************************************************************/
/*     raz table cases                                                   */
/******************************************************************/
razTable:
    stp x0,lr,[sp,-16]!     // save  registres
    stp x1,x2,[sp,-16]!     // save  registres
    ldr x1,qAdrqTbCase
    mov x2,#0
1:
    str xzr,[x1,x2,lsl #3]
    add x2,x2,#1
    cmp x2,#SIZE * SIZE
    blt 1b
100:
    ldp x1,x2,[sp],16       // restaur des  2 registres
    ldp x0,lr,[sp],16       // restaur des  2 registres
    ret
/******************************************************************/
/*     key move                                                   */
/******************************************************************/
/* x0 contains key value               */
keyMove:
    stp x1,lr,[sp,-16]!     // save  registres
    lsr x0,x0,#16
    cmp x0,#0x42                  // down arrow
    bne 1f
    bl moveDown
    b 100f
1:
    cmp x0,#0x41                  // high arrow
    bne 2f
    bl moveUp
    b 100f
2:
    cmp x0,#0x43                  // right arrow
    bne 3f
    bl moveRight
    b 100f
3:
    cmp x0,#0x44                  // left arrow
    bne 4f
    bl moveLeft
    b 100f
4:
    ldr x0,qAdrqTouche
    ldrb w0,[x0]
    cmp w0,#'q'                   // quit game
    bne 5f
    mov x0,#-1
    b 100f
5:
    cmp w0,#'Q'                   // quit game
    bne 100f
    mov x0,#-1
    b 100f

100:
    ldp x1,lr,[sp],16       // restaur des  2 registres
    ret
/******************************************************************/
/*           move left                                   */
/******************************************************************/
/* x0 return -1 if ok     */
moveLeft:
    stp x1,lr,[sp,-16]!          // save  registres
    stp x2,x3,[sp,-16]!          // save  registres
    stp x4,x5,[sp,-16]!          // save  registres
    stp x6,x7,[sp,-16]!          // save  registres
    stp x8,x9,[sp,-16]!          // save  registres
    stp x10,x11,[sp,-16]!        // save  registres
    ldr x1,qAdrqTbCase
    mov x0,#0                   // top move Ok
    mov x2,#0                   // line indice
1:
    mov x6,#0                   // counter empty case
    mov x7,#0                   // first digit
    mov x10,#0                  // last digit to add
    mov x3,#0                   // column indice
2:
    lsl x5,x2,#2                // change this if size <> 4
    add x5,x5,x3                // compute table indice
    ldr x4,[x1,x5,lsl #3]
    cmp x4,#0
    cinc x6,x6,eq               // positions vides
    beq 5f
    cmp x6,#0
    beq 3f                      // no empty left case
    mov x8,#0
    str x8,[x1,x5,lsl #3]       // raz digit
    sub x5,x5,x6
    str x4,[x1,x5,lsl #3]       // and store to left empty position
    mov x0,#1                   // move Ok
3:
    cmp x7,#0                   // first digit
    beq 4f
    cmp x10,x4                  // prec digit have to add
    beq 4f
    sub x8,x5,#1                // prec digit
    ldr x9,[x1,x8,lsl #3]
    cmp x4,x9                   // equal ?
    bne 4f
    mov x10,x4                  // save digit
    add x4,x4,x9                // yes -> add
    str x4,[x1,x8,lsl #3]
    cmp x4,#TOTAL
    beq 6f
    mov x4,#0
    str x4,[x1,x5,lsl #3]
    add x6,x6,#1                // empty case + 1
    mov x0,#1                   // move Ok
4:
    add x7,x7,#1                // no first digit

5:                              // and loop
    add x3,x3,#1
    cmp x3,#SIZE
    blt 2b
    add x2,x2,#1
    cmp x2,#SIZE
    blt 1b
    b 100f
6:
    mov x0,#2                   // total = 2048
100:
    ldp x10,x11,[sp],16         // restaur des  2 registres
    ldp x8,x9,[sp],16           // restaur des  2 registres
    ldp x6,x7,[sp],16           // restaur des  2 registres
    ldp x4,x5,[sp],16           // restaur des  2 registres
    ldp x2,x3,[sp],16           // restaur des  2 registres
    ldp x1,lr,[sp],16           // restaur des  2 registres
    ret
/******************************************************************/
/*           move right                                   */
/******************************************************************/
/* x0 return -1 if ok     */
moveRight:
    stp x1,lr,[sp,-16]!          // save  registres
    stp x2,x3,[sp,-16]!          // save  registres
    stp x4,x5,[sp,-16]!          // save  registres
    stp x6,x7,[sp,-16]!          // save  registres
    stp x8,x9,[sp,-16]!          // save  registres
    stp x10,x11,[sp,-16]!        // save  registres
    ldr x1,qAdrqTbCase
    mov x0,#0
    mov x2,#0
1:
    mov x6,#0
    mov x7,#0
    mov x10,#0
    mov x3,#SIZE-1
2:
    lsl x5,x2,#2                  // change this if size <> 4
    add x5,x5,x3
    ldr x4,[x1,x5,lsl #3]
    cmp x4,#0
    cinc x6,x6,eq               // positions vides
    beq 5f

    cmp x6,#0
    beq 3f                      // no empty right case
    mov x0,#0
    str x0,[x1,x5,lsl #3]       // raz digit
    add x5,x5,x6
    str x4,[x1,x5,lsl #3]       // and store to right empty position
    mov x0,#1
3:
    cmp x7,#0                   // first digit
    beq 4f
    add x8,x5,#1                // next digit
    ldr x9,[x1,x8,lsl #3]
    cmp x4,x9                   // equal ?
    bne 4f
    cmp x10,x4
    beq 4f
    mov x10,x4
    add x4,x4,x9                // yes -> add
    str x4,[x1,x8,lsl #3]
    cmp x4,#TOTAL
    beq 6f
    mov x4,#0
    str x4,[x1,x5,lsl #3]
    add x6,x6,#1                // empty case + 1
    mov x0,#1
4:
    add x7,x7,#1                // no first digit

5:                              // and loop
    sub x3,x3,#1
    cmp x3,#0
    bge 2b
    add x2,x2,#1
    cmp x2,#SIZE
    blt 1b
    b 100f
6:
    mov x0,#2
100:
    ldp x10,x11,[sp],16         // restaur des  2 registres
    ldp x8,x9,[sp],16           // restaur des  2 registres
    ldp x6,x7,[sp],16           // restaur des  2 registres
    ldp x4,x5,[sp],16           // restaur des  2 registres
    ldp x2,x3,[sp],16           // restaur des  2 registres
    ldp x1,lr,[sp],16           // restaur des  2 registres
    ret
/******************************************************************/
/*           move down                                   */
/******************************************************************/
/* x0 return -1 if ok     */
moveDown:
    stp x1,lr,[sp,-16]!          // save  registres
    stp x2,x3,[sp,-16]!          // save  registres
    stp x4,x5,[sp,-16]!          // save  registres
    stp x6,x7,[sp,-16]!          // save  registres
    stp x8,x9,[sp,-16]!          // save  registres
    stp x10,x11,[sp,-16]!        // save  registres
    ldr x1,qAdrqTbCase
    mov x0,#0
    mov x3,#0
1:
    mov x6,#0
    mov x7,#0
    mov x10,#0
    mov x2,#SIZE-1
2:
    lsl x5,x2,#2                  // change this if size <> 4
    add x5,x5,x3
    ldr x4,[x1,x5,lsl #3]
    cmp x4,#0
    cinc x6,x6,eq               // positions vides
    beq 5f
    cmp x6,#0
    beq 3f                      // no empty right case
    mov x0,#0
    str x0,[x1,x5,lsl #3]       // raz digit
    lsl x0,x6,#2
    add x5,x5,x0
    str x4,[x1,x5,lsl #3]       // and store to right empty position
    mov x0,#1
3:
    cmp x7,#0                   // first digit
    beq 4f
    add x8,x5,#SIZE                // down digit
    ldr x9,[x1,x8,lsl #3]
    cmp x4,x9                   // equal ?
    bne 4f
    cmp x10,x4
    beq 4f
    mov x10,x4
    add x4,x4,x9                // yes -> add
    str x4,[x1,x8,lsl #3]
    cmp x4,#TOTAL
    beq 6f
    mov x4,#0
    str x4,[x1,x5,lsl #3]
    add x6,x6,#1                // empty case + 1
    mov x0,#1
4:
    add x7,x7,#1                   // no first digit

5:                           // and loop
    sub x2,x2,#1
    cmp x2,#0
    bge 2b
    add x3,x3,#1
    cmp x3,#SIZE
    blt 1b
    b 100f
6:
    mov x0,#2
100:
    ldp x10,x11,[sp],16         // restaur des  2 registres
    ldp x8,x9,[sp],16           // restaur des  2 registres
    ldp x6,x7,[sp],16           // restaur des  2 registres
    ldp x4,x5,[sp],16           // restaur des  2 registres
    ldp x2,x3,[sp],16           // restaur des  2 registres
    ldp x1,lr,[sp],16           // restaur des  2 registres
    ret
/******************************************************************/
/*           move up                                   */
/******************************************************************/
/* x0 return -1 if ok     */
moveUp:
    stp x1,lr,[sp,-16]!          // save  registres
    stp x2,x3,[sp,-16]!          // save  registres
    stp x4,x5,[sp,-16]!          // save  registres
    stp x6,x7,[sp,-16]!          // save  registres
    stp x8,x9,[sp,-16]!          // save  registres
    stp x10,x11,[sp,-16]!        // save  registres
    ldr x1,qAdrqTbCase
    mov x0,#0
    mov x3,#0
1:
    mov x6,#0
    mov x7,#0
    mov x10,#0
    mov x2,#0
2:
    lsl x5,x2,#2                  // change this if size <> 4
    add x5,x5,x3
    ldr x4,[x1,x5,lsl #3]
    cmp x4,#0
    cinc x6,x6,eq               // positions vides
    beq 5f
    cmp x6,#0
    beq 3f                      // no empty right case
    mov x0,#0
    str x0,[x1,x5,lsl #3]       // raz digit
    lsl x0,x6,#2
    sub x5,x5,x0
    str x4,[x1,x5,lsl #3]       // and store to right empty position
    mov x0,#1
3:
    cmp x7,#0                   // first digit
    beq 4f
    sub x8,x5,#SIZE             // up digit
    ldr x9,[x1,x8,lsl #3]
    cmp x4,x9                   // equal ?
    bne 4f
    cmp x10,x4
    beq 4f
    mov x10,x4
    add x4,x4,x9                // yes -> add
    str x4,[x1,x8,lsl #3]
    cmp x4,#TOTAL
    beq 6f
    mov x4,#0
    str x4,[x1,x5,lsl #3]
    add x6,x6,#1                // empty case + 1
    mov x0,#1
4:
    add x7,x7,#1                // no first digit

5:                              // and loop
    add x2,x2,#1
    cmp x2,#SIZE
    blt 2b
    add x3,x3,#1
    cmp x3,#SIZE
    blt 1b
    b 100f
6:
    mov x0,#2
100:
    ldp x10,x11,[sp],16         // restaur des  2 registres
    ldp x8,x9,[sp],16           // restaur des  2 registres
    ldp x6,x7,[sp],16           // restaur des  2 registres
    ldp x4,x5,[sp],16           // restaur des  2 registres
    ldp x2,x3,[sp],16           // restaur des  2 registres
    ldp x1,lr,[sp],16           // restaur des  2 registres
    ret
/******************************************************************/
/*           add new digit on game                                   */
/******************************************************************/
/* x0 return -1 if ok     */
addDigit:
    stp x1,lr,[sp,-16]!          // save  registres
    stp x2,x3,[sp,-16]!          // save  registres
    stp x4,x5,[sp,-16]!          // save  registres
    sub sp,sp,#8 * SIZE*SIZE
    mov fp,sp

    mov x0,#100
    bl genereraleas
    cmp x0,#10
    mov x1,#4
    mov x5,#2
    csel x5,x5,x1,ge
   // movlt x5,#4
    //movge x5,#2
    ldr x1,qAdrqTbCase
    mov x3,#0
    mov x4,#0
1:
    ldr x2,[x1,x3,lsl 3]
    cmp x2,#0
    bne 2f
    str x3,[fp,x4,lsl 3]
    add x4,x4,#1
2:
    add x3,x3,#1
    cmp x3,#SIZE*SIZE
    blt 1b
    cmp x4,#0                 // no empty case
    beq 4f
    cmp x4,#1
    bne 3f
    ldr x2,[fp]               // one case
    str x5,[x1,x2,lsl 3]
    mov x0,#0
    b 100f
3:                            // multiple case
    sub x0,x4,#1
    bl genereraleas
    ldr x2,[fp,x0,lsl 3]
    str x5,[x1,x2,lsl 3]
    mov x0,#0
    b 100f
4:
    mov x0,#-1
100:
    add sp,sp,#8*  (SIZE*SIZE)  // stack alignement
    ldp x4,x5,[sp],16           // restaur des  2 registres
    ldp x2,x3,[sp],16           // restaur des  2 registres
    ldp x1,lr,[sp],16           // restaur des  2 registres
    ret
qAdrqTbCase:         .quad qTbCase
/******************************************************************/
/*            display game                                      */
/******************************************************************/
displayGame:
    stp x1,lr,[sp,-16]!          // save  registres
    stp x2,x3,[sp,-16]!          // save  registres
    ldr x0,qAdrszCleax1
    bl affichageMess
    ldr x0,qAdrszLineH
    bl affichageMess
    ldr x0,qAdrszLineVT
    bl affichageMess
    ldr x0,qAdrszLineV
    bl affichageMess
    ldr x1,qAdrqTbCase
    mov x2,#0
1:
    ldr x0,[x1,x2,lsl #3]
    bl digitString
    bl affichageMess
    ldr x0,qAdrszLineV
    bl affichageMess
    add x2,x2,#1
    cmp x2,#SIZE
    blt 1b
    ldr x0,qAdrszCarriageReturn
    bl affichageMess
    ldr x0,qAdrszLineVT
    bl affichageMess
    ldr x0,qAdrszLineH
    bl affichageMess
    ldr x0,qAdrszLineVT
    bl affichageMess
    ldr x0,qAdrszLineV
    bl affichageMess
2:
    ldr x0,[x1,x2,lsl #3]
    bl digitString
    bl affichageMess
    ldr x0,qAdrszLineV
    bl affichageMess
    add x2,x2,#1
    cmp x2,#SIZE*2
    blt 2b
    ldr x0,qAdrszCarriageReturn
    bl affichageMess
    ldr x0,qAdrszLineVT
    bl affichageMess
    ldr x0,qAdrszLineH
    bl affichageMess
    ldr x0,qAdrszLineVT
    bl affichageMess
    ldr x0,qAdrszLineV
    bl affichageMess
3:
    ldr x0,[x1,x2,lsl #3]
    bl digitString
    bl affichageMess
    ldr x0,qAdrszLineV
    bl affichageMess
    add x2,x2,#1
    cmp x2,#SIZE*3
    blt 3b
    ldr x0,qAdrszCarriageReturn
    bl affichageMess
    ldr x0,qAdrszLineVT
    bl affichageMess
    ldr x0,qAdrszLineH
    bl affichageMess
    ldr x0,qAdrszLineVT
    bl affichageMess
    ldr x0,qAdrszLineV
    bl affichageMess
4:
    ldr x0,[x1,x2,lsl #3]
    bl digitString
    bl affichageMess
    ldr x0,qAdrszLineV
    bl affichageMess
    add x2,x2,#1
    cmp x2,#SIZE*4
    blt 4b
    ldr x0,qAdrszCarriageReturn
    bl affichageMess
    ldr x0,qAdrszLineVT
    bl affichageMess
    ldr x0,qAdrszLineH
    bl affichageMess

100:
    ldp x2,x3,[sp],16           // restaur des  2 registres
    ldp x1,lr,[sp],16           // restaur des  2 registres
    ret
qAdrszLineH:         .quad szLineH
qAdrszLineV:         .quad szLineV
qAdrszLineVT:        .quad szLineVT
/******************************************************************/
/*            digits string                                       */
/******************************************************************/
/* x0 contains number */
/* x0 return address string */
digitString:
    stp x1,lr,[sp,-16]!          // save  registres
    cmp x0,#0
    bne 1f
    ldr x0,qAdrszMess0
    b 100f
1:
    cmp x0,#2
    bne 2f
    ldr x0,qAdrszMess2
    b 100f
2:
    cmp x0,#4
    bne 3f
    ldr x0,qAdrszMess4
    b 100f
3:
    cmp x0,#8
    bne 4f
    ldr x0,qAdrszMess8
    b 100f
4:
    cmp x0,#16
    bne 5f
    ldr x0,qAdrszMess16
    b 100f
5:
    cmp x0,#32
    bne 6f
    ldr x0,qAdrszMess32
    b 100f
6:
    cmp x0,#64
    bne 7f
    ldr x0,qAdrszMess64
    b 100f
7:
    cmp x0,#128
    bne 8f
    ldr x0,qAdrszMess128
    b 100f
8:
    cmp x0,#256
    bne 9f
    ldr x0,qAdrszMess256
    b 100f
9:
    cmp x0,#512
    bne 10f
    ldr x0,qAdrszMess512
    b 100f
10:
    cmp x0,#1024
    bne 11f
    ldr x0,qAdrszMess1024
    b 100f
11:
    cmp x0,#2048
    bne 12f
    ldr x0,qAdrszMess2048
    b 100f
12:
    ldr x1,qAdrszMessErreur                       // error message
    bl   displayError
100:
    ldp x1,lr,[sp],16           // restaur des  2 registres
    ret
qAdrszMess0:          .quad szMess0
qAdrszMess2:          .quad szMess2
qAdrszMess4:          .quad szMess4
qAdrszMess8:          .quad szMess8
qAdrszMess16:         .quad szMess16
qAdrszMess32:         .quad szMess32
qAdrszMess64:         .quad szMess64
qAdrszMess128:        .quad szMess128
qAdrszMess256:        .quad szMess256
qAdrszMess512:        .quad szMess512
qAdrszMess1024:       .quad szMess1024
qAdrszMess2048:        .quad szMess2048

//qAdrsBuffer:         .quad sBuffer
qAdrszMessErreur :        .quad szMessErreur

/***************************************************/
/*   Generation random number                  */
/***************************************************/
/* x0 contains limit  */
genereraleas:
    stp x1,lr,[sp,-16]!            // save  registers
    stp x2,x3,[sp,-16]!            // save  registers
    ldr x1,qAdrqGraine
    ldr x2,[x1]
    ldr x3,qNbDep1
    mul x2,x3,x2
    ldr x3,qNbDep2
    add x2,x2,x3
    str x2,[x1]                    // maj de la graine pour l appel suivant
    cmp x0,#0
    beq 100f
    udiv x3,x2,x0
    msub x0,x3,x0,x2               // résult = remainder

100:                               // end function
    ldp x2,x3,[sp],16              // restaur  2 registers
    ldp x1,lr,[sp],16              // restaur  2 registers
    ret                            // return to address lr x30
/*****************************************************/
qAdrqGraine: .quad qGraine
qNbDep1:     .quad 0x0019660d
qNbDep2:     .quad 0x3c6ef35f

/******************************************************************/
/*     traitement du signal                                       */
/******************************************************************/
sighandler:
    stp x0,lr,[sp,-16]!            // save  registers
    str x1,[sp,-16]!
    ldr x0,qAdrqEnd
    mov x1,#1                      // maj zone end
    str x1,[x0]
    ldr x1,[sp],16
    ldp x0,lr,[sp],16              // restaur  2 registers
    ret                            // return to address lr x30
/***************************************************/
/*   display error message                         */
/***************************************************/
/* x0 contains error code  x1 : message address */
displayError:
    stp x2,lr,[sp,-16]!            // save  registers
    mov x2,x0                      // save error code
    mov x0,x1
    bl affichageMess
    mov x0,x2                      // error code
    ldr x1,qAdrsZoneConv
    bl conversion16                // conversion hexa
    ldr x0,qAdrszMessErr           // display error message
    ldr x1,qAdrsZoneConv
    bl strInsertAtCharInc               // insert result at @ character
    mov x3,x0
    mov x0,x2                      // error code
    ldr x1,qAdrsZoneConv               // result address
    bl conversion10S                // conversion decimale
    mov x0,x3
    ldr x1,qAdrsZoneConv
    bl strInsertAtCharInc               // insert result at @ character
    bl affichageMess
100:
    ldp x2,lr,[sp],16              // restaur  2 registers
    ret                            // return to address lr x30
qAdrszMessErr:                 .quad szMessErr
/*********************************/
/* init terminal state            */
/*********************************/
initTerm:
    stp x1,lr,[sp,-16]!            // save  registers
    /* read terminal state */
    mov x0,STDIN                   // input console
    mov x1,TCGETS
    ldr x2,qAdrstOldtio
    mov x8,IOCTL                   // call system Linux
    svc 0
    cbnz x0,98f                    // error ?

    adr x0,sighandler              // adresse routine traitement signal
    ldr x1,qAdrstSigAction         // adresse structure sigaction
    str x0,[x1,sa_handler]         // maj handler
    mov x0,SIGINT                  // signal type
    ldr x1,qAdrstSigAction
    mov x2,0
    mov x3,8
    mov x8,SIGACTION               // call system
    svc 0

    cmp x0,0                       // error ?
    bne 98f
    mov x0,SIGQUIT
    ldr x1,qAdrstSigAction
    mov x2,0                       // NULL
    mov x8,SIGACTION               // call system
    svc 0
    cmp x0,0                       // error ?
    bne 98f
    mov x0,SIGTERM
    ldr x1,qAdrstSigAction
    mov x2,0                       // NULL
    mov x8,SIGACTION               // appel systeme
    svc 0
    cmp x0,0
    bne 98f
    //
    adr x0,qAdrSIG_IGN             // address signal igonre function
    ldr x1,qAdrstSigAction1
    str x0,[x1,sa_handler]
    mov x0,SIGTTOU                 //invalidate other process signal
    ldr x1,qAdrstSigAction1
    mov x2,0                       // NULL
    mov x8,SIGACTION               // call system
    svc 0
    cmp x0,0
    bne 98f
    //
    /* read terminal current state  */
    mov x0,STDIN
    mov x1,TCGETS
    ldr x2,qAdrstCurtio            // address current termio
    mov x8,IOCTL                   // call systeme
    svc 0
    cmp x0,0                       // error ?
    bne 98f
    mov x2,ICANON | ECHO           // no key pressed echo on display
    mvn x2,x2                      // and one key
    ldr x1,qAdrstCurtio
    ldr x3,[x1,#term_c_lflag]
    and x3,x2,x2                   // add flags
    str x3,[x1,#term_c_lflag]      // and store
    mov x0,STDIN                   // maj terminal current state
    mov x1,TCSETS
    ldr x2,qAdrstCurtio
    mov x8,IOCTL                   // call system
    svc 0
    cbz x0,100f
98:                                // error display
    ldr x1,qAdrszMessErrInitTerm
    bl   displayError
    mov x0,-1
100:
    ldp x1,lr,[sp],16              // restaur  2 registers
    ret                            // return to address lr x30
qAdrstSigAction2:    .quad stSigAction2
qAdrstSigAction3:    .quad stSigAction3
/*********************************/
/* init instance epool            */
/*********************************/
initPoll:
    stp x1,lr,[sp,-16]!            // save  registers
    ldr x0,qAdrstevents
    mov x1,STDIN                   // maj structure events
    str x1,[x0,#poll_fd]           // maj FD
    mov x1,POLLIN                  // action code
    str x1,[x0,#poll_event]
    mov x0,0
    mov x8,CREATPOLL               // create epoll instance
    svc 0
    cmp x0,0                       // error ?
    ble 98f
    mov x10,x0                     // return FD epoll instance
    mov x1,EPOLL_CTL_ADD
    mov x2,STDIN                   // Fd to we want add
    ldr x3,qAdrstevents            // structure events address
    mov x8,CTLPOLL                 // call system control epoll
    svc 0
    cmp x0,0                       // error ?
    blt 98f                       // no
    mov x0,x10                     // return FD epoll instance
    b 100f
98:                                // error display
    ldr x1,qAdrszMessErrInitPoll   // error message
    bl   displayError
    mov x0,-1
100:
    ldp x1,lr,[sp],16              // restaur  2 registers
    ret                            // return to address lr x30
/*********************************/
/* wait key                      */
/*********************************/
/* x0 contains FD poll    */
waitKey:
    stp x1,lr,[sp,-16]!            // save  registers
    ldr x11,qAdrqTouche            // key address
    str xzr,[x11]                  // raz key
1:
    ldr x1,qAdrqEnd                // if signal ctrl-c  -> end
    ldr x1,[x1]
    cbnz x1,100f

    ldr x1,qAdrstevents
    mov x2,12                      // size events
    mov x3,1                       // timeout = 1  TODO: ??
    mov x4,0
    mov x8,SYSPOLL                 // call system wait POLL
    svc 0
    cmp x0,0                       // key pressed ?
    bge 100f
98:                                // error display
    ldr x1,qAdrszMessErreurKey        // error message
    bl   displayError
    mov x0,-1
100:
    ldp x1,lr,[sp],16              // restaur  2 registers
    ret                            // return to address lr x30
/*********************************/
/* read key                      */
/*********************************/
/* x0 returns key value */
readKey:
    stp x1,lr,[sp,-16]!            // save  registers
    mov x0,STDIN                   // File Descriptor
    ldr x1,qAdrqTouche             // buffer address
    mov x2,KEYSIZE                 // key size
    mov x8,READ                    // read key
    svc #0
    cmp x0,0                       // error ?
    ble 98f
    ldr x2,qAdrqTouche             // key address
    ldr x0,[x2]
    b 100f
98:                                // error display
    ldr x1,qAdrszMessErreur        // error message
    bl   displayError
    mov x0,-1
100:
    ldp x1,lr,[sp],16              // restaur  2 registers
    ret                            // return to address lr x30
/*********************************/
/* restaur terminal state        */
/*********************************/
restauTerm:
    stp x1,lr,[sp,-16]!            // save  registers
    mov x0,STDIN                   // end then restaur begin state terminal
    mov x1,TCSETS
    ldr x2,qAdrstOldtio
    mov x8,IOCTL                   // call system
    svc 0
    cbz x0,100f
    ldr x1,qAdrszMessErreur        // error message
    bl   displayError
100:
    ldp x1,lr,[sp],16              // restaur  2 registers
    ret                            // return to address lr x30
/********************************************************/
/*        File Include fonctions                        */
/********************************************************/
/* for this file see task include a file in language AArch64 assembly */
.include "../includeARM64.inc"


with Ada.Text_IO; use Ada.Text_IO;
with System.Random_Numbers;
procedure Play_2048 is
   -- ----- Keyboard management
   type t_Keystroke is (Up, Down, Right, Left, Quit, Restart, Invalid);
   -- Redefining this standard procedure as function to allow Get_Keystroke as an expression function
   function Get_Immediate return Character is
   begin
      return Answer : Character do Ada.Text_IO.Get_Immediate(Answer);
      end return;
   end Get_Immediate;
   Arrow_Prefix : constant Character := Character'Val(224); -- works for windows
   function Get_Keystroke return t_Keystroke is
     (case Get_Immediate is
         when 'Q' | 'q' => Quit,
         when 'R' | 'r' => Restart,
         when 'W' | 'w' => Left,
         when 'A' | 'a' => Up,
         when 'S' | 's' => Down,
         when 'D' | 'd' => Right,
         -- Windows terminal
         when Arrow_Prefix => (case Character'Pos(Get_Immediate) is
                                  when 72 => Up,
                                  when 75 => Left,
                                  when 77 => Right,
                                  when 80 => Down,
                                  when others => Invalid),
         -- Unix escape sequences
         when ASCII.ESC => (case Get_Immediate is
                               when '[' => (case Get_Immediate is
                                               when 'A' => Up,
                                               when 'B' => Down,
                                               when 'C' => Right,
                                               when 'D' => Left,
                                               when others => Invalid),
                               when others => Invalid),
         when others => Invalid);

   -- ----- Game data
   function Random_Int is new System.Random_Numbers.Random_Discrete(Integer);
   type    t_List  is array (Positive range <>) of Natural;
   subtype t_Row   is t_List (1..4);
   type    t_Board is array  (1..4) of t_Row;
   Board     : t_Board;
   New_Board : t_Board;
   Blanks    : Natural;
   Score     : Natural;
   Generator : System.Random_Numbers.Generator;

   -- ----- Displaying the board
   procedure Display_Board is
      Horizontal_Rule : constant String := "+----+----+----+----+";
      function Center (Value : in String) return String is
        ((1..(2-(Value'Length-1)/2) => ' ') & -- Add leading spaces
         Value(Value'First+1..Value'Last)   & -- Trim the leading space of the raw number image
         (1..(2-Value'Length/2) => ' '));     -- Add trailing spaces
   begin
      Put_Line (Horizontal_Rule);
      for Row of Board loop
         for Cell of Row loop
            Put('|' & (if Cell = 0 then "    " else Center(Cell'Img)));
         end loop;
         Put_Line("|");
         Put_Line (Horizontal_Rule);
      end loop;
      Put_Line("Score =" & Score'Img);
   end Display_Board;

   -- ----- Game mechanics
   procedure Add_Block is
      Block_Offset : Positive := Random_Int(Generator, 1, Blanks);
   begin
      Blanks := Blanks-1;
      for Row of Board loop
         for Cell of Row loop
            if Cell = 0 then
               if Block_Offset = 1 then
                  Cell := (if Random_Int(Generator,1,10) = 1 then 4 else 2);
                  return;
               else
                  Block_Offset := Block_Offset-1;
               end if;
            end if;
         end loop;
      end loop;
   end Add_Block;

   procedure Reset_Game is
   begin
      Board  := (others => (others => 0));
      Blanks := 16;
      Score  := 0;
      Add_Block;
      Add_Block;
   end Reset_Game;

   -- Moving and merging will always be performed leftward, hence the following transforms
   function HFlip (What : in t_Row) return t_Row is
     (What(4),What(3),What(2),What(1));
   function VFlip (What : in t_Board) return t_Board is
     (HFlip(What(1)),HFlip(What(2)),HFlip(What(3)),HFlip(What(4)));
   function Transpose (What : in t_Board) return t_Board is
   begin
      return Answer : t_Board do
         for Row in t_Board'Range loop
            for Column in t_Row'Range loop
               Answer(Column)(Row) := What(Row)(Column);
            end loop;
         end loop;
      end return;
   end Transpose;

   -- For moving/merging, recursive expression functions will be used, but they
   -- can't contain statements, hence the following sub-function used by Merge
   function Add_Blank (Delta_Score : in Natural) return t_List is
   begin
      Blanks := Blanks+1;
      Score  := Score+Delta_Score;
      return (1 => 0);
   end Add_Blank;

   function Move_Row (What : in t_List) return t_List is
     (if What'Length = 1 then What
      elsif What(What'First) = 0
      then Move_Row(What(What'First+1..What'Last)) & (1 => 0)
      else (1 => What(What'First)) & Move_Row(What(What'First+1..What'Last)));

   function Merge (What : in t_List) return t_List is
     (if What'Length <= 1 or else What(What'First) = 0 then What
      elsif What(What'First) = What(What'First+1)
      then (1 => 2*What(What'First)) & Merge(What(What'First+2..What'Last)) & Add_Blank(What(What'First))
      else (1 => What(What'First)) & Merge(What(What'First+1..What'Last)));

   function Move (What : in t_Board) return t_Board is
     (Merge(Move_Row(What(1))),Merge(Move_Row(What(2))),Merge(Move_Row(What(3))),Merge(Move_Row(What(4))));

begin
   System.Random_Numbers.Reset(Generator);

   Main_Loop: loop
      Reset_Game;
      Game_Loop: loop
         Display_Board;
         case Get_Keystroke is
            when Restart => exit Game_Loop;
            when Quit    => exit Main_Loop;
            when Left    => New_Board := Move(Board);
            when Right   => New_Board := VFlip(Move(VFlip(Board)));
            when Up      => New_Board := Transpose(Move(Transpose(Board)));
            when Down    => New_Board := Transpose(VFlip(Move(VFlip(Transpose(Board)))));
            when others  => null;
         end case;

         if New_Board = Board then
            Put_Line ("Invalid move...");
         elsif (for some Row of New_Board => (for some Cell of Row => Cell = 2048)) then
            Display_Board;
            Put_Line ("Win !");
            exit Main_Loop;
         else
            Board := New_Board;
            Add_Block; -- OK since the board has changed
            if Blanks = 0
               and then (for all Row in 1..4 =>
                           (for all Column in 1..3 =>
                                (Board(Row)(Column) /= Board(Row)(Column+1))))
               and then (for all Row in 1..3 =>
                           (for all Column in 1..4 =>
                                (Board(Row)(Column) /= Board(Row+1)(Column)))) then
               Display_Board;
               Put_Line ("Lost !");
               exit Main_Loop;
            end if;
         end if;
      end loop Game_Loop;
   end loop Main_Loop;
end Play_2048;