#|
methods:
  ;; return #t if the object is player-controlled.
  ;; default: #f
  player?: (self)

  ;; ticker: called if the object is active.
  ;; should mark the object inactive for the current game step.
  ;; return value doesn't matter.
  ;; default: does nothing
  tick: (self otype x y)

  ;; something is trying to step onto the object, or snap it.
  ;; `x` and `y` are object coordinates.
  ;; `dx` and `dy` are push direction (always in [-1..1]).
  ;; `otype` is the object type which the player wants to push.
  ;; `ptype` is the player type.
  ;; this should change the object to emptyness, or perform the effect.
  ;; return value: boolean, #t if some action is taken.
  ;; the return value is used in diagonal movement emulation code.
  ;; default: do nothing, return #f
  player-push: (self otype x y dx dy ptype is-snap)

  ;; return otype
  ;; default: etype:O_EXPLODE_1
  explosion-type: (self)

  ;; return value doesn't matter.
  ;; default: plays corresponding sounds from edef
  play-sound: (self otype)
  play-walk: (self otype)
  play-push: (self otype)
  play-fall: (self otype)
|#


(printf "registering game objects...\n")


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; basic object handler
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
constant basic-game-obj
  method-lambda basic-game-obj
    player?: (self)
      #f
    tick: (self otype x y)
      #void
    player-push: (self otype x y dx dy ptype is-snap)
      #f
    explosion-type: (self)
      etype:O_EXPLODE_1
    play-sound: (self otype)
      play-sound-of-otype otype
    play-walk: (self otype)
      play-walk-sound-of-otype otype
    play-push: (self otype)
      play-push-sound-of-otype otype
    play-fall: (self otype)
      play-fall-sound-of-otype otype


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; helpers
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
define register-game-objects(eobj ... list)
  assert {pair? list} "register what objects?"
  while {pair? list}
    edef:object-set! entity-defs[car(list)] eobj
    {list := cdr(list)}


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; dirt and other statics
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
register-game-objects
  method-lambda static-obj
    player-push: (self otype x y dx dy ptype is-snap)
      if game:field-prop-at?('P_PLAYER_EDIBLE x y)
        then
          self[play-walk: otype]
          game:spawn-at x y etype:O_SPACE
          #t
        #f
    else
      basic-game-obj
  ;; object list
  etype:O_SPACE
  etype:O_DIRT
  etype:O_DIRT_SLOPED_UP_RIGHT
  etype:O_DIRT_SLOPED_UP_LEFT
  etype:O_DIRT_SLOPED_DOWN_LEFT
  etype:O_DIRT_SLOPED_DOWN_RIGHT
  etype:O_DIRT2
  etype:O_BRICK
  etype:O_BRICK_SLOPED_UP_RIGHT
  etype:O_BRICK_SLOPED_UP_LEFT
  etype:O_BRICK_SLOPED_DOWN_LEFT
  etype:O_BRICK_SLOPED_DOWN_RIGHT
  etype:O_BRICK_NON_SLOPED
  etype:O_STEEL
  etype:O_STEEL_SLOPED_UP_RIGHT
  etype:O_STEEL_SLOPED_UP_LEFT
  etype:O_STEEL_SLOPED_DOWN_LEFT
  etype:O_STEEL_SLOPED_DOWN_RIGHT
  etype:O_STEEL_EXPLODABLE
  etype:O_STEEL_EATABLE
  etype:O_BRICK_EATABLE
  etype:O_GRAVESTONE
  ;; glued objects do nothing
  etype:O_STONE_GLUED
  etype:O_DIAMOND_GLUED
  etype:O_DIRT_GLUED
  ;  etype:O_POT
  ;; this will not be implemented
  ;  etype:O_GRAVITY_SWITCH
  ;
  ;  etype:O_TELEPORTER
  ;  etype:O_SKELETON
  ;;
  ;  etype:O_COW_1
  ;  etype:O_COW_2
  ;  etype:O_COW_3
  ;  etype:O_COW_4
  ;
  ;  etype:O_COW_ENCLOSED_1
  ;  etype:O_COW_ENCLOSED_2
  ;  etype:O_COW_ENCLOSED_3
  ;  etype:O_COW_ENCLOSED_4
  ;  etype:O_COW_ENCLOSED_5
  ;  etype:O_COW_ENCLOSED_6
  ;  etype:O_COW_ENCLOSED_7
  ;
  ;  etype:O_WALLED_DIAMOND
  ;  etype:O_WALLED_KEY_1
  ;  etype:O_WALLED_KEY_2
  ;  etype:O_WALLED_KEY_3
  ;
  ;  etype:O_REPLICATOR
  ;
  ;  etype:O_CONVEYOR_LEFT
  ;  etype:O_CONVEYOR_RIGHT
  ;
  ;; engine has a hack for it. sorry.
  etype:O_LAVA
  ;
  ;  etype:O_PLAYER_BOMB
  ;; FIXME: glued player should change the animation state according to the real player!
  etype:O_PLAYER_GLUED
  ;  etype:O_PLAYER_STIRRING
  ;
  ;  etype:O_BOMB
  ;  etype:O_NITRO_PACK_F
  ;  etype:O_NITRO_PACK_EXPLODE
  ;  etype:O_PLAYER_PNEUMATIC_LEFT
  ;  etype:O_PLAYER_PNEUMATIC_RIGHT
  ;  etype:O_PNEUMATIC_ACTIVE_LEFT
  ;  etype:O_PNEUMATIC_ACTIVE_RIGHT
  ;
  etype:O_UNKNOWN
  etype:O_NONE
  etype:O_FAKE_BONUS
  etype:O_OUTBOX_CLOSED
  etype:O_OUTBOX_OPEN
  etype:O_COVERED
  ;  etype:O_CREATURE_SWITCH_ON
  ;  etype:O_EXPANDING_WALL_SWITCH_HORIZ
  ;  etype:O_EXPANDING_WALL_SWITCH_VERT
  ;  etype:O_GRAVITY_SWITCH_ACTIVE
  ;  etype:O_REPLICATOR_SWITCH_ON
  ;  etype:O_REPLICATOR_SWITCH_OFF
  ;  etype:O_CONVEYOR_DIR_NORMAL
  ;  etype:O_CONVEYOR_DIR_CHANGED
  ;  etype:O_CONVEYOR_SWITCH_OFF
  ;  etype:O_CONVEYOR_SWITCH_ON
  ;
  etype:O_QUESTION_MARK
  etype:O_EATABLE
  etype:O_DOWN_ARROW
  etype:O_LEFTRIGHT_ARROW
  etype:O_EVERYDIR_ARROW
  etype:O_GLUED
  etype:O_OUT
  etype:O_EXCLAMATION_MARK


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; helpers
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
define space-at?(x y)
  define otype game:field-otype-ref(x y)
  {{otype = etype:O_SPACE} or {otype = etype:O_LAVA}}


define explode-no-center(x y expl-otype)
  play-sound 'GD_S_EXPLOSION
  game:replay-put-play-sound 'GD_S_EXPLOSION
  game:explode-at {x - 1} {y - 1} expl-otype
  game:explode-at x       {y - 1} expl-otype
  game:explode-at {x + 1} {y - 1} expl-otype
  ;
  game:explode-at {x - 1} y       expl-otype
  ;game:explode-at x       y       expl-otype
  game:explode-at {x + 1} y       expl-otype
  ;
  game:explode-at {x - 1} {y + 1} expl-otype
  game:explode-at x       {y + 1} expl-otype
  game:explode-at {x + 1} {y + 1} expl-otype

define explode-ghost(x y expl-otype)
  play-sound 'GD_S_GHOST_EXPLOSION
  game:replay-put-play-sound 'GD_S_GHOST_EXPLOSION
  game:explode-at-voodoo-special x       y       expl-otype
  game:explode-at-voodoo-special {x - 1} {y - 1} expl-otype
  game:explode-at-voodoo-special {x + 1} {y + 1} expl-otype
  game:explode-at-voodoo-special {x - 1} {y + 1} expl-otype
  game:explode-at-voodoo-special {x + 1} {y - 1} expl-otype

define explode-bomb(x y expl-otype)
  play-sound 'GD_S_BOMB_EXPLOSION
  game:replay-put-play-sound 'GD_S_BOMB_EXPLOSION
  game:explode-at-voodoo-special x       y       expl-otype
  game:explode-at-voodoo-special {x - 1} {y - 1} expl-otype
  game:explode-at-voodoo-special {x + 1} {y + 1} expl-otype
  game:explode-at-voodoo-special {x - 1} {y + 1} expl-otype
  game:explode-at-voodoo-special {x + 1} {y - 1} expl-otype

define explode-voodo(x y expl-otype)
  play-sound 'GD_S_VOODOO_EXPLOSION
  game:replay-put-play-sound 'GD_S_VOODOO_EXPLOSION
  game:explode-at {x - 1} {y - 1} expl-otype
  game:explode-at x       {y - 1} expl-otype
  game:explode-at {x + 1} {y - 1} expl-otype
  ;
  game:explode-at {x - 1} y       expl-otype
  game:explode-at x       y       etype:O_TIME_PENALTY
  game:explode-at {x + 1} y       expl-otype
  ;
  game:explode-at {x - 1} {y + 1} expl-otype
  game:explode-at x       {y + 1} expl-otype
  game:explode-at {x + 1} {y + 1} expl-otype

define explode(x y expl-otype soundid)
  if {symbol? soundid}
    then
      play-sound soundid
      game:replay-put-play-sound soundid
  game:explode-at {x - 1} {y - 1} expl-otype
  game:explode-at x       {y - 1} expl-otype
  game:explode-at {x + 1} {y - 1} expl-otype
  ;
  game:explode-at {x - 1} y       expl-otype
  game:explode-at x       y       expl-otype
  game:explode-at {x + 1} y       expl-otype
  ;
  game:explode-at {x - 1} {y + 1} expl-otype
  game:explode-at x       {y + 1} expl-otype
  game:explode-at {x + 1} {y + 1} expl-otype

define explode-object-at(x y)
  define ett game:field-eobj-ref(x y)[explosion-type:]
  if {not {false? ett}}
    then
      case lax-cdr(game:field-get-prop-at('P_EXPLOSION_TYPE x y))
        (GHOST)
          explode-ghost x y ett
        (BOMB)
          explode-bomb x y ett
        (VOODOO)
          explode-voodo x y ett
        (NITRO)
          explode-nitro x y ett
        else
          explode x y ett 'GD_S_EXPLOSION


;; 0:left, 1:up, 2:right, 3:down
define new-x(x dir)
  cond
    {dir = 0} {x - 1}
    {dir = 2} {x + 1}
    else x

;; 0:left, 1:up, 2:right, 3:down
define new-y(y dir)
  cond
    {dir = 1} {y - 1}
    {dir = 3} {y + 1}
    else y


;;       0:left, 1:up, 2:right, 3:down
;; back: 0:right, 1:down, 2:left, 3:up
define mobile-new-x(x dir)
  if game:creatures-backwards
    cond
      {dir = 0} {x + 1}
      {dir = 2} {x - 1}
      else x
    cond
      {dir = 0} {x - 1}
      {dir = 2} {x + 1}
      else x

;;       0:left, 1:up, 2:right, 3:down
;; back: 0:right, 1:down, 2:left, 3:up
define mobile-new-y(y dir)
  if game:creatures-backwards
    cond
      {dir = 1} {y + 1}
      {dir = 3} {y - 1}
      else y
    cond
      {dir = 1} {y - 1}
      {dir = 3} {y + 1}
      else y


define check-lrud?(x y otype)
  {{game:field-otype-ref({x - 1} y) eq? otype} or
   {game:field-otype-ref({x + 1} y) eq? otype} or
   {game:field-otype-ref(x {y - 1}) eq? otype} or
   {game:field-otype-ref(x {y + 1}) eq? otype}}


define fly-blows-at?(x y)
  if game:field-eobj-ref(x y)[player?:]
    if {game:cave-finished or game:cheat-harmless-mobiles}
      #f
      game:field-prop-at? 'P_BLOWS_UP_FLIES x y
    game:field-prop-at? 'P_BLOWS_UP_FLIES x y

define fly-blows-lrud?(x y)
  {fly-blows-at?({x - 1} y) or
   fly-blows-at?({x + 1} y) or
   fly-blows-at?(x {y - 1}) or
   fly-blows-at?(x {y + 1})}


;; base: otype base
;; dir: 0-3
define mobile-move(x y base dir ccw expl-proc expl-otype soundid)
  if check-lrud?(x y etype:O_VOODOO)
    gset! game:voodoo-touched #t
  if game:creatures-backwards {ccw := {not ccw}}
  define dirn {{dir + (if ccw 3 1)} mod 4}
  define dirp {{dir + (if ccw 1 3)} mod 4}
  cond
    fly-blows-lrud?(x y)
      expl-proc x y expl-otype soundid
    space-at?(mobile-new-x(x dirn) mobile-new-y(y dirn))
      ;; turn and move
      game:spawn-move-at x y mobile-new-x(x dirn) mobile-new-y(y dirn) {base + dirn}
    space-at?(mobile-new-x(x dir) mobile-new-y(y dir))
      ;; go on
      game:move-obj x y mobile-new-x(x dir) mobile-new-y(y dir)
    else
      ;; turn in place
      game:spawn-at x y {base + dirp}


;; base: otype base
;; dir: 0-3
define mobilexy-move(x y base dir ccw expl-proc expl-otype soundid)
  if check-lrud?(x y etype:O_VOODOO)
    gset! game:voodoo-touched #t
  if game:creatures-backwards {ccw := {not ccw}}
  define dirn {{dir + (if ccw 3 1)} mod 4}
  cond
    fly-blows-lrud?(x y)
      expl-proc x y expl-otype soundid
    space-at?(mobile-new-x(x dir) mobile-new-y(y dir))
      ;; go on
      game:move-obj x y mobile-new-x(x dir) mobile-new-y(y dir)
    else
      ;; turn in place
      game:spawn-at x y {base + dirn}


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; voodoo doll
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
register-game-objects
  method-lambda static-obj
    explosion-type: (self)
      etype:O_PRE_STEEL_1
    else
      basic-game-obj
  ;; object list
  etype:O_VOODOO


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; time penalty
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
register-game-objects
  method-lambda o-time-penalty
    tick: (self otype x y)
      game:spawn-at x y etype:O_GRAVESTONE
      gset! game:cave-time max(0 {game:cave-time + game:option-ref('level-penalty-time)})
    else
      basic-game-obj
  ;; object list
  etype:O_TIME_PENALTY


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; expanding wall
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
register-game-objects
  method-lambda o-expanding-wall
    tick: (self otype x y)
      define expand(nx ny otype)
        cond
          space-at?(nx ny)
            self[play-sound: otype]
            game:spawn-at nx ny otype
            #t
          else
            #f
      ;;
      define horiz #f
      define vert #f
      cond
        {{otype = etype:O_H_EXPANDING_WALL} or {otype = etype:O_H_EXPANDING_STEEL_WALL}}
          if game:option-ref('expanding-wall-changed)
            {vert := #t}
            {horiz := #t}
        {{otype = etype:O_V_EXPANDING_WALL} or {otype = etype:O_V_EXPANDING_STEEL_WALL}}
          if game:option-ref('expanding-wall-changed)
            {horiz := #t}
            {vert := #t}
        else
          {horiz := #t}
          {vert := #t}
      cond
        {horiz and vert}
          (or expand({x - 1} y otype) expand({x + 1} y otype)
              expand(x {y - 1} otype) expand(x {y + 1} otype))
        horiz
          {expand({x - 1} y otype) or expand({x + 1} y otype)}
        vert
          {expand(x {y - 1} otype) or expand(x {y + 1} otype)}
    else
      basic-game-obj
  ;; object list
  etype:O_H_EXPANDING_WALL
  etype:O_V_EXPANDING_WALL
  etype:O_H_EXPANDING_STEEL_WALL
  etype:O_V_EXPANDING_STEEL_WALL
  etype:O_EXPANDING_WALL
  etype:O_EXPANDING_STEEL_WALL


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; falling start code
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
define get-fall-dir(self otype)
  cond
    {otype = etype:O_FLYING_STONE} -1
    {otype = etype:O_FLYING_DIAMOND} -1
    {otype = etype:O_FLYING_STONE_F} -1
    {otype = etype:O_FLYING_DIAMOND_F} -1
    else 1

define do-start-fall(self otype x y fall-otype roll-otype)
  ;if (cave->gravity_disabled) return;
  define dy get-fall-dir(self otype)
  define sslop (if {negative? dy} 'P_SLOPED_UP 'P_SLOPED_DOWN)
  define edown game:field-edef-ref(x {y + dy})
  define dtype game:field-otype-ref(x {y + dy})
  cond
    {{not {false? fall-otype}} and {{dtype = etype:O_SPACE} or {dtype = etype:O_LAVA}}}
      game:spawn-at x y etype:O_SPACE
      game:spawn-at x {y + dy} fall-otype
      self[play-fall: otype]
      #t
    {{not {false? roll-otype}} and {space-at?({x - 1} y) and space-at?({x - 1} {y + dy})}}
      cond
        {{edef:prop?(edown 'P_SLOPED)} or
         {edef:prop?(edown 'P_SLOPED_LEFT) and edef:prop?(edown sslop)}}
          game:spawn-at x y etype:O_SPACE
          game:spawn-at {x - 1} y roll-otype
          self[play-fall: otype]
          #t
        else
          #f
    {{not {false? roll-otype}} and {space-at?({x + 1} y) and space-at?({x + 1} {y + dy})}}
      cond
        {{edef:prop?(edown 'P_SLOPED)} or
         {edef:prop?(edown 'P_SLOPED_RIGHT) and edef:prop?(edown sslop)}}
          game:spawn-at x y etype:O_SPACE
          game:spawn-at {x + 1} y roll-otype
          self[play-fall: otype]
          #t
        else
          #f
    else
      #f


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; falling continuation code
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
define try-crush-voodoo?(self otype x y)
  cond
    {{not game:cave-finished} and game:option-ref('voodoo-dies-by-stone)}
      define dy get-fall-dir(self otype)
      cond
        {game:field-otype-ref(x {y + dy}) = etype:O_VOODOO}
          ; this is a 1stB-style vodo. explodes by stone, collects diamonds
          explode-object-at x {y + dy}
          #t
        else
          #f
    else
      #f

define try-eat-voodoo?(self otype x y)
  cond
    {game:option-ref('voodoo-collects-diamonds) and otype-prop?(otype 'P_DIAMOND)}
      define dy get-fall-dir(self otype)
      cond
        {game:field-otype-ref(x {y + dy}) = etype:O_VOODOO}
          ; this is a 1stB-style vodo. explodes by stone, collects diamonds
          self[play-push: otype]
          game:diamond-collected()
          game:spawn-at x y etype:O_SPACE
          #t
        else
          #f
    else
      #f

define try-crack-nut?(self otype x y stop-otype)
  cond
    {false? stop-otype}
      #f
    else
      define dy get-fall-dir(self otype)
      define fot game:field-otype-ref(x {y + dy})
      cond
        {{fot = etype:O_NUT} or {fot = etype:O_NUT_F}}
          game:spawn-at x y stop-otype
          game:spawn-at x {y + dy} game:option-ref('nut-turns-to-when-crushed)
          play-sound-with-id 'GD_S_NUT_CRACK
          #t
        else
          #f

define try-magic?(self otype x y magic-otype)
  cond
    {false? magic-otype}
      #f
    else
      define dy get-fall-dir(self otype)
      cond
        {game:field-otype-ref(x {y + dy}) = etype:O_MAGIC_WALL}
          play-push-sound-of-otype etype:O_DIAMOND  ; always play diamond sound
          game:activate-magic-walls()
          if {game:magic-walls-active?() and space-at?(x {y + dy + dy})}
            game:spawn-at x {y + dy + dy} magic-otype
          ; active or non-active or anything, element falling in will always disappear
          game:spawn-at x y etype:O_SPACE
          #t
        else
          #f

define try-crush?(self otype x y)
  define dy get-fall-dir(self otype)
  cond
    game:field-prop-at?('P_EXPLODES_BY_HIT x {y + dy})
      cond
        {not game:cave-finished}
          explode-object-at x {y + dy}
          #t
        {not game:field-eobj-ref(x {y + dy})[player?:]}
          explode-object-at x {y + dy}
          #t
        else
          #f
    else
      #f

define do-falling(self otype x y)
  define dy get-fall-dir(self otype)
  define sslop (if {negative? dy} 'P_SLOPED_UP 'P_SLOPED_DOWN)
  define edown game:field-edef-ref(x {y + dy})
  define dtype game:field-otype-ref(x {y + dy})
  cond
    {{dtype = etype:O_SPACE} or {dtype = etype:O_LAVA}}
      game:move-obj x y x {y + dy}
      #t
    {space-at?({x - 1} y) and space-at?({x - 1} {y + dy})}
      cond
        {{edef:prop?(edown 'P_SLOPED)} or
         {edef:prop?(edown 'P_SLOPED_LEFT) and edef:prop?(edown sslop)}}
          self[play-fall: otype]
          game:move-obj x y {x - 1} y
          #t
        else
          #f
    {space-at?({x + 1} y) and space-at?({x + 1} {y + dy})}
      cond
        {{edef:prop?(edown 'P_SLOPED)} or
         {edef:prop?(edown 'P_SLOPED_RIGHT) and edef:prop?(edown sslop)}}
          self[play-fall: otype]
          game:move-obj x y {x + 1} y
          #t
        else
          #f
    else
      #f


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; diamonds
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
register-game-objects
  method-lambda o-trapped-diamond
    tick: (self otype x y)
      if game:key-used(game:DIAMOND_KEY_IDX)
        game:spawn-at x y etype:O_DIAMOND
    else
      basic-game-obj
  ;; object list
  etype:O_TRAPPED_DIAMOND

register-game-objects
  method-lambda o-diamond
    player-push: (self otype x y dx dy ptype is-snap)
      self[play-push: otype]
      game:diamond-collected()
      game:spawn-at x y etype:O_SPACE
      #t
    tick: (self otype x y)
      do-start-fall self otype x y
        game:option-ref('diamond-falling-effect)
        game:option-ref('diamond-falling-effect)
    else
      basic-game-obj
  ;; object list
  etype:O_DIAMOND
  ;; O_DIAMOND_GLUED

register-game-objects
  method-lambda o-flying-diamond
    player-push: (self otype x y dx dy ptype is-snap)
      self[play-push: otype]
      game:diamond-collected()
      game:spawn-at x y etype:O_SPACE
      #t
    tick: (self otype x y)
      do-start-fall self otype x y etype:O_FLYING_DIAMOND_F etype:O_FLYING_DIAMOND_F
    else
      basic-game-obj
  ;; object list
  etype:O_FLYING_DIAMOND


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; stones
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
define stone-obj-ctor(otype fall-otype roll-otype push-prob)
  define get-fall-otype()
    if {symbol? fall-otype}
      (game:option-ref fall-otype)
      fall-otype
  ;;
  define get-roll-otype()
    if {symbol? roll-otype}
      (game:option-ref roll-otype)
      roll-otype
  ;;
  define get-prob(is-snap)
    if {procedure? push-prob}
      push-prob(is-snap)
      push-prob
  ;;
  register-game-objects
    method-lambda o-stone
      player-push: (self otype x y dx dy ptype is-snap)
        assert {{dx <> 0} or {dy <> 0}} "invalid push direction"
        ;; only horizontal pushes
        cond
          {{zero? dy} and space-at?({x + dx} {y + dy}) and
           {game:random(1_000_000) < get-prob(is-snap)}}
            self[play-push: otype]
            game:move-obj x y {x + dx} {y + dy}
            #t
          else
            #f
      tick: (self otype x y)
        do-start-fall self otype x y get-fall-otype() get-roll-otype()
      else
        basic-game-obj
    ;; object list
    otype

; waiting stones are light, can always push
(stone-obj-ctor etype:O_WAITING_STONE etype:O_CHASING_STONE etype:O_WAITING_STONE 1_000_000)
(stone-obj-ctor etype:O_STONE 'stone-falling-effect 'stone-falling-effect (lambda (is-snap) (if game:sweet-eaten 1_000_000 250_000)))
(stone-obj-ctor etype:O_NITRO_PACK etype:O_NITRO_PACK_F etype:O_NITRO_PACK_F (lambda (is-snap) (if game:sweet-eaten 1_000_000 250_000)))
(stone-obj-ctor etype:O_FLYING_STONE etype:O_FLYING_STONE_F etype:O_FLYING_STONE_F (lambda (is-snap) (if game:sweet-eaten 1_000_000 250_000)))
(stone-obj-ctor etype:O_NUT etype:O_NUT_F etype:O_NUT_F (lambda (is-snap) (if game:sweet-eaten 1_000_000 250_000)))
; a box is only pushed with the fire pressed
(stone-obj-ctor etype:O_MEGA_STONE etype:O_MEGA_STONE_F etype:O_MEGA_STONE_F
  (lambda (is-snap)
    (if {game:sweet-eaten and game:option-ref('mega-stone-pushable-with-sweet)} 1_000_000 0)))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; box
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
register-game-objects
  method-lambda o-box
    player-push: (self otype x y dx dy ptype is-snap)
      assert {{dx <> 0} or {dy <> 0}} "invalid push direction"
      if {is-snap and space-at?({x + dx} {y + dy})}
        then
          self[play-push: otype]
          game:move-obj x y {x + dx} {y + dy}
          #t
        #f
    else
      basic-game-obj
  ;; object list
  etype:O_BOX


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; chasing stone
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
register-game-objects
  method-lambda o-chasing-stone
    player-push: (self otype x y dx dy ptype is-snap)
      assert {{dx <> 0} or {dy <> 0}} "invalid push direction"
      ;; only horizontal pushes
      cond
        {{zero? dy} and game:sweet-eaten and space-at?({x + dx} {y + dy})}
          self[play-push: otype]
          game:move-obj x y {x + dx} {y + dy}
          #t
        else
          #f
    tick: (self otype x y)
      define ndx
      define ndy
      define px game:player-chase-x()
      define py game:player-chase-y()
      define dx (if {x >= px} -1 1)
      define dy (if {y >= py} -1 1)
      define horiz {game:random(1_000_000) >= 500_000}
      define moved #f
      define i 3
      define looped #t
      ;; i am not sure that i correctly implemented this.
      ;; but GDash code is a freakin' pasta, i cannot stand it.
      while {true? looped}
        {looped := #nil}
        {ndx := (if horiz sign({px - x}) 0)}
        {ndy := (if horiz 0 sign({py - y}))}
        cond
          {{zero? ndx} and {zero? ndy}}
            {horiz := {not horiz}}
            if {dec!(i) = 2} {looped := #t}
          space-at?({x + ndx} {y + ndy})
            game:move-obj x y {x + ndx} {y + ndy}
            {moved := #t}
            {looped := #f}
          {dec!(i 2) = 1}
            {horiz := {not horiz}}
            {looped := #t}
          else
            #void
        if {null? looped}
          then
            {looped := #f}
            if {i <> 0} {moved := #t}
      ; if we should move in both directions, but can not move in any, stop
      if {not moved}
        if horiz
          if {space-at?(x {y - 1}) and space-at?({x + dx} {y - 1})}
            game:move-obj x y x {y - 1}
            if {space-at?(x {y + 1}) and space-at?({x + dx} {y + 1})}
              game:move-obj x y x {y + 1}
          ;; vertical
          if {space-at?({x - 1} y) and space-at?({x - 1} {y + dy})}
            game:move-obj x y {x - 1} y
            if {space-at?({x + 1} y) and space-at?({x + 1} {y + dy})}
              game:move-obj x y {x + 1} y
    else
      basic-game-obj
  ;; object list
  etype:O_CHASING_STONE


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; falling dirt
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
define dirtball-obj-ctor(otype fall-otype)
  register-game-objects
    method-lambda o-dirtball
      player-push: (self otype x y dx dy ptype is-snap)
        self[play-walk: otype]
        game:spawn-at x y etype:O_SPACE
        #t
      tick: (self otype x y)
        do-start-fall self otype x y fall-otype fall-otype
      else
        basic-game-obj
    ;; object list
    otype

(dirtball-obj-ctor etype:O_DIRT_BALL etype:O_DIRT_BALL_F)
(dirtball-obj-ctor etype:O_DIRT_LOOSE etype:O_DIRT_LOOSE_F)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; falling stone-likes
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
define falling-obj-ctor(otype stop-otype crush-voodo? eat-voodo? crack-nut-otype magic-otype crush?)
  define get-stop-otype()
    if {symbol? stop-otype}
      game:option-ref(stop-otype)
      stop-otype
  ;;
  define get-nut-otype()
    if {symbol? crack-nut-otype}
      game:option-ref(crack-nut-otype)
      crack-nut-otype
  ;;
  define get-magic-otype()
    if {symbol? magic-otype}
      game:option-ref(magic-otype)
      magic-otype
  ;;
  register-game-objects
    method-lambda o-falling
      tick: (self otype x y)
        if (or {crush-voodo? and try-crush-voodoo?(self otype x y)}
               {eat-voodo? and try-eat-voodoo?(self otype x y)}
               {{not {false? crack-nut-otype}} and try-crack-nut?(self otype x y get-nut-otype())}
               {{not {false? magic-otype}} and try-magic?(self otype x y get-magic-otype())}
               {crush? and try-crush?(self otype x y)}
               do-falling(self otype x y))
          #void
          else
            self[play-fall: otype]
            game:spawn-at x y get-stop-otype()
      else
        basic-game-obj
    ;; object list
    otype

(falling-obj-ctor etype:O_DIRT_BALL_F etype:O_DIRT_BALL #f #f #f #f #f)
(falling-obj-ctor etype:O_DIRT_LOOSE_F etype:O_DIRT_LOOSE #f #f #f #f #f)
(falling-obj-ctor etype:O_STONE_F
                    'stone-bouncing-effect #t #f
                    'stone-bouncing-effect
                    'magic-stone-to #t)
(falling-obj-ctor etype:O_MEGA_STONE_F
                    etype:O_MEGA_STONE #t #f
                    etype:O_MEGA_STONE
                    'magic-mega-stone-to #t)
(falling-obj-ctor etype:O_DIAMOND_F
                    'diamond-bouncing-effect #f #t #f
                    'magic-diamond-to #t)
(falling-obj-ctor etype:O_FLYING_DIAMOND_F
                    etype:O_FLYING_DIAMOND #f #t #f
                    'magic-flying-diamond-to #t)
(falling-obj-ctor etype:O_NUT_F
                    etype:O_NUT #f #f #f
                    'magic-nut-to #t)
(falling-obj-ctor etype:O_FLYING_STONE_F
                    etype:O_FLYING_STONE #t #f
                    etype:O_FLYING_STONE
                    'magic-flying-stone-to #t)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; keys
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
define register-collectible-obj(otype handler)
  register-game-objects
    method-lambda o-collectible
      player-push: (self otype x y dx dy ptype is-snap)
        handler self otype x y is-snap
      else
        basic-game-obj
    ;; object list
    otype


define key-obj-handler(key-index)
  lambda key-obj (self otype x y is-snap)
    self[play-push: otype]
    game:key-collected(key-index)
    game:spawn-at x y etype:O_SPACE
    #t

(register-collectible-obj etype:O_DIAMOND_KEY key-obj-handler(game:DIAMOND_KEY_IDX))
(register-collectible-obj etype:O_KEY_1 key-obj-handler(1))
(register-collectible-obj etype:O_KEY_2 key-obj-handler(2))
(register-collectible-obj etype:O_KEY_3 key-obj-handler(3))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; doors
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
define door-obj-handler(key-index)
  lambda door-obj (self otype x y is-snap)
    if {game:key-used(key-index)}
      then
        self[play-push: otype]
        game:spawn-at x y etype:O_SPACE
        #t
      else
        #f

(register-collectible-obj etype:O_DOOR_1 door-obj-handler(1))
(register-collectible-obj etype:O_DOOR_2 door-obj-handler(2))
(register-collectible-obj etype:O_DOOR_3 door-obj-handler(3))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; switches
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
register-collectible-obj etype:O_BITER_SWITCH
  lambda biter-switch (self otype x y is-snap)
    self[play-sound: otype]
    gset! game:biter-delay-frame {{game:biter-delay-frame + 1} mod 4}
    #t

register-collectible-obj etype:O_CREATURE_SWITCH
  lambda biter-switch (self otype x y is-snap)
    self[play-sound: otype]
    gset! game:creatures-backwards {not game:creatures-backwards}
    #t

;(register-game-obj etype:O_EXPANDING_WALL_SWITCH (switch-obj-ctor 1))
;(register-game-obj etype:O_REPLICATOR_SWITCH (switch-obj-ctor 3))
;(register-game-obj etype:O_CONVEYOR_SWITCH (switch-obj-ctor 4))
;(register-game-obj etype:O_CONVEYOR_DIR_SWITCH (switch-obj-ctor 5))
;(register-game-obj etype:O_CONVEYOR_DIR_SWITCH (switch-obj-ctor 5))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; sweet
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
register-collectible-obj etype:O_SWEET
  lambda sweet-handler (self otype x y is-snap)
    self[play-push: otype]
    gset! game:sweet-eaten #t
    game:spawn-at x y etype:O_SPACE
    #t


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; pneumatic hammer
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
register-collectible-obj etype:O_PNEUMATIC_HAMMER
  lambda hammer-handler (self otype x y is-snap)
    self[play-push: otype]
    gset! game:got-pneumatic-hammer #t
    game:spawn-at x y etype:O_SPACE
    #t


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; clock
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
register-collectible-obj etype:O_CLOCK
  lambda clock-handler (self otype x y is-snap)
    self[play-push: otype]
    define ntt {game:cave-time + game:option-ref('level-bonus-time)}
    while {ntt > game:option-ref('max-time)}
      dec! ntt game:option-ref('max-time)
    gset! game:cave-time max(0 ntt)
    ; no space, rather a dirt remains there...
    game:spawn-at x y etype:O_DIRT
    #t


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; bomb
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
register-collectible-obj etype:O_BOMB
  lambda bomb-handler (self otype x y is-snap)
    ;; the original allows collecting only one bomb.
    ;; it is boring, so let's allow collecting as many bombs as the player wants to.
    self[play-push: otype]
    gset! game:bombs-collected {game:bombs-collected + 1}
    game:spawn-at x y etype:O_SPACE
    #t

;; on the level this is the same as the normal bomb (for now)
register-collectible-obj etype:O_BOMB_K8
  lambda bomb-handler (self otype x y is-snap)
    ;; the original allows collecting only one bomb.
    ;; it is boring, so let's allow collecting as many bombs as the player wants to.
    self[play-push: otype]
    gset! game:bombs-collected {game:bombs-collected + 1}
    game:spawn-at x y etype:O_SPACE
    gset! game:bomb-is-k8 #t
    #t


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; pre-outbox
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
register-game-objects
  method-lambda o-pre-outbox
    tick: (self otype x y)
      if game:gate-open
        if {otype = etype:O_PRE_OUTBOX}
          game:spawn-at x y etype:O_OUTBOX
          game:spawn-at x y etype:O_INVIS_OUTBOX
    else
      basic-game-obj
  ;; object list
  etype:O_PRE_OUTBOX
  etype:O_PRE_INVIS_OUTBOX


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; outbox
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
register-game-objects
  method-lambda o-outbox
    player-push: (self otype x y dx dy ptype is-snap)
      play-sound 'GD_S_FINISHED
      gset! game:cave-finished #t
      game:spawn-at x y etype:O_SPACE
      #t
    else
      basic-game-obj
  ;; object list
  etype:O_OUTBOX
  etype:O_INVIS_OUTBOX

;; never spawned by the engine, but cound be used in BDCFF (for some unknown reason).
;; replaced with O_OUTBOX by the flattener.
;(register-game-obj etype:O_OUTBOX_CLOSED outbox-obj-ctor)
;(register-game-obj etype:O_OUTBOX_OPEN outbox-obj-ctor)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; inbox
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
register-game-objects
  method-lambda o-inbox
    tick: (self otype x y)
      game:player-found(x y #f)
      if {game:tick >= game:hatch-time}
        game:spawn-at x y etype:O_PRE_PL_1
    else
      basic-game-obj
  ;; object list
  etype:O_INBOX


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; hatching
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
register-game-objects
  method-lambda o-hatching
    tick: (self otype x y)
      if {otype = etype:O_PRE_PL_1}
        game:player-hatch()  ;; "start signal"
      cond
        {otype = etype:O_PRE_PL_3}
          game:spawn-at x y etype:O_PLAYER
          gset! game:last-dir-left {{x > 0} and space-at?({x - 1} y)}
          game:player-found(x y #t) ;; because the real player just spawned
        else
          game:spawn-at x y {otype + 1}
          game:player-found(x y #f)
    else
      basic-game-obj
  ;; object list
  etype:O_PRE_PL_1
  etype:O_PRE_PL_2
  etype:O_PRE_PL_3


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; mobiles
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
define make-mobile(base expl-proc ... rest)
  ;define ccw (edef:prop? def 'P_CCW)
  define ccw (otype-prop? base 'P_CCW)
  ;;
  define expl-otype()
    define res (lax-cdr otype-prop-ref(base 'P_EXPLOSION_OPTION))
    if {null? res}
      etype:O_EXPLODE_1
      game:option-ref(res)
  ;;
  define get-dir(base otype)
    {otype - base}
  ;;
  apply register-game-objects
    cons
      method-lambda o-mobile
        tick: (self otype x y)
          mobile-move x y base get-dir(base otype) ccw expl-proc expl-otype() 'GD_S_EXPLOSION
        explosion-type: (self)
          expl-otype()
        else
          basic-game-obj
      ;; object list
      rest

(make-mobile etype:O_FIREFLY_1 explode
  etype:O_FIREFLY_1 etype:O_FIREFLY_2 etype:O_FIREFLY_3 etype:O_FIREFLY_4)

(make-mobile etype:O_ALT_FIREFLY_1 explode
  etype:O_ALT_FIREFLY_1 etype:O_ALT_FIREFLY_2 etype:O_ALT_FIREFLY_3 etype:O_ALT_FIREFLY_4)

(make-mobile etype:O_BUTTER_1 explode
  etype:O_BUTTER_1 etype:O_BUTTER_2 etype:O_BUTTER_3 etype:O_BUTTER_4)

(make-mobile etype:O_ALT_BUTTER_1 explode
  etype:O_ALT_BUTTER_1 etype:O_ALT_BUTTER_2 etype:O_ALT_BUTTER_3 etype:O_ALT_BUTTER_4)

(make-mobile  etype:O_STONEFLY_1 explode
  etype:O_STONEFLY_1 etype:O_STONEFLY_2 etype:O_STONEFLY_3 etype:O_STONEFLY_4)


define make-mobilexy(base expl-proc ... rest)
  ;define ccw (edef:prop? def 'P_CCW)
  define ccw (otype-prop? base 'P_CCW)
  ;;
  define expl-otype()
    define res (lax-cdr (otype-prop-ref base 'P_EXPLOSION_OPTION))
    if {null? res}
      etype:O_EXPLODE_1
      game:option-ref(res)
  ;;
  define get-dir(base otype)
    {otype - base}
  ;;
  apply register-game-objects
    cons
      method-lambda o-mobilexy
        tick: (self otype x y)
          mobile-movexy x y base get-dir(base otype) ccw expl-proc expl-otype() 'GD_S_EXPLOSION
        explosion-type: (self)
          expl-otype()
        else
          basic-game-obj
      ;; object list
      rest

(make-mobilexy etype:O_DRAGONFLY_1 explode
  etype:O_DRAGONFLY_1 etype:O_DRAGONFLY_2 etype:O_DRAGONFLY_3 etype:O_DRAGONFLY_4)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; explosions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
register-game-objects
  method-lambda o-explosion
    tick: (self otype x y)
      define next (otype-prop-ref otype 'P_EXPLOSION_NEXT_OPTION)
      cond
        {pair? next}
          ;printf "opt=%o; has=%o\n" cdr(next) game:has-override-option?(cdr(next))
          if {cdr(next) eq? 'explosion-3-effect}
            if game:has-override-option?(cdr(next))
              {next := cons(#nil game:option-ref(cdr(next)))}
              {next := (otype-prop-ref otype 'P_EXPLOSION_NEXT)}
            {next := cons(#nil game:option-ref(cdr(next)))}
        else
          {next := (otype-prop-ref otype 'P_EXPLOSION_NEXT)}
      cond
        {false? next}
          game:spawn-at x y {otype + 1}
        else
          game:spawn-at x y cdr(next)
    else
      basic-game-obj
  ;; object list
  etype:O_PRE_CLOCK_1
  etype:O_PRE_CLOCK_2
  etype:O_PRE_CLOCK_3
  etype:O_PRE_CLOCK_4
  ;;
  etype:O_PRE_DIA_1
  etype:O_PRE_DIA_2
  etype:O_PRE_DIA_3
  etype:O_PRE_DIA_4
  etype:O_PRE_DIA_5
  ;;
  etype:O_EXPLODE_1
  etype:O_EXPLODE_2
  etype:O_EXPLODE_3
  etype:O_EXPLODE_4
  etype:O_EXPLODE_5
  ;;
  etype:O_PRE_STONE_1
  etype:O_PRE_STONE_2
  etype:O_PRE_STONE_3
  etype:O_PRE_STONE_4
  ;;
  etype:O_PRE_STEEL_1
  etype:O_PRE_STEEL_2
  etype:O_PRE_STEEL_3
  etype:O_PRE_STEEL_4
  ;;
  etype:O_BOMB_EXPL_1
  etype:O_BOMB_EXPL_2
  etype:O_BOMB_EXPL_3
  etype:O_BOMB_EXPL_4
  ;;
  etype:O_BOMB_K8_EXPL_1
  etype:O_BOMB_K8_EXPL_2
  etype:O_BOMB_K8_EXPL_3
  etype:O_BOMB_K8_EXPL_4
  ;;
  etype:O_NITRO_EXPL_1
  etype:O_NITRO_EXPL_2
  etype:O_NITRO_EXPL_3
  etype:O_NITRO_EXPL_4
  ;;
  etype:O_AMOEBA_2_EXPL_1
  etype:O_AMOEBA_2_EXPL_2
  etype:O_AMOEBA_2_EXPL_3
  etype:O_AMOEBA_2_EXPL_4
  ;;
  etype:O_NUT_EXPL_1
  etype:O_NUT_EXPL_2
  etype:O_NUT_EXPL_3
  etype:O_NUT_EXPL_4


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; bomb
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
register-game-objects
  method-lambda o-ticking-bomb
    tick: (self otype x y)
      cond
        {otype = etype:O_BOMB_TICK_7}
          play-sound 'GD_S_EXPLOSION
          game:replay-put-play-sound 'GD_S_EXPLOSION
          game:explode-at-voodoo-special x       y       etype:O_BOMB_EXPL_1
          game:explode-at-voodoo-special {x - 1} y       etype:O_BOMB_EXPL_1
          game:explode-at-voodoo-special {x + 1} y       etype:O_BOMB_EXPL_1
          game:explode-at-voodoo-special x       {y + 1} etype:O_BOMB_EXPL_1
          game:explode-at-voodoo-special x       {y - 1} etype:O_BOMB_EXPL_1
        {otype = etype:O_BOMB_K8_TICK_7}
          play-sound 'GD_S_EXPLOSION
          game:replay-put-play-sound 'GD_S_EXPLOSION
          game:explode-at-voodoo-special x       y       etype:O_BOMB_K8_EXPL_1
          game:explode-at-voodoo-special {x - 1} y       etype:O_BOMB_K8_EXPL_1
          game:explode-at-voodoo-special {x + 1} y       etype:O_BOMB_K8_EXPL_1
          game:explode-at-voodoo-special x       {y + 1} etype:O_BOMB_K8_EXPL_1
          game:explode-at-voodoo-special x       {y - 1} etype:O_BOMB_K8_EXPL_1
        else
          game:spawn-at x y {otype + 1}
    else
      basic-game-obj
  ;; object list
  etype:O_BOMB_TICK_1
  etype:O_BOMB_TICK_2
  etype:O_BOMB_TICK_3
  etype:O_BOMB_TICK_4
  etype:O_BOMB_TICK_5
  etype:O_BOMB_TICK_6
  etype:O_BOMB_TICK_7
  ;;
  etype:O_BOMB_K8_TICK_1
  etype:O_BOMB_K8_TICK_2
  etype:O_BOMB_K8_TICK_3
  etype:O_BOMB_K8_TICK_4
  etype:O_BOMB_K8_TICK_5
  etype:O_BOMB_K8_TICK_6
  etype:O_BOMB_K8_TICK_7


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ghost
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
register-game-objects
  method-lambda o-ghost
    tick: (self otype x y)
      cond
        fly-blows-lrud?(x y)
          explode-ghost x y etype:O_GHOST_EXPL_1
        else
          ; the ghost is given four possibilities to move
          define dir
          define tries 4
          define done #f
          while {{tries <> 0} and {not {done}}}
            {dir := game:random(4)}
            if space-at?(new-x(x dir) new-y(y dir))
              then
                game:move-obj x y new-x(x dir) new-y(y dir)
                {done := #t}
            dec! tries
    explosion-type: (self)
      etype:O_GHOST_EXPL_1
    else
      basic-game-obj
  ;; object list
  etype:O_GHOST


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ghost explosion
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(constant ghost-explosion-items (list->vector `(
  ,etype:O_SPACE
  ,etype:O_SPACE
  ,etype:O_DIRT
  ,etype:O_DIRT
  ,etype:O_CLOCK
  ,etype:O_CLOCK
  ,etype:O_PRE_OUTBOX
  ,etype:O_BOMB
  ,etype:O_BOMB
  ,etype:O_PLAYER
  ,etype:O_GHOST
  ,etype:O_BLADDER
  ,etype:O_DIAMOND
  ,etype:O_SWEET
  ,etype:O_WAITING_STONE
  ,etype:O_BITER_1)))

register-game-objects
  method-lambda o-ghost-explosion
    tick: (self otype x y)
      cond
        {otype = etype:O_GHOST_EXPL_4}
          let <* idx game:random(vector-length(ghost-explosion-items)) *>
            game:spawn-at x y ghost-explosion-items[idx]
        else
          game:spawn-at x y {otype + 1}
    else
      basic-game-obj
  ;; object list
  etype:O_GHOST_EXPL_1
  etype:O_GHOST_EXPL_2
  etype:O_GHOST_EXPL_3
  etype:O_GHOST_EXPL_4


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; amoeba 1
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
define amoeba-can-eat-at?(x y)
  game:field-prop-at? 'P_AMOEBA_CONSUMES x y

register-game-objects
  method-lambda o-amoeba
    tick: (self otype x y)
      ;;   'SLEEPING
      ;;   'AWAKE
      ;;   'TOO-BIG
      ;;   'ENCLOSED
      case game:amoeba-state
        (AWAKE SLEEPING)
          ;printf "state0: %o\n" game:amoeba-state
          game:amoeba-processed()
          if {amoeba-can-eat-at?({x - 1} y) or
              amoeba-can-eat-at?({x + 1} y) or
              amoeba-can-eat-at?(x {y - 1}) or
              amoeba-can-eat-at?(x {y + 1})}
            then
              gset! game:amoeba-state 'AWAKE
              gset! game:amoeba-can-spread #t
          ;printf "state1: %o (can-spread=%o)\n" game:amoeba-state game:amoeba-can-spread
          if {game:amoeba-can-spread and {game:random(1000000) < game:amoeba-growth-prob}}
            then
              define dir game:random(4)
              define nx new-x(x dir)
              define ny new-y(y dir)
              ;printf "  dir=%o; can-eat=%o\n" dir
              if amoeba-can-eat-at?(nx ny)
                game:spawn-at nx ny etype:O_AMOEBA
        (TOO-BIG)
          game:spawn-at x y game:option-ref('amoeba-too-big-effect)
        (ENCLOSED)
          game:spawn-at x y game:option-ref('amoeba-enclosed-effect)
    explosion-type: (self)
      etype:O_EXPLODE_1
    play-sound: (self otype)
      #void
    play-walk: (self otype)
      #void
    play-push: (self otype)
      #void
    play-fall: (self otype)
      #void
    else
      basic-game-obj
  ;; object list
  etype:O_AMOEBA


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; amoeba 2
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
register-game-objects
  method-lambda o-amoeba
    tick: (self otype x y)
      ;check if it is touching an amoeba, and explodsion is enabled
      if {game:option-ref('amoeba-2-explodes-by-amoeba) and
          (or like-otype-at?(x {y + 1} etype:O_AMOEBA)
              like-otype-at?(x {y - 1} etype:O_AMOEBA)
              like-otype-at?({x - 1} y etype:O_AMOEBA)
              like-otype-at?({x + 1} y etype:O_AMOEBA))}
        then
          game:amoeba-2-processed()
          explode x y 'O_AMOEBA_2_EXPL_1 'GD_S_EXPLOSION
        else
          ;;   'SLEEPING
          ;;   'AWAKE
          ;;   'TOO-BIG
          ;;   'ENCLOSED
          case game:amoeba-2-state
            (AWAKE SLEEPING)
              ;printf "state0: %o\n" game:amoeba-2-state
              game:amoeba-2-processed()
              if {amoeba-can-eat-at?({x - 1} y) or
                  amoeba-can-eat-at?({x + 1} y) or
                  amoeba-can-eat-at?(x {y - 1}) or
                  amoeba-can-eat-at?(x {y + 1})}
                then
                  gset! game:amoeba-2-state 'AWAKE
                  gset! game:amoeba-2-can-spread #t
              ;printf "state1: %o (can-spread=%o)\n" game:amoeba-2-state game:amoeba-2-can-spread
              if {game:amoeba-2-can-spread and {game:random(1000000) < game:amoeba-2-growth-prob}}
                then
                  define dir game:random(4)
                  define nx new-x(x dir)
                  define ny new-y(y dir)
                  ;printf "  dir=%o; can-eat=%o\n" dir
                  if amoeba-can-eat-at?(nx ny)
                    game:spawn-at nx ny etype:O_AMOEBA_2
            (TOO-BIG)
              game:spawn-at x y game:option-ref('amoeba-2-too-big-effect)
            (ENCLOSED)
              game:spawn-at x y game:option-ref('amoeba-2-enclosed-effect)
    explosion-type: (self)
      etype:O_AMOEBA_2_EXPL_1
    play-sound: (self otype)
      #void
    play-walk: (self otype)
      #void
    play-push: (self otype)
      #void
    play-fall: (self otype)
      #void
    else
      basic-game-obj
  ;; object list
  etype:O_AMOEBA_2


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; magic wall
;; the only reason for separate object is to notify the engine that
;; some magic wall was scanned. this is required to play proper sound.
;; of course, it could be done much better, but we're trying to write
;; INefficient code there, that's the whole reason of this project's
;; existance.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
register-game-objects
  method-lambda o-magic-wall
    tick: (self otype x y)
      if game:magic-walls-active?()
        game:magic-wall-scanned()
    explosion-type: (self)
      etype:O_EXPLODE_1
    play-sound: (self otype)
      #void
    play-walk: (self otype)
      #void
    play-push: (self otype)
      #void
    play-fall: (self otype)
      #void
    else
      basic-game-obj
  ;; object list
  etype:O_MAGIC_WALL


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; slime
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
define slime-active?()
  ;printf "slime: pred=%o; pp=%o; pr=%o\n" predictable perm-pred perm-rand
  if game:option-ref('slime-predictable)
    then
      if {not game:slime-pprng-seed-inited}
        game:init-slime-pprng-seed()
      {zero? bit-and(game:pprng-u8() game:option-ref('level-slime-permeability-c64))}
    else
      {game:random(1_000_000) < game:option-ref('level-slime-permeability)}

define slime-process(self x y)
  define otype
  define dtype
  define dy
  cond
    space-at?(x {y + 1})
      {dy := 1}
      {otype := game:field-otype-ref(x {y - 1})}
      define convert game:option-ref('slime-eat-convert)
      cond
        ;; "abs", because converted items are always inactive
        {otype = convert[0]} {dtype := abs(convert[1])}
        {otype = convert[2]} {dtype := abs(convert[3])}
        {otype = convert[4]} {dtype := abs(convert[5])}
        {otype = etype:O_WAITING_STONE} {dtype := etype:O_WAITING_STONE} ; don't awake
        {otype = etype:O_CHASING_STONE} {dtype := etype:O_CHASING_STONE}
        else {dtype := #f}
      ;printf "check-up: otype=%o; cvt=%o : %o : dtype=%o\n" otype vector->list(convert) {otype = convert[2]} dtype
    space-at?(x {y - 1})
      {dy := -1}
      {otype := game:field-otype-ref(x {y + 1})}
      ;printf "check-down: otype=%o\n" otype
      cond
        {otype = etype:O_BLADDER} {dtype := etype:O_BLADDER_1}
        {otype = etype:O_FLYING_STONE} {dtype := etype:O_CHASING_STONE_F}
        {otype = etype:O_FLYING_DIAMOND} {dtype := etype:O_FLYING_DIAMOND_F}
        else {dtype := #f}
    else
      {dtype := #f}
  ;; do it?
  ;printf "check-up: otype=%o; dtype=%o\n" otype dtype
  if {not {false? dtype}}
    then
      game:spawn-at x {y + dy} dtype
      game:spawn-at x {y - dy} etype:O_SPACE
      self[play-sound: otype]


register-game-objects
  method-lambda o-slime
    tick: (self otype x y)
      if slime-active?()
        slime-process(self x y)
    else
      basic-game-obj
  ;; object list
  etype:O_SLIME


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; falling wall
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
register-game-objects
  method-lambda o-falling-wall
    tick: (self otype x y)
      if space-at?(x {y + 1})
        then
          ;; scan
          define ostop etype:O_SPACE
          define end {y + game:field-height}
          define y0 y
          while {{y0 < end} and {{ostop = etype:O_SPACE} or {ostop = etype:O_LAVA}}}
            inc! y0
            {ostop := game:field-otype-ref(x y0)}
          ; if scanning stopped by a player... start falling! in silence.
          ; GDash: glued and bomb, but not hammer? wtf?!
          if entity-objects[ostop][player?:]
            game:spawn-move-at x y x {y + 1} etype:O_FALLING_WALL_F
    else
      basic-game-obj
  ;; object list
  etype:O_FALLING_WALL

register-game-objects
  method-lambda o-falling-wall-f
    tick: (self otype x y)
      cond
        game:field-eobj-ref(x {y + 1})[player?:]
          explode x y etype:O_EXPLODE_1 'GD_S_EXPLOSION
        space-at?(x {y + 1})
          game:move-obj x y x {y + 1}
        else
          self[play-fall: otype]
          game:spawn-at x y etype:O_FALLING_WALL
    else
      basic-game-obj
  ;; object list
  etype:O_FALLING_WALL_F


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; acid
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
define like-otype-at?(x y otype)
  define ft game:field-otype-ref(x y)
  if otype-prop?(ft 'P_DIRT)
    {ft := etype:O_DIRT}
  if otype-prop?(otype 'P_DIRT)
    {otype := etype:O_DIRT}
  if {ft = etype:O_LAVA}
    {ft := etype:O_SPACE}
  {otype = ft}


define acid-spread(self otype x y)
  define try-spread-to(x y eat-this)
    if like-otype-at?(x y eat-this)
      then
        game:spawn-at x y etype:O_ACID
        1
      else
        0
  ;;
  game:spawn-at x y game:option-ref('acid-turns-to)
  define eat-this game:option-ref('acid-eats-this)
  define count 0
  inc! count try-spread-to(x {y - 1} eat-this)
  inc! count try-spread-to(x {y + 1} eat-this)
  inc! count try-spread-to({x - 1} y eat-this)
  inc! count try-spread-to({x + 1} y eat-this)
  if {positive? count}
    self[play-sound: otype]


register-game-objects
  method-lambda o-acid
    tick: (self otype x y)
      ;from the author:
      ;IF random(256) - Acid_Speed < 0 then ACID_SPEAD;
      ;seems to use non-predictable prng.
      if {game:random(1000000) <= game:option-ref('acid-spread-ratio)}
        acid-spread self otype x y
    else
      basic-game-obj
  ;; object list
  etype:O_ACID


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; bladder
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
define bladder-sloped?(x y)
  game:field-prop-at?('P_BLADDER_SLOPED x y)


define sloped?(x y dx dy)
  assert {{{dx = 0} or {dy = 0}} and {{dx <> 0} or {dy <> 0}}} "invalid direction"
  cond
    game:field-prop-at?('P_SLOPED x y) #t
    {negative? dx} game:field-prop-at?('P_SLOPED_LEFT x y)
    {positive? dx} game:field-prop-at?('P_SLOPED_RIGHT x y)
    {negative? dy} game:field-prop-at?('P_SLOPED_DOWN x y)
    {positive? dy} game:field-prop-at?('P_SLOPED_UP x y)


;; `x` and `y` are object coordinates.
;; `dx` and `dy` is direction.
define do-push-bladder(x y dx dy is-snap)
  define ok #f
  cond
    {negative? dy}
      ;; cannot push the bladder up
      {ok := #f}
    ;; push can be diagonal
    {{dx <> 0} and {positive? dy}}
      ;; cannot push the bladder diagonally
      {ok := #f}
    space-at?({x + dx} {y + dy})
      game:spawn-move-at x y {x + dx} {y + dy} etype:O_BLADDER
      {ok := #t}
    {positive? dy}
      cond
        space-at?({x - 1} y)
          game:spawn-move-at x y {x - 1} y etype:O_BLADDER
          {ok := #t}
        space-at?({x + 1} y)
          game:spawn-move-at x y {x + 1} y etype:O_BLADDER
          {ok := #t}
        else
          {ok := #f}
    else
      cond
        space-at?(x {y + 1})
          game:spawn-move-at x y x {y + 1} etype:O_BLADDER
          {ok := #t}
        space-at?(x {y - 1})
          game:spawn-move-at x y x {y - 1} etype:O_BLADDER
          {ok := #t}
        else
          {ok := #f}
  if ok
    play-sound-of-otype etype:O_BLADDER
  ok


register-game-objects
  method-lambda o-bladder-spender
    tick: (self otype x y)
      if space-at?(x {y - 1})
        then
          game:spawn-at x {y - 1} etype:O_BLADDER
          game:spawn-at x y etype:O_PRE_STEEL_1
          self[play-sound: otype]
    else
      basic-game-obj
  ;; object list
  etype:O_BLADDER_SPENDER


register-game-objects
  method-lambda o-bladder
    player-push: (self otype x y dx dy ptype is-snap)
      do-push-bladder x y dx dy is-snap
    tick: (self otype x y)
      game:spawn-at x y etype:O_BLADDER_1
    else
      basic-game-obj
  ;; object list
  etype:O_BLADDER


register-game-objects
  method-lambda o-bladderx
    player-push: (self otype x y dx dy ptype is-snap)
      do-push-bladder x y dx dy is-snap
    tick: (self otype x y)
      define bcb game:option-ref('bladder-converts-by)
      cond
        {like-otype-at?(x {y - 1} bcb) or
         like-otype-at?({x - 1} y bcb) or
         like-otype-at?({x + 1} y bcb)}
          game:spawn-at x y etype:O_PRE_CLOCK_1
          play-sound-with-id 'GD_S_BLADDER_CONVERT
        space-at?(x {y - 1})
          cond
            {otype = etype:O_BLADDER_8}
              game:spawn-move-at x y x {y - 1} etype:O_BLADDER_1
              play-sound-of-otype etype:O_BLADDER_1
            else
              game:spawn-at x y {otype + 1}
        {bladder-sloped?(x {y - 1}) and sloped-for?(x {y - 1} 0 -1)}
          define dx 0
          cond
            {sloped-for?(x {y - 1} -1 0) and
             space-at?({x - 1} y) and space-at?({x - 1} {y - 1})}
              {dx := -1}
            {sloped-for?(x {y - 1} 1 0) and
             space-at?({x + 1} y) and space-at?({x + 1} {y - 1})}
              {dx := 1}
            else
              {dx := 0}
          if {dx <> 0}
            cond
              {otype = etype:O_BLADDER_8}
                game:spawn-move-at x y {x + dx} {y - 1} etype:O_BLADDER_1
                play-sound-of-otype etype:O_BLADDER_1
              else
                game:spawn-at x y {otype + 1}
        else
          game:spawn-at x y etype:O_BLADDER_1
    else
      basic-game-obj
  ;; object list
  etype:O_BLADDER_1
  etype:O_BLADDER_2
  etype:O_BLADDER_3
  etype:O_BLADDER_4
  etype:O_BLADDER_5
  etype:O_BLADDER_6
  etype:O_BLADDER_7
  etype:O_BLADDER_8


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; biter
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
constant biter-try make-vector(#t etype:O_DIRT 'biter-eat etype:O_SPACE etype:O_STONE)

define biter-move(self otype x y)
  ; biters eating elements preference, they try to go in this order
  ;; 0:up, 1:right, 2:down, 3:left
  define new-x(x dir)
    cond
      {dir = 1} {x + 1}
      {dir = 3} {x - 1}
      else x
  ;; 0:up, 1:right, 2:down, 3:left
  define new-y(y dir)
    cond
      {dir = 0} {y - 1}
      {dir = 2} {y + 1}
      else y
  ;; return #t if eaten something
  define biter-try-eat(x y dir otype)
    define nx new-x(x dir)
    define ny new-y(y dir)
    cond
      like-otype-at?(nx ny otype)
        game:spawn-move-at x y nx ny {etype:O_BITER_1 + dir}
        #t
      else
        #f
  ;;
  define eat-otype
  define idx
  define nx
  define ny
  define done
  define xsound #f
  define dir {otype - etype:O_BITER_1} ; direction, last two bits 0..3
  define dirn {{dir + 3} mod 4}
  define dirp {{dir + 1} mod 4}
  iterate
    init
      {idx := 0}
      {done := #f}
    repeat {{not done} and {idx <> vector-length(biter-try)}}
      {eat-otype := biter-try[idx]}
      if {symbol? eat-otype} {eat-otype := game:option-ref(eat-otype)}
      {done := {biter-try-eat(x y dir eat-otype) or
                biter-try-eat(x y dirn eat-otype) or
                biter-try-eat(x y dirp eat-otype)}}
      if done
        if {eat-otype <> etype:O_SPACE} {xsound := #t}
        inc! idx
    else #void
  cond
    done
      ; if there was a stone there, where we moved...
      ; do not eat stones, just throw them back.
      if {eat-otype = etype:O_STONE}
        then
          game:spawn-at x y etype:O_STONE
          play-push-sound-of-otype etype:O_STONE
        if xsound
          play-sound-of-otype etype:O_BITER_1
    else
      ; could not move, so just turn
      game:spawn-at x y {etype:O_BITER_1 + dirp}


register-game-objects
  method-lambda o-biter
    tick: (self otype x y)
      if {game:biters-wait-frame = 0}
        biter-move self otype x y
    else
      basic-game-obj
  ;; object list
  etype:O_BITER_1
  etype:O_BITER_2
  etype:O_BITER_3
  etype:O_BITER_4


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; water
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

register-game-objects
  method-lambda o-water-main
    tick: (self otype x y)
      if {{not game:option-ref('water-does-not-flow-down)} and space-at?(x {y + 1})}
        game:spawn-at x {y + 1} etype:O_WATER1
      if space-at?(x {y - 1})
        game:spawn-at x {y - 1} etype:O_WATER1
      if space-at?({x - 1} y)
        game:spawn-at {x - 1} y etype:O_WATER1
      if space-at?({x + 1} y)
        game:spawn-at {x + 1} y etype:O_WATER1
    else
      basic-game-obj
  ;; object list
  etype:O_WATER

register-game-objects
  method-lambda o-water
    tick: (self otype x y)
      play-sound-of-otype otype
      game:spawn-at x y {otype + 1}
    else
      basic-game-obj
  ;; object list
  etype:O_WATER_1
  etype:O_WATER_2
  etype:O_WATER_3
  etype:O_WATER_4
  etype:O_WATER_5
  etype:O_WATER_6
  etype:O_WATER_7
  etype:O_WATER_8
  etype:O_WATER_9
  etype:O_WATER_10
  etype:O_WATER_11
  etype:O_WATER_12
  etype:O_WATER_13
  etype:O_WATER_14
  etype:O_WATER_15

register-game-objects
  method-lambda o-water-16
    tick: (self otype x y)
      game:spawn-at x y etype:O_WATER
    else
      basic-game-obj
  ;; object list
  etype:O_WATER_16


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; player
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
define common-player-object()
  define tapping?(otype)
    {{otype = etype:O_PLAYER_TAP} or {otype = etype:O_PLAYER_TAP_BLINK}}
  ;;
  define blinking?(otype)
    {{otype = etype:O_PLAYER_BLINK} or {otype = etype:O_PLAYER_TAP_BLINK}}
  ;;
  define idle-obj(otype)
    define tap tapping?(otype)
    define blink {game:random(4) = 0}
    cond
      {zero? game:bombs-collected}
        if {game:random(16) = 0}
          {tap := {not tap}}
        if blink
          if tap etype:O_PLAYER_TAP_BLINK etype:O_PLAYER_BLINK
          if tap etype:O_PLAYER_TAP etype:O_PLAYER
      else
        etype:O_PLAYER_BOMB
  ;;
  define set-player(x y otype ot-plr)
    cond
      {false? ot-plr}
        set-player x y otype idle-obj(otype)
      {otype <> ot-plr}
        game:player-found(x y #t)
        game:spawn-at x y ot-plr
      else
        game:player-found(x y #t)
  ;;
  ;; return #t if moved.
  ;; this is used for diagonal movements.
  define do-move(self otype x y dx dy)
    if {zero? dy} gset!(game:last-dir-left {dx < 0})
    define new-plr
      cond
        game:key-pressed?(game:KEY_LEFT) etype:O_PLAYER_LEFT
        game:key-pressed?(game:KEY_RIGHT) etype:O_PLAYER_RIGHT
        game:last-dir-left etype:O_PLAYER_LEFT
        else etype:O_PLAYER_RIGHT
    define nx {x + dx}
    define ny {y + dy}
    define dest-obj game:field-eobj-ref(nx ny)
    define dest-otype game:field-otype-ref(nx ny)
    define pushed dest-obj[player-push: dest-otype
                                        nx ny dx dy otype
                                        game:key-pressed?(game:KEY_SNAP)]
    define new-obj game:field-eobj-ref(nx ny)
    define new-otype game:field-otype-ref(nx ny)
    define did-something {pushed or {new-otype <> dest-otype}}
    define can-eat {new-otype = etype:O_SPACE}
    cond
      {{not game:key-pressed?(game:KEY_SNAP)} and can-eat}
        game:move-obj x y nx ny
        set-player nx ny otype new-plr
        #t  ;; moved
      {{game:key-pressed?(game:KEY_SNAP)} and {not did-something} and
       {new-otype = etype:O_SPACE}}
        define sel game:option-ref('snap-element)
        if {sel <> etype:O_SPACE}
          game:spawn-at nx ny sel
        set-player x y otype new-plr
        #t  ;; snapped, block multiple snapping
      else
        set-player x y otype new-plr
        ; it is important to block multiple snapping!
        {did-something or game:key-pressed?(game:KEY_SNAP)}
  ;;
  ;; return bool, set game:last-move-hdir if moved
  define try-horiz-move(self otype x y dx dy)
    if {dx <> 0}
      if do-move(self otype x y dx 0)
        gset! game:last-move-hdir #t
        #f
      #f
  ;;
  ;; return bool, set game:last-move-hdir if moved
  define try-vert-move(self otype x y dx dy)
    if {dy <> 0}
      if do-move(self otype x y 0 dy)
        (begin (gset! game:last-move-hdir #f) #t)
        #f
      #f
  ;;
  define dir-keys-pressed?()
    (or game:key-pressed?(game:KEY_LEFT)
        game:key-pressed?(game:KEY_RIGHT)
        game:key-pressed?(game:KEY_UP)
        game:key-pressed?(game:KEY_DOWN))
  ;;
  method-lambda o-player
    player?: (self)
      #t
    tick: (self otype x y)
      if {{game:kill-player or game:player-suicide-request} and {not game:cave-finished}}
        then
          explode-object-at x y
          gset! game:player-suicide-request #f
        else
          define dx 0
          define dy 0
          if game:key-pressed?(game:KEY_LEFT) (dec! dx)
          if game:key-pressed?(game:KEY_RIGHT) (inc! dx)
          if game:key-pressed?(game:KEY_UP) (dec! dy)
          if game:key-pressed?(game:KEY_DOWN) (inc! dy)
          cond
            game:cave-finished
              set-player x y otype (if game:last-dir-left etype:O_PLAYER_LEFT etype:O_PLAYER_RIGHT)
            {{positive? game:bombs-collected} and game:key-pressed?(game:KEY_SNAP) and
             space-at?({x + dx} {y + dy})}
              ;; place bomb
              if game:bomb-is-k8
                then
                  game:spawn-at {x + dx} {y + dy} etype:O_BOMB_K8_TICK_1
                  gset! game:bomb-is-k8 #f
                else
                  game:spawn-at {x + dx} {y + dy} etype:O_BOMB_TICK_1
              gset! game:bombs-collected {game:bombs-collected - 1}
            else
              define moved #f
              if {{dx <> 0} and {dy <> 0} and game:option-ref('diagonal-movements)}
                {moved := do-move(self otype x y dx dy)}
              cond
                {moved}
                  gset! game:last-move-hdir {dx <> 0}
                {true? game:last-move-hdir}
                  ;; prev was horizontal
                  if try-vert-move(self otype x y dx dy)
                    gset! game:last-move-hdir #f
                    if try-horiz-move(self otype x y dx dy)
                      gset! game:last-move-hdir #t
                      gset! game:last-move-hdir #nil
                else
                  ;; prev was standing or vertical
                  if try-horiz-move(self otype x y dx dy)
                    gset! game:last-move-hdir #t
                    if try-vert-move(self otype x y dx dy)
                      gset! game:last-move-hdir #f
                      gset! game:last-move-hdir #nil
              if {{null? game:last-move-hdir} and {not dir-keys-pressed?()}}
                set-player x y otype #f
    else
      basic-game-obj

register-game-objects common-player-object()
  ;; object list
  etype:O_PLAYER
  etype:O_PLAYER_BOMB
  ;etype:O_PLAYER_GLUED
  ;etype:O_PLAYER_STIRRING
  ;etype:O_PLAYER_PNEUMATIC_LEFT
  ;etype:O_PLAYER_PNEUMATIC_RIGHT
  etype:O_PLAYER_LEFT
  etype:O_PLAYER_RIGHT
  etype:O_PLAYER_TAP
  etype:O_PLAYER_BLINK
  etype:O_PLAYER_TAP_BLINK


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; unknown object handler
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
setup-entity-objects
  method-lambda unknown-object
    tick: (self otype x y)
      printf "ERROR! the cave is using undefined object %o!\n"
        otype-name(game:field-otype-ref(x y))
      ;; replace with unknown
      game:spawn-at x y etype:O_QUESTION_MARK
      gset! game:has-bad-objects #t
    else
      basic-game-obj

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; done
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
