refactored so assets are easier to add more key vals to (add-behaviour-to) form
Lindsey Handley
parent
9cb9592eab
commit
d649fd8b9d
90
blocks.rkt
90
blocks.rkt
|
|
@ -1,8 +1,6 @@
|
|||
#lang racket
|
||||
|
||||
(provide block-struct)
|
||||
(provide block-struct?)
|
||||
(provide compile-blocks)
|
||||
|
||||
(provide define-block)
|
||||
|
||||
(provide default-block)
|
||||
|
|
@ -20,19 +18,33 @@
|
|||
; groups = {cracky=3, stone=1}
|
||||
;})
|
||||
|
||||
(struct block-struct asset-struct (tiles groups) #:transparent)
|
||||
;(struct block-struct asset-struct (tiles groups) #:transparent)
|
||||
|
||||
(define (block-struct name desc tiles m)
|
||||
(asset-struct name desc
|
||||
(make-immutable-hash
|
||||
(list
|
||||
(cons 'tiles
|
||||
(map (curry compileable-tile m name)
|
||||
tiles
|
||||
(range (length tiles))
|
||||
))))
|
||||
m))
|
||||
|
||||
(define (compileable-tile m prefix img i)
|
||||
(compileable-image m (format "~a_~a" prefix i) img))
|
||||
|
||||
;;Makes a stub -- e.g. for default:stone
|
||||
(define (default-block id)
|
||||
(block-struct (++ "" id)
|
||||
(++ "The default " id)
|
||||
'()
|
||||
'()))
|
||||
default-mod))
|
||||
|
||||
(define-syntax (define-default-block stx)
|
||||
(syntax-case stx ()
|
||||
[(_ x )
|
||||
(with-syntax* ([name (symbol->string (format-symbol "default:~a" #'x))])
|
||||
(with-syntax* ([name (symbol->string (format-symbol "~a" #'x))])
|
||||
#`(begin
|
||||
(define x (default-block name) )
|
||||
(provide x)
|
||||
|
|
@ -43,7 +55,6 @@
|
|||
[(_ x ... )
|
||||
#`(begin
|
||||
(define-default-block x ) ...
|
||||
|
||||
) ]))
|
||||
|
||||
(define-default-blocks
|
||||
|
|
@ -73,72 +84,9 @@
|
|||
(syntax-case stx ()
|
||||
[(_ id desc tiles ... )
|
||||
(with-syntax* ([item-id (format-id stx "~a" #'id)]
|
||||
|
||||
[name (symbol->string (format-symbol "~a" #'id))])
|
||||
#`(begin
|
||||
; (define my-mod (empty-mod))
|
||||
(define id (block-struct name desc (list tiles ...) '()))
|
||||
(define id (block-struct name desc (list_ tiles ...) my-mod))
|
||||
(set-my-mod! (add-block my-mod id)))
|
||||
)]))
|
||||
|
||||
(define/contract (export-tiles-to-file m b)
|
||||
(-> mod-struct? block-struct? (listof boolean?))
|
||||
(map save-image
|
||||
(block-struct-tiles b)
|
||||
(map (lambda (n)
|
||||
(++ (path-for m)
|
||||
"/textures/"
|
||||
n))
|
||||
(block-file-names b))))
|
||||
|
||||
|
||||
(define/contract (block-file-names b)
|
||||
(-> block-struct? (listof string?))
|
||||
(map (lambda (num) (++ (asset-struct-name b) "_tile_" (number->string num) ".png"))
|
||||
(range (length (block-struct-tiles b)))))
|
||||
|
||||
(define/contract (compile-block-tiles m b)
|
||||
(-> mod-struct? block-struct? string?)
|
||||
(let ([file-names (block-file-names b)])
|
||||
(format "tiles = ~a" (compile-arr file-names STR_TYPE))))
|
||||
|
||||
|
||||
(define/contract (compile-block-group m b)
|
||||
(-> mod-struct? block-struct? string?)
|
||||
(format "groups = ~a" (compile-ass-arr
|
||||
(block-struct-groups b)
|
||||
SYM_TYPE
|
||||
INT_TYPE)))
|
||||
|
||||
|
||||
|
||||
(define/contract (compile-block m b)
|
||||
(-> mod-struct? block-struct? string?)
|
||||
(++ "-- My block is named " (asset-name m b) "\n"
|
||||
(format
|
||||
" minetest.register_node(\"~a\", {
|
||||
~a,
|
||||
~a,
|
||||
~a,
|
||||
})\n\n" (asset-name m b)
|
||||
(compile-asset-description m b)
|
||||
(compile-block-tiles m b)
|
||||
(compile-block-group m b)
|
||||
)))
|
||||
|
||||
(define/contract (export-block-code m b)
|
||||
(-> mod-struct? block-struct? boolean?)
|
||||
(with-output-to-file (lua-file-for m) #:exists 'append
|
||||
(lambda () (printf (++
|
||||
(compile-block m b)
|
||||
"\n"))))
|
||||
#t)
|
||||
|
||||
|
||||
(define/contract (compile-blocks m is)
|
||||
(-> mod-struct? (listof block-struct?) boolean?)
|
||||
(and
|
||||
(all-true (flatten (map (curry export-tiles-to-file m) is)))
|
||||
(all-true (map (curry export-block-code m) is))
|
||||
))
|
||||
|
||||
|
|
|
|||
88
compiler.rkt
88
compiler.rkt
|
|
@ -2,18 +2,62 @@
|
|||
|
||||
(require 2htdp/image)
|
||||
|
||||
(provide mod)
|
||||
(provide compile-mod)
|
||||
|
||||
(require "core.rkt")
|
||||
(require "items.rkt")
|
||||
(require "blocks.rkt")
|
||||
(require "recipes.rkt")
|
||||
(require "lua.rkt")
|
||||
|
||||
|
||||
;Can be redone to return a special-compile.
|
||||
; Then the compiler just compiles all the assets wrapped in special compiles...
|
||||
; Then writes to the file.
|
||||
(define (compile-item i)
|
||||
(special-compile
|
||||
(thunk
|
||||
|
||||
(++ "-- My item is named " (asset-name i) "\n"
|
||||
(format
|
||||
"minetest.register_craftitem(\"~a\", ~a)\n\n"
|
||||
(asset-name i)
|
||||
(compile-v (asset->hash i)))))))
|
||||
|
||||
(define (compile-block b)
|
||||
(special-compile
|
||||
(thunk
|
||||
(++ "-- My block is named " (asset-name b) "\n"
|
||||
(format
|
||||
"minetest.register_node(\"~a\", ~a)\n\n"
|
||||
(asset-name b)
|
||||
(compile-v (asset->hash b)))))))
|
||||
|
||||
(define (compile-recipe b)
|
||||
(special-compile
|
||||
(thunk
|
||||
(++ "-- My recipe... \n"
|
||||
(format
|
||||
"minetest.register_craft(~a)\n\n"
|
||||
(compile-v (asset->hash b)))))))
|
||||
|
||||
|
||||
(define (compile-lua-def b)
|
||||
(special-compile
|
||||
(thunk
|
||||
(++ "-- Some lua code sent by Racket \n"
|
||||
(asset-struct-more b)))))
|
||||
|
||||
|
||||
(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))
|
||||
|
||||
(define/contract (compile-mod m)
|
||||
(-> mod-struct? boolean?)
|
||||
(displayln m)
|
||||
(make-directory* (path-for m))
|
||||
(make-directory* (++ (path-for m) "/textures"))
|
||||
(with-output-to-file (lua-file-for m) #:exists 'replace
|
||||
|
|
@ -21,15 +65,27 @@
|
|||
"-- This is my mod! It's called "
|
||||
(mod-struct-name m)
|
||||
"\n\n\n"))))
|
||||
(and
|
||||
(compile-lua-defs m (mod-struct-lua-defs m))
|
||||
(compile-blocks m (mod-struct-blocks m))
|
||||
(compile-items m (mod-struct-items m))
|
||||
(compile-recipes m (mod-struct-recipes m))
|
||||
))
|
||||
(map (curry append-to-file (lua-file-for m))
|
||||
(map compile-v
|
||||
(append
|
||||
(map compile-lua-def
|
||||
(mod-struct-lua-defs m))
|
||||
(map compile-item
|
||||
(mod-struct-items m))
|
||||
(map compile-block
|
||||
(mod-struct-blocks m))
|
||||
(map compile-recipe
|
||||
(mod-struct-recipes m))
|
||||
)))
|
||||
#t)
|
||||
|
||||
|
||||
; (and
|
||||
; (compile-lua-defs m (mod-struct-lua-defs m))
|
||||
; (compile-blocks m (mod-struct-blocks m))
|
||||
; (compile-items m (mod-struct-items m))
|
||||
; (compile-recipes m (mod-struct-recipes m))
|
||||
; )
|
||||
;)
|
||||
|
||||
|
||||
(define (mod name . things )
|
||||
(mod-struct name (filter item-struct? things)
|
||||
(filter block-struct? things)
|
||||
'()))
|
||||
|
|
|
|||
150
core.rkt
150
core.rkt
|
|
@ -13,19 +13,19 @@
|
|||
(provide asset-short-name)
|
||||
|
||||
(provide asset-struct)
|
||||
(provide asset-struct?)
|
||||
(provide asset-struct-name)
|
||||
(provide asset-struct-more)
|
||||
(provide asset->hash)
|
||||
|
||||
(provide compile-arr)
|
||||
(provide compile-ass-arr)
|
||||
(provide compile-v)
|
||||
(provide special-compile)
|
||||
(provide special-compile-f)
|
||||
|
||||
(provide compile-asset-description)
|
||||
|
||||
(provide lua-file-for)
|
||||
|
||||
(provide STR_TYPE)
|
||||
(provide SYM_TYPE)
|
||||
(provide INT_TYPE)
|
||||
|
||||
(provide path-for)
|
||||
|
||||
(provide tree-map)
|
||||
|
|
@ -44,14 +44,20 @@
|
|||
(provide add-recipe)
|
||||
(provide add-lua-def)
|
||||
|
||||
(define STR_TYPE "~s")
|
||||
(define INT_TYPE "~a")
|
||||
(define SYM_TYPE "~a")
|
||||
(define ARR_TYPE "ARR_TYPE")
|
||||
(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)
|
||||
|
|
@ -71,9 +77,64 @@
|
|||
|
||||
;DATA STRUCTURES
|
||||
|
||||
(struct mod-struct (name items blocks recipes lua-defs) #:transparent)
|
||||
(struct special-compile (f))
|
||||
|
||||
(struct asset-struct (name description) #:transparent)
|
||||
(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" '() '() '() '()))
|
||||
|
|
@ -111,8 +172,9 @@
|
|||
(define (asset-short-name m a)
|
||||
(second (string-split (asset-name m a) ":")))
|
||||
|
||||
(define (asset-name m a)
|
||||
(let ([name (variableify (asset-struct-name 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))
|
||||
|
|
@ -134,26 +196,56 @@
|
|||
(-> 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?)
|
||||
(format "description = ~s" (asset-description i)))
|
||||
(compile-kv "description" (asset-description i)))
|
||||
|
||||
|
||||
(define/contract (compile-arr arr type)
|
||||
(-> list? any/c string?)
|
||||
(format
|
||||
"{~a}"
|
||||
(string-join
|
||||
(map (lambda (x) (format type x))
|
||||
arr) ",")))
|
||||
|
||||
|
||||
(define/contract (compile-ass-arr arr type1 type2)
|
||||
(-> list? any/c any/c string?)
|
||||
(format
|
||||
"{~a}"
|
||||
(string-join
|
||||
(map (lambda (x) (format (++ type1 "=" type2) (first x) (second x)))
|
||||
arr) ",")))
|
||||
;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
|
||||
|
|
@ -290,7 +290,7 @@
|
|||
0 -1 -1 4 1 #"\0"
|
||||
0 -1 1 #"\0"
|
||||
1.0 0 92 -1 -1 -1 -1 -1 0 0 0 0 0 1 0.0 0.0 0.0 0.0 0.0 0.0 0 0 0 255
|
||||
255 0 -1 -1 0 558 0 28 3 12 #"#lang racket"
|
||||
255 0 -1 -1 0 571 0 28 3 12 #"#lang racket"
|
||||
0 0 24 29 1 #"\n"
|
||||
0 0 24 29 1 #"\n"
|
||||
0 0 17 3 14 #";Housecleaning"
|
||||
|
|
@ -369,7 +369,7 @@
|
|||
0 0 15 3 7 #"require"
|
||||
0 0 24 3 1 #" "
|
||||
0 0 19 3 9 #"\"lua.rkt\""
|
||||
0 0 24 3 1 #")"
|
||||
0 0 24 3 3 #") "
|
||||
0 0 24 29 1 #"\n"
|
||||
0 0 24 3 1 #"("
|
||||
0 0 15 3 7 #"require"
|
||||
|
|
@ -378,6 +378,7 @@
|
|||
0 0 24 3 1 #")"
|
||||
0 0 24 29 1 #"\n"
|
||||
0 0 24 29 1 #"\n"
|
||||
0 0 24 3 1 #" "
|
||||
0 0 24 29 1 #"\n"
|
||||
0 0 17 3 9 #";MY MOD!!"
|
||||
0 0 24 29 1 #"\n"
|
||||
|
|
@ -684,6 +685,8 @@
|
|||
0 0 24 3 2 #"))"
|
||||
0 0 24 29 1 #"\n"
|
||||
0 0 24 29 1 #"\n"
|
||||
0 0 24 29 1 #"\n"
|
||||
0 0 24 29 1 #"\n"
|
||||
0 0 24 3 1 #"("
|
||||
0 0 15 3 12 #"define-block"
|
||||
0 0 24 3 1 #" "
|
||||
|
|
@ -774,6 +777,8 @@
|
|||
0 0 24 3 2 #"))"
|
||||
0 0 24 29 1 #"\n"
|
||||
0 0 24 29 1 #"\n"
|
||||
0 0 24 29 1 #"\n"
|
||||
0 0 24 29 1 #"\n"
|
||||
0 0 24 3 1 #"("
|
||||
0 0 15 3 12 #"define-block"
|
||||
0 0 24 3 1 #" "
|
||||
|
|
@ -786,14 +791,7 @@
|
|||
0 0 14 3 10 #"cool-block"
|
||||
0 0 24 3 1 #" "
|
||||
0 0 19 3 8 #"\"yellow\""
|
||||
0 0 24 3 1 #")"
|
||||
0 0 24 29 1 #"\n"
|
||||
0 0 24 3 2 #" "
|
||||
0 0 17 3 2 #";("
|
||||
0 0 17 3 8 #"on-punch"
|
||||
0 0 17 3 6 #" test)"
|
||||
0 0 24 29 1 #"\n"
|
||||
0 0 24 3 3 #" )"
|
||||
0 0 24 3 2 #"))"
|
||||
0 0 24 29 1 #"\n"
|
||||
0 0 24 29 1 #"\n"
|
||||
0 0 24 29 1 #"\n"
|
||||
|
|
@ -840,6 +838,7 @@
|
|||
0 0 24 3 1 #")"
|
||||
0 0 24 29 1 #"\n"
|
||||
0 0 24 29 1 #"\n"
|
||||
0 0 24 29 1 #"\n"
|
||||
0 0 24 3 1 #"("
|
||||
0 0 15 3 13 #"define-recipe"
|
||||
0 0 24 3 1 #" "
|
||||
|
|
@ -870,12 +869,12 @@
|
|||
0 0 24 29 1 #"\n"
|
||||
0 0 24 29 1 #"\n"
|
||||
0 0 24 29 1 #"\n"
|
||||
0 0 24 29 1 #"\n"
|
||||
0 0 24 3 1 #"("
|
||||
0 0 15 3 10 #"define-lua"
|
||||
0 0 24 3 1 #" "
|
||||
0 0 14 3 3 #"foo"
|
||||
0 0 14 3 8 #"testtest"
|
||||
0 0 24 29 1 #"\n"
|
||||
0 0 24 3 2 #" "
|
||||
0 0 19 3 1 #"\""
|
||||
0 0 19 29 1 #"\n"
|
||||
0 0 19 3 20 #" return function("
|
||||
|
|
@ -884,25 +883,39 @@
|
|||
0 0 19 3 1 #" "
|
||||
0 0 19 3 4 #"node"
|
||||
0 0 19 3 1 #","
|
||||
0 0 19 3 1 #" "
|
||||
0 0 19 3 7 #"puncher"
|
||||
0 0 19 3 8 #" puncher"
|
||||
0 0 19 3 1 #","
|
||||
0 0 19 3 1 #" "
|
||||
0 0 19 3 13 #"pointed_thing"
|
||||
0 0 19 3 1 #")"
|
||||
0 0 19 29 1 #"\n"
|
||||
0 0 19 3 24 #" print('hello world"
|
||||
0 0 19 3 2 #"')"
|
||||
0 0 19 3 26 #" print('hello world')"
|
||||
0 0 19 29 1 #"\n"
|
||||
0 0 19 3 4 #" "
|
||||
0 0 19 3 3 #"end"
|
||||
0 0 19 3 7 #" end"
|
||||
0 0 19 29 1 #"\n"
|
||||
0 0 19 3 3 #" \""
|
||||
0 0 19 3 1 #"\""
|
||||
0 0 24 3 1 #")"
|
||||
0 0 24 29 1 #"\n"
|
||||
0 0 24 29 1 #"\n"
|
||||
0 0 24 29 1 #"\n"
|
||||
0 0 24 3 1 #"("
|
||||
0 0 14 3 16 #"add-behaviour-to"
|
||||
0 0 24 3 1 #" "
|
||||
0 0 14 3 12 #"yellow_block"
|
||||
0 0 24 29 1 #"\n"
|
||||
0 0 24 3 19 #" ("
|
||||
0 0 14 3 8 #"on_punch"
|
||||
0 0 24 3 2 #" ("
|
||||
0 0 14 3 8 #"call-lua"
|
||||
0 0 24 3 1 #" "
|
||||
0 0 14 3 8 #"testtest"
|
||||
0 0 24 3 3 #")))"
|
||||
0 0 24 29 1 #"\n"
|
||||
0 0 24 29 1 #"\n"
|
||||
0 0 24 29 1 #"\n"
|
||||
0 0 24 29 1 #"\n"
|
||||
0 0 24 29 1 #"\n"
|
||||
0 0 24 3 1 #"("
|
||||
0 0 14 3 11 #"compile-mod"
|
||||
0 0 24 3 1 #" "
|
||||
0 0 14 3 6 #"my-mod"
|
||||
|
|
|
|||
103
items.rkt
103
items.rkt
|
|
@ -1,24 +1,45 @@
|
|||
#lang racket
|
||||
|
||||
(provide item-struct)
|
||||
(provide item-struct?)
|
||||
(provide compile-items)
|
||||
(provide define-item)
|
||||
|
||||
;ONLY provide this to the end user?
|
||||
(provide custom-item)
|
||||
(provide define-item)
|
||||
|
||||
(require 2htdp/image)
|
||||
(require "core.rkt")
|
||||
(require (for-syntax racket/syntax))
|
||||
|
||||
(struct item-struct asset-struct (image) #:transparent)
|
||||
;(struct item-struct asset-struct (image) #:transparent)
|
||||
|
||||
;Was a struct... not anymore...
|
||||
(define (item-struct id desc img m)
|
||||
(asset-struct id desc (make-immutable-hash
|
||||
(list
|
||||
(cons 'inventory_image
|
||||
(compileable-image m id img))
|
||||
))
|
||||
m))
|
||||
|
||||
|
||||
(define-syntax (define-item stx)
|
||||
(syntax-case stx ()
|
||||
[(_ id desc image)
|
||||
(with-syntax* ([item-id (format-id stx "~a" #'id)]
|
||||
[name (symbol->string (format-symbol "~a" #'id))])
|
||||
#`(begin
|
||||
(define id (item-struct name desc image my-mod))
|
||||
(set-my-mod! (add-item my-mod id)))
|
||||
)]))
|
||||
|
||||
;id desc img m
|
||||
;;Makes a stub -- e.g. for default:stone
|
||||
(define (default-item id)
|
||||
(item-struct (++ "" id)
|
||||
(++ "The default " id)
|
||||
(circle 0 "solid" "transparent")))
|
||||
(++ "The default " id)
|
||||
(circle 0 "solid" "transparent")
|
||||
default-mod))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
(define-syntax (define-default-item stx)
|
||||
(syntax-case stx ()
|
||||
|
|
@ -88,67 +109,3 @@ sword_diamond
|
|||
key)
|
||||
|
||||
|
||||
|
||||
(define/contract (export-image-to-file m i)
|
||||
(-> mod-struct? item-struct? boolean?)
|
||||
(save-image (item-struct-image i)
|
||||
(string-append (path-for m)
|
||||
"/textures/"
|
||||
(asset-short-name m i) ".png")))
|
||||
|
||||
|
||||
(define/contract (compile-item-inventory_image m i)
|
||||
(-> mod-struct? item-struct? string?)
|
||||
(format "inventory_image = ~s" (++ (asset-short-name m i) ".png") ))
|
||||
|
||||
;minetest.register_craftitem("test:diamond_fragments", {
|
||||
; description = "Alien Diamond Fragments",
|
||||
; inventory_image = "my_diamonds.png"
|
||||
;})
|
||||
(define/contract (compile-item m i)
|
||||
(-> mod-struct? item-struct? string?)
|
||||
(++ "-- My item is named " (asset-name m i) "\n"
|
||||
(format
|
||||
" minetest.register_craftitem(\"~a\", {
|
||||
~a,
|
||||
~a,
|
||||
})\n\n" (asset-name m i)
|
||||
(compile-asset-description m i)
|
||||
(compile-item-inventory_image m i))))
|
||||
|
||||
(define/contract (export-item-code m i)
|
||||
(-> mod-struct? item-struct? boolean?)
|
||||
(with-output-to-file (lua-file-for m) #:exists 'append
|
||||
(lambda () (printf (++
|
||||
(compile-item m i)
|
||||
"\n"))))
|
||||
#t)
|
||||
|
||||
|
||||
|
||||
|
||||
(define (custom-item name
|
||||
(image "missing.png")
|
||||
(desc "Missing Description"))
|
||||
(item-struct name desc image))
|
||||
|
||||
|
||||
(define-syntax (define-item stx)
|
||||
(syntax-case stx ()
|
||||
[(_ id desc image)
|
||||
(with-syntax* ([item-id (format-id stx "~a" #'id)]
|
||||
[name (symbol->string (format-symbol "~a" #'id))])
|
||||
#`(begin
|
||||
(define id (custom-item name image desc))
|
||||
(set-my-mod! (add-item my-mod id)))
|
||||
)]))
|
||||
|
||||
|
||||
(define/contract (compile-items m is)
|
||||
(-> mod-struct? (listof item-struct?) boolean?)
|
||||
(and
|
||||
(all-true (map (curry export-image-to-file m) is))
|
||||
(all-true (map (curry export-item-code m) is))
|
||||
))
|
||||
|
||||
|
||||
|
|
|
|||
38
lua.rkt
38
lua.rkt
|
|
@ -1,43 +1,31 @@
|
|||
#lang racket
|
||||
|
||||
(provide define-lua)
|
||||
(provide lua)
|
||||
(provide lua-code)
|
||||
(provide compile-lua-defs)
|
||||
(provide call-lua)
|
||||
|
||||
(require "core.rkt")
|
||||
(require (for-syntax racket/syntax))
|
||||
|
||||
(struct lua (name code) #:transparent)
|
||||
;Basically a thunk in lua
|
||||
(define (lua-def id code m)
|
||||
(asset-struct id ""
|
||||
(++ "function " id "()\n"
|
||||
code
|
||||
"\nend\n")
|
||||
m))
|
||||
|
||||
(define (lua-call code)
|
||||
(lua "" code))
|
||||
(define (call-lua ref)
|
||||
(special-compile
|
||||
(thunk
|
||||
(format "~a()" (asset-struct-name ref)))))
|
||||
|
||||
(define/contract (compile-lua-def m d)
|
||||
(-> mod-struct? lua? string?)
|
||||
(++ "-- Some lua code sent by Racket\n"
|
||||
"function " (lua-name d) "()\n"
|
||||
(lua-code d)
|
||||
"end\n"))
|
||||
|
||||
(define/contract (export-lua-def-code m i)
|
||||
(-> mod-struct? lua? boolean?)
|
||||
(with-output-to-file (lua-file-for m) #:exists 'append
|
||||
(lambda () (printf (++
|
||||
(compile-lua-def m i)
|
||||
"\n"))))
|
||||
#t)
|
||||
|
||||
(define/contract (compile-lua-defs m defs)
|
||||
(-> mod-struct? (listof lua?) boolean?)
|
||||
(all-true (map (curry export-lua-def-code m) defs)))
|
||||
|
||||
(define-syntax (define-lua stx)
|
||||
(syntax-case stx ()
|
||||
[(_ id body-string)
|
||||
(with-syntax* ([name (symbol->string (format-symbol "~a" #'id))])
|
||||
#`(begin
|
||||
(define id (lua name body-string) )
|
||||
(define id (lua-def name body-string my-mod) )
|
||||
(set-my-mod! (add-lua-def my-mod id))
|
||||
) ) ]))
|
||||
|
||||
|
|
|
|||
107
recipes.rkt
107
recipes.rkt
|
|
@ -1,8 +1,5 @@
|
|||
#lang racket
|
||||
|
||||
(provide recipe-struct)
|
||||
(provide recipe-struct?)
|
||||
(provide compile-recipes)
|
||||
(provide define-recipe)
|
||||
|
||||
(require (for-syntax racket/syntax))
|
||||
|
|
@ -10,74 +7,42 @@
|
|||
(require 2htdp/image)
|
||||
(require "core.rkt")
|
||||
|
||||
(struct recipe-struct asset-struct (num output inputs) #:transparent)
|
||||
|
||||
(define (compile-recipe-output m r)
|
||||
(let ([name (asset-name m (recipe-struct-output r))])
|
||||
(format "output = \"~a ~a\""
|
||||
name
|
||||
(recipe-struct-num r))))
|
||||
|
||||
(define (compile-recipe-input m r)
|
||||
(let ([asset-names (map
|
||||
(curry asset-name m)
|
||||
(recipe-struct-inputs r))])
|
||||
(format "recipe = ~a" (compile-arr asset-names STR_TYPE))))
|
||||
|
||||
(define (compile-recipe-input-shaped m r)
|
||||
(let ([asset-names (tree-map
|
||||
(curry asset-name m)
|
||||
(recipe-struct-inputs r))])
|
||||
(format "recipe = {~a}" (string-join
|
||||
(map (curryr compile-arr STR_TYPE) asset-names)
|
||||
",\n"))))
|
||||
|
||||
;minetest.register_craft({
|
||||
; type = "shapeless",
|
||||
; output = "mymod:diamond",
|
||||
; recipe = {"mymod:diamond_fragments", "mymod:diamond_fragments", "mymod:diamond_fragments"}
|
||||
;})
|
||||
(define/contract (compile-shapeless-recipe m r)
|
||||
(-> mod-struct? recipe-struct? string?)
|
||||
(++ "-- My recipe is named " (asset-name m r) "\n"
|
||||
(format
|
||||
" minetest.register_craft({
|
||||
type = \"shapeless\",
|
||||
~a,
|
||||
~a,
|
||||
})\n\n"
|
||||
(compile-recipe-output m r)
|
||||
(compile-recipe-input m r))))
|
||||
(define (recipe-struct id desc num output inputs m)
|
||||
(asset-struct id
|
||||
desc
|
||||
(make-immutable-hash
|
||||
(list
|
||||
(cons 'type (if (list? (first inputs)) "shaped" "shapeless"))
|
||||
(cons 'output (format "~a ~a"
|
||||
(asset-name output)
|
||||
num))
|
||||
(cons 'recipe (tree-map asset-name inputs))
|
||||
))
|
||||
m))
|
||||
|
||||
(define/contract (compile-shaped-recipe m r)
|
||||
(-> mod-struct? recipe-struct? string?)
|
||||
(++ "-- My recipe is named " (asset-name m r) "\n"
|
||||
(format
|
||||
" minetest.register_craft({
|
||||
~a,
|
||||
~a,
|
||||
})\n\n"
|
||||
(compile-recipe-output m r)
|
||||
(compile-recipe-input-shaped m r))))
|
||||
|
||||
(define (is-shaped? r)
|
||||
(list? (first (recipe-struct-inputs r))))
|
||||
;(define (compile-recipe-input-shaped m r)
|
||||
; (let ([asset-names (tree-map
|
||||
; (curry asset-name m)
|
||||
; (recipe-struct-inputs r))])
|
||||
; (format "recipe = {~a}" (string-join
|
||||
; (map (curryr compile-arr STR_TYPE) asset-names)
|
||||
; ",\n"))))
|
||||
|
||||
(define/contract (compile-recipe m r)
|
||||
(-> mod-struct? recipe-struct? string?)
|
||||
(if (is-shaped? r)
|
||||
(compile-shaped-recipe m r)
|
||||
(compile-shapeless-recipe m r)))
|
||||
|
||||
;;Unshaped version...
|
||||
(define-syntax (define-recipe stx)
|
||||
(syntax-case stx (make: from:)
|
||||
[(_ id make: num output from: (i1 i2 i3) (i4 i5 i6) (i7 i8 i9) )
|
||||
(with-syntax* ([name (symbol->string (format-symbol "~a" #'id))])
|
||||
#`(begin
|
||||
(define id (recipe-struct name "" num output (list (list i1 i2 i3)
|
||||
(define id (asset-struct name "" num output (list (list i1 i2 i3)
|
||||
(list i4 i5 i6)
|
||||
(list i7 i8 i9))))
|
||||
(list i7 i8 i9))
|
||||
my-mod))
|
||||
(set-my-mod! (add-recipe my-mod id)))
|
||||
)]
|
||||
[(_ id make: num output from: (i1 i2) (i3 i4) (i5 i6) )
|
||||
|
|
@ -85,44 +50,30 @@
|
|||
#`(begin
|
||||
(define id (recipe-struct name "" num output (list (list i1 i2)
|
||||
(list i3 i4)
|
||||
(list i5 i6))))
|
||||
(list i5 i6))
|
||||
my-mod))
|
||||
(set-my-mod! (add-recipe my-mod id)))
|
||||
)]
|
||||
[(_ id make: num output from: (i1 i2 i3) (i4 i5 i6) )
|
||||
(with-syntax* ([name (symbol->string (format-symbol "~a" #'id))])
|
||||
#`(begin
|
||||
(define id (recipe-struct name "" num output (list (list i1 i2 i3)
|
||||
(list i4 i5 i6))))
|
||||
(list i4 i5 i6))
|
||||
my-mod))
|
||||
(set-my-mod! (add-recipe my-mod id)))
|
||||
)]
|
||||
[(_ id make: num output from: (i1 i2) (i3 i4) )
|
||||
(with-syntax* ([name (symbol->string (format-symbol "~a" #'id))])
|
||||
#`(begin
|
||||
(define id (recipe-struct name "" num output (list (list i1 i2)
|
||||
(list i3 i4))))
|
||||
(list i3 i4))
|
||||
my-mod))
|
||||
(set-my-mod! (add-recipe my-mod id)))
|
||||
)]
|
||||
[(_ id make: num output from: items ... )
|
||||
(with-syntax* ([name (symbol->string (format-symbol "~a" #'id))])
|
||||
#`(begin
|
||||
(define id (recipe-struct name "" num output (list items ...)))
|
||||
(define id (recipe-struct name "" num output (list items ...) my-mod))
|
||||
(set-my-mod! (add-recipe my-mod id)))
|
||||
)]))
|
||||
|
||||
|
||||
(define/contract (export-recipe-code m i)
|
||||
(-> mod-struct? recipe-struct? boolean?)
|
||||
(with-output-to-file (lua-file-for m) #:exists 'append
|
||||
(lambda () (printf (++
|
||||
(compile-recipe m i)
|
||||
"\n"))))
|
||||
#t)
|
||||
|
||||
|
||||
|
||||
|
||||
(define/contract (compile-recipes m rs)
|
||||
(-> mod-struct? (listof recipe-struct?) boolean?)
|
||||
(all-true (map (curry export-recipe-code m) rs)))
|
||||
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue