#!/usr/bin/env perl

use 5.014;
use warnings;

{
    my %entity_for = qw{& &amp; < &lt; > &gt;};
    sub chars_to_ents { $_[0] =~ s/([&<>])/$entity_for{$1}/gr }
}

my @plain_captures = qw{white_space remainder};
my @highlight_captures = qw{operator variable function constant statement
                            datatype comment string integer float pragma};

my $re = qr{
    (?>
        (?<white_space>
            \s+
        )
    |
        (?<comment>
            (?>
                \/\* (?: . (?! \*\/ ) )*+ (?: . (?= \*\/ ) )?+ \*\/
            |
                \/\/ [^\n]* $
            )
        )
    |
        (?<pragma>
            (?>
                [#]include \s+ " \w+ " \s* $
            |
                [#]define \s+ \w+ \s+ \w+ \s* $
            )
        )
    |
        (?<string>
            " (?: [^"\\]++ | \\. )*+ "
        )
    |
        (?<float>
            \b \d+ \. \d+ f? \b
        )
    |
        (?<integer>
            \b \d+ \b
        )
    |
        (?<constant>
            \b [A-Z0-9_]+ \b
        )
    |
        (?<datatype>
            \b (?>
                action | const | effect | event | float | int
                | itemproperty | location | object | string
                | struct \s+ \w+ | talent | vector | void
            ) \b
        )
    |
        (?<statement>
            \b (?>
                break | continue | do | for | if | else
                | return | switch | case | default | while
            ) \b
        )
    |
        (?<function>
            \b [A-Za-z_] \w* (?= \s*\( )
        )
    |
        (?<variable>
            \b [A-Za-z_] \w* \b
        )
    |
        (?<operator>
            (?>
                \>\>\>\= | \>\>\> | \>\>\= | \<\<\= | \>\> | \<\< | \+\+ | \-\-
                | \&\= | \|\= | \^\= | \*\= | \/\= | \%\= | \+\= | \-\=
                | \=\= | \!\= | \<\= | \>\= | \&\& | \|\|
                | \< | \> | \! | \& | \| | \^ | \~ | \* | \/ | \% | \+ | \- | \=
                | \? | \: | \; | \. | \{ | \} | \( | \) | \, | \@
            )
        )
    |
        (?<remainder>
            .*?
        )
    )
}msx;

my $init_code = do { local $/; <> };

say '<pre class="syntax-highlight">';

MATCH:
while ($init_code =~ /$re/g) {
    for my $plain_capture (@plain_captures) {
        if (exists $+{$plain_capture}) {
            print $+{$plain_capture};
            next MATCH;
        }
    }

    for my $highlight_capture (@highlight_captures) {
        if (exists $+{$highlight_capture}) {
            print '<span class="', $highlight_capture, '">',
                    chars_to_ents($+{$highlight_capture}), '</span>';
            next MATCH;
        }
    }
}

say '</pre>';

exit;