# [ʞ] rsrc.janet
# ~ lexi hale <lexi@hale.su>
# ? the usual bullshit
# > CC=cc gd_build_out=out gd_build_gen=gen
# janet rsrc.janet -- <file> <file>...
(def *cc* (gensym))
(def *out-path* (gensym))
(def *gen-path* (gensym))
(defn blob->c-array [data]
(def bytes (string/bytes data))
(def buf @"")
(defn nl [] (buffer/push buf "\n"))
(loop [i :range [0 (length bytes)]
:let [col (mod i 20)
val (data i)]
:after (when (= col 0) (nl))]
(buffer/push buf (string/format "%d," val)))
(string buf))
(defn basename [f] (array/peek (string/split "/" f)))
(defn blob [path]
(print "doing path " path)
(let [fd (file/open path :r)
rec {:id (reduce |(string/replace-all $1 "_" $0)
(basename path) ["-" "." "/"])
:vals (blob->c-array (:read fd :all))}]
(:close fd)
rec))
(defn c-base [t]
(string "const uint8_t gdjn_rsrc_" (t :id) " [" (length (t :vals))"]"))
(defn c-decl [t]
(string "extern " (c-base t)))
(defn c-def [t]
(string (c-base t) " = {" (t :vals) "}"))
(defn c-compile [c to-path]
(def cc (os/spawn [(dyn *cc*)
"-xc" "-c" "-"
"-o" to-path]
:p {:in :pipe}))
(ev/gather (do (:write (cc :in)
"#include <stdint.h>\n")
(ev/write (cc :in) c)
(ev/close (cc :in)))
(os/proc-wait cc)))
(defn build [paths]
(let [ lst (map blob (slice paths 2 -1))
decl (map |(string (c-decl $) ";\n") lst)
impl (map |(string (c-def $) ";\n") lst)
obj-path (string/format "%s/rsrc.o" (dyn *out-path*))
decl-path (string/format "%s/rsrc.h" (dyn *gen-path*))
decl-fd (file/open decl-path :w)]
(:write decl-fd
"#pragma once\n"
"#include <stdint.h>\n")
(each d decl (:write decl-fd d))
(each i impl (c-compile i obj-path))
(:close decl-fd)))
(defn env: [k dflt]
(or (get (os/environ) k) dflt))
(defn main [& argv]
(with-dyns [ *cc* (env: "CC" "cc" )
*out-path* (env: "gd_build_out" "out")
*gen-path* (env: "gd_build_gen" "gen")]
(build argv))
0)