;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; cave rendering
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

define set-dirt-pattern(x y img-idx)
  cond
    ;{{img-idx = 2} or {img-idx = 3} or
    ; between?(img-idx 280 283) or
    ; ;; titanium walls
    ; {img-idx = 4} or
    ; ;; simple walls
    ; {img-idx = 5}}
    (or between?(img-idx 2 5)  ;; dirts, titanium wall, wall
        between?(img-idx 96 103) ;; water
        between?(img-idx 184 207) ;; magic wall, amoeba, slime
        between?(img-idx 276 288) ;; sloped wall and dirt, titanium parts
        between?(img-idx 312 320) ;; lava
        between?(img-idx 364 368) ;; growing walls
    )
      sdl:set-texture-color-mod game-gfx-tex
        dirt-pattern[{{{y mod game:max-field-height} * game:max-field-width} +
                      {x mod game:max-field-width}}]
    else
      sdl:set-texture-color-mod game-gfx-tex sdl:rgbf(1 1 1)

define sdl-blit-img(x y img-idx)
  define ix bit-shl(bit-and(img-idx 7) 4)
  define iy bit-shl(bit-shr(img-idx 3) 4)
  sdl:blit-texture-rect game-gfx-tex x y 16 16 ix iy 16 16


define sdl-render-cave(tx0 ty0 x0 y0 w h scr-x-ofs scr-w scr-y-ofs scr-h shake shake-delta)
  define fix-x0-width()
    if {tx0 <= -16}
      then
        define shift {{- tx0} div 16}
        inc! tx0 {shift * 16}
        inc! x0 shift
        dec! w shift
    {w := clamp({{scr-w + 32} div 16} 0 w)}
  ;;
  define fix-y0-width()
    if {ty0 <= -16}
      then
        define shift {{- ty0} div 16}
        inc! ty0 {shift * 16}
        inc! y0 shift
        dec! h shift
    {h := clamp({{scr-h + 32} div 16} 0 h)}
  ;;
  define covered?(x y)
    cond
      {null? covered-array}
        #f
      else
        {x := {x mod game:field-width}}
        {y := {y mod game:field-height}}
        {covered-array[{{y * game:field-width} + x}]}
  ;;
  define img-idx
  define x
  define wleft
  define def
  define prop
  define sx0
  ;{shake := #t}
  if shake
    then
      inc! tx0 game:random-range-incl({- shake-delta} shake-delta)
      inc! ty0 game:random-range-incl({- shake-delta} shake-delta)
  fix-x0-width()
  fix-y0-width()
  lgfx:set-clip-rect scr-x-ofs scr-y-ofs scr-w scr-h
  while {{positive? w} and {positive? h}}
    {x := x0}
    {sx0 := tx0}
    {wleft := w}
    while {positive? wleft}
      cond
        covered?(x y0)
          {img-idx := {{16 * 8} + anim-frame}}
        else
          {img-idx := game:field-image-index-ref(x y0)}
          if {negative? img-idx}
            {img-idx := {{- img-idx} + anim-frame}}
      set-dirt-pattern x y0 img-idx
      sdl-blit-img {scr-x-ofs + sx0} {scr-y-ofs + ty0} img-idx
      inc! x
      inc! sx0 16
      dec! wleft
    inc! y0
    inc! ty0 16
    dec! h
  sdl:set-texture-color-mod game-gfx-tex sdl:rgbf(1 1 1)
  lgfx:reset-clip-rect()


define sdl-render-bad-cave-warning()
  constant char-w 32
  constant char-h 32
  ;;
  define print-str(x y str)
    define ch
    define ix
    define iy
    define idx 0
    while {idx <> string-length(str)}
      if between?({ch := {str[idx]}} 0 127)
        then
          {ix := bit-shl(bit-and(ch 15) 3)}
          {iy := bit-shl(bit-shr(ch 4) 3)}
          sdl:blit-texture-rect game-font-tex x y char-w char-h ix iy 8 8
      inc! x char-w
      inc! idx
  ;;
  constant text "UNPLAYABLE"
  define xpos {{window-width - {string-length(text) * char-w}} div 2}
  define ypos {{window-height - char-h} div 2}
  sdl:set-texture-blend-mode game-font-tex 'BLEND
  sdl:set-texture-color-mod game-font-tex sdl:rgb(0 0 0)
  define dx
  define dy
  iterate
    init {dy := -2}
    repeat {dy <> 3}
      iterate
        init {dx := -2}
        repeat {{dx = 0} and {dy = 0}}
          inc! dx
        repeat {dx <> 3}
          print-str({xpos + dx} {ypos + dy} text)
          inc! dx
        else #void
      inc! dy
    else #void
  ;;
  sdl:set-texture-color-mod game-font-tex sdl:rgbf(1 {anim-frame / 8} 0)
  print-str xpos ypos text


define sdl-render-statusbar-ingame(x0 y0)
  define num2str(num width lfillch)
    define str number->string(num)
    while {string-length(str) < width}
      {str := string-append("" lfillch str)}
    str
  ;;
  define skip(char-count)
    inc! x0 {char-count * 8}
  ;;
  define print-char(ch color)
    sdl-print-char x0 y0 ch color
    skip 1
  ;;
  define print-str(str color)
    sdl-print-str x0 y0 str color
    skip string-length(str)
  ;;
  define print-num(num width lfillch color)
    print-str num2str(num width lfillch) color
  ;;
  ;; diamonds required
  cond
    {game:diamond-count < game:diamonds-required}
      cond
        {game:diamonds-required < 100}
          skip 1
          print-num game:diamonds-required 2 #\0 sdl:rgbf(1 1 0)
        else
          print-num game:diamonds-required 3 #\0 sdl:rgbf(1 1 0)
    else
      ;; diamond sign
      print-char 9 sdl:rgbf(0.8 0.8 0.8)
      print-char 9 sdl:rgbf(0.8 0.8 0.8)
      print-char 9 sdl:rgbf(0.8 0.8 0.8)
  ;; diamond sign
  print-char 9 sdl:rgbf(1 1 1)
  ;; diamond price
  print-num game:diamond-price() 3 #\0 sdl:rgbf(0.8 0.8 0.8)
  ;; blank
  skip 2
  ;; diamonds collected
  print-num game:diamond-count 3 #\0 sdl:rgbf(1 1 0)
  ;; blank
  skip 3
  ;; time
  if {zero? game:cave-time}
    print-num game:cave-time 3 #\space sdl:rgbf(1.0 0.2 0.5)
    print-num game:cave-time 3 #\space sdl:rgbf(0.5 0.9 0.5)
  ;; blank
  skip 3
  ;; score
  print-num game:cave-score 6 #\0 sdl:rgbf(0.86 0.86 0.86)
  ;; blank
  skip 3
  ;; cave index
  print-num {game:cave-index + 1} 2 #\space sdl:rgbf(0.7 0.3 0)
  print-char #\: sdl:rgbf(0.7 0.3 0)
  ;; cave name
  print-str game:cave-name sdl:rgbf(1 0.5 0)


define sdl-render-statusbar-pregame(x0 y0)
  define skip(char-count)
    inc! x0 {char-count * 8}
  ;;
  define print-char(ch color)
    sdl-print-char x0 y0 ch color
    skip 1
  ;;
  define print-str(str color)
    sdl-print-str x0 y0 str color
    skip string-length(str)
  ;;
  ;; diamonds to collect
  print-str number->string(game:diamonds-required) sdl:rgbf(1 1 0)
  ;; diamond sign
  print-char 9 sdl:rgbf(0.8 0.8 0.8)
  ;; game name
  print-str bdcff-loader:get-game-title() sdl:rgbf(1 1 1)
  ;; game author
  print-str " by " sdl:rgbf(0.6 0.6 0.6)
  print-str bdcff-loader:get-game-author() sdl:rgbf(0.7 0.7 0.7)
  ;; game date
  if {not empty-string?(bdcff-loader:get-game-date())}
    then
      print-str "  " sdl:rgbf(0.7 0.7 0.7)
      print-str bdcff-loader:get-game-date() sdl:rgbf(1 1 0)
  ;; cave name
  ;print-str "  Cave " sdl:rgbf(0.7 0.3 0)
  skip 2
  print-str number->string({game:cave-index + 1}) sdl:rgbf(0.7 0.3 0)
  print-char #\: sdl:rgbf(0.7 0.3 0)
  print-str game:cave-name sdl:rgbf(1 0.5 0)


define sdl-render-statusbar(x0 y0)
  lgfx:set-clip-rect x0 y0 window-width 8
  lgfx:set-draw-blend-mode 'NONE
  lgfx:set-draw-color sdl:rgb(0 0 0)
  lgfx:fill-rect()
  if {game:player-hatched and {not game-paused}}
    sdl-render-statusbar-ingame x0 y0
    sdl-render-statusbar-pregame x0 y0
  lgfx:reset-clip-rect()
  if game:has-bad-objects
    sdl-render-bad-cave-warning()
