#!/usr/local/bin/perl
#
# this thing generates all sorts of component crap
#
# usage: makecomponent prefix outputfile.h outputfile.c inputfiles...
#    eg: makecomponent PETE :include:petecomp.h petecomp.c :{ext}:editor:pete.h
#
#		 Will also generate seconds header file for CFM macros named
#		 ouputfilecfm.h.
#
#		 I left in my comments that begin with #**. They can be deleted since I was
#		 using them to walk through the code and figure it out.
#


#** get arguments, shift removed first item so you can get the next in line
#** $prefix = $ARGV[0]; shift;
$prefix = 'PETE';
#** $hfile = $ARGV[0]; shift;
$hfile = ':Editor:Source:Application Headers:petecomponent.h';
$cfile = ':Editor:Source:Editor Source:petecomponent.c';
$mfile = ':Editor:Source:Application Headers:petecfm.h';


#** open output files
open(HFILE,">$hfile")||die;
open(MFILE,">$mfile")||die;
open(CFILE,">$cfile")||die;

#put top of outputfilecfm.h here
print MFILE <<BOILER;
/* gComponentDispatchUPP is a global initialized to GetToolTrapAddress(_ComponentDispatch) */
extern UniversalProcPtr gComponentDispatchUPP;

BOILER

# put top of outputfile.h stuff here
print HFILE <<BOILER;
#ifndef PETECOMPONENT_H
#define PETECOMPONENT_H

#ifndef PETE_H
#include "pete.h"
#endif

#define TWOBYTESIZE(x) (sizeof(x) == 1 ? 2 : sizeof(x))

BOILER

#** $_ default variable still has the last parameter ':{ext}:editor:pete.h'
#** read each line from file
while (<>)
{
	if (/^pascal/)
#** if "pascal" is at the beginning of the input line
#** only care about pascal type declarations in this file
	{
		chop;
#** chop CR

		#
		# make sure we can use whitespace for tokens
		s/\(/ \(/g;
#** search for "(" replace with " (", all occurances in line

		#
		# trim the pascal part
		s/pascal\s*//;
#** delete "pascal" and space (replace with nothing)

		#
		# nab the return type
		#** "[ \t]+" is one or more spaces or tabs
		#** "2" limits the result into two peices
		#** $returns = the return type
		#** $rest = the rest of the string
		($returns,$rest) = split("[ \t]+",$_,2);

		#
		# nab the function name
		#** do it again
		($func,$rest) = split("[ \t]+",$rest,2);

		#
		# and the parameters
		$rest =~ s/.*\(//;
	#** delete all chars before and including the "("
		$rest =~ s/\).*//;
	#** delete all chars after and including the ")"
		$params = $rest;
		#** $params is comman delim param list
		@params = split(',',$rest);		#** @params is array of the parameters, cool!

		#
		# record the function name
		$funcList[$#funcList+1] = $func;  #** add the func name to an array each loop

		#** got the info, now do something with it

		#
		# Declare the param structure
		#** plug in function name and concat the strings together, write out to file
		print MFILE "#define $func(";

		for ($i=0;$i<=$#params;$i++)
		{
			if ($i) {print MFILE ",";}
			print MFILE "p" . ($i+1);
		}
		print MFILE ") \\\n";
		
		print MFILE "\tCallUniversalProc(gComponentDispatchUPP, \\\n";
		print MFILE "\t\tkD0DispatchedPascalStackBased \\\n";

		if ($returns ne "void")
		{
			print MFILE "\t\t | RESULT_SIZE(SIZE_CODE(sizeof($returns))) \\\n";
		}
		
		print MFILE "\t\t | DISPATCHED_STACK_ROUTINE_SELECTOR_SIZE(kFourByteCode)";
		
		for ($i=0;$i<=$#params;$i++)
		{
			($type,$littleParam) = split("[ \t]+",$params[$i]);
			$littleParam =~ s/[ \t]+.*//;
					#** deletes everything after the space
			if ($littleParam =~ /^\*/)
						#** if this is a pointer parameter
			{
			  $type .= '*';

	#** add * to type
			}
			print MFILE " \\\n\t\t | DISPATCHED_STACK_ROUTINE_PARAMETER(" . ($i+1) . ", SIZE_CODE(sizeof($type)))";
		}
		print MFILE " \\\n\t\t | DISPATCHED_STACK_ROUTINE_PARAMETER(" . ($#params + 2) . ", kTwoByteCode)";
		print MFILE " \\\n\t\t | DISPATCHED_STACK_ROUTINE_PARAMETER(" . ($#params + 3) . ", kTwoByteCode)";

		print MFILE ", \\\n\t\t0L, \\\n\t\t";
		
		for ($i=0;$i<=$#params;$i++)
		{
			if ($i) {print MFILE ",";}
			print MFILE "(p" . ($i+1) . ")";
		}
		
		print MFILE ", \\\n\t\tk" . ($func) . "Rtn";
		print MFILE ", \\\n\t\tk" . ($func) . "ParamSize)\n\n";

		#
		# UPP enum and ParamSize
		$sizeof = "TWOBYTESIZE(";
		print HFILE "enum {\n";
		print HFILE "\tupp" . $func . "ProcInfo = kPascalStackBased\n";
		if ($returns ne "void")
		{
			print HFILE "\t\t| RESULT_SIZE(SIZE_CODE(sizeof($returns)))\n";
		}
		for ($i=0;$i<=$#params;$i++)
		{
			($type,$littleParam) = split("[ \t]+",$params[$i]);
			$littleParam =~ s/[ \t]+.*//;
					#** deletes everything after the space
			if ($littleParam =~ /^\*/)
						#** if this is a pointer parameter
			{
			  $type .= '*';

	#** add * to type
			}
			print HFILE "\t\t| STACK_ROUTINE_PARAMETER(" . ($i+1) . ", SIZE_CODE(sizeof($type)))\n";
			if($i)
			{
				if($i!=1) {$sizeof .= " + TWOBYTESIZE(";}
				$sizeof .= $type;
				$sizeof .= ")"
			}
		}
		print HFILE "};\n\n";

		print HFILE "#define k" . ($func) . "ParamSize (" . ($sizeof) . ")\n\n";

	}
		
}  #** end of looping through input.h file

#
# a really big enum
print HFILE "\ntypedef enum\n{\n";
print HFILE "\tk$prefix" . "EnumStart=256,\n";
for ($i=0;$i<=$#funcList;$i++)
{
	print HFILE "\tk$funcList[$i]" . "Rtn,\n";
}
print HFILE "\tk$prefix" . "EnumEnd\n";
print HFILE "} $prefix" . "ComponentRoutineEnum;\n\n";

# put bottom of outputfile.h file stuff here
print HFILE <<BOILER;

#endif
BOILER

# put top of C file stuff here
print CFILE <<BOILER;  #** print everything out to file until you reach 'BOILER'
#include "petepch.h"

#if GENERATINGCFM
RoutineDescriptor MainRD = BUILD_ROUTINE_DESCRIPTOR(uppComponentRoutineProcInfo, main);
ProcInfoType __procinfo = uppComponentRoutineProcInfo;
#endif

pascal ComponentResult main(ComponentParameters *params, Handle globals)
{
	ComponentFunctionUPP routine;
	ComponentInstance inst;
	ComponentResult errCode;
	short refNum;
	long response;
	
	if((globals != nil) && ((**(PETEGlobalsHandle)globals).hasBeenCalledCallback != nil)) {
		CallPETEHasBeenCalledProc((**(PETEGlobalsHandle)globals).hasBeenCalledCallback, true);
	}
	
	switch(params->what) {
		case kComponentRegisterSelect :
			errCode = Gestalt(gestaltProcessorType, &response);
			if(errCode == noErr) {
				if(response < gestalt68020) {
					errCode = true;
				}
			} else {
				errCode = true;
			}
			goto Exit;
			
		case kComponentOpenSelect :
			COMPONENT_UPP_DECLARATION(GetInstance, MyGetInstance, routine);
			inst = (ComponentInstance)CallComponentFunction(params, routine);
			refNum = OpenComponentResFile((Component)inst);
			if(refNum <= 0) {
				errCode = resFNotFound;
			} else {
				errCode = PETEInit((PETEGlobalsHandle *)&globals);
				CloseComponentResFile(refNum);
			}
			if(errCode == noErr) {
				SetComponentInstanceStorage(inst, globals);
			}
			goto Exit;

		case kComponentCloseSelect :
			if(globals != nil) {
				errCode = PETECleanup((PETEGlobalsHandle)globals);
				globals = nil;
			} else {
				errCode = noErr;
			}
			goto Exit;

		case kComponentCanDoSelect :
			COMPONENT_UPP_DECLARATION(CanDo, MyCanDo, routine);
			errCode = CallComponentFunction(params, routine);
			goto Exit;

		case kComponentVersionSelect :
			errCode = kPETECurrentVersion;
			goto Exit;

BOILER

for ($i=0;$i<=$#funcList;$i++)
{
	$littleFunc = $funcList[$i];
#	$littleFunc =~ s/$prefix//;
	print CFILE "		case k" . $funcList[$i] . "Rtn:\n";
	print CFILE "			COMPONENT_UPP_DECLARATION($littleFunc,$littleFunc,routine);\n";
	print CFILE "			break;\n\n";
}

#Put bottom of C file here
print CFILE <<BOILER;
		default :
			errCode = badComponentSelector;
			goto Exit;
	}
	errCode = CallComponentFunctionWithStorage(globals, params, routine);
	
Exit :
	if((globals != nil) && ((**(PETEGlobalsHandle)globals).hasBeenCalledCallback != nil)) {
		CallPETEHasBeenCalledProc((**(PETEGlobalsHandle)globals).hasBeenCalledCallback, false);
	}
	
	return errCode;
}

pascal ComponentInstance MyGetInstance(ComponentInstance inst)
{
	return inst;
}

pascal ComponentResult MyCanDo(short selector)
{
	return (selector > kPETEEnumStart && selector < kPETEEnumEnd);
}
BOILER