Justin Wright

{This script will take all symbols in a file and convert them into a PROCEDURE for use in scripts}
{Edit text at line 215 to adjust the procedure name}
{Edit text at line 215 to adjust the procedure name}
{Orginally written by Justin Wright, Assembly Architecture Ltd. Jan 2009, VW2009}
{If you use this script I ask you share one of your own, open source helps all}
{Cut and paste the pop up list into a pop up of a PIO, The pop up will select which symbol to draw}
{The PROCEDURE PlatformFileName you can alter the exported text file name and location}



PROCEDURE StirpGeometery;

VAR
	PrefixString:			String;
	CurrentLetter:			string;
	ProcedureNameToCreate:	String;
	TempString:				STRING;

   fileName,FileNameWrite :STRING;
   major, minor, maintenance, platform :INTEGER;
   hRecord:handle;
   result: Boolean;
   LnToStart: Array[1..10000] Of Integer;
   LnToStop: Array[1..10000] Of Integer;
   FileText: Array[1..10000]  of String;

   PopName: Array[1..100]  of String;
   WriteVar: Array[1..100]  of String;
   WriteBody: Array[1..100]  of String;

   TellMeMessage:String;
	iTemp:Integer;
   i,p:	Integer;
   j:	Integer;
   n,m,v,b:	Integer;

   LnCount: Integer;
   Endclip:	Integer;
   SybStartCheck:STRING;
   SybEndCheck:STRING;
   LnStart,LnStop:Integer;
   ProcedureName:STRING;




Procedure PlatformFileName;
	BEGIN
	   GetVersion(major, minor, maintenance, platform);
	   IF platform = 1 THEN
		   BEGIN
			  fileName := '/StripSyb.txt';
			  FileNameWrite:='/StripSybConvert.txt'
		   END
	   ELSE
		   BEGIN
			  fileName := 'C:\StripSyb.txt';
			  FileNameWrite:='/StripSybConvert.txt'
			END;
	END;

 Procedure OpenAndRead;
	Begin;
		Open(FileName);
		For i:= 1 TO 10000 DO
		Read(FileText[i]);
		Close(FileName);
		Rewrite(FileNameWrite);
	End;



PROCEDURE CheckForFunctionsAndDelete;
{By including some of these functions you can strip out a lot of lines included in the symbol}
{Include all and you get down to simple polylines.}
 	Begin;
 	For i:=1 to 10000 DO
 		Begin;
			TempString:=Copy(FileText[i],1,3);
{			IF TempString='Fil' THEN FileText[i]:='';}
{			IF TempString='Set' THEN FileText[i]:='';}
{			IF TempString='Pen' THEN FileText[i]:='';}
{			IF TempString='Nam' THEN FileText[i]:='';}
{			IF TempString='FPa' THEN FileText[i]:='';}
{			IF TempString='LSB' THEN FileText[i]:='';}
{			IF TempString='LWB' THEN FileText[i]:='';}
{			IF TempString='Mar' THEN FileText[i]:='';}
{			IF TempString='Opa' THEN FileText[i]:='';}
{			IF TempString='Fie' THEN FileText[i]:='';}
{			IF TempString='obj' THEN FileText[i]:='';}
			IF TempString='boo' THEN FileText[i]:='';
		End;
	End;

PROCEDURE WriteProcedureName;
	Begin;
		WriteLn('PROCEDURE ',ProcedureNameToCreate,Chr(59));
		WriteLn('');
	END;

PROCEDURE WriteProcedureBegin;
	Begin;
		WriteLn('{---------Main Body Starts------------}');
		WriteLn('BEGIN',CHR(59));
		WriteLn('ProfileSelect',CHR(59));
	END;

PROCEDURE WriteProcedureEnds;
	Begin;
		WriteLn('End',Chr(59));
		WriteLn('');
		WriteLn('Run(',ProcedureNameToCreate,')',Chr(59));
	END;

Procedure WritePopUpNames;
Begin;
	iTemp:=n;
	WriteLn('{PopNames');
	For n:= 1 to iTemp DO
		WriteLn(PopName[n]);
	WriteLn('PopNames List Ends}');
End;

PROCEDURE WriteProfileSelect;
Begin;
WriteLn('PROCEDURE ProfileSelect',Chr(59));
WriteLn('BEGIN',Chr(59));
		For n:= 1 to iTemp DO
			WriteLn(Concat('IF ', 'pSelect=',CHr(39),PopName[n],CHr(39),' THEN ',	Popname[n],Chr(59)));
WriteLn('END',Chr(59));
End;


Function RemoveBungChr(Checkthis:String):String;
Begin;
	TempString:='';
	iTemp:=Len(Checkthis);
	For m:=1 to iTemp DO
		BEGIN;
			CurrentLetter:=Copy(Checkthis,m,1);
			For p:=32 to 47 Do IF CurrentLetter=Chr(p) Then CurrentLetter:='';

			TempString:=Concat(TempString,CurrentLetter);
		ENd;
		RemoveBungChr:=TempString;
End;

Procedure ConvertSyb2Procedure;
	Begin;
		For i:=1 to 10000 DO
			BEGIN;
				SybStartCheck:=Copy(FileText[i],1,8);
				IF SybStartCheck='BeginSym' THEN
					BEGIN;
						ProcedureName:=Copy(FileText[i],11,Len(FileText[i])-13);
						ProcedureName:=RemoveBungChr(ProcedureName);
						ProcedureName:=Concat('PROCEDURE ',PrefixString,ProcedureName,CHR(59),CHR(13),
						'BEGIN',CHR(59));
						{Copy takes out the procedure name of the symbol deffinition line.
						11=  the Char length of BeginSym('
						13=  the Char Length of BeginSym(' AND ');}
						{ProcedureName:=RemoveBungChr(ProcedureName);}
						n:=n+1;
						LnToStart[n]:=i;
						PopName[N]:=Concat(PrefixString,Copy(FileText[i],11,Len(FileText[i])-13));
						PopName[N]:=RemoveBungChr(PopName[N]);


						FileText[i]:=ProcedureName;


					END;

				SybEndCheck:=Copy(FileText[i],1,6);
				IF SybEndCheck='EndSym' THEN
					BEGIN;
						FileText[i]:=Concat('END',CHR(59));
						LnToStop[n]:=i;
					END;
			END;
			itemp:=n;
			Message(n);
		For n:= 1 to iTemp DO
			BEGIN;
				WriteLn('');
				For i:= LntoStart[n] to LnToStop[n] DO IF FileText[i]<> '' THEN WriteLn(FileText[i]);
				WriteLn('');
			END;

		End;

Procedure SetPopFields;
Begin;
WriteVar[v]:=Concat('bTemp:Boolean',CHR(59)); v:=v+1;
WriteVar[v]:=Concat('ObjectName:String',CHR(59)); v:=v+1;
WriteVar[v]:=Concat('ObjectHandit,RecordHand,WallHand:Handle,',CHR(59)); v:=v+1;

WriteBody[b]:=Concat('bTemp:=GetCustomObjectInfo(ObjectName,ObjectHand,RecordHand,WallHand)');b:=b+1;

For n:= 1 to iTemp DO
	Begin;
		WriteBody[b]:=Concat('SetRField(ObjectHand,RecordHand, ',Chr(39),'Select',Chr(39),',',Chr(39),PopName[v],Chr(39),')');
		b:=b+1;
	End;
End;

Procedure WriteBodyFull;
Begin;
iTemp:=b;
For b:=1 to iTemp Do WriteLn(WriteBody[b],Chr(59));
End;

Procedure WriteVariables;
Begin;
	Writeln('VAR');
	WriteLn('');
	WriteLn('bTemp:Boolean',CHR(59)); v:=v+1;
	WriteLn('ObjectName:String',CHR(59)); v:=v+1;
	WriteLn('ObjectHand,RecordHand,WallHand:Handle',CHR(59)); v:=v+1;
End;


Begin;
	ProcedureNameToCreate:='Sybol2Object';
	PlatformFileName;
	OpenAndRead;

	CheckForFunctionsAndDelete;

	WriteProcedureName;
	PrefixString:='JD';
	WriteVariables;

	ConvertSyb2Procedure;
	WritePopUpNames;

	WriteProfileSelect;




WriteProcedureBegin;

WriteProcedureEnds;
Close(FileNameWrite);






END;

Run(StirpGeometery);