minetest/core.rkt

#lang racket

(provide ++)
(provide all-true)
(provide asset-struct)
(provide mod-struct)
(provide mod-struct-blocks)
(provide mod-struct-items)
(provide mod-struct-recipes)
(provide MINETEST_PATH)
(provide path-for)
(provide asset-name)
(provide asset-short-name)

(provide asset-struct)
(provide asset-struct?)
(provide asset-struct-name)
(provide asset-struct-more)
(provide asset->hash)

(provide compile-v)
(provide special-compile)
(provide special-compile-f)

(provide compile-asset-description)

(provide lua-file-for)

(provide path-for)

(provide tree-map)



(provide mod-struct)
(provide mod-struct?)
(provide mod-struct-name)
(provide mod-struct-lua-defs)
(provide set-my-mod!)
(provide my-mod)

(provide add-item)
(provide add-block)
(provide add-recipe)
(provide add-lua-def)

(provide list_)

(provide add-behaviour-to)
(provide add-behaviour)

(require (for-syntax racket/syntax))

;UTIL

(define (list_ x)
  (if (list? x)
      x
      (list x)))

(define ++ string-append)

(define/contract (all-true l)
  (-> list? boolean?)
  (= (count identity l) (length l)))

(define (tree-map f tree)
  (if (list? tree)
      (map (curry tree-map f) tree)
      (f tree)
      ))

;CONFIG

(define MINETEST_PATH "/home/thoughtstem/.minetest/")


;DATA STRUCTURES

(struct special-compile (f))

(struct mod-struct (name items blocks recipes lua-defs) )

(struct asset-struct (name description more mod) #:transparent)

(define (asset->hash a)
  (hash-set
   (asset-struct-more a)
   'description
   (asset-struct-description a)))


(define-syntax (add-behaviour-to stx)
  (syntax-case stx ()
    [(_ target (key val)) 
     (with-syntax* ([target-id (format-id stx "~a" #'target)]
                    [key-str (symbol->string
                              (format-symbol "~a" #'key))])
       #`(begin
           (add-behaviour target-id
                       (list key-str val)
                       my-mod)
          "Added behaviour"))]))


(define (add-behaviour target kv m)
  (let ([updated-target (add-to-more target kv)])
    (set! my-mod
          (replace-in-mod m target updated-target))))

(define (replace-in-mod m t1 t2)
  (mod-struct
     (mod-struct-name  m)
     (replace-in-list (mod-struct-items m) t1 t2)
     (replace-in-list (mod-struct-blocks m) t1 t2)
     (replace-in-list (mod-struct-recipes m) t1 t2)
     (replace-in-list (mod-struct-lua-defs m) t1 t2)))

(define (replace-in-list l t1 t2)
  (map (lambda (x)
         (if (eq? (asset-struct-name x) (asset-struct-name t1))
             t2
             x)) l))

(define (add-to-more a kv)
  (let ([new-more   (hash-set
                     (asset-struct-more a)
                     (string->symbol (first kv))
                     (second kv))])
    (struct-copy asset-struct a
                 [more new-more])))



(provide default-mod)
(define default-mod
  (mod-struct "default" '() '() '() '()))

(define my-mod
  (mod-struct "my_racket_mod" '() '() '() '()))

(define (set-my-mod! m)
  (set! my-mod m))

;NOTE: Could make a syntax for defining adders automatically...
(define (add-item m i)
  (struct-copy mod-struct m
               [items (cons i (mod-struct-items m))]))

(define (add-recipe m i)
  (struct-copy mod-struct m
               [recipes (cons i (mod-struct-recipes m))]))

(define (add-block m i)
  (struct-copy mod-struct m
               [blocks (cons i (mod-struct-blocks m))]))

(define (add-lua-def m i)
  (struct-copy mod-struct m
               [lua-defs (cons i (mod-struct-lua-defs m))]))




(define (variableify s)
  (string-downcase
   (string-replace
    s
    " "
    "_")))

(define (asset-short-name m a)
  (second (string-split (asset-name m a) ":")))

(define (asset-name a)
  (let ([m  (asset-struct-mod a)]
        [name (variableify (asset-struct-name a))])
    (if (string-contains? name "default:")
              name
              (++ (mod-struct-name m) ":" name))
    ))

(define (asset-description a)
  (asset-struct-description a))



(define/contract (lua-file-for m)
  (-> mod-struct? string?)
  (string-append
                    (path-for m)
                              "/init.lua"))


(define/contract (path-for m)
  (-> mod-struct? string?)
  (string-append MINETEST_PATH "/mods/" (mod-struct-name m)))

(define/contract (compile-v v)
  (-> any/c any/c)
  (cond [(special-compile? v) ((special-compile-f v))]
        [(string? v) (format "\"~a\"" v)]
        [(number? v) (number->string v)]
        [(hash? v) (compile-hash v)]
        [(list? v) (++ "{" (string-join (map compile-v v) ",") "}")]
        [else
         (displayln v)
         (error "Non compilable value")]))

(define/contract (compile-kv k v)
  (-> (or/c string? symbol? number?) any/c string?)
    (format "~a = ~a" k (compile-v v)))

(define/contract (compile-hash h)
  (-> hash? string?)
  (let ([compiled-keys (map (lambda(k) (compile-kv k (hash-ref h k)))
                            (hash-keys h))])
    (++ "{\n"
        (string-join
         (map (curry string-append "  ")
              compiled-keys)
         ",\n")
        "\n}")))

(define/contract (compile-asset-description m i)
  (-> mod-struct? asset-struct? string?)
    (compile-kv "description" (asset-description i)))




;IMAGE SUPPORT.  Could go in a different file...

(require 2htdp/image) 

(provide compileable-image)
(define (compileable-image m id img)
  (special-compile
     (lambda ()
       (export-image-to-file m id img )
       (format "~s" (++ id ".png"))
       )))


(define/contract (export-image-to-file m id img)
  (-> mod-struct? string? image? boolean?)
  (save-image img
              (string-append (path-for m)
                             "/textures/"
                             id ".png")))
;END IMAGE SUPPORT