minetest/core.rkt

251 lines
5.6 KiB
Racket

#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