// 2011.07.01 # Doj
// Конструкции для описания уровней

include" lab.de"

namespace LEVEL
  // Doj -- вынести это в rtl dembro?
  : cells-- create cells swap dup , + does> @ + ;
  : t_table-- 256 cells-- ;

  // структура level_s для хранения уровня
  0
    // параметры уровня (см. lab.de)
    t_int -- .player-x
    t_int -- .player-y
    t_int -- .player-color
    t_int -- .cell-x
    t_int -- .cell-y
    t_int -- .offset-x
    t_int -- .offset-y
    t_int -- .maze-x
    t_int -- .maze-y
    t_ptr -- .maze-ptr
    t_ptr -- .next
    // глобальные события уровня
    t_ptr -- .init
    t_ptr -- .done
    t_ptr -- .render
    t_ptr -- .player-draw
    t_ptr -- .after-update
    // события уровня каждой ячейки
    t_table-- .draw
    t_table-- .enter
    t_table-- .leave
    t_table-- .oninit
  struct level_s

  // последний созданный лабиринт -- указатель на структуру level_s
  variable *last-level
  // .next поле текущего уровня
  variable *standart-next
  
  // сделать переданный уровень текущим
  : init-level ( p)
    ." Hello" cr
    dup .player-x @             player-x !
    dup .player-y @             player-y !
    // dup .player-color @         player-color !
    dup .cell-x @               cell-x !
    dup .cell-y @               cell-y !
    dup .offset-x @             offset-x !
    dup .offset-y @             offset-y !
    dup .maze-x @               maze-x !
    dup .maze-y @               maze-y !
    dup .maze-ptr @             maze-ptr !
    dup .next @                 *standart-next !
    // dup .done @                 *done !
    // dup .render @               *render !
    // dup .player-draw @          *player-draw !
    dup .after-update @         *after-update !
    dup .enter on-moving-table 256 cells move
    dup .draw on-cell-render-table 256 cells move
    dup .leave *leave 256 cells move
    dup .init @                 execute
    drop
    timer *level-started !
  ;
  : default-level
    1 *last-level @ .player-x !
    1 *last-level @ .player-y !
    16 *last-level @ .cell-x !
    16 *last-level @ .cell-y !
    0 *last-level @ .offset-x !
    60 *last-level @ .offset-y !
    ['] nop *last-level @ .after-update !
    
    256 begin dup while 1- ['] cell-render-nothing over *last-level @ .draw table[]! repeat drop
    256 begin dup while 1- ['] passed over *last-level @ .enter table[]! repeat drop
    256 begin dup while 1- ['] passed over *last-level @ .leave table[]! repeat drop
    256 begin dup while 1- ['] 2drop over *last-level @ .oninit table[]! repeat drop
    ['] stopped 35 *last-level @ .enter table[]!
    ['] cell-render-rect 35 *last-level @ .draw table[]!
  ;
  : player-x! *last-level @ .player-x ! ;
  : player-y! *last-level @ .player-y ! ;
  : cell-x! *last-level @ .cell-x ! ;
  : cell-y! *last-level @ .cell-y ! ;
  : offset-x! *last-level @ .offset-x ! ;
  : offset-y! *last-level @ .offset-y ! ;
  
  variable *next-level
  : init-next-level ." init-next-level"cr *next-level @ ." value:" dup . cr  init-level ." after init-level"cr ;
  // Перейти к следующему уровню
  ' init-next-level ." init-next-level = " dup . cr *xt-next-level !
  : next ( p) dup . cr *next-level ! *next-level? on ;

  // Конструкция для создания уровня
  //   level name
  // В дальнейшем при вызове name текущим уровнем будет становится этот
  : level create here *last-level ! level_s allot default-level ;

  variable last-lab-ptr
  : last-lab-x last-lab-ptr @ @ ;
  : last-lab-y last-lab-ptr @ cell+ @ ;
  : last-lab-y+ last-lab-ptr @ cell+ 1+! ;
  : last-lab-maze last-lab-ptr @ 2 cells + ;
  : last-lab[]! ( xyc) last-lab-x * + cells last-lab-maze + ! ;
  : last-lab-last-line last-lab-ptr @ 2 cells + last-lab-y 1- last-lab-x * cells + ;
  : lab here last-lab-ptr ! 
    source-next-line-passive ( parse-space-trim) str# bdrop , 0 ,
    begin source-next-line ( parse-space-trim) " \lab" str^ bdrop 0 <> while
      last-lab-x cells allot last-lab-y+
      last-lab-last-line 0 begin dup last-lab-x < while
        dup str[]@ lrot tuck ! cell+ swap
        dup dup str[]@ last-lab-y 1- swap *last-level @ .oninit table[]@ execute
      1+ repeat
    bdrop repeat bdrop
  ;


  : maze! last-lab-x *last-level @ .maze-x !
          last-lab-y *last-level @ .maze-y ! 
          last-lab-maze *last-level @ .maze-ptr ! 
  ;

  // Для удобства описания событий уровня
  // Пример:
  //   :n .... ;init
  // Установит действия .... когда уровень инициализируется
  : ;init postpone ; *last-level @ .init ! ; immediate
  : ;done postpone ; *last-level @ .done ! ; immediate
  : ;render postpone ; *last-level @ .render ! ; immediate
  : ;player-draw postpone ; *last-level @ .player-draw ! ; immediate
  : ;after-update postpone ; *last-level @ .after-update ! ; immediate

  : draw_ char *last-level @ .draw table[]! ;
  : enter_ char *last-level @ .enter table[]! ;
  : leave_ char *last-level @ .leave table[]! ;
  : oninit_ char *last-level @ .oninit table[]! ;
  
  // Для удобства описания событий ячеек уровня
  // Пример:
  //   :n .... ;ender_ ?
  // Установит действия .... когда игрок вступает на клетку ?
  : ;draw_ postpone ; draw_ ; immediate
  : ;enter_ postpone ; enter_ ; immediate
  : ;leave_ postpone ; leave_ ; immediate
  : ;oninit_ postpone ; oninit_ ; immediate

  : centrize 
    800 *last-level @ .maze-x @ *last-level @ .cell-x @ * - *last-level @ .cell-x @ 2 div - 2 div offset-x! 
    600 *last-level @ .maze-y @ *last-level @ .cell-y @ * - 2 div offset-y! 
  ;
  : draw-cell-rect 
                     cell-y @ * offset-y @ + swap
                     cell-x @ * offset-x @ + swap
                     cell-x @ cell-y @ draw-recti ;
  : x->global cell-x @ * offset-x @ + ;
  : y->global cell-y @ * offset-y @ + ;
  // нарисовать квадрат в ячейке xy размером s
  variable temp : temp! temp ! ; : temp@ temp @ ;
  : temp@/2 temp@ 2 div ;
  : draw-sized-cell ( xys) temp!
      y->global cell-y @ 2 div + temp@/2 - swap
      x->global cell-x @ 2 div + temp@/2 - swap
      temp@ dup draw-recti ;
  ;
  : draw-sized-rect ( xys) temp!
      cell-y @ 2 div + temp@/2 - swap
      cell-x @ 2 div + temp@/2 - swap
      temp@ dup draw-recti ;
  ;
  : draw-finish-rect
     COLOR
       0 BROWNS GEN[] set-color 2dup cell-x @ cell-y @ min 3 * 3 div draw-sized-rect
       1 BROWNS GEN[] set-color 2dup cell-x @ cell-y @ min 2 * 3 div draw-sized-rect
       2 BROWNS GEN[] set-color 2dup cell-x @ cell-y @ min 1 * 3 div draw-sized-rect
       2drop
     ^
  ;
  : draw-finish-cell ( xy) 
     COLOR
       0 BROWNS GEN[] set-color 2dup cell-x @ cell-y @ min 3 * 3 div draw-sized-cell
       1 BROWNS GEN[] set-color 2dup cell-x @ cell-y @ min 2 * 3 div draw-sized-cell
       2 BROWNS GEN[] set-color 2dup cell-x @ cell-y @ min 1 * 3 div draw-sized-cell
       2drop
     ^
  ;
  : draw-finish draw-finish-cell ;
\namespace
