#!/bin/sh
: ; exec klone $0 "$@"
; The above line allows not to embed the exact path of the klone executable

;;Skeleton of a typical klone script

(setq args (getopts "USAGE: %0 [options] "
    ("-v" () verbose "verbose operation")
    ("-debug" () enter-debugger-on-error "enter klone debugger on error")
    ("-stackdump" () stackdump-on-error "verbose stack dump on error")
))

(if enter-debugger-on-error (kdb t))
(if stackdump-on-error (stack-dump-on-error t))

(defun main (&aux)
  (dolist (file args)
    (bspinfo file)
  )
)

(setq re-key (regcomp "\"[-a-zA-Z_0-9+=#.,/]+\""))
(defun bspinfo (file &aux
    (s (String (open file)))
    pos					;start of entities
    ent
    (stats (list))			;plist name occurences_count
  )
  ;; check 
  (if (setq pos (seek s "{\n\""))
    (if (not (regexec re-key s (+ pos 2)))
      (fatal-error 1 "Error: No valid BSP entities section in %0\n" file)
    )
    (fatal-error 1 "Error: No BSP entities section in %0\n" file)
  )
  (while (setq ent (parse-entity s 'pos))
    (process-entity stats ent)
  )
  (if (getn stats "name")
    (print-stats file stats)
  )
)

(setq re-ent-start (regcomp "^[ \t\n]*{[ \t\n]*\n"))
(setq re-ent-end (regcomp "^[ \t\n]*}[ \t\n]*\n"))
(setq re-ent-item (regcomp "^[ \t\n]*\"([^\"]+)\"[ \t\n]*\"([^\"]*)\"[ \t\n]*\n"))

(defun parse-entity (s posvar &aux
    (p (eval posvar))
    (ent (list))
    (notdone t)
  )
  (while notdone
    (if
      (= 0 (get s p))
      (setq notdone ())

      (regexec re-ent-start s p)
      (setq p (1 (get re-ent-start 0)))

      (regexec re-ent-end s p) (progn
	(setq notdone ())
	(set posvar (1 (get re-ent-end 0)))
      )
      (regexec re-ent-item s p) (progn
	(lappend ent (regsub re-ent-item 1))
	(lappend ent (regsub re-ent-item 2))
	(setq p (1 (get re-ent-item 0)))
      )
      t
      (fatal-error 1 "Bad entity syntax: %r0\n" (subseq s p (+ p 100)))
  ))
  ent
)

(defun process-entity (stats ent &aux val)
  (if
    (= "worldspawn" (getn ent "classname")) (progn
      (insert stats 0 (getn ent "message"))
      (insert stats 0 "name")
    )
  )
)

(defun print-stats (file stats)
  (PF "%0 %1\n" (file-part file) (trim-chars (get stats "name" "")))
)

(setq file-part:re (regcomp "^(.*[/])?([^/]*)([.][bB][sS][pP])$"))
(defun file-part (s)
  (if (regexec file-part:re s) (setq s (regsub file-part:re 2)))
  (tolower s)
)

(setq re-space (regcomp "^[\x01-\x20\x7f-\xff]+"))
(setq re-nospace (regcomp "^[^\x01-\x20\x7f-\xff]+"))
(setq re-newline (regcomp "[\\]n"))
(setq re-redchars (regcomp "[\x7f-\xff]"))

(defun trim-chars (s &aux (res (copy "")) (pos 0))
  (replace-string s re-newline "" :all t :quote t)
  (replace-string s re-redchars printable-version :all t :quote t)
  (if (regexec re-space s pos)
    (setq pos (1 (get re-space 0)))
  )
  (while (regexec re-nospace s pos)
    (if (/= "" res) (nconc res " "))
    (nconc res (regsub re-nospace 0))
    (setq pos (1 (get re-nospace 0)))
    (if (regexec re-space s pos)
      (setq pos (1 (get re-space 0)))
    )
  )
  res
)

;; converts a red char into its ascii equivalent
(defun printable-version (s &aux (c (get (regsub s 0) 0)))
  (String (list
      (if (and (>= c 225) (<= c 250)) (- c 128)
	(and (>= c 193) (<= c 218)) (- c 128)
	(and (>= c 176) (<= c 185)) (- c 128)
	c
))))

(main)

;;; EMACS MODES
;;; Local Variables: ***
;;; mode:lisp ***
;;; End: ***