GLUT + MzScheme (2)

前回はhello, worldを表示しただけだった。
今回はテキストビューアをつくる。
テキストのエンコーディングはShift_JISとする。

実装

まずいくつかの関数を定義しておく。

• readlines

  ファイルを読み各行をbyte stringにしてリストを作って返す。

  (define (readlines name)
    (let ((port (open-input-file name)))
      (let loop ((xs '()))
        (let ((x (read-bytes-line port 'return-linefeed)))
          (cond
            ((eof-object? x) (close-input-port port) (reverse! xs))
            (else (loop (cons x xs))))))))
  

• char-type

  一言でいうと、次のバイトが半角か全角の第1バイトか、
  全角だとしたら第1面か第2面か、などを判定する。
  Shift_JISでは半角文字は必ず1バイトで全角文字は必ず2バイトになる。

  (define (char-type c)
    (cond
      ((<= #x00 c #x1f) 'control)
      ((= #x20 c) 'space)
      ((<= #x21 c #x7e) 'ascii)
      ((= #x7f c) 'delete)
      ((= #x80 c) '?)
      ((<= #x81 c #x9f) 'jis1)
      ((= #xa0 c) '?)
      ((<= #xa1 c #xdf) 'kana)
      ((<= #xe0 c #xef) 'jis1)
      ((<= #xf0 c #xfc) 'jis2)
      (else '?)))
  

• conv!

  byte stringを破壊的に書き換えてShift_JISからEUCのようなものに変換する。
  ちなみにEUC-JPの半角カナは2バイト (0x8exx) で
  JISX0213の第2面は3バイト (0x8fxxxx) らしいが無視する。

  (define (conv! s i)
    (define blank #x20)
    (case (char-type (bytes-ref s i))
      ((ascii space) 1)
      ((jis1)
       (if (not (< (+ i 1) (bytes-length s))) (begin (bytes-set! s i blank) 1)
         (let ((c (bytes-ref s i))
               (d (bytes-ref s (+ i 1))))
           (when (<= #xe0 c) (set! c (- c #x40)))
           (set! c (- c #x81))
           (when (< #x7f d) (set! d (- d 1)))
           (set! d (- d #x40))
           (bytes-set! s i (+ (* c 2) (quotient d 94) #xa1))
           (bytes-set! s (+ i 1) (+ (modulo d 94) #xa1))
           2)))
      (else (bytes-set! s i blank) 1)))
  

• readlines-sjis

  readlinesして各文字に対してconv!したものを返す。

  (define (readlines-sjis name)
    ((lambda (f xs) (for-each f xs) xs)
     (lambda (x)
       (do ((i 0 (+ i (conv! x i))))
         ((>= i (bytes-length x)))))
     (readlines (bytes->path name))))
  

• set-buf!

  一番下の行にファイル名を表示。
  30行のうち上の28行でファイルの中身を表示。
  1行が80バイトを超えたらその分は表示しない (いつか改良する)。

  (define (set-buf! buf xs name)
    (bytes-fill! buf #x20)
    (do ((i 0 (+ i 1)) (xs xs (cdr xs)))
      ((or (= 28 i) (null? xs)))
      (bytes-copy! buf (* i 80) (car xs) 0 (min 80 (bytes-length (car xs)))))
    (bytes-copy! buf (* 29 80) name 0 (min 80 (bytes-length name)))
    (redisplay buf))
  

ここまで書けたら後は簡単。
ls.txtに見たいファイルの一覧を書いておく方式にしてみた。

(define buf (make-bytes (* 80 30)))
(define nf (readlines "ls.txt"))
(when (null? nf) (exit))
(define pf '())
(define nl (readlines-sjis (car nf)))
(define pl '())

(define (next-line)
  (when (and (pair? nl) (pair? (cdr nl)))
    (set! pl (cons (car nl) pl))
    (set! nl (cdr nl))
    (set-buf! buf nl (car nf))))

(define (prev-line)
  (when (pair? pl)
    (set! nl (cons (car pl) nl))
    (set! pl (cdr pl))
    (set-buf! buf nl (car nf))))

(define (prev-file)
  (when (pair? pf)
    (set! nf (cons (car pf) nf))
    (set! pf (cdr pf))
    (set! nl (readlines-sjis (car nf)))
    (set! pl '())
    (collect-garbage)
    (set-buf! buf nl (car nf))))

(define (next-file)
  (when (pair? (cdr nf))
    (set! pf (cons (car nf) pf))
    (set! nf (cdr nf))
    (set! nl (readlines-sjis (car nf)))
    (set! pl '())
    (collect-garbage)
    (set-buf! buf nl (car nf))))

(set-keyboardfunc
  (lambda (key x y)
    (case (integer->char key)
      ((#\q) (exit))
      ((#\j) (next-line))
      ((#\k) (prev-line))
      ((#\h) (prev-file))
      ((#\l) (next-file)))))

(set-buf! buf nl (car nf))

問題点

遅い。
glBitmapが遅いという噂を聞いていたので早速書き直す。

main2.c

glBitmapの代わりにテクスチャを使う。
その部分だけを変更すればよい。

#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;
}

/* {{{ 追加 */
static unsigned char texture[512][1024];
void bitmap(int x, int y, int w, int h, const unsigned char *p)
{
  int i, j;
  const unsigned char *q;
  unsigned mask;

  for (j = 0; j < h; ++j) {
    q = p + (h - 1 - j) * ((w - 1) / 8 + 1);
    mask = 0x80;
    for (i = 0; i < w; ++i) {
      texture[y + j][x + i] = *q & mask ? 0xff : 0;
      mask >>= 1;
      if (!mask) {
        mask = 0x80;
        ++q;
      }
    }
  }
}
/* }}} */

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]));
        */
        if (x + 1 == buf_size_x) {
          bitmap(x * 8, y * 16 + 1, 8, 14, ascii(' '));
        } else {
          bitmap(x * 8, y * 16 + 1, 16, 14, kanji(q[0], q[1]));
        }
        ++x;
        /* }}} */
      } else {
        /* {{{ 変更 */
        /*
        glBitmap(7, 14, -1.0, 15.0, 8.0, 0.0, ascii(*q));
        */
        bitmap(x * 8, y * 16 + 1, 8, 14, ascii(*q));
        /* }}} */
      }
    }
  }
  /* {{{ 追加 */
  glEnable(GL_TEXTURE_2D);
  glTexImage2D(GL_TEXTURE_2D, 0, GL_LUMINANCE, 1024, 512, 0, GL_LUMINANCE,
      GL_UNSIGNED_BYTE, &texture[0][0]);
  glBegin(GL_QUADS);
  glTexCoord2i(0, 0); glVertex2i(0, 0);
  glTexCoord2i(1, 0); glVertex2i(1024, 0);
  glTexCoord2i(1, 1); glVertex2i(1024, 512);
  glTexCoord2i(0, 1); glVertex2i(0, 512);
  glEnd();
  glDisable(GL_TEXTURE_2D);
  /* }}} */
  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);
}

/* {{{ 追加 */
static unsigned texName;
/* }}} */
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);
    /* {{{ 追加 */
    glGenTextures(1, &texName);
    glBindTexture(GL_TEXTURE_2D, texName);
    glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP);
    glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP);
    glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST);
    glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
    glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE);
    /* }}} */

    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;
}