/*
 * Make c++ code for event selected messages
 *
 * Copyright (c) 1994, 1995, 1996 Gunther Schadow.  All rights reserved.
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2 of the License, or
 * (at your option) any later version.
 * 
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 * 
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 */

:- module(mkc_evs,[event_selected/3, mkc_evs/4]).

:- style_check(+string).

:- use_module(desc-files).
:- use_module(desc-names).
:- use_module(db-inter).
:- use_module(mkc-print).
:- use_module(mkc-grp).
:- use_module(mkc-msg).

/*
NAME
	event-selected/3  --  optimize for event selected polymorphism

SYNOPSIS
	event-selected(Message,DefL,EvcL).

DESCRIPTION
	In the ADT message event codes are merely selectors from
	the syntactical point of view. There are many to one relations
	from event codes to actual syntax definitions. I optimize my
	code for size by reducing these redundancies. Therfore I have
	to compare message definitions by their structure. I will
	build groups of event codes which have the same message
	syntax.

	Messages which make use of the EVNseg are scanned in some
	common way.  First the MSH segment is read in order to
	determine the message type, then the EVN segment is read and
	the parser branches for each type of structure. Thus I can
	use a common ancestor class, called `EvnMessage'. The task
        left to	this program generator is to build the variant classes
        (formally called `trailer classes') with each one handling one
        branch of this polymorphism.

	NOTE that this is done here for the ADT domain only but it
	might be necessary to extend this on any two messages that show
	this kind of polymorphism. Especially if EVNseg is the first
        obligatory and independedt segment after the MSHseg.

	The predicate event_selected/3 takes a message type (usually
	`adt') and returns a list of variant definitions in `DefL'
	plus a flat list `EvcL' of all event codes that were taken
	into account in `DefL'. The list of variant definitions has
	the following format:

	    [[[<event codes> ...] <common definition>] ...]

	The name of the variant class will be constructed as the
	concatenation of the first item in the [<event codes> ...]
        list in upper case followed by the suffix `var' in lower case
        (see desc_names:varname/2). 
*/

event_selected(Message,DefL,EvcL) :-
  findall(Def, implemented(_:message(Message,_,_,Def)), DefL1us),
  sort(DefL1us,DefL1),
  findall([EvcL,Def],
    (	member(Def,DefL1),
        findall(Evc, implemented(_:message(Message,Evc,_,Def)),EvcLus),
	length(EvcLus,Len),
	Len > 1,
        sort(EvcLus,EvcL)
    ), DefL),
  findall(Evc,
    (   member([EvcL,_],DefL),
	member(Evc,EvcL)), EvcL).


mkc_evs(M,E,VarName,DefL) :-
	file(message,msg(M,E),Fnh),
	message(M,E,Comm,_),
	message_type(M, _, FunArea),  
	evco(E,Ec),

	unimesg(M,Ec,Mu),
	msgname(Mu,Mn),

	groups(DefL,_,DefLG),
	build_vdecl(DefLG,DecL),

	htell(Fnh,Def,message),

	nl,
        main_package(P),
        package(P,_,_,R,_),
	format("#include <~w~w.h>~n", [R,VarName]),

	comment('MESSAGE',Mn,FunArea,Comm),

	class_begin(Mn, VarName),

        format("/*~n"),
	format(" * The following attributes are declared in ~w.h~n *~n",
	       VarName),
	print_vdecl(DecL),
	format(" */~n"),

	ppublic,

	/* ctor */

	format("~n~w();~n", Mn),

	class_end,
	htold(Def),

	cctell(Fnh,message),

	nl,
	format("#include ~'~w.h~'~n", VarName),
	format("#include ~'UniMesIdCode.h~'~n"),

	comment('MESSAGE',Mn,FunArea,Comm),
	
	/* ctor */

	valname(Mu,MuVal),
	format("~n~n~w::~w() : ~w(UniMesIdCode::~w)",
	       [Mn, Mn, VarName, MuVal]),

	init(DecL),
	nl,
	cctold,

        vcgtell,
        format("node: {~>~ntitle: ~'~w~'~n", [Mn]),
        uppercase(M,UM), 
        uppercase(E,UE), 
        format("label: ~'~w^~w~'~n", [UM, UE]),
        format("color: darkgreen~n"),
        format("level: 0~<~n}~n"),
        format("edge: {~>~n"),
        format("label: ~'*~'~n"),
        format("sourcename: ~'~w~'~n", [Mn]),
        format("targetname: ~'~w~'~<~n}~n", [VarName]),
        vcgtold.