// Definicion de "contextos"
#context-free select Position of aleatory tail
   set Decimal (-1)
   tSIZE=0,
   Let( tSIZE := var(SIZE) Plus (1) )
__NO_VALID_POS__:
      x=0, y=0
      When( Is Zero? ( Ceil( Rand(10) Mul by(10) ) Module (tSIZE) » (x) )){ x = 1 }
      When( Is Zero? ( Ceil( Rand(10) Mul by(10) ) Module (tSIZE) » (y) )){ y = 1 }
      At Interval [x,y], Get (table), Goto If Not Zero(__NO_VALID_POS__)
   newTail=2
   When ( Rand(1) Is Gt (0.9) ) { newTail=4 }
   Take( newTail ), and SPut(table).
   set Decimal(0)
   Return\\

#context-free check Winner or Game Over
   When ( Summatory ( Val( var(table) Is Gt (0) ) ), Is Eq? ( var(SIZE) Mulby(SIZE) ) ) {
      MStore( 0, go, swFin ), and Back // You loose!
   }
   ReDim( table, 0 )  // convierte en vector
   When( Scan(1, 2048, table ) Is Not Eq? (0) ){
      ReDim( table, SIZE, SIZE ), Let ( go:=0 ) and Back   // You Win!
   }
   ReDim( table, SIZE, SIZE )
   Return\\

#context-free show Table
   tmpTable=0
   Let ( tmpTable := CPad$(" ", 6, Str$(table)) )
   Let ( tmpTable := Tran$("\BGLGR\BK      \OFF","  0   ", tmpTable) )
   Let ( tmpTable := Tran$("\BGLGR\BK  2   \OFF","  2   ", tmpTable) )
   Let ( tmpTable := Tran$("\BGLGR\B  4   \OFF","  4   ", tmpTable) )
   Let ( tmpTable := Tran$("\BGLGR\B  8   \OFF","  8   ", tmpTable) )
   Let ( tmpTable := Tran$("\BGR\W  16  \OFF","  16  ", tmpTable) )
   Let ( tmpTable := Tran$("\BGY\BK  32  \OFF","  32  ", tmpTable) )
   Let ( tmpTable := Tran$("\BGB\W  64  \OFF","  64  ", tmpTable) )
   Let ( tmpTable := Tran$("\BGLM\BK 128  \OFF"," 128  ", tmpTable) )
   Let ( tmpTable := Tran$("\BGG\W 256  \OFF"," 256  ", tmpTable) )
   Let ( tmpTable := Tran$("\BGB\W 512  \OFF"," 512  ", tmpTable) )
   Let ( tmpTable := Tran$("\BGR\W 1024 \OFF"," 1024 ", tmpTable) )
   Let ( tmpTable := Tran$("\BGBK\W\ENF 2048 \OFF"," 2048 ", tmpTable) )
   When( show Structure ) { print Table structure, and Let ( show Structure := 0 ) }
   Clear Mark
   scrx=2
   For (i=1, var(i) Is Le (SIZE), ++i)
        Locate in Column (scrx)
        Locate in Row (2), At Interval [1,i], Print( Get (tmpTable) )
        Locate in Row (4), At Interval [2,i], Print( Get (tmpTable) )
        Locate in Row (6), At Interval [3,i], Print( Get (tmpTable) )
        Locate in Row (8), At Interval [4,i], Print( Get (tmpTable) )
        When( var(SIZE) Is Ge? (5) ) {Locate in Row (10), At Interval [5,i], Print( Get (tmpTable) )}
        When( var(SIZE) Is Ge? (6) ) {Locate in Row (12), At Interval [6,i], Print( Get (tmpTable) )}
        scrx += 7
   Next
   Clear Mark
   Take( "\BGB\W\ENF","\n\n\t   2 0 4 8   \OFF\n\n",\
         "Movimiento # ",contador de movimientos,", \INVSCORE=",score,"\OFF\n" )
   and Print It
   Return\\

#context-free print Table structure
   Locate (1,1)
   If ( var(SIZE) Is Eq? (4) )
      Str2Utf8$("┌──────┬──────┬──────┬──────┐\n")
      Str2Utf8$("│ 2048 │ 2048 │ 2048 │ 2048 │\n")
      Str2Utf8$("├──────┼──────┼──────┼──────┤\n")
      Str2Utf8$("│ 2048 │ 2048 │ 2048 │ 2048 │\n")
      Str2Utf8$("├──────┼──────┼──────┼──────┤\n")
      Str2Utf8$("│ 2048 │ 2048 │ 2048 │ 2048 │\n")
      Str2Utf8$("├──────┼──────┼──────┼──────┤\n")
      Str2Utf8$("│ 2048 │ 2048 │ 2048 │ 2048 │\n")
      Str2Utf8$("└──────┴──────┴──────┴──────┘")
   Else If( var(SIZE) Is Eq? (5) )
      Str2Utf8$("┌──────┬──────┬──────┬──────┬──────┐\n")
      Str2Utf8$("│ 2048 │ 2048 │ 2048 │ 2048 │ 2048 │\n")
      Str2Utf8$("├──────┼──────┼──────┼──────┼──────┤\n")
      Str2Utf8$("│ 2048 │ 2048 │ 2048 │ 2048 │ 2048 │\n")
      Str2Utf8$("├──────┼──────┼──────┼──────┼──────┤\n")
      Str2Utf8$("│ 2048 │ 2048 │ 2048 │ 2048 │ 2048 │\n")
      Str2Utf8$("├──────┼──────┼──────┼──────┼──────┤\n")
      Str2Utf8$("│ 2048 │ 2048 │ 2048 │ 2048 │ 2048 │\n")
      Str2Utf8$("├──────┼──────┼──────┼──────┼──────┤\n")
      Str2Utf8$("│ 2048 │ 2048 │ 2048 │ 2048 │ 2048 │\n")
      Str2Utf8$("└──────┴──────┴──────┴──────┴──────┘")
   Else If( var(SIZE) Is Eq? (6) )
      Str2Utf8$("┌──────┬──────┬──────┬──────┬──────┬──────┐\n")
      Str2Utf8$("│ 2048 │ 2048 │ 2048 │ 2048 │ 2048 │ 2048 │\n")
      Str2Utf8$("├──────┼──────┼──────┼──────┼──────┼──────┤\n")
      Str2Utf8$("│ 2048 │ 2048 │ 2048 │ 2048 │ 2048 │ 2048 │\n")
      Str2Utf8$("├──────┼──────┼──────┼──────┼──────┼──────┤\n")
      Str2Utf8$("│ 2048 │ 2048 │ 2048 │ 2048 │ 2048 │ 2048 │\n")
      Str2Utf8$("├──────┼──────┼──────┼──────┼──────┼──────┤\n")
      Str2Utf8$("│ 2048 │ 2048 │ 2048 │ 2048 │ 2048 │ 2048 │\n")
      Str2Utf8$("├──────┼──────┼──────┼──────┼──────┼──────┤\n")
      Str2Utf8$("│ 2048 │ 2048 │ 2048 │ 2048 │ 2048 │ 2048 │\n")
      Str2Utf8$("├──────┼──────┼──────┼──────┼──────┼──────┤\n")
      Str2Utf8$("│ 2048 │ 2048 │ 2048 │ 2048 │ 2048 │ 2048 │\n")
      Str2Utf8$("└──────┴──────┴──────┴──────┴──────┴──────┘")
   End If
   now Print It
   Return\\

// definicion de prototipos:
#proto MovingRightDown(_X_)
#proto MovingLeftUp(_X_)
#proto checkPointLeftUp(_X_)
#proto checkPointRightDown(_X_)
#proto checkMoveRightDown(_X_)
#proto checkMoveLeftUp(_X_)

// definiciones varias:
#define KUP        5
#define KDOWN     24
#define KLEFT     19
#define KRIGHT     4
#define KESCAPE   27
#define MOVEHORZ   1
#define MOVEVERT   0

// archivo de inclusión de macros H-BASIC:
#include <hbasic.h>

Begin
  Option Ctrl+C
  Option Stack 16

  contador de movimientos=0
  score=0, SIZE=4
  When( ArgCount, Is Eq? (2) ){ get ArgNumber(2,SIZE) }

  If ( var(SIZE) Is Not Between?(4,includ,6,includ) )
     Print("Usage: hopper 2048.bas [4(default)-6]\n")
     Stop
  End If

  Dim (SIZE,SIZE) for Zeros Array (table)

  oldTable=0, show Structure=1
 /* define initial positions */
  Token Sep("")
  select Position of aleatory tail
  select Position of aleatory tail
  Cls
  Hide Cursor
  show Table
  c=0, go=1,swFin=1

 /* game! */
  While ( go )
     Let ( c:=GetCh )
     oldTable = table
     Switch(c)
        Case(KRIGHT) { _check Move Right Down(MOVEHORZ), Exit }
        Case(KDOWN)  { _check Move Right Down(MOVEVERT), Exit }
        Case(KLEFT)  { _check Move Left Up(MOVEHORZ),    Exit }
        Case(KUP)    { _check Move Left Up(MOVEVERT),    Exit }
        Case(KESCAPE){ go=0, swFin=0 }
     End Switch

     check Winner or Game Over
     When( go ){
        If ( are Not EqArray? (oldTable, table) )  //( not( equal tables(oldTable, table) ) )
           select Position  of aleatory tail
           ++contador de movimientos
        End If
        show Table
     }
  Wend

  If ( swFin )
     show Table
     Print("          \LG","YOU WIN!!!\OFF")
  Else
     Print("          \LR","GAME OVER\OFF")
  End If
  Put a Newl
  Show Cursor
End

Subrutines

Moving Right Down(tmpTab)
   ht=0, sizet=0
   Let( sizet := var(SIZE) Minus ( Length( Compact(tmpTab), Copy to (ht) ) ) )
   If ( Is Not Zero?(sizet) )
      Clear(tmpTab)
      Dim (sizet) for Zeros Array (tmpTab)
      Concat( ht,tmpTab )
   End If
Return (tmpTab)

Moving Left Up(tmpTab)
   sizet=0
   Compact( tmpTab ),Clear(tmpTab) and Copy to (tmpTab); get Length It, Subtracted from (SIZE); then Move to (sizet)
   //When( Is Not Zero?(sizet) ){
   When( var(sizet) Is Not Zero? ){
      ht=0
      Dim (sizet) for Zeros Array (ht)
      Concat( ht, tmpTab )
   }
Return (tmpTab)

check Point Right Down(tmpTab)
  v1=0,v2=0,tScore=0,totScore=0
  For(k=SIZE, var(k) Is Gt (1), --k)
     Set Interval [k] and Get (tmpTab); then Move to (v1)
     Set Interval [ var(k) Minus(1)], Get(tmpTab), and Move to (v2)
     If( var(v1) Is Eq? (v2) )
         Add(v1,v2), Copy to(tScore);
         At Interval [k] Put(tmpTab)
         At Interval [ var(k) Minus(1) ], now Take(0); then Put (tmpTab)
         Let( totScore := var(tScore) Plus (totScore) )
     End If
  Next
  Take(tmpTab,totScore) and Return

check Move Right Down (_DIRECTION_)
  tmpTab=0
  For(i=1, while var(i) Is Le (SIZE), ++i)
    If ( _DIRECTION_ )    // rows or cols??
       Set Interval [i,1:SIZE]   // rows!
    Else
       Set Interval [1:SIZE,i]   // cols!
    End If
    now Let( tmpTab := Get(table) )

    If( Summatory ( tmpTab ) )     // exist numbers in the row??
       Clear Mark

       Let( tmpTab := _Moving Right Down(tmpTab) )    // move its!
       Clear Mark
       Store ( _check Point Right Down(tmpTab) Plus (score), tmpTab, score )  // check score...
       Clear Mark
       Let ( tmpTab := _Moving Right Down(tmpTab) )   // move remanents!
       If( _DIRECTION_ )
          Set Interval [i,1:SIZE]
       Else
          Set Interval [1:SIZE,i]
       End If
       Take( tmpTab ), and Put(table)
    End If
  Next
  Clear(tmpTab) and Clear Mark.
Return

check Point Left Up(tmpTab)
  v1=0,v2=0,tScore=0,totScore=0
  For(k=1, while var(k) Is Lt (SIZE),++k)
     At Interval [k] Get (tmpTab), and Move to (v1)
     At Interval [ var(k) Plus(1) ] Get(tmpTab), and Move to (v2)
     If( var(v1) Is Eq? (v2) )
        Add(v1, v2),Copy to (tScore)
        At Interval [k] Put(tmpTab), At Interval [ var(k) Plus(1)]; then Take(0) and Put(tmpTab)
        Let( totScore := var(tScore) Plus (totScore) )
     End If
  Next
  Take (tmpTab,totScore)
Return

check Move Left Up(_DIRECTION_)
  tmpTab=0
  For(i=1, while var(i) Is Le (SIZE),++i)
    If( _DIRECTION_ )
       Set Interval [i,1:SIZE]
    Else
       Set Interval [1:SIZE,i]
    End If
    now Get(table), and Move to (tmpTab)
    If( Summatory (tmpTab) )  // exist numbers in the row??
       Clear Mark
       Let ( tmpTab := _Moving Left Up(tmpTab) )  // move its!
       Clear Mark
       Store ( _check Point Left Up(tmpTab) Plus (score), tmpTab, score )  // check score...

       Clear Mark
       Let ( tmpTab := _Moving Left Up(tmpTab) )  // move remanents!
       If( _DIRECTION_ )
          Set Interval [i,1:SIZE]
       Else
          Set Interval [1:SIZE,i]
       End If
       now Take (tmpTab), and Put(table)
    End If
  Next
  Clear Mark.
Return