/// Copyright (C) 2013, Mocchi /// License: Boost ver.1 #include "tcl.h" #include "tk.h" #include #include extern "C" { int Vfs_Init(Tcl_Interp *); int Memchan_Init(Tcl_Interp *); } std::string read_vfs_script(const char *tarfile){ if (!tarfile) return ""; FILE *fp = std::fopen(tarfile, "rb"); if (!fp) return ""; std::string script; char buf[513]; buf[512] = '\0'; int datablocks = 0; long filesize = 0; bool add_to_script = false; while(!std::feof(fp)){ if (datablocks == 0){ // header size_t sz = fread(buf, 512, 1, fp); char typeflag = buf[156]; switch(typeflag){ case '1': case '2': case '3': case '4': case '5': case '6': case '7': continue; } filesize = std::strtol(buf + 124, 0, 8); datablocks = (filesize + 511) / 512; add_to_script = (std::strstr(buf, "vfs1.3/tarvfs.tcl") != 0) || (std::strstr(buf, "vfs1.3/vfsUtils.tcl") != 0); }else if (add_to_script){ size_t sz = std::fread(buf, 512, 1, fp); --datablocks; if (!add_to_script) continue; if (filesize < 512) buf[filesize] = '\0'; script += buf; filesize -= 512; }else{ std::fseek(fp, datablocks * 512, SEEK_CUR); datablocks = filesize = 0; } } std::fclose(fp); return script; } int main(int argc, char *argv[]){ Tcl_Interp *interp = ::Tcl_CreateInterp(); Tcl_FindExecutable(argv[0]); int rc; ::Tcl_StaticPackage(interp, "Tcl", Tcl_Init, 0); ::Tcl_StaticPackage(interp, "Tk", Tk_Init, 0); ::Tcl_StaticPackage(interp, "vfs", Vfs_Init, 0); ::Tcl_StaticPackage(interp, "memchan", Memchan_Init, 0); // 実行ファイルのディレクトリを取得 std::string exedir = argv[0]; exedir = exedir.substr(0, exedir.find_last_of('\\')+1); for (size_t i = 0; i < exedir.size(); ++i) if (exedir[i] == '\\') exedir[i] = '/'; ::Tcl_SetVar2(interp, "tcl_library", 0, (exedir + "lib/tcl8.5/").c_str(), TCL_GLOBAL_ONLY); // tarファイル をマウントするために必要なモジュール群をロード rc = ::Vfs_Init(interp); rc = ::Memchan_Init(interp); // tarファイル をマウントするために必要なスクリプトをtarファイルの中から見つけて取得 std::string scr = read_vfs_script((exedir + "tcl_rt.tar").c_str()); rc = ::Tcl_Eval(interp, scr.c_str()); // tarファイル をマウント rc = ::Tcl_Eval(interp, "package require vfs::tar;"); rc = ::Tcl_Eval(interp, "vfs::tar::Mount $tcl_library/../../tcl_rt.tar $tcl_library/../;"); // Tcl、Tk の初期化 rc = ::Tcl_Init(interp); rc = ::Tk_Init(interp); // デモを動かす Tcl_Eval(interp, "source $tcl_library/../tk8.5/demos/widget;"); Tk_MainLoop(); return 0; }