// 2011.06.30 # Doj
// Необходимый код для хранения текущего состояния уровня и рендера

include" units\utils\parser.de"

include" utils.de"
include" graph.de"
include" color.de"

// координаты игрока в лабиринте
variable player-x
variable player-y
// предыдущие координаты игрока в лабиринте
variable player-last-x
variable player-last-y
// цвет игрока
variable player-color
// размер ячейки карты в пикселях
variable cell-x
variable cell-y
// смещение верхнего левого угла лабиринта в пикселях
variable offset-x
variable offset-y
// размеры лабиринта в ячейках
variable maze-x
variable maze-y
// глобальные события
variable *done
variable *render
variable *player-draw
variable *after-update ' nop *after-update !
// время старта уровня
variable *level-started : level-started *level-started @ ;
// последнее время, когда игрок сдвинулся
variable *last-step-time
timer *last-step-time !
// промежутки времени, через которые смещаем игрока
// 200 constant MIN_STEP_DELTA
variable *MIN_STEP_DELTA
: MIN_STEP_DELTA *MIN_STEP_DELTA @ ;
// указатель на двумерный массив ячеек лабиринта
variable maze-ptr
: maze[] ( xy-p) maze-x @ * + cells maze-ptr @ + ;
: maze[]@ ( xy-i) maze[] @ ;
: maze[]! ( ixy) maze[] ! ;
// команда, инициализирующая следующий уровень
variable *xt-next-level
variable *next-level?

// кол-во еды на поле
variable *food#
: food# *food# @ ;
: food+ *food# 1+! ;
: food- *food# @ 1- *food# ! ;
: 0food! *food# off ; last execute
// кол-во съеденной еды
variable *ate#
: ate# *ate# @ ;
: ate+ *ate# 1+! ;
: 0ate! *ate# off ; last execute

: table[] ( it-) swap cells + ;
: table[]! ( pit-) table[] ! ;
: table[]@ ( it-p) table[] @ ;

// направление движения
// 0 - вправо, 1 - вниз, 2 - влево, 3 - вверх
variable *dir
// предыдущее направление
variable *last-dir
// последнее направление, указанное клавишей
variable *key-dir

// угол между направлениями, измеряемый в четвертях
: dir-dist ( ii-i) - abs dup 4 swap - min ;

// последняя нажатая клавиша направления
variable *last-arrow
*last-arrow off

// обработчики смещения игрока на каждый из 256 тип клетки
create on-moving-table 256 cells allot
create *draw 256 cells allot
create *leave 256 cells allot
: on-moving[] ( i-p) cells on-moving-table + ;
: on-moving[]@ ( i-x) on-moving[] @ ;
: on-moving[]! ( xi-) on-moving[] ! ;
: on-moving ( xy)
  player-x @ player-last-x !
  player-y @ player-last-y !
  2dup maze[]@ on-moving[]@ execute 
;
// время с последнего смещения игрока
: step-delta timer *last-step-time @ - ;
// функции для смещения игрока
: check-delta step-delta MIN_STEP_DELTA >= 
              dup if timer *last-step-time ! then ;
// линейная комбинация a и b, плавная при смещении игрока
: delta-linear-comb ( ab-c) 
  step-delta MIN_STEP_DELTA min tuck * rrot MIN_STEP_DELTA swap - * +
  MIN_STEP_DELTA div
; 

: x->global cell-x @ * offset-x @ + ;
: y->global cell-y @ * offset-y @ + ;
: size->global cell-x @ * 32 div ;
                         
include" snake.de"

// обработчик, разрешающий смещение
: passed 
  2dup snake-step
  player-y ! player-x ! 
  // 3 random 0= if COLOR BLUE ^ true 16 snake+ then
;

// обработчик, запрещающий смещение
: stopped drop drop snake- *last-dir @ *dir ! ;

: teleport
  2dup snake-teleport
  player-y ! player-x ! 
;

: check-next-level 
  // wp *saved !
  *next-level? @ 
  if *xt-next-level @ execute *next-level? off 
    player-x @ player-y @ COLOR КИНОВАРЬ ^ true 32 snake-init
    200 *MIN_STEP_DELTA !
  then
  // wp *saved @ - . cr
;
*next-level? off

: do-left  ( check-delta if player-x @ 1- player-y @    on-moving then) ;
: do-right ( check-delta if player-x @ 1+ player-y @    on-moving then) ;
: do-down  ( check-delta if player-x @    player-y @ 1+ on-moving then) ;
: do-up    ( check-delta if player-x @    player-y @ 1- on-moving then) ;

// апдейты
: update
  timer *last-step-time @ - MIN_STEP_DELTA >= if
    snake-moving-done
    timer *last-step-time !
    *last-arrow @ switch
      KEY_RIGHT of 0 \of
      KEY_DOWN of 1 \of
      KEY_LEFT of 2 \of
      KEY_UP of 3 \of
      0
    \switch
    *key-dir !

    *dir @ *last-dir !
    *key-dir @ *dir @ dir-dist 1 <= if *key-dir @ *dir ! then

    *dir @ switch 
      0 of player-x @ 1+ player-y @ \of
      1 of player-x @ player-y @ 1+ \of
      2 of player-x @ 1- player-y @ \of
      3 of player-x @ player-y @ 1- \of
      player-x @ player-y @
    \switch
    2dup in-snake? if stopped exit then
    // passed
    on-moving
  then
;

// устанавливаем обработчики, разрешающие смещение
: set-on-moving-passed 256 begin dup while 1- ['] passed over on-moving[]! repeat drop ;
: set-on-moving-default set-on-moving-passed 
  ['] stopped 35 on-moving[]! 
;

// обработчик рендера игрока
: do-player-render ( xy) player-color @ set-color 
                         cell-y @ 4 div + swap
                         cell-x @ 4 div + swap
                         cell-x @ 2 div cell-y @ 2 div draw-recti ( 520 400 32 32 draw-recti) ;
// обработчик рендера каждой ячейки
create on-cell-render-table 256 cells allot
: on-cell-render[] ( i-p) cells on-cell-render-table + ;
: on-cell-render[]@ ( i-x) on-cell-render[] @ ;
: on-cell-render[]! ( xi-) on-cell-render[] ! ;
: on-cell-render ( xy) 2dup maze[]@ on-cell-render[]@ execute ;
: cell-render-nothing drop drop ;
: draw-cell-rect 
                   cell-y @ * offset-y @ + swap
                   cell-x @ * offset-x @ + swap
                   cell-x @ cell-y @ draw-recti ;
: cell-render-rect COLOR ( 1 GEN) 2dup GEN2-PURPLE ^ set-color draw-cell-rect ;
: cell-render-rect-finish COLOR MAZE ^ set-color draw-cell-rect ;
: set-cell-render-default 
  256 begin dup while 1- ['] cell-render-nothing over on-cell-render[]! repeat drop 
  ['] cell-render-rect 35 on-cell-render[]!
  ['] cell-render-rect-finish 70 on-cell-render[]!
  ['] cell-render-rect-finish 71 on-cell-render[]!
;
: do-render-maze
  0 begin dup maze-x @ < while
    0 begin dup maze-y @ < while
      2dup on-cell-render
    1+ repeat drop
  1+ repeat drop
  *after-update @ execute
;

// значения по умолчанию
set-on-moving-default
set-cell-render-default
16 cell-x !
16 cell-y !
0 offset-x !
60 offset-y !

1 player-x !
1 player-y !
COLOR PLAYER ^ player-color !

: teleport1 23 player-x ! 8 player-y ! ;
: teleport2 1 player-x ! 1 player-y ! 100 random COLOR GEN ^ player-color ! ;

:noname set-on-moving-default 
  ['] teleport1 70 on-moving[]!
  ['] teleport2 71 on-moving[]!
; execute
