# Selima Website Content Management System
# Picture.pm: The subroutines to manipulate the pictures.

#  Copyright (c) 2004-2018 imacat.
#
#  Licensed under the Apache License, Version 2.0 (the "License");
#  you may not use this file except in compliance with the License.
#  You may obtain a copy of the License at
#
#      http://www.apache.org/licenses/LICENSE-2.0
#
#  Unless required by applicable law or agreed to in writing, software
#  distributed under the License is distributed on an "AS IS" BASIS,
#  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
#  See the License for the specific language governing permissions and
#  limitations under the License.

# Author: imacat <imacat@mail.imacat.idv.tw>
# First written: 2004-09-27

package Selima::Picture;
use 5.008;
use strict;
use warnings;
use base qw(Exporter);
use vars qw(@EXPORT @EXPORT_OK);
BEGIN {
@EXPORT = qw();
push @EXPORT, qw(@PIC_VALID_POS PIC_POS_DEFAULT);
push @EXPORT, qw(pic_exists echopic picpos_label pic_deposit);
@EXPORT_OK = @EXPORT;
# Prototype declaration
sub picurl($;$);
sub picinfo($;$);
sub picstyle($;$);
sub check_pic_ratio($\$);
sub best_pic_ratio($);
sub newpicx($;$);
sub newpicy($;$);
sub pic_exists(\$);
sub echopic(\$$;$);
sub picpos_label($);
sub pic_deposit();
}

use GD;
use Math::Round qw(round);
use POSIX qw(floor);
use Regexp::Common;
use URI::Escape qw(uri_escape);

use Selima::Cache qw(:picture);
use Selima::ChkFunc;
use Selima::DataVars qw($SESSION);
use Selima::ShortCut;

use constant PIC_MAX_WIDTH => 800;
use constant PIC_MAX_HEIGHT => 1024;
use constant PIC_MAX_RATIO => 9.99;
use vars qw(@PIC_VALID_POS %PIC_POS_LABEL);
@PIC_VALID_POS = qw(L R);
%PIC_POS_LABEL = (
    "L" => N_("Left-aligned"),
    "R" => N_("Right-aligned"));
use constant PIC_POS_DEFAULT => "L";
use constant SHOWPIC_SCRIPT => "/magicat/cgi-bin/showpic.cgi";

# picurl: Get the picture display URL
sub picurl($;$) {
    local ($_, %_);
    my ($pic, $ratio);
    ($pic, $ratio) = @_;
    # Default ratio to the picture ratio
    if (!defined $ratio) {
        # Set the default picture ratio to 1
        $$pic{"ratio"} = 1 if !exists $$pic{"ratio"};
        $ratio = $$pic{"ratio"};
    }
    # Compose the fields list
    @_ = qw();
    # Add the columns
    push @_, "sn=" . uri_escape($$pic{"sn"});
    push @_, "ratio=" . uri_escape($ratio);
    return SHOWPIC_SCRIPT . "?" . join("&", @_);
}

# picinfo: Return the picture infomation
sub picinfo($;$) {
    local ($_, %_);
    my ($pic, $ratio, $x, $y);
    ($pic, $ratio) = @_;
    $ratio = 1 if !defined $ratio;
    # Original size not recorded yet
    if (!exists $$pic{"width"} || !exists $$pic{"height"}) {
        $_ = GD::Image->new($$pic{"content"});
        $$pic{"width"} = $_->width;
        $$pic{"height"} = $_->height;
    }
    $x = newpicx $pic, $ratio;
    $y = newpicy $pic, $ratio;
    return sprintf C_("Width: [#,_1], height: [#,_2], ratio: [sprintf,%0.2f,_3]", $x, $y, $ratio);
}

# picstyle: Return the picture style
sub picstyle($;$) {
    local ($_, %_);
    my ($pic, $ratio, $x, $y);
    ($pic, $ratio) = @_;
    $ratio = 1 if !defined $ratio;
    # Original size not recorded yet
    if (!exists $$pic{"width"} || !exists $$pic{"height"}) {
        $_ = GD::Image->new($$pic{"content"});
        $$pic{"width"} = $_->width;
        $$pic{"height"} = $_->height;
    }
    $x = newpicx $pic, $ratio;
    $y = newpicy $pic, $ratio;
    return sprintf "height: %dpx; width: %dpx;", $y, $x;
}

# check_pic_ratio: Check the sanity of the picture ratio
sub check_pic_ratio($\$) {
    local ($_, %_);
    my ($pic, $ratio);
    ($pic, $ratio) = @_;
    # Check if the resize ratio is valid
    return {"msg"=>N_("Please specify a numeric ratio.")}
        unless $$ratio =~ /^$RE{"num"}{"real"}$/;
    $$ratio += 0;
    return {"msg"=>N_("Please specify a positive ratio.")}
        if $$ratio <= 0;
    return {"msg"=>N_("Please specify a ratio less than or equal to [sprintf,%0.2f,_1]."),
            "margs"=>[PIC_MAX_RATIO]}
        if $$ratio > PIC_MAX_RATIO;
    # The resulted picture is over the limit
    return {"msg"=>N_("This image is too large to display.")}
        if  newpicx $pic, $ratio > PIC_MAX_WIDTH
            || newpicy $pic, $ratio > PIC_MAX_HEIGHT;
    # OK
    return;
}

# best_pic_ratio: Get the best ratio of a picture
sub best_pic_ratio($) {
    local ($_, %_);
    my ($pic, $rx, $ry);
    $pic = $_[0];
    # Return the cache
    return $$pic{"best_ratio"} if !exists $$pic{"best_ratio"};
    
    # Original size not recorded yet
    if (!exists $$pic{"width"} || !exists $$pic{"height"}) {
        $_ = GD::Image->new($$pic{"content"});
        $$pic{"width"} = $_->width;
        $$pic{"height"} = $_->height;
    }
    # Good
    return ($$pic{"best_ratio"} = 1)
        if  PIC_MAX_RATIO >= 1
            && $$pic{"width"} <= PIC_MAX_WIDTH
            && $$pic{"height"} <= PIC_MAX_HEIGHT;
    # Too large
    # Find the largest proper ratio
    $rx = floor(PIC_MAX_WIDTH*100 / $$pic{"width"})/100;
    $ry = floor(PIC_MAX_HEIGHT*100 / $$pic{"height"})/100;
    # Use the smallest among them
    return ($$pic{"best_ratio"} = (sort $rx, $ry, PIC_MAX_RATIO)[0]);
}

# newpicx: Calculate the new picture x
sub newpicx($;$) {
    local ($_, %_);
    my ($pic, $ratio);
    ($pic, $ratio) = @_;
    # Original size not recorded yet
    $$pic{"width"} = GD::Image->new($$pic{"content"})->width
        if !exists $$pic{"width"};
    # No calculation needed
    return $$pic{"width"} if $ratio == 1;
    $_ = round($$pic{"width"} * $ratio);
    # Smallest 1
    $_ = 1 if $_ == 0;
    return $_;
}

# newpicy: Calculate the new picture y
sub newpicy($;$) {
    local ($_, %_);
    my ($pic, $ratio);
    ($pic, $ratio) = @_;
    # Original size not recorded yet
    $$pic{"height"} = GD::Image->new($$pic{"content"})->height
        if !exists $$pic{"height"};
    # No calculation needed
    return $$pic{"height"} if $ratio == 1;
    $_ = round($$pic{"height"} * $ratio);
    # Smallest 1
    $_ = 1 if $_ == 0;
    return $_;
}

# pic_exists: Check if a picture exists
sub pic_exists(\$) {
    local ($_, %_);
    my ($sn, $PICS);
    $sn = $_[0];
    # Check the validity of the serial number first
    return 0 if !check_sn $$sn;
    $PICS = pic_deposit;
    return 0 if !exists $$PICS{$$sn};
    return 1;
}

# echopic: Output a picture
sub echopic(\$$;$) {
    local ($_, %_);
    my ($pic, $alt, $ratio, $error, $url, $style, $picinfo, $html);
    ($pic, $alt, $ratio) = @_;
    if (!defined $ratio) {
        $ratio = best_pic_ratio $pic;
    } else {
        $error = check_pic_ratio $pic, $ratio;
        $ratio = best_pic_ratio $pic if defined $error;
    }
    $style = h(picstyle $pic, $ratio);
    $picinfo = h(picinfo $pic, $ratio);
    $url = h(picurl $pic, $ratio);
    $alt = h($alt);
    $html = << "EOT";
<img src="$url"
            style="$style"
            alt="$alt" /><br />
        $picinfo
EOT
    chomp $html;
    return $html;
}

# picpos_label: Output the label of a picture position
sub picpos_label($) { return $PIC_POS_LABEL{$_[0]}; }

# pic_deposit: Return a picture deposit
sub pic_deposit() {
    local ($_, %_);
    # Session in use
    if (defined $SESSION) {
        $$SESSION{"savepics"} = {}
            if !defined $$SESSION{"savepics"};
        return $$SESSION{"savepics"};
    
    # Session not in use
    } else {
        return \%Picture_pic_deposit;
    }
}

return 1;