(begin-module 'edef)
(module-export '(
  entity?
  ?entity
  new-prop-list
  ;;
  ?check
  parse-new
  dump
  ;;
  index
  index-set!
  name
  name-set!
  props
  props-set!
  bdcff-name
  bdcff-name-set!
  bdcff-char
  bdcff-char-set!
  editor-image
  editor-image-set!
  simple-image
  simple-image-set!
  game-image
  game-image-set!
  inactive-image
  inactive-image-set!
  proc-delay
  hammered-etype
  object
  object-set!
  ;;
  prop?
  get-prop
))


define new-prop-list(list)
  define res #nil
  cond
    {symbol? list}
      cons(cons(list #nil) #nil)
    else
      while {pair? list}
        cond
          {symbol? car(list)}
            assert {false? assq(car(list) res)}
              string-append("duplicate property \"" symbol->string(car(list)) "\"")
            {res := cons(cons(car(list) #nil) res)}
          {symbol? lax-caar(list)}
            assert {false? assq(caar(list) res)}
              string-append("duplicate property \"" symbol->string(caar(list)) "\"")
            {res := cons(car(list) res)}
          else
            error "property should be a symbol"
        {list := cdr(list)}
      reverse! res


constant edef-id  cons('entity #nil)

(constant eidx-index          1)  ;; element number. for example O_DIRT
(constant eidx-name           2)  ;; name in editor, for example "Dirt". some have different names than their real engine meaning!
(constant eidx-props          3)  ;; engine properties assoc list, like P_SLOPED or P_EXPLODES
(constant eidx-bdcff-name     4)  ;; name in bdcff file, like "DIRT" (string)
(constant eidx-bdcff-char     5)  ;; character representation in bdcff file, like '.'
(constant eidx-editor-image   6)  ;; image in editor (index in cells.png)
(constant eidx-simple-image   7)  ;; image for simple view in editor, and for combo box (index in cells.png)
(constant eidx-game-image     8)  ;; image for game. negative if animated
(constant eidx-inactive-image 9)  ;; image for game. negative if animated
(constant eidx-object        10)  ;; handling objects
(constant eidx-size 11)

define new()
  make-vector eidx-size edef-id #nil

define entity?(def)
  {{vector? def} and {def[0] eq? edef-id}}

define ?entity(def)
  assert entity?(def) "entity description expected"


(define (index def) (?entity def) {def[eidx-index]})
(define (index-set! def idx) (?entity def) {def[eidx-index] := idx})

(define (name def) (?entity def) {def[eidx-name]})
(define (name-set! def name) (?entity def) {def[eidx-name] := name})

(define (props def) (?entity def) {def[eidx-props]})
(define (props-set! def list) (?entity def) {def[eidx-props] := list})

(define (bdcff-name def) (?entity def) {def[eidx-bdcff-name]})
(define (bdcff-name-set! def name) (?entity def) {def[eidx-bdcff-name] := name})

(define (bdcff-char def) (?entity def) {def[eidx-bdcff-char]})
(define (bdcff-char-set! def char) (?entity def) {def[eidx-bdcff-char] := char})

(define (editor-image def) (?entity def) {def[eidx-editor-image]})
(define (editor-image-set! def img) (?entity def) {def[eidx-editor-image] := img})

(define (simple-image def) (?entity def) {def[eidx-simple-image]})
(define (simple-image-set! def img) (?entity def) {def[eidx-simple-image] := img})

(define (game-image def) (?entity def) {def[eidx-game-image]})
(define (game-image-set! def img) (?entity def) {def[eidx-game-image] := img})

(define (inactive-image def) (?entity def) {def[eidx-inactive-image]})
(define (inactive-image-set! def img) (?entity def) {def[eidx-inactive-image] := img})

define prop?(ent pname)
  define plist props(ent)
  while {pair? pname}
    if {pair? assq(car(pname) plist)} ::SYSTEM:return(#t)
    {pname := cdr(pname)}
  if {not {null? pname}}
    {pair? assq(pname plist)}
    #f

define player?(ent)
  prop? ent 'P_PLAYER

;; pair or #f
define get-prop(ent pname)
  define plist props(ent)
  define xp
  while {pair? pname}
    {xp := assq(car(pname) plist)}
    if {pair? xp} ::SYSTEM:return(xp)
    {pname := cdr(pname)}
  if {not {null? pname}}
    assq(pname plist)
    #f

define proc-delay(ent)
  ?entity ent
  define pp get-prop(ent 'P_DELAY)
  if {pair? pp}
    cdr(pp)
    0

define hammered-etype(ent)
  ?entity ent
  define pp get-prop(ent 'P_HAMMERED_TO)
  if {pair? pp}
    cdr(pp)
    #nil

(define (object def) (?entity def) {def[eidx-object]})
(define (object-set! def value) (?entity def) {def[eidx-object] := value})


define ?check(ent)
  ?entity ent
  define value
  {value := (index ent)}
  assert (and (fixnum? value) (between? value 0 {::etype:_MAX_VALUE_ - 1}))
  {value := (name ent)}
  assert (or (string? value) (null? value))
  {value := (props ent)}
  assert (or (null? value) (list? value))
  {value := (bdcff-name ent)}
  assert (or (string? value) (null? value))
  {value := (bdcff-char ent)}
  assert (and (fixnum? value) (between? value 0 126))
  {value := (editor-image ent)}
  assert (or (null? value) (fixnum? value))
  {value := (simple-image ent)}
  assert (or (null? value) (fixnum? value))
  {value := (game-image ent)}
  assert (or (null? value) (fixnum? value))
  {value := (proc-delay ent)}
  assert (and (fixnum? value) (between? value 0 666))
  {value := (hammered-etype ent)}
  assert (or (null? value) (and (fixnum? value) (between? value 0 {::etype:_MAX_VALUE_ - 1})))


define dump(ent)
  define find-sym(idx)
    define xx enum:find-value(eximg idx)
    if {false? xx}
      number->string(idx)
      string-append("eximg:" symbol->string(xx))
  ;;
  define img(idx)
    if {negative? idx}
      string-append "(- " find-sym({- idx}) ")"
      find-sym(idx)
  ;;
  define eidx(idx)
    define xx enum:find-value(etype idx)
    if {false? xx}
      number->string(idx)
      string-append("etype:" symbol->string(xx))
  ;;
  define dump-props(list)
    ;printf "pp=%o\n" list
    cond
      {null? list}
        #f
      {null? cdr(list)}
        ;; one
        printf "  props: '%s\n" car(list)
      else
        printf "  props: '("
        let loop <* spc "" \\ list list *>
          if {null? list}
            printf ")\n"
            else
              printf "%s%s" spc caar(list)
              loop " " cdr(list)
  ;;
  ?entity ent
  printf "(edef:parse-new ;;%d\n" (index ent)
  printf "  index: %s\n" (eidx (index ent))
  if {not {null? (name ent)}}
    printf "  name: %o\n" (name ent)
  if {not {null? (bdcff-name ent)}}
    printf "  bdcff-name: %o\n" (bdcff-name ent)
  ;printf " char=%o\n" (bdcff-char ent)
  if {not {zero? (bdcff-char ent)}}
    if between?((bdcff-char ent) 33 126)
      printf "  bdcff-char: #\\%s\n" string-append("" (bdcff-char ent))
      printf "  bdcff-char: %o\n" (bdcff-char ent)
  printf "  editor-image: %s\n" (img (editor-image ent))
  printf "  simple-image: %s\n" (img (simple-image ent))
  printf "  game-image: %s\n" (img (game-image ent))
  if {not {zero? (proc-delay ent)}}
    printf "  proc-delay: %d\n" (proc-delay ent)
  dump-props props(ent)
  if {number? (hammered-etype ent)}
    printf "  hammered-etype: %s\n" (eidx (hammered-etype ent))
  printf ")"


constant field-keywords `(
  (,index:          ,eidx-index           ,(lambda (value) (and (fixnum? value) (between? value 0 {::etype:_MAX_VALUE_ - 1}))))
  (,name:           ,eidx-name            ,(lambda (value) (or (string? value) (null? value))))
  (,props:          ,eidx-props           ,(lambda (value) (or (null? value) (symbol? value) (list? value)))  ,new-prop-list)
  (,bdcff-name:     ,eidx-bdcff-name      ,(lambda (value) (or (string? value) (null? value))))
  (,bdcff-char:     ,eidx-bdcff-char      ,(lambda (value) (and (fixnum? value) (between? value 32 126))))
  (,editor-image:   ,eidx-editor-image    ,(lambda (value) (fixnum? value)))
  (,simple-image:   ,eidx-simple-image    ,(lambda (value) (fixnum? value)))
  (,game-image:     ,eidx-game-image      ,(lambda (value) (fixnum? value)))
  (,inactive-image: ,eidx-inactive-image  ,(lambda (value) (fixnum? value)))
)

;; kw: value
define parse-new(... defs)
  define ent new()
  define key
  define value
  define kw
  define error(msg)
    if {number? (index ent)}
      ::error(string-append(msg ", index=" (number->string (index ent))))
      ::error(msg)
  (bdcff-char-set! ent 0)
  while {pair? defs}
    {key := car(defs)}
    {value := cadr(defs)}
    {defs := cddr(defs)}
    if {not {symbol? key}} error("key is not a symbol")
    {kw := assq(key field-keywords)}
    if {not {pair? kw}} error(string-append("invalid key: \"" symbol->string(key) "\""))
    if {not caddr(kw)(value)} error(string-append("invalid value for key: \"" symbol->string(key) "\""))
    ;printf "key=%o; value=%o\n" cadr(kw) value
    if {procedure? lax-cadddr(kw)}
      {ent[cadr(kw)] := cadddr(kw)(value)}
      {ent[cadr(kw)] := value}
  if {not {fixnum? (inactive-image ent)}}
    inactive-image-set! ent (game-image ent)
  ?check ent
  ent


(end-module 'edef)
