306 lines
6.9 KiB
Racket
306 lines
6.9 KiB
Racket
#lang racket
|
|
|
|
(provide ++)
|
|
(provide zip)
|
|
(provide all-true)
|
|
(provide asset-struct)
|
|
(provide mod-struct)
|
|
(provide mod-struct-blocks)
|
|
(provide mod-struct-items)
|
|
(provide mod-struct-recipes)
|
|
(provide mod-struct-lua-defs)
|
|
(provide mod-struct-entities)
|
|
(provide MINETEST_PATH)
|
|
(provide path-for)
|
|
(provide asset-name)
|
|
(provide asset-short-name)
|
|
|
|
(provide add-behaviour)
|
|
|
|
(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 anonymous-compileable-image)
|
|
|
|
(provide lua-file-for)
|
|
|
|
(provide path-for)
|
|
|
|
(provide tree-map)
|
|
|
|
|
|
|
|
(provide mod-struct)
|
|
(provide mod-struct?)
|
|
(provide mod-struct-name)
|
|
|
|
(provide add-to-more)
|
|
|
|
(provide set-my-mod!)
|
|
(provide my-mod)
|
|
|
|
(provide add-item)
|
|
(provide add-block)
|
|
(provide add-recipe)
|
|
(provide add-lua-def)
|
|
(provide add-entity)
|
|
|
|
|
|
(provide list_)
|
|
|
|
(provide variableify)
|
|
|
|
(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)
|
|
))
|
|
|
|
(define (zip l1 l2)
|
|
(map list l1 l2))
|
|
|
|
(define (with-index l1)
|
|
(zip l1 (range (length l1))))
|
|
|
|
(define (filter-index pred l)
|
|
(map first
|
|
(filter (lambda (x) (pred (second x)))
|
|
(with-index l))))
|
|
|
|
(define (evens l)
|
|
(filter-index even? l))
|
|
|
|
(define (odds l)
|
|
(filter-index odd? l))
|
|
|
|
(provide in-pairs)
|
|
(define (in-pairs l)
|
|
(zip (evens l) (odds l)))
|
|
|
|
;CONFIG
|
|
|
|
;(define MINETEST_PATH "/home/thoughtstem/.minetest/")
|
|
|
|
(define home (find-system-path 'home-dir))
|
|
|
|
(define MINETEST_PATH
|
|
(cond
|
|
[(eq? (system-type 'os) 'unix) (string-append (path->string home) ".minetest/")]
|
|
[(eq? (system-type 'os) 'macosx) (string-append (path->string home) "Library/Application Support/minetest")]
|
|
[(eq? (system-type 'os) 'windows) "C:/minetest/"]))
|
|
|
|
;DATA STRUCTURES
|
|
|
|
(struct special-compile (f))
|
|
|
|
(struct mod-struct (name items blocks recipes entities 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 (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-entities 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 (variableify (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 (add-entity m i)
|
|
(struct-copy mod-struct m
|
|
[entities (cons i (mod-struct-entities m))]))
|
|
|
|
|
|
|
|
(define (variableify s)
|
|
(string-downcase
|
|
(string-replace
|
|
(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 [(asset-struct? v) (format "~s" (asset-name v))]
|
|
[(image? v) (compile-v (anonymous-compileable-image v))]
|
|
[(special-compile? v) ((special-compile-f v))]
|
|
[(string? v) (format "\"~a\"" v)]
|
|
[(number? v) (number->string v)]
|
|
[(boolean? v) (if v "true" "false")]
|
|
[(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 (anonymous-compileable-image img)
|
|
(compileable-image my-mod (random-file-id) img))
|
|
|
|
(provide random-file-id)
|
|
(define (random-file-id)
|
|
(number->string (random 1000000)))
|
|
|
|
(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
|
|
|
|
(provide append-to-file)
|
|
(define (append-to-file f-name s)
|
|
(begin
|
|
;(displayln (++ "Appending to file? " f-name))
|
|
(with-output-to-file f-name #:exists 'append
|
|
(thunk
|
|
(printf
|
|
(++
|
|
s
|
|
"--\n\n"))))
|
|
s))
|