  #compact
  % filename "t.exe"
 'uses RTL32
  % Title    "Chainshot3D:    (left-click & right-click)"
  % Animated
  % ScaleUp
 '% PlaceCentral
 '% AnchorCentral
  uses ConsoleG

  %side 8

  indexbase 1

  type celltype
  int  a,n
  int  x,y,z
  float px,py,pz
  float tx,ty,tz
  end type

  sys sseed=GetTickCount
  celltype cell[side*side*side]

  sub initcells()
  ===============  
  int r,x,y,z
  'seed=0x2468abcd
  seed=sseed
  celltype *c
  @c=@cell
  for z=1 to side
    for y=1 to side
      for x= 1 to side
        r=irnd(1,4)
        c.x=x
        c.y=y
        c.z=z
        c.a=r
        c.n=z*64+y*side+x-side
        c.px= x*2
        c.py=-y*2
        c.pz=-z*2
        @c+=sizeof cell
      next
    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
  a.tz=b.pz-a.pz 'TRANSIT Z
  end sub

  sub vcompact()
  ===============
  sys i,j,k,w,x,y,z,zz,iz
  iz=side*side
  for z=1 to side
    zz=z*iz-side
    for x=1 to side
      i=zz+x
      j=i
      k=j-side
      for y=side to 2 step -1
        if cell[j].a then
          j-=side
        elseif cell[k].a then
          transfer cell[j],cell[k]
          j-=side
        end if
        k-=side
      next
    next
  next
  end sub
  
  sub hcompact()
  ==============
  sys i,j,k,w,x,y,z,zz,iz
  iz=side*side
  for z=1 to side
    zz=z*iz-iz
    for y=1 to side
      i=zz+y*side-side
      j=i+1
      k=j+1
      for x=1 to <side
        if cell[j].a then
          j++
        elseif cell[k].a then
          transfer cell[j],cell[k]
          j++
        end if
        k++
      next
    next
  next
  end sub

  sub dcompact()
  ==============
  sys i,j,k,w,x,y,z,iz
  iz=side*side
  for y=1 to side
    for x=1 to side
      i=y*side-side+x
      j=i
      k=j+iz
      for z=1 to <side
        if cell[j].a then
          j+=iz
        elseif cell[k].a then
          transfer cell[j],cell[k]
          j+=iz
        end if
        k+=iz
      next
    next
  next
  end sub

  function GameLogic(sys i,optional a) as sys
  ===========================================
  '
  sys j,m,x,y,z
  if i=0 or i>512 then exit sub
  x=cell[i].x
  y=cell[i].y
  z=cell[i].z
  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<side then
    j=i+1
    GameLogicAct() 'RIGHT
  end if
  if y>1 then
    j=i-side
    GameLogicAct() 'ABOVE
  end if
  if y<side then
    j=i+side
    GameLogicAct() 'BELOW
  end if
  if z>1 then
    j=i-64
    GameLogicAct() 'NEAR
  end if
  if z<side then
    j=i+64
    GameLogicAct() 'FAR
  end if
  return m
  end function

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

  sub main()
  ==========
  '
  static float ay
  static sys   pki,count
  glClearColor 0,0.10,0,0
  if not pick
    shading
    pushstate
    'DISPLAY TOP SECTION
    pushstate
      move 2
      color .90,.90,.90,.99
      scale 2 : print3d "clicks: " count
    popstate
  end if
  '
  move 16,4,-20
  rotatey ay
  ay+=.125
  scale 2
  move -8,0,8
  '
  'DISPLAY
  sys a,i,x,y
  static sys e = side*side*side
  for i=1 to e
    render i
  next
  picklabel 0
  '
  popstate 'whole
  '
  if GameLogic(picked) then
    count++
    if bRight then
      hcompact()
      dcompact()
    else
      vcompact()
    end if
    picked=0
  end if
  '
  end sub

  EndScript
