den4b Forum

eric91

Member

Registered: 2015-10-14

Posts: 3

Roman To Arabic in filename conversion

Hello,
in musical files, i have often someting like
"Variation XV Canone alla Quinta.flac"
Such roman number does'nt sort correctly so i wrote a VBS function which run and convert it to Pascal.

function RomanToArabic(Roman:string):string;
// limited to roman string <255 car !!
var
   idx:byte;
   total, valPrec, valCourante:Word;
begin
   ValPrec:=65535;
	for i:=1 to Length(Roman) do
	begin
		case roman[idx] of
		  'M' : valCourante:=1000;
		  'D' : valCourante:=500;
		  'C' : valCourante:=100;
		  'L' : valCourante:=50;
		  'X' : valCourante:=10;
		  'V' : valCourante:=5;
		  'I' : valCourante:=1;
		end;
		total:=total+valcourante;
		if valcourante>valprec then valprec:=valprec - (2*valprec);
		valprec:=valcourante;
	end;
	result:=IntToStr(total);
end;

But my problem now is to use it.
I know to use a regexp to to extract a $x value but i don't know how to collect this value, how to apply the function and how to insert the result back to the filename.

An idea can be to allow the possibility to use $1...$9 as parameters for users functions.

If you can help me it would be nice.

Regards

Eric

Stefan

Moderator

From: Germany, EU

Registered: 2007-10-23

Posts: 1,161

Re: Roman To Arabic in filename conversion

Hi and welcome Eric!

I don't know.... but here are some hints:

http://www.den4b.com/wiki/ReNamer:Pascal_Script
In Pascal Script, ReNamer has defined the FileName variable to represent the New Name of the File.
Therefore, in your script, you will have to manipulate this variable to change the filename.

http://www.den4b.com/wiki/ReNamer:Pasca … g_Handling
function SubMatchesRegEx(const Input, Find: WideString;const CaseSensitive: Boolean): TStringsArray;

My guess is something like this idea may be an start:

(non tested script)

var
   Parts: TStringsArray;
begin
   Parts := SubMatchesRegEx(FileName , '(.+ )([MDCLXVI]+)( .+)', TRUE);
   If (Length(Parts) = 3)Then
   begin
      // WideShowMessage(Parts[0] + Parts[1] + Parts[2]);
      FileName := Parts[0] + RomanToArabic(Parts[1]) + Parts[2];
      Exit;
   End;
   function RomanToArabic(Roman:string):string;
     ;
     ;
   end;
end.

HTH?

---

Read the  *WIKI* for HELP + MANUAL + Tips&Tricks.
If ReNamer had helped you, please *DONATE* to Denis or buy a PRO license. (Read *Lite vs Pro*)

Stefan

Moderator

From: Germany, EU

Registered: 2007-10-23

Posts: 1,161

Re: Roman To Arabic in filename conversion

OK, I didn't get peace, so here is my tested script:

FROM:
"Variation XV Canone alla Quinta.flac"

TO:
"Variation 15 Canone alla Quinta.flac"

USE PascalScript (http://www.den4b.com/wiki/ReNamer:Rules:PascalScript)

{
Change Roman numbers to arabic:
FROM: "Variation XV Canone alla Quinta.flac"
TO:    "Variation 15 Canone alla Quinta.flac"
}

// Helper Function:
function RomanToArabic(Roman:string):string;
(* limited to roman string <255 car !! *)
var
   idx:byte;
   total, valPrec, valCourante:Word;

begin
   ValPrec:=65535;
    for idx:=1 to Length(Roman) do
    begin
        case roman[idx] of
          'M' : valCourante:=1000;
          'D' : valCourante:=500;
          'C' : valCourante:=100;
          'L' : valCourante:=50;
          'X' : valCourante:=10;
          'V' : valCourante:=5;
          'I' : valCourante:=1;
        end;
        total:=total+valcourante;
        if valcourante>valprec then valprec:=valprec - (2*valprec);
        valprec:=valcourante;
    end;
    result:=IntToStr(total);
end;

// Main script:
var
   Parts: TStringsArray;
begin
   Parts := SubMatchesRegEx(FileName , '(.+ )([MDCLXVI]+)( .+)', TRUE);
   If (Length(Parts) = 3)Then
   begin
      // WideShowMessage(Parts[0] + Parts[1] + Parts[2]);
      FileName := Parts[0] + RomanToArabic(Parts[1]) + Parts[2];
      Exit;
   End;
end.

HTH?

Last edited by Stefan (2015-10-14 12:43)

---

Read the  *WIKI* for HELP + MANUAL + Tips&Tricks.
If ReNamer had helped you, please *DONATE* to Denis or buy a PRO license. (Read *Lite vs Pro*)

eric91

Member

Registered: 2015-10-14

Posts: 3

Re: Roman To Arabic in filename conversion

Hello Stefan,

thanks for help and bonus : Now I know the HTH acronym :)

Thats works perfectly.

As idea of evolution, i imagine a custom string function library on a side and on the regex rule tab , in the replace line, the ability to replace a subexpression by function(subexpression). 

I use very often Renamer and am happy to have bought it.

Regards

Eric

den4b

Administrator

From: den4b.com

Registered: 2006-04-06

Posts: 3,479

Re: Roman To Arabic in filename conversion

I went with a bit of an old fashioned and hardcore approach - manually parsing, extracting and replacing all roman numerals. The result is a more flexible way than RegEx, by allowing roman numerals to appear at the start or end of name, surrounded by punctuation, etc.

Example: "VI test (M) test-XI.txt" will be converted to "6 test (1000) test-11.txt"

WARNING: In this code the RomanToArabic function is the one that you have provided! Beware that it does not handle least-significant-order roman numerals correctly, i.e. IX and XI both get converted to 11, while it should be 9 and 11, respectively.

const
  AllRomanDigits = 'MDCLXVI';

function RomanToArabic(const Roman: String): String;
var
  i: byte;
  total, valPrec, valCourante: Word;
begin
  ValPrec:=65535;
	for i:=1 to Length(Roman) do
	begin
		case roman[i] of
		  'M' : valCourante:=1000;
		  'D' : valCourante:=500;
		  'C' : valCourante:=100;
		  'L' : valCourante:=50;
		  'X' : valCourante:=10;
		  'V' : valCourante:=5;
		  'I' : valCourante:=1;
		end;
		total:=total+valcourante;
		if valcourante>valprec then
      valprec:=valprec - (2*valprec);
		valprec:=valcourante;
	end;
	result:=IntToStr(total);
end;

function IsWideCharWordBreak(const WC: WideChar): Boolean;
begin
  Result := IsWideCharSpace(WC) or IsWideCharPunct(WC);
end;

function FindRomanNumber(const Subject: WideString;
  out RomanNumber: WideString; var NextPosition: Integer): Boolean;
var
  Started: Boolean;
begin
  Result := False;
  Started := (NextPosition = 1);
  RomanNumber := '';
  while NextPosition <= Length(Subject) do
  begin
    if IsWideCharWordBreak(Subject[NextPosition]) then
    begin
      if Length(RomanNumber) > 0 then
        Break;
      Started := True;
    end
    else if Started then
    begin
      if WidePos(Subject[NextPosition], AllRomanDigits) > 0 then
        RomanNumber := RomanNumber + Subject[NextPosition]
      else
      begin
        Started := False;
        RomanNumber := '';
      end;
    end;
    NextPosition := NextPosition + 1;
  end;
  Result := WideLength(RomanNumber) > 0;
end;

procedure ReplaceRomanDigits(var S: WideString);
var
  RomanNumber, ArabicNumber: WideString;
  NextPosition, RomanNumberPos: Integer;
begin
  NextPosition := 1;
  while FindRomanNumber(S, RomanNumber, NextPosition) do
  begin
    ArabicNumber := RomanToArabic(RomanNumber);
    RomanNumberPos := NextPosition - WideLength(RomanNumber);
    WideDelete(S, RomanNumberPos, WideLength(RomanNumber));
    WideInsert(ArabicNumber, S, RomanNumberPos);
    NextPosition := NextPosition - WideLength(RomanNumber) + WideLength(ArabicNumber);
  end;
end;

var
  BaseName: WideString;

begin
  BaseName := WideExtractBaseName(FileName);
  ReplaceRomanDigits(BaseName);
  FileName := BaseName + WideExtractFileExt(FileName);
end.

---

A story of software development, and how it all evolves into Live vs Pro
Request a Wiki account | Reporting spam and abuse | Why did I get banned?

eric91

Member

Registered: 2015-10-14

Posts: 3

Re: Roman To Arabic in filename conversion

Hi,
thanks for this code. I will look it further later to try to full understand it. (The last time i do Turbo Pascal was in 1984.)

I try my vbs code and it work. In fact, i do a mistake when I convert VBS to Pascal.
The good code is a modification after the test.

replace :

if valcourante>valprec then valprec:=valprec - (2*valprec);

by

if valcourante>valprec then total:=total - (valprec+valprec);

Sorry .

the good code with all your modifications is :

const
  AllRomanDigits = 'MDCLXVI';

function RomanToArabic(const Roman: String): String;
var
  i: byte;
  total, valPrec, valCourante: Word;
begin
  ValPrec:=65535;
	for i:=1 to Length(Roman) do
	begin
		case roman[i] of
		  'M' : valCourante:=1000;
		  'D' : valCourante:=500;
		  'C' : valCourante:=100;
		  'L' : valCourante:=50;
		  'X' : valCourante:=10;
		  'V' : valCourante:=5;
		  'I' : valCourante:=1;
		end;
		total:=total + valCourante;
		if valCourante > valPrec then total:=total - (valPrec + valPrec);
		valPrec:=valCourante;
	end;
	result:=IntToStr(total);
end;

function IsWideCharWordBreak(const WC: WideChar): Boolean;
begin
  Result := IsWideCharSpace(WC) or IsWideCharPunct(WC);
end;

function FindRomanNumber(const Subject: WideString;
  out RomanNumber: WideString; var NextPosition: Integer): Boolean;
var
  Started: Boolean;
begin
  Result := False;
  Started := (NextPosition = 1);
  RomanNumber := '';
  while NextPosition <= Length(Subject) do
  begin
    if IsWideCharWordBreak(Subject[NextPosition]) then
    begin
      if Length(RomanNumber) > 0 then
        Break;
      Started := True;
    end
    else if Started then
    begin
      if WidePos(Subject[NextPosition], AllRomanDigits) > 0 then
        RomanNumber := RomanNumber + Subject[NextPosition]
      else
      begin
        Started := False;
        RomanNumber := '';
      end;
    end;
    NextPosition := NextPosition + 1;
  end;
  Result := WideLength(RomanNumber) > 0;
end;

procedure ReplaceRomanDigits(var S: WideString);
var
  RomanNumber, ArabicNumber: WideString;
  NextPosition, RomanNumberPos: Integer;
begin
  NextPosition := 1;
  while FindRomanNumber(S, RomanNumber, NextPosition) do
  begin
    ArabicNumber := RomanToArabic(RomanNumber);
    RomanNumberPos := NextPosition - WideLength(RomanNumber);
    WideDelete(S, RomanNumberPos, WideLength(RomanNumber));
    WideInsert(ArabicNumber, S, RomanNumberPos);
    NextPosition := NextPosition - WideLength(RomanNumber) + WideLength(ArabicNumber);
  end;
end;

var
  BaseName: WideString;

begin
  BaseName := WideExtractBaseName(FileName);
  ReplaceRomanDigits(BaseName);
  FileName := BaseName + WideExtractFileExt(FileName);
end.

This code has some limits and "unreal" roman numbers are interpreted like IXI =10
I test (in VBS) RomanToArabic from 1 to 4000 with the ArabicToRoman (den4b.com/forum/viewtopic.php?id=828) and it works till 4000 where ArabicToRoman produce M(V) but RomanToArabic expect MMMM.
I try "MMMMDCCCLXXXVIII" which give 4888 (Wikipedia : fr.wikipedia.org/wiki/Num%C3%A9ration_romaine)

Eric