neotype/neotype/scmprims.c

// Guile 関数の定義。
// $Id: scmprims.c,v 1.2 2002/07/30 12:45:04 toru Exp $

#include <guile/gh.h>
#include <stdio.h>

#include "util.h"
#include "pdf.h"
#include "parse.h"
#include "scmprims.h"

void
nt_scm_register_procs ()
{

    gh_new_procedure ("nt-set-text-pos", nt_scm_set_text_pos, 2, 0, 0);
    gh_new_procedure ("nt-font", nt_scm_font, 3, 0, 0);
    gh_new_procedure ("nt-rotate", nt_scm_rotate, 1, 0, 0);
    gh_new_procedure ("nt-translate", nt_scm_translate, 2, 0, 0);
    gh_new_procedure ("nt-show", nt_scm_show, 1, 0, 0);
    gh_new_procedure ("nt-moveto", nt_scm_moveto, 2, 0, 0);
    gh_new_procedure ("nt-lineto", nt_scm_lineto, 2, 0, 0);
    gh_new_procedure ("nt-stroke", nt_scm_stroke, 0, 0, 0);

    gh_new_procedure ("nt-begin-page", nt_scm_begin_page, 2, 0, 0);
    gh_new_procedure ("nt-end-page", nt_scm_end_page, 0, 0, 0);
    gh_new_procedure ("nt-save", nt_scm_save, 0, 0, 0);
    gh_new_procedure ("nt-restore", nt_scm_restore, 0, 0, 0);

    gh_new_procedure ("nt-current-position", nt_scm_current_position, 0, 0, 0);
    gh_new_procedure ("nt-current-angle", nt_scm_current_angle, 0, 0, 0);
    gh_new_procedure ("nt-text-width", nt_scm_text_width, 4, 0, 0);

    gh_new_procedure ("nt-split-string", nt_scm_split_string, 1, 0, 0);

    gh_new_procedure ("nt-open", nt_scm_open, 1, 0, 0);
    gh_new_procedure ("nt-close", nt_scm_close, 0, 0, 0);
    gh_new_procedure ("nt-include", nt_scm_include, 1, 0, 0);

    gh_new_procedure ("nt-parse-string", nt_scm_parse_string, 1, 0, 0);
}


SCM
nt_scm_open (SCM s_file)
{
    char *file;
    int len;

    file = gh_scm2newstr (s_file, &len);
    nt_pdf_open (file);
    free (file);

    return s_file;
}

SCM
nt_scm_close ()
{
    nt_pdf_close ();

    return SCM_EOL;
}

SCM
nt_scm_include (SCM s_file)
{
    int d;
    char *file;
    FILE *fp;

    file = gh_scm2newstr (s_file, &d);
    fp = fopen (file, "r");

    if (! fp) {
        fprintf (stderr, "%s: open failed.", file);
    } else {
        nt_prs_loop (fp);
    }

    free (file);
    return SCM_EOL;
}

SCM
nt_scm_parse_string (SCM s_str)
{
    int d;
    char *str;

    str = gh_scm2newstr (s_str, &d);
    nt_prs_loop_with_string_literal (str);

    free (str);
    return SCM_EOL;
}

SCM
nt_scm_set_text_pos (SCM s_x, SCM s_y)
{
    float x, y;

    x = (float) gh_scm2double (s_x);
    y = (float) gh_scm2double (s_y);

    nt_pdf_set_text_pos (x, y);

    return SCM_EOL;
}

SCM
nt_scm_font (SCM s_font_name, SCM s_encoding, SCM s_size)
{
    char *font_name, *encoding;
    double size;
    int d;

    font_name = gh_scm2newstr (s_font_name, &d);
    encoding = gh_scm2newstr (s_encoding, &d);
    size = gh_scm2double (s_size);

    nt_pdf_font (font_name, encoding, size);

    free (font_name);
    free (encoding);

    return SCM_EOL;
}

SCM
nt_scm_translate (SCM s_x, SCM s_y)
{
    float x, y;

    x = gh_scm2double (s_x);
    y = gh_scm2double (s_y);

    nt_pdf_translate (x, y);

    return SCM_EOL;
}

SCM
nt_scm_rotate (SCM s_angle)
{
    float angle = (float) gh_scm2double (s_angle);

    nt_pdf_rotate (angle);

    return SCM_EOL;
}

SCM
nt_scm_show (SCM s_string)
{
    char *str;
    int len;
    SCM s_len;

    str = gh_scm2newstr (s_string, &len);
    nt_pdf_show (str);

    free (str);

    s_len = gh_int2scm (len);
    return s_len;
}

SCM
nt_scm_moveto (SCM s_x, SCM s_y)
{
    float x, y;

    x = (float) gh_scm2double (s_x);
    y = (float) gh_scm2double (s_y);

    nt_pdf_moveto (x, y);

    return SCM_EOL;
}

SCM
nt_scm_lineto (SCM s_x, SCM s_y)
{
    float x, y;

    x = (float) gh_scm2double (s_x);
    y = (float) gh_scm2double (s_y);

    nt_pdf_lineto (x, y);

    return SCM_EOL;
}

SCM
nt_scm_stroke ()
{
    nt_pdf_stroke ();
    return SCM_EOL;
}


SCM
nt_scm_begin_page (SCM s_width, SCM s_height)
{
    float w, h;

    w = (float) gh_scm2double (s_width);
    h = (float) gh_scm2double (s_height);

    nt_pdf_begin_page (w, h);

    return SCM_EOL;
}

SCM
nt_scm_end_page ()
{
    nt_pdf_end_page ();
    return SCM_EOL;
}

SCM
nt_scm_save ()
{
    nt_pdf_save ();

    return SCM_EOL;
}

SCM
nt_scm_restore ()
{
    nt_pdf_restore ();

    return SCM_EOL;
}


SCM
nt_scm_current_position ()
{
    return SCM_EOL;
}

SCM
nt_scm_current_angle ()
{
    return SCM_EOL;
}

SCM
nt_scm_text_width (SCM s_string, SCM s_font, SCM s_encoding, SCM s_size)
{
    char *str, *font, *encoding;
    double size, width;
    int len;

    SCM_ASSERT(SCM_STRINGP (s_string), s_string, SCM_ARG1, "nt-text-width");
    SCM_ASSERT(SCM_STRINGP (s_font), s_font, SCM_ARG2, "nt-text-width");
    SCM_ASSERT(SCM_STRINGP (s_encoding), s_encoding, SCM_ARG3, "nt-text-width");

    str = gh_scm2newstr (s_string, &len);
    font = gh_scm2newstr (s_font, &len);
    encoding = gh_scm2newstr (s_encoding, &len);
    size = gh_scm2double (s_size);

//      debug_printf ("nt_scm_text_width: %s %s %s %f", str, font, encoding, size);

    width = nt_pdf_text_width (str, font, encoding, size);

    free (encoding);
    free (font);
    free (str);

    return gh_double2scm (width);
}

SCM
nt_scm_split_string (SCM s_string)
{
    char *str, *p;
    int len, c_len;
    char type_tag [10];
    char quote_code [100];
    char c [3];
    int first = 1;
    SCM s_dest, s_c, s_type_tag;

    str = gh_scm2newstr (s_string, &len);

    for (p = str; *p; p ++) {
        if (isascii (*p)) {
            strcpy (type_tag, "ascii");
            c [0] = *p;
            c [1] = '\0';
            c_len = 1;
        } else {
            strcpy (type_tag, "jeuc");
            c [0] = *p;
            c [1] = *(++ p);
            c [2] = '\0';
            c_len = 2;
        }

        s_c = gh_str2scm (c, c_len);

        sprintf (quote_code, "'%s", type_tag);
        s_type_tag = gh_eval_str (quote_code);
//      s_type_tag = gh_symbol2scm (type_tag);

//      gh_display (s_type_tag);

        if (first) {
            s_dest = SCM_LIST1 (SCM_LIST2 (s_c, s_type_tag));
        } else {
            s_dest = gh_append2 (s_dest, SCM_LIST1 (SCM_LIST2 (s_c, s_type_tag)));
        }

        first = 0;
    }

    return s_dest;
}

// Local Variables:
// buffer-file-coding-system: euc-jp-unix
// End: