The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use strict;
use warnings;
use utf8;
use Prima qw(Label InputLine Buttons Application PodView Edit FontDialog);
use Prima::Bidi qw(:require :rtl);

$::application-> wantUnicodeInput(1);

my $w;
my $pod;
my $arabic;
my $editor;
my $pod_text;
my $font_dialog;

$w = Prima::MainWindow-> create(
	size => [ 430, 200],
	designScale => [7, 16],
	text => "Bidirectional texts",
	menuItems => [
		[ "~Options" => [
			[ "~Toggle direction" => sub {
				$arabic-> alignment( $arabic-> alignment == ta::Left ? ta::Right : ta::Left );
				my $td = !$w-> Hebrew-> textDirection;
				$w-> Hebrew-> textDirection($td);
				$pod->textDirection($td);
				$pod->format(1);
			} ],
			[ "~Set font" => sub {
				$font_dialog //= Prima::FontDialog-> create(logFont => $w->font);
				$w->font($font_dialog-> logFont) if $font_dialog-> execute == mb::OK;
			} ],
		]],
	],
);

sub can_rtl
{
	$::application->font(shift);
	my @r = @{ $::application->get_font_ranges };
	my $hebrew = ord('א');
	my $arabic = ord('ر');
	my $found_hebrew;
	my $found_arabic;
	for ( my $i = 0; $i < @r; $i += 2 ) {
		my ( $l, $r ) = @r[$i, $i+1];
		$found_hebrew = 1 if $l <= $hebrew && $r >= $hebrew;
		$found_arabic = 1 if $l <= $arabic && $r >= $arabic;
	}
	return $found_hebrew && $found_arabic;
}

# try to find font with arabic and hebrew letters
$::application->begin_paint_info;
unless (can_rtl($w->font)) {
	my $found;
	my @f = @{$::application->fonts};

	# fontconfig fonts
	for my $f ( @f ) {
		next unless $f->{vector};
		next unless $f->{name} =~ /^[A-Z]/;
		next unless can_rtl($f);
		$found = $f;
		goto FOUND;
	}

	# x11/core vector fonts
	for my $f ( @f ) {
		next unless $f->{vector};
		next if $f->{name} =~ /^[A-Z]/;
		next unless can_rtl($f);
		$found = $f;
		goto FOUND;
	}

	# bitmap fonts
	for my $f ( @f ) {
		next if $f->{vector};
		next unless can_rtl($f);
		$found = $f;
		goto FOUND;
	}
FOUND:	
	$w->font->name($found->{name}) if $found;

}
$::application->end_paint_info;

$w->insert( InputLine =>
	name => 'Hebrew',
	origin => [ 10, 10],
	width  => 200,
	text => "אפס123 - תרttttאה מה אני יכול!",
	growMode => gm::Floor,
);

$w-> insert( Button => 
	name => 'Farsi',
	text => 'ترک',
	origin => [ 320, 10 ],
	growMode => gm::GrowLoX,
	onClick => sub { $::application-> close },
);

my $panel = $w->insert( Widget =>
	origin => [ 10, 50 ],
	size   => [ 410, 140 ],
	growMode  => gm::Client,
);

my $arabic_text = "الفالح حلمه كبير.
طول ساق النبتة وصارت
شجرة في أرض الفالح
وعلى الشجرة غصون و أوراق
بفيتها إ حتمى الفالح
الفالح حلمه كبير";

$editor = $panel-> insert( Edit => 
	packInfo => { fill => 'both', expand => 1, pad => 10 , side => 'left'},
	geometry => gt::Pack,
	name => 'Editor',
	text     => $arabic_text,
);

$arabic = $panel->insert( Label =>
	packInfo => { fill => 'both', expand => 1, pad => 10, side => 'left' },
	geometry => gt::Pack,
	name  => 'Arabic',
	backColor => cl::Yellow,
	text     => $arabic_text,
	wordWrap => 1,
	showPartial => 0,
);

$pod = $panel-> insert( PodView => 
	packInfo => { fill => 'both', expand => 1, pad => 10 , side => 'left'},
	geometry => gt::Pack,
	name => 'Pod',
);

$arabic_text =~ s/(.*?)\n//;
$pod_text = "=head1 $1\n\n" . join("\n\n", split "\n", $arabic_text) . "\n\n";
$pod-> open_read( createIndex => 0 );
$pod-> read($pod_text);
$pod-> close_read;

run Prima;