// blocks

fall-timer 25 . default-fall-timer 25 . block-id 0 . max-width 10 . max-height 20

#tick . !shape _X _Y _BLOCKS = #new-shape
#tick . $shape _X _Y _BLOCKS = #input-u

#new-shape . $max-height H = new-shape 4 H ((block -1 0) ((block 0 0) ((block 1 0) ((block 0 1) cons)))) . #shape-to-blocks #input-lr
#new-shape . $max-height H = new-shape 4 H ((block 0 -1) ((block 0 0) ((block 0 1) cons))) . #shape-to-blocks #input-lr
#new-shape . $max-height H = new-shape 4 H ((block 0 -1) ((block 0 0) ((block 0 1) ((block 1 1) cons)))) . #shape-to-blocks #input-lr

#shape-to-blocks RETURN: {
  block-falling _ID _X _Y = ()
  $new-shape _X _Y BLOCKS . !BLOCKS = BLOCKS
  () = #shape-to-blocks-create RETURN
}

#shape-to-blocks-create RETURN: {
  $new-shape X Y _ . (block DX DY) BLOCK . block-id ID . + ID 1 ID2 . + X DX X' . + Y DY Y' = block-falling ID X' Y' . block-id ID2 . BLOCK
  () = #shape-to-blocks-check RETURN
}

#shape-to-blocks-check RETURN . block-falling _ X Y . $block-set _ X Y = #shape-to-blocks-fail RETURN
#shape-to-blocks-check RETURN . block-falling _ X _ . < X 0 = #shape-to-blocks-fail RETURN
#shape-to-blocks-check RETURN . block-falling _ X _ . $max-width W . >= X W = #shape-to-blocks-fail RETURN
#shape-to-blocks-check RETURN . () = #shape-to-blocks-ok RETURN

#shape-to-blocks-ok RETURN: {
  shape _ _ _ = ()
  new-shape X Y BLOCKS . () = shape X Y BLOCKS . RETURN
}

#shape-to-blocks-fail RETURN: {
  new-shape _ _ _ = ()
  $shape X Y BLOCKS . () = new-shape X Y BLOCKS . #shape-to-blocks RETURN
}

#input-u . ^kp up = #rotate-shape
#input-u . () = #input-lr

#rotate-shape: {
  $shape X Y BLOCKS . !new-shape X Y _  = new-shape X Y BLOCKS . new-blocks cons
  new-shape X Y ((block DX DY) BLOCKS) . new-blocks BLOCKS2 . + DX2 DX 0 = new-shape X Y BLOCKS . new-blocks ((block DY DX2) BLOCKS2)
  new-shape X Y _ . new-blocks BLOCKS . () = new-shape X Y BLOCKS . #shape-to-blocks #input-d
}

#input-lr . ^kp left . $shape X Y BLOCKS . + X' 1 X = new-shape X' Y BLOCKS . #shape-to-blocks #input-d
#input-lr . ^kp right . $shape X Y BLOCKS . + X 1 X' = new-shape X' Y BLOCKS . #shape-to-blocks #input-d
#input-lr . () = #input-d

#input-d: {
  ^kd down . default-fall-timer 25 . fall-timer _ = default-fall-timer 5 . fall-timer 0
  ^ku down . default-fall-timer 5 . fall-timer _ = default-fall-timer 25 . fall-timer 0
  () = #collision
}

#collision: {
  block-falling ID X Y . + Y' 1 Y . $block-set _ X Y' = block-setting ID X Y
  block-falling ID X Y . + Y' 1 Y . < Y' 0 = block-setting ID X Y
  $block-setting _ _ _ . block-falling ID X' Y' = block-setting ID X' Y'
  $block-setting _ _ _ . shape _ _ _ = ()
  () = #set
}

#set: {
  block-setting ID X Y = block-set ID X Y
  $max-width W . () = #score-x . score-counter W 0
}

#score-x . score-counter X Y . + X' 1 X . $block-set _ X' Y = score-counter X' Y . #score-x
#score-x . score-counter 0 Y = #clear . clear-y Y
#score-x . $score-counter _ _ . () = #score-y

#score-y . score-counter _ Y . + Y 1 Y' . $max-width W . $max-height H . < Y' H = score-counter W Y' . #score-x
#score-y . score-counter _ _ . () = #fall-tick

#clear: {
  $clear-y Y . block-set _ _ Y = ()
  block-clear-move _ = ()
  () = #clear-move
}

#clear-move: {
  $clear-y Y . block-set ID X Y' . !block-clear-move ID . > Y' Y . + Y'' 1 Y' = block-set ID X Y'' . block-clear-move ID
  $max-width W . clear-y _ . () = #score-x . score-counter W 0
}

#fall-tick . fall-timer TIMER . >= TIMER 0 . $dt DT . + TIMER2 DT TIMER . >= TIMER2 0 = fall-timer TIMER2 . #clean
#fall-tick . fall-timer TIMER . >= TIMER 0 . $dt DT . + TIMER2 DT TIMER . < TIMER2 0 . $default-fall-timer D = fall-timer D . #fall

#fall . shape X Y BLOCKS . + Y' 1 Y = new-shape X Y' BLOCKS . #shape-to-blocks #clean
#fall . () = #clean

#clean: {
  dt _ = ()
  cons = ()
}