 #compact
  % filename "t.exe"
 'uses RTL32
  % Title "Game Demo"
  % Animated
  % ScaleUp
 '% PlaceCentral
 '% AnchorCentral
  uses ConsoleG

  indexbase 1
  type celltype
  long  a,n
  long  x,y
  float px,py,tx,ty
  end type

  sys sseed=GetTickCount
  celltype cell[256]

  sub initcells()
  ===============  
  sys r,x,y
  'seed=0x2468abcd
  seed=sseed
  celltype *c
  @c=@cell
  for y=1 to 8
    for x= 1 to 8
      r=irnd(1,4)
      c.x=x
      c.y=y
      c.a=r
      c.n=y*8+x-8
      c.px=x*2
      c.py=-y*2
      @c+=sizeof cell
    next
  next
  end sub

  initcells()

  sub transfer(celltype *a,*b)
  ============================
  a.a=b.a        'TRANFER MATERIAL
  a.n=b.n        'TRANSFER NAME
  b.a=0          'CANCEL SOURCE MATERIAL
  b.n=0          'CANCEL SOURCE NAME
  a.tx=b.px-a.px 'TRANSIT X
  a.ty=b.py-a.py 'TRANSIT Y
  end sub

  sub vcompact()
  ===============
  sys i,j,k,w,x,y
  for x=1 to 8
    i=56+x
    j=i
    k=j-8
    for y=8 to 2 step -1
      if cell[j].a then
        j-=8
      elseif cell[k].a then
        transfer cell[j],cell[k]
        j-=8
      end if
      k-=8
    next
  next
  end sub
  
  sub hcompact()
  ==============
  sys i,j,k,w,x,y
  for y=1 to 8
    i=y*8-8
    j=i+1
    k=j+1
    for x=1 to <8
      if cell[j].a then
        j++
      elseif cell[k].a then
        transfer cell[j],cell[k]
        j++
      end if
      k++
    next
  next
  end sub
  
  function GameLogic(sys i,optional a) as sys
  ===========================================
  '
  sys j,m,x,y
  if i=0 or i>64 then exit sub
  x=cell[i].x
  y=cell[i].y
  if not a then
    a=cell[i].a
    if not a then
      exit sub
  end if
  end if
  '
  macro GameLogicAct()
    if cell[j].a=a then
      cell[j].a=0
      cell[i].a=0
      GameLogic j,a 'RECURSE
      m=1
    end if
  end macro
  '
  if x>1 then
    j=i-1
    GameLogicAct() 'LEFT
  end if
  if x<8 then
    j=i+1
    GameLogicAct() 'RIGHT
  end if
  if y>1 then
    j=i-8
    GameLogicAct() 'ABOVE
  end if
  if y<8 then
    j=i+8
    GameLogicAct() 'BELOW
  end if
  return m
  end function

  sub render(sys i)
  =================
  celltype c at (@cell[i])
  sys a
  a=c.a
  if a then
    if pick then
      Picklabel i
    else
      select a
      case 1 : Material RedShiny
      case 2 : Material BlueShiny
      case 3 : Material WhiteShiny
      case 4 : Material Gold
      end select
    end if
    glpushmatrix
    move c.px+c.tx, c.py+c.ty
    if c.tx then c.tx*=.75
    if c.ty then c.ty*=.75
    go sphere 'cylinder sphere cube
    glpopmatrix
   end if
  end sub

  sub main()
  ==========
  '
  static sys count
  glClearColor 0,0.10,0,0
  if not pick
    '
    shading 'opposite of 'flat'
    '
    'DISPLAY TOP SECTION
    pushstate
    Material Gold
    move 2,0,-1
    go sphere
    move 0,-2
    Material Red
    go cube
    pushstate
      move 2
      scale 3
      color .70,.70,.20,.99
      scale .5 : print3d "clicks: " count
    popstate
    move 0,-2
    Material Silver
    go sphere
    popstate
  end if
  '
  'DISPLAY
  move 2,-3
  scale 1.5
  pushstate
  sys a,i,x,y
  for i=1 to 64
    render i
  next
  popstate
  '
  if GameLogic(picked) then
    count++
    if bRight then
      hcompact()
    else
      vcompact()
    end if
    picked=0
  end if
  '
  end sub

  EndScript
