;; extra map codes, assoc list: (char . element)
;(add-option default-cave-options 'map #nil)
;; prerendered map
;(add-option default-cave-options 'map-legend #nil)
;; object list
;(add-option default-cave-options 'cave-objects #nil)

;;TODO: most options can be set as game defaults.
;;      this is not currently supported, and i believe that
;;      there are not a lot of BDCFF files utilising this feature.
;;      i might add it later, though.
;(printf "compiling BDCFF parser...\n")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; BDCFF loader
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(begin-module 'bdcff-loader)
(module-export '(
  reset
  load-file
  load-string
  ;;
  set-warning-callback
  warning
  ;;
  get-bdcff-version  ;; string
  get-game-title
  get-game-date
  get-game-author
  get-game-lives-init
  get-game-lives-max
  get-game-description
  get-game-remark
  get-game-story
  get-game-difficulty
  get-game-levels
  get-game-cave-count
  get-cave-options
  ;;
  get-error-line-number
  get-error-message
  get-error-line-text
  ;;
  set-print-warnings
  print-warnings?
  ;;
  game-author-set!
  game-title-set!
  game-date-set!
  game-description-set!
  game-story-set!
  game-remark-set!
))
(import '(
  ::edef
  ::etype
))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; simple text file parser
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(begin-module 'parser)
(module-export '(
  load-file
  load-string
  reset
  eot?
  skip-line
  get-key
  get-single-string-value
  get-token
  get-map-line
  ;;
  trim-left
  trim-right
  trim-all
  ;;
  error
  assert
  warning
  ;;
  file-name
  error-line-number
  error-message
  get-error-line-text
  set-error-line-text
))
(module-export-r/w '(
  print-warnings
  warning-callback
))


define trim-left(str)
  define len string-length(str)
  define pos 0
  while {{pos <> len} and {str[pos] <= 32}}
    inc! pos
  if {pos <> len}
    substring(str pos)
    ""

define trim-right(str)
  define len string-length(str)
  while {{positive? len} and {str[{len - 1}] <= 32}}
    dec! len
  if {positive? len}
    substring(str 0 len)
    ""

define trim-all(str)
  trim-right(trim-left(str))


(define file-name #nil)
(define text #nil)
(define line-start-text #nil)
(define line 0)
(define error-line-number 0)
(define error-message "")

(define print-warnings #t)
(define warning-callback #nil)


;; public
define error(msg)
  gset! error-line-number line
  gset! error-message msg
  ;printf "::::::::::::::::::::: %o\n" msg
  ::error string-append("ERROR in file \"" file-name "\" at line "
                        number->string(line) ": " msg)

define warning(msg)
  cond
    {procedure? warning-callback}
      warning-callback msg line get-error-line-text()
    print-warnings
      printf "WARNING in file \"%s\" at line %d: %s\n" file-name line msg
    else #void

;; public
define assert(cc msg)
  ;if {false? cc} printf("$$$$$$$$$$$$$$$$$ %o\n" msg)
  if {false? cc} error(msg)
  #t


;; public
define load-file(fname)
  ;; "Boulder_Rush_cave_pack/Uwe_Drichel.bd" is ~512 kb, wow!
  gset! text load-file-to-string(fname {1024 * 1024})
  gset! line-start-text text
  gset! line 1
  gset! file-name fname

define load-string(fname str)
  assert {string? str} "cannot load from non-string"
  gset! text str
  gset! line-start-text text
  gset! line 1
  gset! file-name fname


;; public
define reset()
  gset! file-name #nil
  gset! text #nil
  gset! line-start-text #nil
  gset! line 0


define eot?()
  empty-string?(text)

define skip-char()
  if {not eot?()}
    gset! text substring(text 1)

define peek-char()
  if eot?() -1 {text[0]}

define peek-next-char()
  if {string-length(text) > 1} {text[1]} -1

define get-char()
  define ch
  if eot?()
    -1
    else
      {ch := text[0]}
      gset! text substring(text 1)
      ch


;; public
define skip-line()
  define ch peek-char()
  while {{positive? ch} and {ch <> 10} and {ch <> 13}}
    skip-char()
    {ch := peek-char()}
  gset! line {line + 1}
  cond
    {ch = 13}
      skip-char()
      if {peek-char() = 10} skip-char()
      gset! line-start-text text
    {ch = 10}
      skip-char()
      gset! line-start-text text
    else
      gset! line-start-text ""
      #t

define blank?(ch)
  {{ch = 9} or {ch = 32}}

define blank-or-eol?(ch)
  {{ch = 9} or {ch = 32} or {ch = 13} or {ch = 10}}

define eol?(ch)
  {{ch = 13} or {ch = 10}}


define get-error-line-text()
  cond
    {string? line-start-text}
      define idx 0
      while {{idx <> string-length(line-start-text)} and {not eol?(line-start-text[idx])}}
        inc! idx
      substring line-start-text 0 idx
    else
      ""

define set-error-line-text(str)
  gset! line-start-text str


define skip-comment()
  define ch peek-char()
  while {{positive? ch} and {ch <> 10} and {ch <> 13}}
    skip-char()
    {ch := peek-char()}
  cond
    {ch = 13}
      if {peek-next-char() = 10} skip-char()
    else
      #t

define skip-blanks()
  define ch peek-char()
  cond
    blank?(ch)
      skip-char()
      skip-blanks()
    {ch = #\;}
      skip-comment()
      10
    {ch = 13}
      if {peek-next-char() = 10} skip-char()
      10
    {ch = 10}
      10
    else
      ch


define ep-skip-blanks(epos)
  while {{epos <> string-length(text)} and blank?({text[epos]})}
    inc! epos
  epos

define ep-fix-eol(epos)
  if {{{epos + 1} < string-length(text)} and {text[epos] = 13} and {text[{epos + 1}] = 10}}
    {epos + 1}
    epos

define ep-parse(fin-proc)
  define epos 0
  while {{epos <> string-length(text)} and {not eol?(text[epos])} and
         {not fin-proc({text[epos]})}}
    inc! epos
  epos


;; public
define get-key()
  define ch skip-blanks()
  cond
    {negative? ch} #nil
    {ch = 10} ""
    {ch = 13}
      if {peek-next-char() = 10} skip-char()
      ""
    else
      define epos (ep-parse (lambda (ch) {{ch = #\=} or blank?(ch)}))
      define res substring(text 0 epos)
      {epos := ep-skip-blanks(epos)}
      if {{epos <> string-length(text)} and {text[epos] = #\=}}
        {epos := ep-skip-blanks({epos + 1})}
      {epos := ep-fix-eol(epos)}
      gset! text substring(text epos)
      res


;; public
define get-single-string-value()
  define ch peek-char()
  cond
    {negative? ch} ""
    {ch = 10} ""
    {ch = 13}
      if {peek-next-char() = 10} skip-char()
      ""
    blank?(ch)
      skip-char()
      get-single-string-value()
    else
      define epos (ep-parse (lambda (ch) #f))
      define res substring(text 0 epos)
      {epos := ep-fix-eol(epos)}
      gset! text substring(text epos)
      res


;; public
;; blank-delimited
define get-token()
  define ch peek-char()
  cond
    {negative? ch} ""
    {ch = 10} ""
    {ch = 13}
      if {peek-next-char() = 10} skip-char()
      ""
    blank?(ch)
      skip-char()
      get-token()
    else
      define epos (ep-parse (lambda (ch) blank?(ch)))
      define res substring(text 0 epos)
      {epos := ep-skip-blanks(epos)}
      {epos := ep-fix-eol(epos)}
      gset! text substring(text epos)
      res


;; public
define get-map-line()
  define ch peek-char()
  cond
    {negative? ch} #nil
    {ch = 10} ""
    {ch = 13}
      if {peek-next-char() = 10} skip-char()
      ""
    else
      define epos (ep-parse (lambda (ch) #f))
      define res substring(text 0 epos)
      {epos := ep-fix-eol(epos)}
      gset! text substring(text epos)
      res

(end-module 'parser)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; main BDCFF parser
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define bdcff-version "")
(define game-title "Untitled Game")
(define game-date "")
(define game-author "Unknown Author")
(define game-description "")
(define game-remark "")
(define game-story "")
(define game-difficulty "")
(define game-levels 1)
(define game-lives-init 3)
(define game-lives-max 9)
(define game-map-legend #nil) ;; copied to each cave
;; item: dictionary with option value override.
;; unchanged/not specified options are not stored.
(define game-caves make-vector())

;; required for ratios, cached here for speed
(define cave-width 40)
(define cave-height 22)

;; default cave size
(define global-cave-width 40)
(define global-cave-height 22)

(define (get-bdcff-version) bdcff-version)
(define (get-game-title) game-title)
(define (get-game-date) game-date)
(define (get-game-author) game-author)
(define (get-game-levels) game-levels)
(define (get-game-cave-count) (vector-length game-caves))
(define (get-game-description) game-description)
(define (get-game-remark) game-remark)
(define (get-game-story) game-story)
(define (get-game-lives-init) game-lives-init)
(define (get-game-lives-max) game-lives-max)
(define (get-game-difficulty) game-difficulty)
(define (get-cave-options idx) (vector-ref game-caves idx))

(define (get-error-line-number) parser:error-line-number)
(define (get-error-message) parser:error-message)
(define (get-error-line-text) (parser:get-error-line-text))

(define (game-author-set! value) (gset! game-author value))
(define (game-title-set! value) (gset! game-title value))
(define (game-date-set! value) (gset! game-date value))
(define (game-description-set! value) (gset! game-description value))
(define (game-story-set! value) (gset! game-story value))
(define (game-remark-set! value) (gset! game-remark value))


(define (set-print-warnings val)
  (assert boolean?(val))
  (gset! parser:print-warnings val))

(define (print-warnings?) parser:print-warnings)

define reset()
  gset! bdcff-version ""
  gset! game-title "Untitled Game"
  gset! game-date ""
  gset! game-author "Unknown Author"
  gset! game-description ""
  gset! game-remark ""
  gset! game-story ""
  gset! game-difficulty ""
  gset! game-levels 1
  gset! game-map-legend #nil
  gset! game-caves make-vector()
  gset! game-lives-init 3
  gset! game-lives-max 9
  gset! global-cave-width 40
  gset! global-cave-height 22


;; => (key default-value . props)
define find-bdcc-option(name)
  define nn
  if {false? {nn := ::dict:find-ci(bdcff-option-map name)}}
    parser:error string-append("invalid cave section key: " name)
  define props option-props-ref(default-cave-options nn)
  define fx lax-cdr(assq(effect: props))
  parser:assert {not {true? fx}} string-append("cave key is an effect: " name)
  cons
    nn
    cons option-ref(default-cave-options nn) props


define find-bdcc-effect(name)
  define nn
  if {false? {nn := ::dict:find-ci(bdcff-option-map name)}}
    parser:error string-append("invalid cave effect key: " name)
  define props option-props-ref(default-cave-options nn)
  define fx lax-cdr(assq(effect: props))
  parser:assert {true? fx} string-append("cave effect key is not an effect: " name)
  cons
    nn
    cons option-ref(default-cave-options nn) props


define find-entity-by-name(name)
  define nn
  if {false? {nn := ::dict:find-ci(bdcff-entity-map name)}}
    parser:error string-append("unknown BDCFF entity: " name)
    nn


define new-cave()
  parser:assert {vector-length(game-caves) < 999} "too many caves"
  define cc new-options-list()
  vector-push! game-caves cc
  gset! global-cave-width 40
  gset! global-cave-height 22
  gset! cave-width global-cave-width
  gset! cave-height global-cave-height
  ;; currently here. deal with overrides later.
  add-option cc 'map-legend game-map-legend

define current-cave()
  {game-caves[{vector-length(game-caves) - 1}]}

define add-cave-option(name value)
  define cc current-cave()
  cond
    {{name eq? 'map} or {name eq? 'map-legend} or {name eq? 'cave-objects}}
      add-option cc name value
    ;{not has-option?(default-cave-options name)}
    ;  add-option cc name value
    {not {option-ref(default-cave-options name) equal? value}}
      add-option cc name value
    else
      ;printf "SKIPPED option \"%o\" with default value\n" name
      #void

define finish-cave()
  define cc current-cave()
  if {not has-option?(cc 'author)}
    add-cave-option 'author game-author
  if {not has-option?(cc 'date)}
    add-cave-option 'date game-date
  if {not has-option?(cc 'description)}
    add-cave-option 'description game-description


define set-cave-diamond-value(value1 value2)
  if {null? value2} {value2 := value1}
  add-cave-option 'diamond-value make-vector(5 value1)
  add-cave-option 'extra-diamond-value make-vector(5 value2)

define set-cave-map(value)
  add-cave-option 'map value

define add-cave-object(obj)
  define cc #nil
  if has-option?(current-cave() 'objects)
    {cc := option-ref(current-cave() 'objects)}
    {cc := make-vector()}
  vector-push! cc obj


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; parsing helpers
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

define single-string-value()
  define res parser:trim-all(parser:get-single-string-value())
  parser:skip-line()
  res

define single-int-value(vmin vmax)
  define res parser:trim-all(parser:get-single-string-value())
  define num string->number(res)
  parser:assert {fixnum? num} string-append("invalid numeric value: " res)
  parser:assert between?(num vmin vmax) string-append("numeric value out of range: " res)
  parser:skip-line()
  num


define one-string-value
  case-lambda
    ()
      one-string-value #void
    (missing-msg)
      define res parser:trim-all(parser:get-token())
      cond
        {{null? res} or empty-string?(res)}
          parser:assert {void-object? missing-msg} missing-msg
          #nil
        else
          res

define one-bool-value
  case-lambda
    ()
      one-bool-value #void
    (missing-msg)
      define res parser:trim-all(parser:get-token())
      cond
        {{null? res} or empty-string?(res)}
          parser:assert {void-object? missing-msg} missing-msg
          #nil
        string-ci=?(res "true")
          #t
        string-ci=?(res "false")
          #f
        else
          parser:error string-append("invalid boolean value: " res)

define one-int-value
  case-lambda
    (vmin vmax)
      one-int-value vmin vmax #void
    (vmin vmax missing-msg)
      define res parser:trim-all(parser:get-token())
      cond
        {{null? res} or empty-string?(res)}
          parser:assert {void-object? missing-msg} missing-msg
          #nil
        else
          define num string->number(res)
          parser:assert {fixnum? num} string-append("invalid numeric value: " res)
          parser:assert between?(num vmin vmax) string-append("numeric value out of range: " res)
          num

define one-float-value
  case-lambda
    (vmin vmax)
      one-float-value vmin vmax #void
    (vmin vmax missing-msg)
      define res parser:trim-all(parser:get-token())
      cond
        {{null? res} or empty-string?(res)}
          parser:assert {void-object? missing-msg} missing-msg
          #nil
        else
          define num string->number(res)
          parser:assert {number? num} string-append("invalid numeric value: " res)
          parser:assert between?(num vmin vmax) string-append("numeric value out of range: " res)
          num

define one-prob-value
  case-lambda
    ()
      one-prob-value #void
    (missing-msg)
      define res parser:trim-all(parser:get-token())
      cond
        {{null? res} or empty-string?(res)}
          parser:assert {void-object? missing-msg} missing-msg
          #nil
        else
          define num string->number(res)
          parser:assert {number? num} string-append("invalid probability value: " res)
          parser:assert between?(num 0 1) string-append("probability value out of range: " res)
          trunc({{num * 1_000_000} + 0.5})

define one-ratio-value
  case-lambda
    ()
      one-ratio-value #void
    (missing-msg)
      define rr {cave-width * cave-height}
      define res parser:trim-all(parser:get-token())
      cond
        {{null? res} or empty-string?(res)}
          parser:assert {void-object? missing-msg} missing-msg
          #nil
        else
          define num string->number(res)
          parser:assert {number? num} string-append("invalid ratio value: " res)
          parser:assert between?(num 0 1) string-append("ratio value out of range: " res)
          trunc({{num * rr} + 0.5})

define one-ratio-value-no-checks
  case-lambda
    ()
      one-ratio-value-no-checks #void
    (missing-msg)
      define res parser:trim-all(parser:get-token())
      cond
        {{null? res} or empty-string?(res)}
          parser:assert {void-object? missing-msg} missing-msg
          #nil
        else
          define num string->number(res)
          parser:assert {number? num} string-append("invalid ratio value: " res)
          parser:assert between?(num 0 10000) string-append("ratio value out of range: " res)
          num


define one-element-value
  case-lambda
    ()
      one-element-value #void
    (missing-msg)
      define res parser:trim-all(parser:get-token())
      cond
        {{null? res} or empty-string?(res)}
          parser:assert {void-object? missing-msg} missing-msg
          #nil
        else
          find-entity-by-name res


define diamond-price-values()
  define n0 one-int-value(0 1000 "at least one numeric value expected")
  define n1 one-int-value(0 1000)
  if {null? n1} {n1 := n0}
  parser:skip-line()
  set-cave-diamond-value n0 n1


define parse-cave-size-property()
  define w one-int-value(2 128 "missing cave width")
  define h one-int-value(2 128 "missing cave height")
  ;;
  define good-viewport?(x0 y0 x1 y1)
    cond
      {{negative? x0} or {negative? y0} or
       {negative? x1} or {negative? y1}}
        #f
      {{x0 > x1} or {y0 > y1}}
        #f
      {{not between?(x0 0 {w - 1})} or {not between?(y0 0 {h - 1})} or
       {not between?(x1 0 {w - 1})} or {not between?(y1 0 {h - 1})}}
        #f
      {{{x1 - x0} < 4} or {{y1 - y0} < 4}}
        #f
      else
        #t
  ;;
  gset! cave-width w
  gset! cave-height h
  add-cave-option 'width w
  add-cave-option 'height h
  ;; viewport
  define vp-x0 one-int-value(0 {w - 1})
  cond
    {null? vp-x0}
      add-cave-option 'viewport-x 0
      add-cave-option 'viewport-y 0
      add-cave-option 'viewport-w w
      add-cave-option 'viewport-h h
      ;printf "Size=%o %o\n" w h
    else
      define vp-y0 one-int-value(0 128 "invalid viewport y0")
      define vp-x1 one-int-value(0 128 "invalid viewport x1")
      define vp-y1 one-int-value(0 128 "invalid viewport y1")
      if {not good-viewport?(vp-x0 vp-y0 vp-x1 vp-y1)}
        then
          parser:warning "invalid viewport dimensions"
          {vp-x0 := 0}
          {vp-y0 := 0}
          {vp-x1 := {w - 1}}
          {vp-y1 := {h - h}}
      add-cave-option 'viewport-x vp-x0
      add-cave-option 'viewport-y vp-y0
      add-cave-option 'viewport-w {vp-x1 - vp-x0 - -1}
      add-cave-option 'viewport-h {vp-y1 - vp-y0 - -1}
      ;printf "Size=%o %o  %o %o %o %o\n" w h vp-x0 vp-y0 vp-x1 vp-y1
  parser:skip-line()


define parse-global-cave-size-property()
  define w one-int-value(2 128 "missing cave width")
  define h one-int-value(2 128 "missing cave height")
  gset! global-cave-width w
  gset! global-cave-height h
  parser:skip-line()


;; Effect=effect-name effect-value
define parse-effect-property()
  define fx-name parser:trim-all(parser:get-token())
  parser:assert {string? fx-name} "effect name expected"
  ;printf "Effect name: %o\n" fx-name
  define kvp
  cond
    ;; sigh...
    string-ci=?(fx-name "HEXPANDING_WALL")
      {fx-name := parser:trim-all(parser:get-token())}
      parser:assert {{string? fx-name} and string-ci=?(fx-name "STEEL_HEXPANDING_WALL")}
        "bad \"HEXPANDING_WALL\" effect"
      {kvp := find-bdcc-effect("EXPANDINGWALLLOOKSLIKEeffect")}
    else
      {kvp := find-bdcc-effect(fx-name)}
  parse-cave-property fx-name kvp
  parser:skip-line()

define parse-random-fill()
  define vp
  define vel
  define el make-vector(4 etype:O_DIRT)
  define prob make-vector(4 0)
  define idx 0
  iterate
    repeat {idx <> 4}
      {vel := one-element-value("missing RandomFill element")}
      {vp := one-int-value(0 255 "missing RandomFill prob")}
      {el[idx] := vel}
      {prob[idx] := vp}
      inc! idx
    else #void
  define res parser:get-token()
  parser:assert {empty-string? res} "too many arguments to RandomFill"
  add-cave-option 'gen-random-fill el
  add-cave-option 'gen-random-prob prob
  parser:skip-line()


define parse-global-lives()
  define init one-int-value(1 99 "missing initial lives")
  define max one-int-value(1 99)
  if {null? max} {max := 9}
  gset! game-lives-init init
  gset! game-lives-max max
  parser:skip-line()


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; main BDCFF keys
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(constant game-fields `(
  ("Name" ,(lambda () (gset! game-title (single-string-value))))
  ("Date" ,(lambda () (gset! game-date (single-string-value))))
  ("Author" ,(lambda () (gset! game-author (single-string-value))))
  ("Difficulty" ,(lambda () (gset! game-difficulty (single-string-value))))
  ("Description" ,(lambda () (gset! game-description (single-string-value))))
  ("Story" ,(lambda () (gset! game-story (single-string-value))))
  ("Remark" ,(lambda () (gset! game-remark (single-string-value))))
  ("Levels" ,(lambda () (gset! game-levels (single-int-value 1 5))))
  ("CaveSize" ,parse-global-cave-size-property)
  ("Lives" ,parse-global-lives)
  ("Charset")
  ("Fontset")
  ("Caves") ;; number of caves; we will count them instead
  ("WWW")
  ("TitleScreen")
  ("TitleScreenScroll")
  ("TitleScreenDirection")
))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; special cave fields
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(constant cave-fields `(
  ("DiamondValue" ,(lambda () (diamond-price-values)))
  ("Size" ,parse-cave-size-property)
  ("Colors")
  ("RandomFill" ,parse-random-fill)
  ("CaveScheduling")
  ("CaveDelay")
  ("Charset")
  ("Fontset")
  ("Effect" ,parse-effect-property)
  ("MagicWallProperties" ,(lambda ()  ; diamonds stones
      (define eld one-element-value("element expected"))
      (define els one-element-value())
      if {null? els} {els := etype:O_DIAMOND_F}
      (add-cave-option 'magic-diamond-to eld)
      (add-cave-option 'magic-stone-to els)
      (parser:skip-line)
    ))
  ("AmoebaGrowthProb" ,(lambda ()  ; normal fast
      (define pnorm one-prob-value("probability expected"))
      (define pfast one-prob-value())
      if {null? pfast} {pfast := pnorm}
      (add-cave-option 'amoeba-growth-prob pnorm)
      (add-cave-option 'amoeba-fast-growth-prob pfast)
      (parser:skip-line)
    ))
  ("Amoeba2GrowthProb" ,(lambda ()  ; normal fast
      (define pnorm one-prob-value("probability expected"))
      (define pfast one-prob-value())
      if {null? pfast} {pfast := pnorm}
      (add-cave-option 'amoeba-2-growth-prob pnorm)
      (add-cave-option 'amoeba-2-fast-growth-prob pfast)
      (parser:skip-line)
    ))
  ("SlimeProperties" ,(lambda () ;3 pairs
      (define pp make-vector(6))
      (define idx 0)
      (define el)
      (while {idx <> 6}
        slime-eat-convert
        {el := one-element-value("element expected")}
        {pp[idx] := el}
        (inc! idx))
      (add-cave-option 'slime-eat-convert pp)
      (parser:skip-line)
    ))
  ("AcidProperties" ,(lambda () ;eat-element spread-ratio
      (define el one-element-value("element expected"))
      (define rt one-prob-value("ratio expected"))
      (add-cave-option 'acid-eats-this el)
      (add-cave-option 'acid-spread-ratio rt)
      (parser:skip-line)
    ))
  ("BiterProperties" ,(lambda () ;delay eat-element
      (define dl one-int-value(0 3 "delay expected"))
      (define el one-element-value("element expected"))
      (add-cave-option 'biter-delay-frame dl)
      (add-cave-option 'biter-eat el)
      (parser:skip-line)
    ))
  ("PushingBoulderProb" ,(lambda () ;normal sweet
      (define nn one-prob-value("probability expected"))
      (define sw one-prob-value())
      (if {null? sw} {sw := nn})
      (add-cave-option 'pushing-stone-prob nn)
      (add-cave-option 'pushing-stone-prob-sweet sw)
      (parser:skip-line)
    ))
  ("Gravitation" ,(lambda ()
      (define vv (single-string-value))
      (if {string? vv}
        (if {not string-ci=?(vv "Down")}
          (parser:warning (string-append "\"Gravitation\" property \"" vv "\" is not supported!"))))
    ))
))


define find-field-handler(name fields)
  while {{pair? fields} and {not string-ci=?(caar(fields) name)}}
    {fields := cdr(fields)}
  if {pair? fields}
    lax-cadar(fields)
    #f


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; section helpers
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

define section-name?(str)
  {{string-length(str) >= 3} and
   {str[0] = #\[} and {str[{string-length(str) - 1}] = #\]}}

define next-section()
  define key parser:get-key()
  cond
    {null? key}
      parser:error "invalid BDCFF file (unexpected eof)"
    empty-string?(key)
      parser:skip-line()
      next-section()
    section-name?(key)
      key
    else
      parser:error "invalid BDCFF file (unexpected non-section)"


define expect-section(sname)
  define key next-section()
  parser:assert string-ci=?(key sname) string-append("invalid BDCFF file; no section: " sname)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; "[map]" section parser
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

define parse-map-section(lines)
  define key parser:get-map-line()
  cond
    {null? key}
      parser:error "invalid BDCFF file (unexpected eof)"
    empty-string?(key)
      parser:skip-line()
      parse-map-section(lines)
    string-ci=?(parser:trim-all(key) "[/map]")
      parser:skip-line()
      parser:assert {not {null? lines}} "empty \"[map]\" section"
      set-cave-map reverse!(lines)
    section-name?(key)
      parser:error string-append("unexpected section: " key)
    else
      if {not {null? lines}}
        parser:assert {string-length(key) = string-length(car(lines))} "invalid map line"
      parse-map-section(cons(key lines))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; "[objects]" section code
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

define-macro swap-vars(nspace env _ v0 v1 vtmp)
  `(begin
     {,vtmp := ,v0}
     {,v0 := ,v1}
     {,v1 := ,vtmp})


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; cave object: Point
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

define one-int-value-warn(vmin vmax msg)
  define val one-int-value(-1024 1024 msg)
  if {not between?(val vmin vmax)}
    parser:warning string-append("out of range value: " number->string(val))
  val

define cobj-point-reader()
  define x one-int-value-warn(0 127 "missing point x")
  define y one-int-value-warn(0 127 "missing point y")
  define otype one-element-value("point element expected")
  parser:skip-line()
  ;; return renderer
  define cobj-point-renderer(spawn-at read-at level cave-w cave-h wrap-x wrap-y)
    spawn-at x y otype


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; cave object: Line
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

define cobj-line-reader()
  define x1 one-int-value-warn(0 127 "missing line x1")
  define y1 one-int-value-warn(0 127 "missing line y1")
  define x2 one-int-value-warn(0 127 "missing line x2")
  define y2 one-int-value-warn(0 127 "missing line y2")
  define otype one-element-value("line element expected")
  parser:skip-line()
  ;; return renderer
  define cobj-line-renderer(spawn-at read-at level cave-w cave-h wrap-x wrap-y)
    ;; this is what GDash does: standard Bresenham
    define tmp
    define xx1 x1
    define yy1 y1
    define xx2 x2
    define yy2 y2
    define steep {abs({yy2 - yy1}) > abs({xx2 - xx1})}
    if steep
      then
        swap-vars xx1 yy1 tmp
        swap-vars xx2 yy2 tmp
    if {xx1 > xx2}
      then
        swap-vars xx1 xx2 tmp
        swap-vars yy1 yy2 tmp
    define dx {xx2 - xx1}
    define dy abs({yy2 - yy1})
    define error 0
    define ystep (if {yy1 < yy2} 1 -1)
    define y yy1
    define x xx1
    while {x <= xx2}
      if steep
        spawn-at y x otype
        spawn-at x y otype
      if {{inc!(error dy) * 2} >= dx}
        then
          inc! y ystep
          dec! error dx
      inc! x


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; cave object: FillRect
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

define cobj-fillrect-reader()
  define x1 one-int-value-warn(0 127 "missing rect x1")
  define y1 one-int-value-warn(0 127 "missing rect y1")
  define x2 one-int-value-warn(0 127 "missing rect x2")
  define y2 one-int-value-warn(0 127 "missing rect y2")
  define otype one-element-value("rect element expected")
  define otype1 one-element-value() ;; can be missing
  if {null? otype1} {otype1 := otype}  ;; fill element
  parser:skip-line()
  ;; return renderer
  define cobj-fillrect-renderer(spawn-at read-at level cave-w cave-h wrap-x wrap-y)
    define tmp
    define xx1 x1
    define yy1 y1
    define xx2 x2
    define yy2 y2
    if {xx1 > xx2}
      swap-vars xx1 xx2 tmp
    if {yy1 > yy2}
      swap-vars yy1 yy2 tmp
    define x
    define y yy1
    while {y <= yy2}
      {x := xx1}
      while {x <= xx2}
        if {{y = yy1} or {y = yy2} or {x = xx1} or {x = xx2}}
          spawn-at x y otype
          spawn-at x y otype1
        inc! x
      inc! y


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; cave object: Rectangle
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

define cobj-rect-reader()
  define x1 one-int-value-warn(0 127 "missing rect x1")
  define y1 one-int-value-warn(0 127 "missing rect y1")
  define x2 one-int-value-warn(0 127 "missing rect x2")
  define y2 one-int-value-warn(0 127 "missing rect y2")
  define otype one-element-value("rect element expected")
  parser:skip-line()
  ;; return renderer
  define cobj-rect-renderer(spawn-at read-at level cave-w cave-h wrap-x wrap-y)
    define tmp
    define xx1 x1
    define yy1 y1
    define xx2 x2
    define yy2 y2
    if {xx1 > xx2}
      swap-vars xx1 xx2 tmp
    if {yy1 > yy2}
      swap-vars yy1 yy2 tmp
    define y yy1
    define x xx1
    while {x <= xx2}
      spawn-at x yy1 otype
      spawn-at x yy2 otype
      inc! x
    while {y <= yy2}
      spawn-at xx1 y otype
      spawn-at xx2 y otype
      inc! y


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; cave object: Raster
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

define cobj-raster-reader()
  define x1 one-int-value-warn(0 127 "missing raster x")
  define y1 one-int-value-warn(0 127 "missing raster y")
  define num-x one-int-value-warn(0 128 "missing raster num-x")
  define num-y one-int-value-warn(0 128 "missing raster num-y")
  define step-x one-int-value-warn(0 127 "missing raster step-x")
  define step-y one-int-value-warn(0 127 "missing raster step-y")
  define otype one-element-value("raster element expected")
  define x2 {x1 + {{num-x - 1} * step-x}}
  define y2 {y1 + {{num-y - 1} * step-y}}
  parser:skip-line()
  ;; return renderer
  define cobj-raster-renderer(spawn-at read-at level cave-w cave-h wrap-x wrap-y)
    define tmp
    define xx1 x1
    define yy1 y1
    define xx2 x2
    define yy2 y2
    define dx max(1 step-x)
    define dy max(1 step-y)
    ; reorder coordinates if not drawing from northwest to southeast
    if {xx1 > xx2}
      swap-vars xx1 xx2 tmp
    if {yy1 > yy2}
      swap-vars yy1 yy2 tmp
    define y yy1
    define x
    while {y <= yy2}
      {x := xx1}
      while {x <= xx2}
        spawn-at x y otype
        inc! x dx
      inc! y dy


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; cave object: FloodFill
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

define do-floodfill(x0 y0 w h spawn-at read-at fill check)
  define fvec make-vector({w * h} #f)
  define filler(x y)
    define idx {{y * w} + x}
    define rd read-at(x y)
    cond
      {{false? rd} or fvec[idx] or {not check(rd)}}
        #void
      else
        {fvec[idx] := #t}
        filler {x - 1} y
        filler x {y - 1}
        filler {x + 1} y
        filler x {y + 1}
  filler x0 y0
  define idx 0
  while {idx <> vector-length(fvec)}
    if fvec[idx]
      spawn-at {idx mod w} {idx div w} fill
    inc! idx
  vector-resize! fvec 0


define cobj-floodfill-reader()
  define x0 one-int-value-warn(0 127 "missing floodfill x")
  define y0 one-int-value-warn(0 127 "missing floodfill y")
  define otype-fill one-element-value("floodfill fill element expected")
  define otype-search one-element-value("floodfill search element expected")
  parser:skip-line()
  ;; return renderer
  define cobj-floodfill-renderer(spawn-at read-at level cave-w cave-h wrap-x wrap-y)
    define rr read-at(x0 y0)
    if {{not {false? rr}} and {rr <> otype-fill}}
      then
        do-floodfill x0 y0 cave-w cave-h spawn-at read-at otype-fill
                     (lambda (otx) {otx = otype-search})


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; cave object: BoundaryFill
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

define cobj-boundary-reader()
  define x0 one-int-value-warn(0 127 "missing starting x")
  define y0 one-int-value-warn(0 127 "missing starting y")
  define otype-fill one-element-value("boundary fill element expected")
  define otype-border one-element-value("boundary border element expected")
  parser:skip-line()
  ;; return renderer
  define cobj-boundary-renderer(spawn-at read-at level cave-w cave-h wrap-x wrap-y)
    do-floodfill x0 y0 cave-w cave-h spawn-at read-at otype-fill
                 (lambda (otx) {otx = otype-border})


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; cave object: CopyPaste
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

define cobj-copypaste-reader()
  define x1 one-int-value-warn(0 127 "missing starting x")
  define y1 one-int-value-warn(0 127 "missing starting y")
  define x2 one-int-value-warn(0 127 "missing ending x")
  define y2 one-int-value-warn(0 127 "missing ending y")
  define xd one-int-value-warn(0 127 "missing destination x")
  define yd one-int-value-warn(0 127 "missing destination y")
  define mirror #f
  define flip #f
  define vv one-string-value()
  if {not {null? vv}}
    then
      cond
        string-ci=?(vv "mirror") {mirror := #t}
        string-ci=?(vv "nomirror") {mirror := #f}
        else parser:error string-append("bad mirror flag: " vv)
      {vv := one-string-value()}
      if {not {null? vv}}
        then
          cond
            string-ci=?(vv "flip") {flip := #t}
            string-ci=?(vv "noflip") {flip := #f}
            else parser:error string-append("bad flip flag: " vv)
  parser:skip-line()
  ;; return renderer
  define cobj-copypaste-renderer(spawn-at read-at level cave-w cave-h wrap-x wrap-y)
    define x
    define y
    define tmp
    define xx1 x1
    define yy1 y1
    define xx2 x2
    define yy2 y2
    if {xx1 > xx2}
      swap-vars xx1 xx2 tmp
    if {yy1 > yy2}
      swap-vars yy1 yy2 tmp
    define w {xx2 - xx1 - -1}
    define h {yy2 - yy1 - -1}
    if {{positive? w} and {positive? h}}
      then
        define xdisp
        define ydisp
        define cb make-vector({w * h})
        ;; copy
        {y := 0}
        while {y < h}
          {x := 0}
          while {x < w}
            {cb[{{y * w} + x}] := read-at({xx1 + x} {yy1 + y})}
            inc! x
          inc! y
        ;; paste
        {y := 0}
        while {y < h}
          {ydisp := (if flip {h - 1 - y} y)}
          {x := 0}
          while {x < w}
            {xdisp := (if mirror {w - 1 - x} x)}
            spawn-at {xd + xdisp} {yd + ydisp} cb[{{y * w} + x}]
            inc! x
          inc! y


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; cave object: RandomFillC64
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

define cobj-randfill-pprng-reader()
  define x1 one-int-value-warn(0 127 "missing starting x")
  define y1 one-int-value-warn(0 127 "missing starting y")
  define x2 one-int-value-warn(0 127 "missing ending x")
  define y2 one-int-value-warn(0 127 "missing ending y")
  define seeds make-vector(5 -1)
  {seeds[0] := one-int-value-warn(-1 255 "missing seed0")}
  {seeds[1] := one-int-value-warn(-1 255 "missing seed1")}
  {seeds[2] := one-int-value-warn(-1 255 "missing seed2")}
  {seeds[3] := one-int-value-warn(-1 255 "missing seed3")}
  {seeds[4] := one-int-value-warn(-1 255 "missing seed4")}
  define otype-init one-element-value("initial element expected")
  define fill-otypes make-vector(4 etype:O_SPACE)
  define fill-probs make-vector(4 0)
  define otype-replace #nil
  define ft #nil
  define pt #nil
  define idx 0
  define done #f
  while {{not done} and {idx <> 4}}
    {ft := one-element-value()}
    if {null? ft}
      {done := #t}
      else
        {pt := one-int-value(0 255)}
        if {null? pt}
          {done := #t}
          else
            {fill-otypes[idx] := ft}
            {fill-probs[idx] := pt}
            inc! idx
  if {not done}
    {ft := one-element-value()}
  if {not {null? ft}}
    {otype-replace := ft}
  parser:skip-line()
  ;; return renderer
  define cobj-randfill-pprng-renderer(spawn-at read-at level cave-w cave-h wrap-x wrap-y)
    define make-pprng-2seeds(seed1 seed2)
      assert fixnum?(seed1) "PPRNG seed1 should be a fixnum"
      assert fixnum?(seed2) "PPRNG seed2 should be a fixnum"
      assert between?(seed1 0 255) "PPRNG seed1 should be a 8-bit unsigned"
      assert between?(seed2 0 255) "PPRNG seed2 should be a 8-bit unsigned"
      cons(seed1 seed2)
    ;;
    define make-pprng-u16(seed)
      if {negative? seed} {seed := game:random(65536)}
      make-pprng-2seeds bit-and(bit-shr(seed 8) #xFF) bit-and(seed #xFF)
    ;;
    define make-pprng-u8(seed)
      if {negative? seed} {seed := game:random(256)}
      make-pprng-2seeds 0 seed
    ;;
    define pprng-next(pctx)
      define temp1
      define temp2
      define result
      define carry
      ;;
      {temp1 := bit-shl(bit-and(car(pctx) #x0001) 7)}
      {temp2 := bit-and(bit-shr(cdr(pctx)) #x007F)}
      {result := {cdr(pctx) + bit-shl(bit-and(cdr(pctx) #x0001) 7)}}
      {carry := bit-shr(result 8)}
      {result := {bit-and(result #x00FF) + carry + #x13}}
      {carry := bit-shr(result 8)}
      cdr-set! pctx bit-and(result #x00FF)
      {result := {car(pctx) + carry + temp1}}
      {carry := bit-shr(result 8)}
      {result := {bit-and(result #x00FF) + carry + temp2}}
      ;printf "res=%o\n" bit-and(result #x00FF)
      car-set! pctx bit-and(result #x00FF)
    ;;
    define pctx make-pprng-u8(seeds[level])
    define x
    define y
    define rr
    define rf-idx
    define tmp
    define otype
    define xx1 x1
    define yy1 y1
    define xx2 x2
    define yy2 y2
    if {xx1 > xx2}
      swap-vars xx1 xx2 tmp
    if {yy1 > yy2}
      swap-vars yy1 yy2 tmp
    ;; the same algo as in "initial-random-fill"
    iterate
      init {y := yy1}
      repeat {y <= yy2}
        iterate
          init {x := xx1}
          repeat {x <= xx2}
            {rr := pprng-next(pctx)}
            ; select the element to draw the way it was done on c64
            iterate
              init
                {otype := otype-init}
                {rf-idx := 0}
              repeat {rf-idx <> 4}
                if {rr < fill-probs[rf-idx]} {otype := fill-otypes[rf-idx]}
                inc! rf-idx
              else #void
            {rr := read-at(x y)}
            if {not {false? rr}}
              if {{null? otype-replace} or {rr = otype-replace}}
                spawn-at x y otype
            inc! x
          else #void
        inc! y
      else #void


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; cave object: RandomFill
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

define cobj-randfill-unpredictable-reader()
  define x1 one-int-value-warn(0 127 "missing starting x")
  define y1 one-int-value-warn(0 127 "missing starting y")
  define x2 one-int-value-warn(0 127 "missing ending x")
  define y2 one-int-value-warn(0 127 "missing ending y")
  define seeds make-vector(5 -1)
  {seeds[0] := one-int-value-warn(-1 255 "missing seed0")}
  {seeds[1] := one-int-value-warn(-1 255 "missing seed1")}
  {seeds[2] := one-int-value-warn(-1 255 "missing seed2")}
  {seeds[3] := one-int-value-warn(-1 255 "missing seed3")}
  {seeds[4] := one-int-value-warn(-1 255 "missing seed4")}
  define otype-init one-element-value("initial element expected")
  define fill-otypes make-vector(4 etype:O_SPACE)
  define fill-probs make-vector(4 0)
  define otype-replace #nil
  define ft #nil
  define pt #nil
  define idx 0
  define done #f
  while {{not done} and {idx <> 4}}
    {ft := one-element-value()}
    if {null? ft}
      {done := #t}
      else
        {pt := one-int-value(0 255)}
        if {null? pt}
          {done := #t}
          else
            {fill-otypes[idx] := ft}
            {fill-probs[idx] := pt}
            inc! idx
  if {not done}
    {ft := one-element-value()}
  if {not {null? ft}}
    {otype-replace := ft}
  parser:skip-line()
  ;; return renderer
  define cobj-randfill-unpredictable-renderer(spawn-at read-at level cave-w cave-h wrap-x wrap-y)
    define pctx ::bjprng:new()  ;; unpredictable
    define x
    define y
    define rr
    define rf-idx
    define tmp
    define otype
    define xx1 x1
    define yy1 y1
    define xx2 x2
    define yy2 y2
    if {xx1 > xx2}
      swap-vars xx1 xx2 tmp
    if {yy1 > yy2}
      swap-vars yy1 yy2 tmp
    ;; the same algo as in "initial-random-fill"
    iterate
      init {y := yy1}
      repeat {y <= yy2}
        iterate
          init {x := xx1}
          repeat {x <= xx2}
            {rr := ::bjprng:random(pctx 256)}
            ; select the element to draw the way it was done on c64
            iterate
              init
                {otype := otype-init}
                {rf-idx := 0}
              repeat {rf-idx <> 4}
                if {rr < fill-probs[rf-idx]} {otype := fill-otypes[rf-idx]}
                inc! rf-idx
              else #void
            {rr := read-at(x y)}
            if {not {false? rr}}
              if {{null? otype-replace} or {rr = otype-replace}}
                spawn-at x y otype
            inc! x
          else #void
        inc! y
      else #void


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; cave object: Add, AddBackward
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

define cobj-joinxx-reader(backwards)
  define inc-x one-int-value-warn(-128 128 "missing add inc-x")
  define inc-y one-int-value-warn(-128 128 "missing add inc-y")
  define otype-search one-element-value("search element expected")
  define otype-replace one-element-value("add element expected")
  parser:skip-line()
  ;; return renderer
  define cobj-joinxx-renderer(spawn-at read-at level cave-w cave-h wrap-x wrap-y)
    ; find every object, and put fill_element next to it. relative coordinates dx,dy
    define x
    define y (if backwards {cave-h - 1} 0)
    while between?(y 0 {cave-h - 1})
      {x := (if backwards {cave-w - 1} 0)}
      while between?(x 0 {cave-w - 1})
        if {read-at(x y) = otype-search}
          ;; should wraparound
          spawn-at {x + inc-x} {y + inc-y} otype-replace
        if backwards
          dec! x
          inc! x
      if backwards
        dec! y
        inc! y


define cobj-add-reader()
  cobj-joinxx-reader(#f)

define cobj-addback-reader()
  cobj-joinxx-reader(#f)


#|
"Maze": it is used in ~20 games. i hate mazes.
|#

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; cave objects parser
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define cave-object-defs (list
  `("Point" ,cobj-point-reader)
  `("Line" ,cobj-line-reader)
  `("FillRect" ,cobj-fillrect-reader)
  `("Rectangle" ,cobj-rect-reader)
  `("Add" ,cobj-add-reader)
  `("AddBackward" ,cobj-addback-reader)
  `("Raster" ,cobj-raster-reader)
  `("FloodFill" ,cobj-floodfill-reader)
  `("BoundaryFill" ,cobj-boundary-reader)
  `("CopyPaste" ,cobj-copypaste-reader)
  `("RandomFillC64" ,cobj-randfill-pprng-reader)
  `("RandomFill" ,cobj-randfill-unpredictable-reader)
  `("Join" ,cobj-add-reader)
))

define find-cave-object-def(name)
  define list cave-object-defs
  iterate
    exit {null? list}
      #nil
    exit string-ci=?(caar(list) name)
      car(list)
    repeat #t
      {list := cdr(list)}
    else #void

;define string-starts-with-ci?(str pat)
;  (and {string-length(str) >= string-length(pat)}
;       string-ci=?(substring(str string-length(pat)) pat))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; "[objects]" section parser
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

define parse-objects-section()
  define def
  define obj
  define obj-list #nil
  define key parser:get-key()
  define in-levels #f
  define levels #(#t #t #t #t #t)
  ;;
  define parse-levels(str)
    define lv make-vector(5 #t)
    parser:assert {{string-length(str) >= 2} and {str[{string-length(str) - 1}] = 93}} "bad level tag"
    {str := parser:trim-all(substring(str 0 {string-length(str) - 1}))}
    define was-number #f
    define in-number #f
    define num 0
    ;printf "str=%o\n" str
    while {not empty-string?(str)}
      ;printf "  str=%o\n" str
      cond
        {in-number and {{str[0] = #\,} or {str[0] <= 32}}}
          parser:assert between?(num 1 5) "invalid level in level tag"
          {lv[{num - 1}] := #t}
          {in-number := #f}
        {{not in-number} and {{str[0] = #\,} or {str[0] <= 32}}}
          #void
        between?(str[0] #\0 #\9)
          if {not in-number}
            then
              {in-number := #t}
              {num := 0}
          {num := {{num * 10} + {str[0] - #\0}}}
          parser:assert between?(num 0 5) "numeric overflow in level tag"
          {was-number := #t}
        else
          parser:error "invalid number in level tag"
      {str := substring(str 1)}
    if in-number
      then
        parser:assert between?(num 1 5) "invalid level in level tag"
        {lv[{num - 1}] := #t}
    parser:assert was-number "bad level tag"
    lv
  ;;
  iterate
    exit {null? key}
      parser:error "invalid BDCFF file (unexpected eof)"
    repeat empty-string?(key)
      parser:skip-line()
      {key := parser:get-key()}
    repeat string-ci=?(key "[Level")
      parser:assert {not in-levels} "nested \"[Level]\" are forbidden"
      {levels := parse-levels(parser:trim-all(parser:get-single-string-value()))}
      {in-levels := #t}
      parser:skip-line()
      {key := parser:get-key()}
    repeat string-ci=?(key "[/Level]")
      parser:assert in-levels "\"[/Level]\" without the corresponding opening tag"
      {levels := #(#t #t #t #t #t)}
      {in-levels := #f}
      parser:skip-line()
      {key := parser:get-key()}
    exit string-ci=?(key "[/objects]")
      parser:skip-line()
      add-cave-option 'cave-objects reverse!(obj-list)
    exit section-name?(key)
      parser:error string-append("unexpected section: " key)
    repeat {pair? {def := find-cave-object-def(key)}}
      {obj := cons(levels cadr(def)())}
      {obj-list := cons(obj obj-list)}
      {key := parser:get-key()}
    else
      parser:error string-append("Unknown cave object \"" key "\"")


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; "[demo]" section parser
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

define parse-demo-section()
  define key parser:get-key()
  cond
    {null? key}
      parser:error "invalid BDCFF file (unexpected eof)"
    string-ci=?(key "[/demo]")
      parser:skip-line()
    section-name?(key)
      parser:error string-append("unexpected section: " key)
    else
      parser:skip-line()
      parse-demo-section()


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; common cave property parser
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; (value default-value . props)
define parse-cave-property(prop-name kvp)
  ;printf "res=%o\n" kv
  define opt-name car(kvp)
  define opt-value cadr(kvp)
  define opt-props cddr(kvp)
  define opt-type lax-cdr(assq(type: opt-props))
  define opt-vv opt-value
  if {vector? opt-vv} {opt-vv := opt-value[0]}
  ;printf "key=%o; v=%o; vv=%o (%s)\n" opt-name opt-value opt-vv ::SYSTEM:type-name(opt-vv)
  if {null? opt-type}
    cond
      {boolean? opt-vv} {opt-type := 'BOOLEAN}
      {fixnum? opt-vv} {opt-type := 'INTEGER}
      {string? opt-vv} {opt-type := 'STRING}
      else parser:error(string-append("invalid option \""
                                      symbol->string(opt-name) "\" type: "
                                      ::SYSTEM:type-name(opt-vv)))
  ;printf "option: %o; type: %o\n" opt-name opt-type
  define vsize (if (vector? opt-value) (vector-length opt-value) 1)
  ;;
  define parse-values(vsize parser)
    define val parser()
    if {{null? val} and {true? lax-cdr(assq(can-be-empty: opt-props))}}
      then
        #void
      else
        parser:assert {not {null? val}} "at least one value expected"
        cond
          {vsize = 1}
            val
          else
            define rvec make-vector(vsize val)
            define idx 1
            {val := parser()}
            while {{idx <> vector-length(rvec)} and {not {null? val}}}
              {rvec[idx] := val}
              {val := parser()}
              inc! idx
            while {idx <> vector-length(rvec)}
              {rvec[idx] := rvec[{idx - 1}]}
              inc! idx
            rvec
  ;;
  define parse-bool(props vsize)
    parse-values vsize one-bool-value
  ;;
  define parse-int(props vsize)
    define vmin lax-cdr(assq(min-value: props))
    define vmax lax-cdr(assq(max-value: props))
    define oor-closure lax-cdr(assq(out-of-range-clamp: props))
    if {null? vmin} {vmin := (fixnum-min)}
    if {null? vmax} {vmax := (fixnum-max)}
    cond
      {null? oor-closure}
        parse-values vsize (lambda () one-int-value(vmin vmax))
      else
        assert procedure?(oor-closure) "oops!"
        parse-values vsize
          lambda ()
            define val one-int-value((fixnum-min) (fixnum-max))
            if {{number? val} and {not between?(val vmin vmax)}}
              then
                ;printf "000: %s: val=%o; vmin=%o; vmax=%o\n" prop-name val vmin vmax
                parser:warning string-append("oor value (" prop-name "): " number->string(val))
                {val := oor-closure(val)}
                ;printf "001: %s: val=%o; vmin=%o; vmax=%o\n" prop-name val vmin vmax
            val
  ;;
  define parse-str(props vsize)
    parser:assert {vsize = 1} "string options cannot be arrays!"
    single-string-value()
  ;;
  define parse-element(props vsize)
    parse-values vsize one-element-value
  ;;
  define parse-prob(props vsize)
    parse-values vsize one-prob-value
  ;;
  define parse-ratio(props vsize)
    ;; ratio: max cave size for GD_TYPE_RATIO. should be set to cave->w*cave->h when calling
    define oor-closure lax-cdr(assq(out-of-range-clamp: props))
    cond
      {null? oor-closure}
        parse-values vsize one-ratio-value
      else
        assert procedure?(oor-closure) "oops!"
        parse-values vsize
          lambda ()
            define val one-ratio-value-no-checks()
            define oor {{number? val} and {not between?(val 0 1)}}
            if {number? val}
              {val := trunc({{val * {cave-width * cave-height}} + 0.5})}
            if oor
              then
                parser:warning string-append("oor value (" prop-name "): " number->string(val))
                {val := oor-closure(val)}
            val
  ;;
  define new-value
  case opt-type
    (BOOLEAN) {new-value := parse-bool(opt-props vsize)}
    (INTEGER) {new-value := parse-int(opt-props vsize)}
    (STRING) {new-value := parse-str(opt-props vsize)}
    (ELEMENT) {new-value := parse-element(opt-props vsize)}
    (PROBABILITY) {new-value := parse-prob(opt-props vsize)}
    (RATIO) {new-value := parse-ratio(opt-props vsize)}
    else
      parser:error(string-append("invalid option \""
                                 symbol->string(opt-name) "\" type: "
                                 symbol->string(opt-type)))
  if {not {void-object? new-value}}
    add-cave-option opt-name new-value


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; "[cave]" section parser
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

define parse-cave-section()
  define key parser:get-key()
  ;;hack! new name in bdash-crli. fuck.
  if string-ci=?(key "MagicWallProperties.breakscan")
    {key := "MagicWallProperties.convertamoeba"}
  cond
    {null? key}
      parser:error "invalid BDCFF file (unexpected eof)"
    empty-string?(key)
      parser:skip-line()
      parse-cave-section()
    string-ci=?(key "[map]")
      parser:skip-line()
      parse-map-section(#nil)
      parse-cave-section()
    string-ci=?(key "[objects]")
      parser:skip-line()
      parse-objects-section()
      parse-cave-section()
    string-ci=?(key "[demo]")
      parser:skip-line()
      parse-demo-section()
      parse-cave-section()
    string-ci=?(key "[highscores]")
      parser:skip-line()
      parse-highscores-section("[/highscores]")
      parse-cave-section()
    string-ci=?(key "[highscore]")
      parser:skip-line()
      parse-highscores-section("[/highscore]")
      parse-cave-section()
    string-ci=?(key "[/cave]")
      finish-cave()
      parser:skip-line()
    section-name?(key)
      parser:error string-append("unexpected section: " key)
    else
      define hh find-field-handler(key cave-fields)
      cond
        {false? hh}
          parse-cave-property key find-bdcc-option(key)
        {null? hh}
          parser:skip-line()
        else
          hh()
      parse-cave-section()


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; "[hiscore]" section parser
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

define parse-highscores-section(end-key)
  define key parser:get-key()
  cond
    {null? key}
      parser:error "invalid BDCFF file (unexpected eof)"
    empty-string?(key)
      parser:skip-line()
      parse-highscores-section(end-key)
    string-ci=?(key end-key)
      parser:skip-line()
    section-name?(key)
      parser:error string-append("unexpected section: " key)
    else
      parser:skip-line()
      parse-highscores-section(end-key)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; "[game]" section parser
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

define parse-game-section()
  define key parser:get-key()
  cond
    {null? key}
      parser:error "invalid BDCFF file (unexpected eof)"
    empty-string?(key)
      parser:skip-line()
      parse-game-section()
    string-ci=?(key "[mapcodes]")
      parser:skip-line()
      parse-mapcodes-section(0 #nil)
      parse-game-section()
    string-ci=?(key "[highscores]")
      parser:skip-line()
      parse-highscores-section("[/highscores]")
      parse-game-section()
    string-ci=?(key "[highscore]")
      parser:skip-line()
      parse-highscores-section("[/highscore]")
      parse-game-section()
    string-ci=?(key "[cave]")
      parser:skip-line()
      new-cave()
      parse-cave-section()
      if {not has-option?(current-cave() 'map)}
        add-cave-option 'map #nil
      if {not has-option?(current-cave() 'cave-objects)}
        add-cave-option 'cave-objects #nil
      parse-game-section()
    string-ci=?(key "[/game]")
      parser:skip-line()
    section-name?(key)
      parser:error string-append("unexpected section: " key)
    else
      define hh find-field-handler(key game-fields)
      parser:assert {not {false? hh}} string-append("invalid game section key: " key)
      if {null? hh}
        parser:skip-line()
        hh()
      parse-game-section()


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; "[mapcodes]" section parser
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

define parse-mapcodes-section(len list)
  define key parser:get-key()
  cond
    {null? key}
      parser:error "invalid BDCFF file (unexpected eof)"
    empty-string?(key)
      parser:skip-line()
      parse-mapcodes-section(len list)
    string-ci=?(key "[/mapcodes]")
      parser:skip-line()
      gset! game-map-legend list
    section-name?(key)
      parser:error string-append("unexpected section: " key)
    string-ci=?(key "Length")
      define lv one-int-value(1 2)
      parser:assert {fixnum? lv} "mapcodes length should be '1' or '2'"
      parser:assert {zero? len} "duplicate \"Length\" property"
      ;; no maps in GDash is using this, so don't bother
      parser:assert {lv = 1} "2-char \"Length\" property is not supported yet"
      parse-mapcodes-section(lv list)
    else
      ;; check it here, because we might have an empty section
      parser:assert {null? game-map-legend} "duplicate \"[mapcodes]\" section"
      if {zero? len} {len := 1}
      parser:assert {string-length(key) = len} "invalid legend symbol size"
      define el one-element-value()
      parser:assert {not {null? el}} "mapcode element missing"
      parser:skip-line()
      parse-mapcodes-section(len cons(cons(key[0] el) list))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; "[BDCFF]" section parser
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

define parse-bdcff-section()
  define key parser:get-key()
  cond
    {null? key}
      parser:error "invalid BDCFF file (unexpected eof)"
    empty-string?(key)
      parser:skip-line()
      parse-bdcff-section()
    string-ci=?(key "[game]")
      parser:skip-line()
      parse-game-section()
      parse-bdcff-section()
    string-ci=?(key "[mapcodes]")
      parser:skip-line()
      parse-mapcodes-section(0 #nil)
      parse-bdcff-section()
    string-ci=?(key "[/bdcff]")
      parser:skip-line()
    section-name?(key)
      parser:error string-append("unexpected section: " key)
    string-ci=?(key "Version")
      parser:assert {empty-string? bdcff-version} "duplicate version property"
      gset! bdcff-version single-string-value()
      parse-bdcff-section()
    else
      parser:error string-append("invalid bdcff section key: " key)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; main BDCFF parser
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

define parse()
  reset()
  expect-section "[BDCFF]"
  parse-bdcff-section()
  gset! game-map-legend #nil  ;; unanchor
  if empty-string?(game-title)
    gset! game-title "Unknown Game"
  if empty-string?(game-author)
    gset! game-author "Unknown Author"


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; load and parse BDCFF file
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

define set-warning-callback(cb)
  gset! parser:warning-callback cb

define warning(msg)
  parser:warning msg

define load-file(fname)
  reset()
  parser:load-file fname
  try-finally-ex parse
    lambda (err?)
      define err-text
      if err? {err-text := parser:get-error-line-text()}
      ;if err? printf("******* fname=%o; err=%o; errt: %o\n" parser:file-name err? err-text)
      parser:reset()
      if err? reset()
      if err? parser:set-error-line-text(err-text)


define load-string(fname str)
  reset()
  parser:load-string fname str
  try-finally-ex parse
    lambda (err?)
      define err-text
      if err? {err-text := parser:get-error-line-text()}
      ;if err? printf("******* fname=%o; err=%o; errt: %o\n" parser:file-name err? err-text)
      parser:reset()
      if err? reset()
      if err? parser:set-error-line-text(err-text)

(end-module 'bdcff-loader)
