Chars::Edit: Add image editing

10 files changed, 173 insertions, 27 deletions

diff --git a/data/style.css b/data/style.css
index 2199bdd9..00347c74 100644
--- a/data/style.css
+++ b/data/style.css
@@ -28,20 +28,6 @@ table.stripe tbody tr:nth-child(odd):not(.nostripe),
 #footer   { margin: 15px auto 0 auto; text-align: center; color: $footer$; }
 #footer a { color: $footer$; text-decoration: underline; }
 
-#debug {
-  position: fixed;
-  left: 0;
-  bottom: 0;
-  background-color: #600;
-  border-right: 1px solid #c00;
-  border-top: 1px solid #c00;
-  width: 200px;
-  height: 50px;
-  text-align: center;
-}
-#debug h2 { color: #f00!important; font-size: 20px; }
-#debug, #debug a { color: #fff!important; }
-
 /* https://snook.ca/archives/html_and_css/hiding-content-for-accessibility */
 .visuallyhidden, .linkradio input {
   position: absolute !important;
@@ -184,6 +170,11 @@ table.formtable tr.newpart td { padding-top: 20px; font-weight: bold; }
 table.formtable td table td { padding: 1px 15px 1px 0px }
 table.formtable td table    { margin-bottom: 5px }
 
+div.formimage > div:nth-child(1) { width: 300px; height: 300px; text-align: center; float: left }
+div.formimage > div:nth-child(1) img { max-width: 290px; max-height: 300px }
+div.formimage > div:nth-child(2) { min-height: 330px }
+div.formimage h2 { margin: 0 }
+
 /* Format checkboxes and radio buttons as if they were normal links with unicode icons.
  * Usage:
  *
@@ -308,7 +299,7 @@ p.mainopts a         { margin: 0 5px }
 /***** main tabs *****/
 
 div.maintabs          { display: flex; justify-content: space-between; position: relative; width: 100%; height: 22px; margin: 20px 0 -22px 0; padding: 0 }
-#maincontent div:nth-child(1).maintabs { margin-top: 0 }
+#maincontent > div:nth-child(1).maintabs { margin-top: 0 }
 div.maintabs.right    { justify-content: flex-end }
 div.maintabs.left     { justify-content: flex-start }
 div.maintabs > ul       { margin: 0; padding: 0; list-style-type: none }
diff --git a/elm/CharEdit.elm b/elm/CharEdit.elm
index 39ec8d4e..87927fc8 100644
--- a/elm/CharEdit.elm
+++ b/elm/CharEdit.elm
@@ -5,6 +5,8 @@ import Html.Events exposing (..)
 import Html.Attributes exposing (..)
 import Browser
 import Browser.Navigation exposing (load)
+import File exposing (File)
+import File.Select as FSel
 import Lib.Util exposing (..)
 import Lib.Html exposing (..)
 import Lib.TextPreview as TP
@@ -25,8 +27,14 @@ main = Browser.element
   }
 
 
+type Tab
+  = General
+  | Image
+  | All
+
 type alias Model =
   { state       : Api.State
+  , tab         : Tab
   , editsum     : Editsum.Model
   , name        : String
   , original    : String
@@ -48,6 +56,8 @@ type alias Model =
   , mainHas     : Bool
   , mainName    : String
   , mainSearch  : A.Model GApi.ApiCharResult
+  , image       : Maybe String
+  , imageState  : Api.State
   , id          : Maybe Int
   }
 
@@ -55,6 +65,7 @@ type alias Model =
 init : GCE.Recv -> Model
 init d =
   { state       = Api.Normal
+  , tab         = General
   , editsum     = { authmod = d.authmod, editsum = TP.bbcode d.editsum, locked = d.locked, hidden = d.hidden }
   , name        = d.name
   , original    = d.original
@@ -76,6 +87,8 @@ init d =
   , mainHas     = d.main /= Nothing
   , mainName    = d.main_name
   , mainSearch  = A.init ""
+  , image       = d.image
+  , imageState  = Api.Normal
   , id          = d.id
   }
 
@@ -102,6 +115,7 @@ encode model =
   , bloodt      = model.bloodt
   , cup_size    = model.cupSize
   , main        = if model.mainHas then model.main else Nothing
+  , image       = model.image
   }
 
 mainConfig : A.Config Msg GApi.ApiCharResult
@@ -109,6 +123,7 @@ mainConfig = { wrap = MainSearch, id = "mainadd", source = A.charSource }
 
 type Msg
   = Editsum Editsum.Msg
+  | Tab Tab
   | Submit
   | Submitted GApi.Response
   | Name String
@@ -128,12 +143,17 @@ type Msg
   | CupSize String
   | MainHas Bool
   | MainSearch (A.Msg GApi.ApiCharResult)
+  | ImageSet String
+  | ImageSelect
+  | ImageSelected File
+  | ImageLoaded GApi.Response
 
 
 update : Msg -> Model -> (Model, Cmd Msg)
 update msg model =
   case msg of
     Editsum m  -> let (nm,nc) = Editsum.update m model.editsum in ({ model | editsum = nm }, Cmd.map Editsum nc)
+    Tab t      -> ({ model | tab = t }, Cmd.none)
     Name s     -> ({ model | name = s }, Cmd.none)
     Original s -> ({ model | original = s }, Cmd.none)
     Alias s    -> ({ model | alias = s }, Cmd.none)
@@ -160,6 +180,12 @@ update msg model =
             Just m2 -> ({ model | mainSearch = A.clear nm "", main = Just m2.id, mainName = m2.name }, c)
             Nothing -> ({ model | mainSearch = A.clear nm "", main = Just m1.id, mainName = m1.name }, c)
 
+    ImageSet s  -> ({ model | image = if s == "" then Nothing else Just s}, Cmd.none)
+    ImageSelect -> (model, FSel.file ["image/png", "image/jpg"] ImageSelected)
+    ImageSelected f -> ({ model | imageState = Api.Loading }, Api.postImage Api.Ch f ImageLoaded)
+    ImageLoaded (GApi.Image i _ _) -> ({ model | image = Just i, imageState = Api.Normal }, Cmd.none)
+    ImageLoaded e -> ({ model | imageState = Api.Error e }, Cmd.none)
+
     Submit -> ({ model | state = Api.Loading }, GCE.send (encode model) Submitted)
     Submitted (GApi.Redirect s) -> (model, load s)
     Submitted r -> ({ model | state = Api.Error r }, Cmd.none)
@@ -173,10 +199,8 @@ isValid model = not
 
 view : Model -> Html Msg
 view model =
-  form_ Submit (model.state == Api.Loading)
-  [ div [ class "mainbox" ]
-    [ h1 [] [ text "General info" ]
-    , table [ class "formtable" ] <|
+  let
+    geninfo =
       [ formField "name::Name (romaji)" [ inputText "name" model.name Name GCE.valName ]
       , formField "original::Original name"
         [ inputText "original" model.original Original GCE.valOriginal
@@ -237,7 +261,46 @@ view model =
         , A.view mainConfig model.mainSearch [placeholder "Set character..."]
         ]
       ]
+
+    image =
+      div [ class "formimage" ]
+      [ div [] [
+        case model.image of
+          Nothing -> text "No image."
+          Just id -> img [ src (imageUrl id) ] []
+        ]
+      , div []
+        [ h2 [] [ text "Image ID" ]
+        , inputText "" (Maybe.withDefault "" model.image) ImageSet GCE.valImage
+        , Maybe.withDefault (text "") <| Maybe.map (\i -> a [ href <| "/img/"++i ] [ text " (flagging)" ]) model.image
+        , br [] []
+        , text "Use an image that already exists on the server or empty to remove the current image."
+        , br_ 2
+        , h2 [] [ text "Upload new image" ]
+        , inputButton "Browse image" ImageSelect []
+        , case model.imageState of
+            Api.Normal -> text ""
+            Api.Loading -> span [ class "spinner" ] []
+            Api.Error e -> b [ class "standout" ] [ text <| Api.showResponse e ]
+        , br [] []
+        , text "Image must be in JPEG or PNG format and at most 10 MiB. Images larger than 256x300 will automatically be resized."
+        -- TODO: Add image flagging vote thingy here after uploading a new image.
+        ]
+      ]
+
+  in
+  form_ Submit (model.state == Api.Loading)
+  [ div [ class "maintabs left" ]
+    [ ul []
+      [ li [ classList [("tabselected", model.tab == General)] ] [ a [ href "#", onClickD (Tab General) ] [ text "General info" ] ]
+      , li [ classList [("tabselected", model.tab == Image  )] ] [ a [ href "#", onClickD (Tab Image  ) ] [ text "Image"        ] ]
+      , li [ classList [("tabselected", model.tab == All    )] ] [ a [ href "#", onClickD (Tab All    ) ] [ text "All items"    ] ]
+      ]
     ]
+  , div [ class "mainbox", classList [("hidden", model.tab /= General && model.tab /= All)] ]
+    [ h1 [] [ text "General info" ], table [ class "formtable" ] geninfo ]
+  , div [ class "mainbox", classList [("hidden", model.tab /= Image && model.tab /= All)] ]
+    [ h1 [] [ text "Image" ], image ]
   , div [ class "mainbox" ] [ fieldset [ class "submit" ]
       [ Html.map Editsum (Editsum.view model.editsum)
       , submitButton "Submit" model.state (isValid model)
diff --git a/elm/ImageFlagging.elm b/elm/ImageFlagging.elm
index 66e8cbe0..0e99f1b5 100644
--- a/elm/ImageFlagging.elm
+++ b/elm/ImageFlagging.elm
@@ -147,7 +147,7 @@ update msg model =
       -- Preload next image
       pre (m, c) =
         case Array.get (m.index+1) m.images of
-          Just i  -> (m, Cmd.batch [ c, preload i.url ])
+          Just i  -> (m, Cmd.batch [ c, preload (imageUrl i.id) ])
           Nothing -> (m, c)
   in
   case msg of
@@ -249,7 +249,7 @@ view model =
         ]
       , div [ style "width" (px boxwidth), style "height" (px boxheight) ] <|
         -- Don't use an <img> here, changing the src= causes the old image to be displayed with the wrong dimensions while the new image is being loaded.
-        [ a [ href i.url, style "background-image" ("url("++i.url++")")
+        [ a [ href (imageUrl i.id), style "background-image" ("url("++imageUrl i.id++")")
             , style "background-size" (if i.width > boxwidth || i.height > boxheight then "contain" else "auto")
             ] [ text "" ] ]
       , div []
@@ -266,7 +266,7 @@ view model =
         , span []
           [ a [ href <| "/img/" ++ i.id ] [ text i.id ]
           , b [ class "grayedout" ] [ text " / " ]
-          , a [ href i.url ] [ text <| String.fromInt i.width ++ "x" ++ String.fromInt i.height ]
+          , a [ href (imageUrl i.id) ] [ text <| String.fromInt i.width ++ "x" ++ String.fromInt i.height ]
           ]
         ]
       , div [] <| if i.token == Nothing then [] else
@@ -325,7 +325,7 @@ view model =
         ]
       , votestats i
       , if model.fullscreen -- really lazy fullscreen mode
-        then div [ class "fullscreen", style "background-image" ("url("++i.url++")"), onClick (Fullscreen False) ] [ text "" ]
+        then div [ class "fullscreen", style "background-image" ("url("++imageUrl i.id++")"), onClick (Fullscreen False) ] [ text "" ]
         else text ""
       ]
 
diff --git a/elm/Lib/Api.elm b/elm/Lib/Api.elm
index 63f519cc..5dfda6d8 100644
--- a/elm/Lib/Api.elm
+++ b/elm/Lib/Api.elm
@@ -1,6 +1,7 @@
 module Lib.Api exposing (..)
 
 import Json.Encode as JE
+import File exposing (File)
 import Http
 
 import Gen.Api exposing (..)
@@ -22,7 +23,7 @@ showResponse res =
   in case res of
     HTTPError (Http.Timeout)        -> "Network timeout, please try again later."
     HTTPError (Http.NetworkError)   -> "Network error, please try again later."
-    HTTPError (Http.BadStatus r)    -> "Server error " ++ String.fromInt r ++ ", please try again later, or report an issue if this persists."
+    HTTPError (Http.BadStatus r)    -> "Server error " ++ String.fromInt r ++ ", please try again later or report an issue if this persists."
     HTTPError (Http.BadBody r)      -> "Invalid response from the server, please report a bug (debug info: " ++ r ++")."
     HTTPError (Http.BadUrl _)       -> unexp
     Success                         -> unexp
@@ -42,6 +43,8 @@ showResponse res =
     DoubleIP                        -> "You can only register one account from the same IP within 24 hours."
     BadCurPass                      -> "Current password is invalid."
     MailChange                      -> unexp
+    ImgFormat                       -> "Unrecognized image format, only JPEG and PNG are accepted."
+    Image _ _ _                     -> unexp
     Releases _                      -> unexp
     BoardResult _                   -> unexp
     TagResult _                     -> unexp
@@ -69,3 +72,23 @@ post name body msg =
     , body = Http.jsonBody body
     , expect = expectResponse msg
     }
+
+
+type ImageType
+  = Ch
+  | Cv
+  | Sf
+
+postImage : ImageType -> File -> (Response -> msg) -> Cmd msg
+postImage ty file msg =
+  Http.post
+    { url  = "/elm/ImageUpload.json"
+    , body = Http.multipartBody
+      [ Http.stringPart "type" <| case ty of
+          Cv -> "cv"
+          Sf -> "sf"
+          Ch -> "ch"
+      , Http.filePart "img" file
+      ]
+    , expect = expectResponse msg
+    }
diff --git a/elm/Lib/Util.elm b/elm/Lib/Util.elm
index f840d003..34189565 100644
--- a/elm/Lib/Util.elm
+++ b/elm/Lib/Util.elm
@@ -2,6 +2,7 @@ module Lib.Util exposing (..)
 
 import Dict
 import Task
+import Lib.Ffi as Ffi
 
 -- Delete an element from a List
 delidx : Int -> List a -> List a
@@ -57,3 +58,10 @@ validateGtin =
         ||  n >= 9770000000000
         || modBy 10 (check n) /= 0
   in String.filter Char.isDigit >> String.toInt >> Maybe.map (not << inval) >> Maybe.withDefault False
+
+
+-- Convert an image ID (e.g. "sf500") into a URL.
+imageUrl : String -> String
+imageUrl id =
+  let num = String.dropLeft 2 id |> String.toInt |> Maybe.withDefault 0
+  in Ffi.urlStatic ++ "/" ++ String.left 2 id ++ "/" ++ String.fromInt (modBy 10 (num // 10)) ++ String.fromInt (modBy 10 num) ++ "/" ++ String.fromInt num ++ ".jpg"
diff --git a/lib/VNWeb/Chars/Edit.pm b/lib/VNWeb/Chars/Edit.pm
index 6dbdf92a..3b2c70de 100644
--- a/lib/VNWeb/Chars/Edit.pm
+++ b/lib/VNWeb/Chars/Edit.pm
@@ -23,6 +23,7 @@ my $FORM = {
     main       => { required => 0, id => 1 },
     main_ref   => { _when => 'out', anybool => 1 },
     main_name  => { _when => 'out', default => '' },
+    image      => { required => 0, regex => qr/ch[1-9][0-9]{0,6}/ },
     hidden     => { anybool => 1 },
     locked     => { anybool => 1 },
 
diff --git a/lib/VNWeb/Elm.pm b/lib/VNWeb/Elm.pm
index 59574aed..46832d01 100644
--- a/lib/VNWeb/Elm.pm
+++ b/lib/VNWeb/Elm.pm
@@ -49,6 +49,8 @@ our %apis = (
     DoubleIP       => [], # Account with same IP already exists
     BadCurPass     => [], # Current password is incorrect when changing password
     MailChange     => [], # A confirmation mail has been sent to change a user's email address
+    ImgFormat      => [], # Unrecognized image format
+    Image          => [ {}, { uint => 1 }, { uint => 1 } ], # Uploaded image id, width, height
     Releases       => [ { aoh => { # Response to 'Release'
         id       => { id => 1 },
         title    => {},
@@ -93,7 +95,6 @@ our %apis = (
     ImageResult => [ { aoh => { # Response to 'Images'
         id              => { }, # image id...
         token           => { required => 0 },
-        url             => { },
         width           => { uint => 1 },
         height          => { uint => 1 },
         votecount       => { uint => 1 },
diff --git a/lib/VNWeb/Images/Vote.pm b/lib/VNWeb/Images/Vote.pm
index ba7047ef..a117834d 100644
--- a/lib/VNWeb/Images/Vote.pm
+++ b/lib/VNWeb/Images/Vote.pm
@@ -52,7 +52,6 @@ sub enrich_image {
     }, $l;
 
     for(@$l) {
-        $_->{url} = tuwf->imgurl($_->{id});
         $_->{entry} = $_->{entry_id} ? { id => $_->{entry_id}, title => $_->{entry_title} } : undef;
         delete $_->{entry_id};
         delete $_->{entry_title};
diff --git a/lib/VNWeb/Misc/ImageUpload.pm b/lib/VNWeb/Misc/ImageUpload.pm
new file mode 100644
index 00000000..4fd1ed0c
--- /dev/null
+++ b/lib/VNWeb/Misc/ImageUpload.pm
@@ -0,0 +1,60 @@
+package VNWeb::Misc::ImageUpload;
+
+use VNWeb::Prelude;
+use Image::Magick;
+
+sub save_img {
+    my($im, $id, $thumb, $ow, $oh, $pw, $ph) = @_;
+
+    if($pw) {
+        my($nw, $nh) = imgsize($ow, $oh, $pw, $ph);
+        if($ow != $nw || $oh != $nh) {
+            $im->GaussianBlur(geometry => '0.5x0.5');
+            $im->Resize(width => $nw, height => $nh);
+            $im->UnsharpMask(radius => 0, sigma => 0.75, amount => 0.75, threshold => 0.008);
+        }
+    }
+
+    my $fn = tuwf->imgpath($id, $thumb);
+    $im->Write($fn) && die "Error saving $fn: $!\n";
+    chmod 0666, $fn;
+}
+
+
+TUWF::post qr{/elm/ImageUpload.json}, sub {
+    if(!auth->csrfcheck(tuwf->reqHeader('X-CSRF-Token')||'')) {
+        warn "Invalid CSRF token in request\n";
+        return elm_CSRF;
+    }
+    return elm_Unauth if !auth->permEdit;
+
+    my $type = tuwf->validate(post => type => { enum => [qw/cv ch sf/] })->data;
+    my $imgdata = tuwf->reqUploadRaw('img');
+    return elm_ImgFormat if $imgdata !~ /^(\xff\xd8|\x89\x50)/; # JPG or PNG header
+
+    my $im = Image::Magick->new;
+    $im->BlobToImage($imgdata);
+    $im->Set(magick => 'JPEG');
+    $im->Set(background => '#ffffff');
+    $im->Set(alpha => 'Remove');
+    $im->Set(quality => 90);
+
+    my($ow, $oh) = ($im->Get('width'), $im->Get('height'));
+    my($nw, $nh) =
+        $type eq 'ch' ? imgsize $ow, $oh, tuwf->{ch_size}->@* :
+        $type eq 'cv' ? imgsize $ow, $oh, tuwf->{cv_size}->@* : ($ow, $oh);
+
+    my $seq = {qw/sf screenshots_seq cv covers_seq ch charimg_seq/}->{$type}||die;
+    my $id = tuwf->dbVali('INSERT INTO images', {
+        id     => sql_func(vndbid => \$type, sql(sql_func(nextval => \$seq), '::int')),
+        width  => $nw,
+        height => $nh
+    }, 'RETURNING id');
+
+    save_img $im, $id, 0, $ow, $oh, $nw, $nh;
+    save_img $im, $id, 1, $nw, $nh, tuwf->{scr_size}->@* if $type eq 'sf';
+
+    elm_Image $id, $ow, $oh;
+};
+
+1;
diff --git a/util/vndb.pl b/util/vndb.pl
index 84398ca9..3eafe5af 100755
--- a/util/vndb.pl
+++ b/util/vndb.pl
@@ -43,7 +43,7 @@ sub _path {
 }
 
 # tuwf->imgpath($image_id, $thumb)
-sub TUWF::Object::imgpath { _path $ROOT, $_[1], $_[2] }
+sub TUWF::Object::imgpath { _path "$ROOT/static", $_[1], $_[2] }
 
 # tuwf->imgurl($image_id, $thumb)
 sub TUWF::Object::imgurl { _path $_[0]{url_static}, $_[1], $_[2] }