GLUT + MzScheme

仕様

実行するとinit.scmの内容が評価される。

init.scmの中で80×30のbyte stringを用意する。

(define buf (make-bytes (* 80 30)))

そこに適当な文字列を

(bytes-copy! buf 0 #"hello")
(bytes-copy! buf 80 #"world")

のように書き込み

(redisplay buf)

とするとbufの内容が80桁30行でウインドウに表示される。
具体的に何が表示されるかはフォントデータ (ascii.txtとkanji.txt) に依存する。

また、

(set-keyboardfunc (lambda (key x y) ・・・))

でキーボード入力に反応するようにできる。

注意すべきことは

• 遅い
• 日本語を使うには自分でUTF8からEUCのようなものに変換しなければならない
• 3m に対応していない
• MacやCygwinではscheme_set_stack_baseが必要らしい
• Windowsではスレッドを生成するとやばいらしい

コンパイル・実行に使うもの

• MzScheme (CGC)

  CGCとは保守的ガベージコレクションのこと。
  MzSchemeをコンパイルするときにGCの種類を選べるらしい。

  • libmzsch*.lib
  • libmzgc*.lib
  • libmzsch*.dll
  • libmzgc*.dll

  今回のプログラムは3mに対応していません。

• ascii.txtとkanji.txt

  独自形式のフォント。
  行の先頭に半角または全角文字を書き
  その後に28または56桁の16進数を書いたもの。
  16進のa〜fは小文字。改行はLFで。
  半角文字は0x21〜0x7e, 全角文字は0xa1〜0xfeを2バイト組み合わせる。
  2, 3行だけでもいいし、空のファイルでも一応動く。

• init.scm

  これを書かないと何も起きない。

• Visual C++ Express Editionなど
• Windows Platform SDK
  • WinMM.Lib
  • OpenGL32.Lib
  • GLU32.Lib
  • GL.h
  • GLU.h
• GLUT
  • glut32.lib
  • glut.h
  • glut32.dll

Schemeを使う準備

• #include "scheme.h"
• scheme_basic_env()

Schemeから呼び出すCの関数の書き方

schem_make_prim_w_arity等を使い関数オブジェクトを作る。

typedef Scheme_Object *(Scheme_Prim)(int argc, Scheme_Object **argv);
Scheme_Object *scheme_make_prim_w_arity(Scheme_Prim *prim, char *name, int mina, int maxa);

mina, maxaで引数の個数を指定する。

そのあとでscheme_add_globalで束縛する。

void scheme_add_global(char *name, Scheme_Object *val, Scheme_Env *env);

CからSchemeの式を評価する方法

• あらかじめscheme_setjmpしておく
• scheme_eval_string, scheme_applyなど

コンパイルの仕方

MzSchemeのヘッダファイルについてはmzcにまかせておけばよい。
ライブラリはソースと同じ場所にコピーすればいいんじゃね

mzc --cc main.c
cl main.obj libmzsch352_000.lib

mzcの--cgcオプションが使えるなら使ったほうがいいと思う。

ソースコード (main.c)

関数は以下の11個。

• error
• フォント関連: ascii, kanji, load_ascii, load_kanji
• Schemeから呼び出されるもの: redisplay, set_keyboardfunc
• GLUTから呼び出されるもの: display, keyboard, resize
• main

#include "scheme.h"

#ifdef MZ_PRECISE_GC
#error
#endif

#include <GL/glut.h>
#include <stdio.h>
#include <stdlib.h>

#define error_if(x) if (x) error(__FILE__, __LINE__)
void error(const char *file, int line)
{
  fprintf(stderr, "%s %d\n", file, line);
  exit(1);
}

/* font */
/* {{{ */
static unsigned char ascii_[94][14];
static unsigned char *kanji_[94][94];
static unsigned char blank[28];

const unsigned char *ascii(int c)
{
  return 0x20 < c && c < 0x7f ? ascii_[c - 0x21] : blank;
}

const unsigned char *kanji(int c1, int c2)
{
  const unsigned char *p;

  if (0xa0 < c1 && c1 < 0xff && 0xa0 < c2 && c2 < 0xff &&
      (p = kanji_[c1 - 0xa1][c2 - 0xa1]) != NULL) {
    return p;
  }
  return blank;
}

#define h(x) ('0' <= (x) && (x) <= '9' ? (x) - '0' : (x) - 'a' + 10)

int load_ascii(const char *filename)
{
  FILE *fp;
  int c;
  int i, j;

  if ((fp = fopen(filename, "rb")) == NULL) {
    return 0;
  }
  while ((c = fgetc(fp)) != EOF) {
    error_if(c <= 0x20 || 0x7f <= c);
    i = c - 0x21;
    for (j = 13; j >= 0; --j) {
      c = fgetc(fp);
      ascii_[i][j] = h(c) << 4;
      c = fgetc(fp);
      ascii_[i][j] |= h(c);
    }
    error_if(fgetc(fp) != '\n');
  }
  error_if(fclose(fp) == EOF);
  return 1;
}

int load_kanji(const char *filename)
{
  FILE *fp;
  int c;
  int i, j, k;

  if ((fp = fopen(filename, "rb")) == NULL) {
    return 0;
  }
  while ((c = fgetc(fp)) != EOF) {
    error_if(c <= 0xa0 || 0xff <= c);
    i = c - 0xa1;
    c = fgetc(fp);
    error_if(c <= 0xa0 || 0xff <= c);
    j = c - 0xa1;
    if (kanji_[i][j]) {
      free(kanji_[i][j]);
    }
    error_if((kanji_[i][j] = malloc(28)) == NULL);
    for (k = 13; k >= 0; --k) {
      c = fgetc(fp);
      kanji_[i][j][k * 2] = h(c) << 4;
      c = fgetc(fp);
      kanji_[i][j][k * 2] |= h(c);
      c = fgetc(fp);
      kanji_[i][j][k * 2 + 1] = h(c) << 4;
      c = fgetc(fp);
      kanji_[i][j][k * 2 + 1] |= h(c);
    }
    error_if((c = fgetc(fp)) != '\n');
  }
  error_if(fclose(fp) == EOF);
  return 1;
}
/* }}} */

static int loading = 1;
static Scheme_Object *buf = NULL;
#define buf_size_x 80
#define buf_size_y 30
#define buf_size (buf_size_x * buf_size_y)
Scheme_Object *redisplay(int argc, Scheme_Object **argv)
{
  error_if(argc != 1);
  buf = *argv;
  error_if(!SCHEME_BYTE_STRINGP(buf));
  error_if(SCHEME_BYTE_STRLEN_VAL(buf) != buf_size);
  if (!loading) {
    glutPostRedisplay();
  }
  return scheme_void;
}

void display(void)
{
  unsigned char *p, *q;
  int x, y;

  glClear(GL_COLOR_BUFFER_BIT);
  if (!buf) {
    glutSwapBuffers();
    return;
  }
  p = SCHEME_BYTE_STR_VAL(buf);
  for (y = 0; y < buf_size_y; ++y) {
    glColor3d(1.0, 1.0, 1.0);
    glRasterPos2i(0, 16 * y);
    for (x = 0; x < buf_size_x; ++x) {
      q = p + y * buf_size_x + x;
      if (q[0] & 0x80) {
        if (++x == buf_size_x) {break;}
        glBitmap(14, 14, -1.0, 15.0, 16.0, 0.0, kanji(q[0], q[1]));
      } else {
        glBitmap(7, 14, -1.0, 15.0, 8.0, 0.0, ascii(*q));
      }
    }
  }
  glutSwapBuffers();
}

static Scheme_Object *keyboardfunc = NULL;
Scheme_Object *set_keyboardfunc(int argc, Scheme_Object **argv)
{
  error_if(argc != 1);
  keyboardfunc = *argv;
  return scheme_void;
}

void keyboard(unsigned char key, int x, int y)
{
  mz_jmp_buf *volatile save = NULL, fresh;
  Scheme_Object *argv[3];

  save = scheme_current_thread->error_buf;
  scheme_current_thread->error_buf = &fresh;
  if (scheme_setjmp(scheme_error_buf)) {
    scheme_current_thread->error_buf = save;
    exit(-1);
  } else if (keyboardfunc) {
    argv[0] = scheme_make_integer((long) key);
    argv[1] = scheme_make_integer(x);
    argv[2] = scheme_make_integer(y);
    scheme_apply(keyboardfunc, 3, argv);
    scheme_current_thread->error_buf = save;
  }
}

void resize(int w, int h)
{
  if (w == 0 || h == 0) {
    return;
  }
  glViewport(0, 0, w, h);
  glMatrixMode(GL_MODELVIEW);
  glLoadIdentity();
  glMatrixMode(GL_PROJECTION);
  glLoadIdentity();
  glTranslated(-1.0, 1.0, 0.0);
  glScaled(2.0 / w, -2.0 / h, 1.0);
}

int main(int argc, char *argv[])
{
  Scheme_Env *e;
  mz_jmp_buf *volatile save, fresh;

  e = scheme_basic_env();
  save = scheme_current_thread->error_buf;
  scheme_current_thread->error_buf = &fresh;
  if (scheme_setjmp(scheme_error_buf)) {
    scheme_current_thread->error_buf = save;
    return -1;
  } else {
    Scheme_Object *f;

    error_if(!load_ascii("ascii.txt"));
    error_if(!load_kanji("kanji.txt"));

    glutInit(&argc, argv);
    glutInitDisplayMode(GLUT_RGBA | GLUT_DOUBLE);
    glutInitWindowSize(640, 480);

    glutCreateWindow(argv[0]);
    glutDisplayFunc(display);
    glutKeyboardFunc(keyboard);
    glutReshapeFunc(resize);

    glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
    glClearColor(0.0, 0.0, 0.5, 1.0);

    f = scheme_make_prim_w_arity(set_keyboardfunc, "set-keyboardfunc", 1, 1);
    scheme_add_global("set-keyboardfunc", f, e);
    f = scheme_make_prim_w_arity(redisplay, "redisplay", 1, 1);
    scheme_add_global("redisplay", f, e);

    loading = 1;
    scheme_eval_string("(load \"init.scm\")", e);
    loading = 0;

    glutMainLoop();
    scheme_current_thread->error_buf = save;
  }
  return 0;
}