[m-dev.] For review: new extras module for generating tgif .obj files

[Ralph Becket]

Estimated hours taken: 3

This module is used to generate .obj files in a form suitable
for the Tgif drawing package.  This should primarily be useful
for generating specialized data representations and algorithm
animations.

- Ralph

tgif/Mmakefile:
# Copyright (C) 2001 Ralph Becket <rbeck at microsoft.com>
# Fri Feb 23 12:05:23 GMT 2001
# vim: ts=8 sw=8 noet tw=0 wm=0 ff=unix ft=make
#
# THIS FILE IS CONTRIBUTED TO THE MERCURY PROJECT TO BE RELEASED
# UNDER WHATEVER LICENCE IS DEEMED APPROPRIATE BY THE MERCURY
# PROJECT MANAGEMENT.

MAIN_TARGET = test_tgif
depend: $(MAIN_TARGET).depend

tgz:
	( cd ..; tar zcvf tgif.tgz tgif/Mmakefile tgif/tgif.m )

tgif/tgif.m:
%------------------------------------------------------------------------------%
% tgif.m
% Copyright (C) 2001 Ralph Becket <rbeck at microsoft.com>
% Fri Feb 23 12:05:23 GMT 2001
% vim: ts=4 sw=4 et tw=0 wm=0 ff=unix ft=mercury
%
%
% THIS FILE IS CONTRIBUTED TO THE MERCURY PROJECT TO BE RELEASED
% UNDER WHATEVER LICENCE IS DEEMED APPROPRIATE BY THE MERCURY
% PROJECT MANAGEMENT.
%
%
% Generates simple tgif .obj files.
%
% The scale is  5     units to the millimeter (with minor error).
% There are   128     units to the inch.
% There are     1.765 units to the point.
%
% Modern versions of tgif will let you turn these .obj files into
% various useful forms from the command line:
%
%   tgif -print -<fmt> foo.obj
%
% where <fmt> can be one of `ps', `eps', `gif', `xpm', `xbm'.
% Consult the tgif documentation for other options.
%
% This is hardly complete.  Options to turn on spline curves for
% poly-lines, select dashed line styles, rotations and bold and
% italic styles for text have yet to be added.
%
%------------------------------------------------------------------------------%
:- module tgif.

:- interface.

:- import_module io, string, int, list.



:- type obj
    --->    box(colour, fill, linewidth, int, int, int, int)  % x1, y1, x2, 
y2
    ;       oval(colour, fill, linewidth, int, int, int, int) % x1, y1, x2, 
y2
    ;       circle(colour, fill, linewidth, int, int, int)    % x, y, radius
    ;       poly(colour, fill, linewidth, coords)             % [{x, y}, 
...]
    ;       line(colour, linewidth, int, int, int, int)       % x1, y1, x2, 
y2
    ;       arrow(colour, linewidth, int, int, int, int)      % x1, y1, x2, 
y2
    ;       text(colour, font, size, justification, int, int, string) % x, y
    .

:- type objs == list(obj).

:- type coords == list({int, int}).     % list({x, y}).

:- type linewidth == int.               % [1 .. 7].

:- type colour.
:- func black        = colour.
:- func blue         = colour.
:- func green        = colour.
:- func cyan         = colour.
:- func red          = colour.
:- func magenta      = colour.
:- func yellow       = colour.
:- func lightblue    = colour.
:- func lightgreen   = colour.
:- func violet       = colour.
:- func orange       = colour.
:- func brown        = colour.
:- func white        = colour.
:- func grey10       = colour.
:- func grey20       = colour.
:- func grey30       = colour.
:- func grey40       = colour.
:- func grey50       = colour.
:- func grey60       = colour.
:- func grey70       = colour.
:- func grey80       = colour.
:- func grey90       = colour.

:- type fill == int.                    % [0 .. 31].
:- func empty = fill.
:- func solid = fill.

:- type font.
:- func times      = font.
:- func courier    = font.
:- func helvetica  = font.
:- func schoolbook = font.
:- func symbol     = font.

:- type size == int.                    % Point size.

:- type justification.
:- func left    = justification.
:- func centred = justification.
:- func right   = justification.

:- pred write_objs(objs, io__state, io__state).
:- mode write_objs(in, di, uo) is det.

%------------------------------------------------------------------------------%
%------------------------------------------------------------------------------%
:- implementation.



:- type colour == string.

:- type font == string.

:- type justification == int.

%------------------------------------------------------------------------------%
black        = "black".
blue         = "blue".
green        = "green".
cyan         = "cyan".
red          = "red".
magenta      = "magenta".
yellow       = "yellow".
lightblue    = "lightblue".
lightgreen   = "lightgreen".
violet       = "violet".
orange       = "orange".
brown        = "brown".
white        = "white".
grey10       = "gray10".
grey20       = "gray20".
grey30       = "gray30".
grey40       = "gray40".
grey50       = "gray50".
grey60       = "gray60".
grey70       = "gray70".
grey80       = "gray80".
grey90       = "gray90".

%------------------------------------------------------------------------------%
empty = 0.
solid = 1.

%------------------------------------------------------------------------------%
times      = "Times-Roman".
courier    = "Courier".
helvetica  = "Helvetica".
schoolbook = "NewCenturySchlbk-Roman".
symbol     = "Symbol".

%------------------------------------------------------------------------------%
left    = 0.
centred = 1.
right   = 2.

%------------------------------------------------------------------------------%
write_objs(Objs) -->
    io__write_string("\
%%TGIF 2.16-p9
state(1,32,100,0,0,0,4,0,10,1,1,0,0,1,1,1,0,'Courier',0,17,0,0,1,10,0,0,1,1,0,16,1,0,1,1,1,1,1485,1050).
%%
%% @(#)$Header$
%% %W%
%%
page(1,\"\").
"),
    list__foldl2(write_obj, Objs, 0, _).



:- pred write_obj(obj, int, int, io__state, io__state).
:- mode write_obj(in, in, out, di, uo) is det.

write_obj(box(Colour, Fill, LW, X1, Y1, X2, Y2), I, I + 1) -->
    io__format("\
box('%s',%d,%d,%d,%d,%d,%d,1,%d,0,0,0,[
]).
",  [s(Colour), i(X1), i(Y1), i(X2), i(Y2), i(Fill), i(LW), i(I)]).

write_obj(oval(Colour, Fill, LW, X1, Y1, X2, Y2), I, I + 1) -->
    io__format("\
oval('%s',%d,%d,%d,%d,%d,%d,1,%d,0,0,0,[
]).
",  [s(Colour), i(X1), i(Y1), i(X2), i(Y2), i(Fill), i(LW), i(I)]).

write_obj(circle(Colour, Fill, LW, X, Y, R), I, I + 1) -->
    io__format("\
oval('%s',%d,%d,%d,%d,%d,%d,1,%d,0,0,0,[
]).
",  [s(Colour), i(X - R), i(Y - R), i(X + R), i(Y + R), i(Fill), i(LW), 
i(I)]).

write_obj(text(Colour, Font, Size, Justification, X, Y, Text), I, I + 1) -->
    io__format("\
text('%s',%d,%d,'%s',0,%d,1,%d,%d,1,49,20,%d,0,16,4,0,0,0,0,[
""%s""]).
",  [s(Colour), i(X), i(Y), s(Font), i(Size), i(Justification),
     i(0 /* Orientation */), i(I), s(Text)]).

write_obj(arrow(Colour, LW, X1, Y1, X2, Y2), I, I + 1) -->
    io__format("\
poly('%s',2,[
%d,%d,%d,%d],1,%d,1,%d,0,1,0,0,10,5,0,
""00"",[
]).
",  [s(Colour),i(X1),i(Y1),i(X2),i(Y2),i(LW),i(I)]).

write_obj(line(Colour, LW, X1, Y1, X2, Y2), I0, I) -->
    write_obj(poly(Colour, empty, LW, [{X1, Y1}, {X2, Y2}]), I0, I).

write_obj(poly(Colour, Fill, LW, XYs), I, I + 1) -->
    io__format("poly('%s',%d,[
",  [s(Colour), i(list__length(XYs))]),
    write_coords("", XYs),
    io__format("],0,%i,1,%d,0,%d,0,0,8,3,0,
""00"",[
]).
",  [i(LW), i(I), i(Fill)]).

%------------------------------------------------------------------------------%
:- pred write_coords(string, coords, io__state, io__state).
:- mode write_coords(in, in, di, uo) is det.

write_coords(_, []) --> [].

write_coords(Prefix, [{X, Y} | XYs]) -->
    io__format("%s%d,%d", [s(Prefix), i(X), i(Y)]),
    write_coords(",", XYs).

%------------------------------------------------------------------------------%
%------------------------------------------------------------------------------%

_________________________________________________________________________
Get Your Private, Free E-mail from MSN Hotmail at http://www.hotmail.com.

--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to:       mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions:          mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------