summaryrefslogtreecommitdiff
path: root/elm
diff options
context:
space:
mode:
Diffstat (limited to 'elm')
-rw-r--r--elm/CharEdit.elm71
-rw-r--r--elm/Lib/Api.elm1
-rw-r--r--elm/Lib/Image.elm162
3 files changed, 181 insertions, 53 deletions
diff --git a/elm/CharEdit.elm b/elm/CharEdit.elm
index 0f75a357..75362ef0 100644
--- a/elm/CharEdit.elm
+++ b/elm/CharEdit.elm
@@ -17,6 +17,7 @@ import Lib.Autocomplete as A
import Lib.Api as Api
import Lib.Editsum as Editsum
import Lib.RDate as RDate
+import Lib.Image as Img
import Gen.Release as GR
import Gen.CharEdit as GCE
import Gen.Types as GT
@@ -65,11 +66,7 @@ type alias Model =
, mainName : String
, mainSearch : A.Model GApi.ApiCharResult
, mainSpoil : Int
- , image : Maybe String
- , imageState : Api.State
- , imageNew : Set.Set String
- , imageSex : Maybe Int
- , imageVio : Maybe Int
+ , image : Img.Image
, traits : List GCE.RecvTraits
, traitSearch : A.Model GApi.ApiTraitResult
, traitSelId : Int
@@ -108,11 +105,7 @@ init d =
, mainName = d.main_name
, mainSearch = A.init ""
, mainSpoil = d.main_spoil
- , image = d.image
- , imageState = Api.Normal
- , imageNew = Set.empty
- , imageSex = d.image_sex
- , imageVio = d.image_vio
+ , image = Img.info d.image_info
, traits = d.traits
, traitSearch = A.init ""
, traitSelId = 0
@@ -148,9 +141,7 @@ encode model =
, cup_size = model.cupSize
, main = if model.mainHas then model.main else Nothing
, main_spoil = model.mainSpoil
- , image = model.image
- , image_sex = model.imageSex
- , image_vio = model.imageVio
+ , image = model.image.id
, traits = List.map (\t -> { tid = t.tid, spoil = t.spoil }) model.traits
, vns = List.map (\v -> { vid = v.vid, rid = v.rid, spoil = v.spoil, role = v.role }) model.vns
}
@@ -188,12 +179,10 @@ type Msg
| MainHas Bool
| MainSearch (A.Msg GApi.ApiCharResult)
| MainSpoil Int
- | ImageSet String
+ | ImageSet String Bool
| ImageSelect
| ImageSelected File
- | ImageLoaded GApi.Response
- | ImageSex Int Bool
- | ImageVio Int Bool
+ | ImageMsg Img.Msg
| TraitDel Int
| TraitSel Int Int
| TraitSpoil Int Int
@@ -240,13 +229,10 @@ update msg model =
Nothing -> ({ model | mainSearch = A.clear nm "", main = Just m1.id, mainName = m1.name }, c)
MainSpoil n -> ({ model | mainSpoil = n }, Cmd.none)
- ImageSet s -> ({ model | image = if s == "" then Nothing else Just s}, Cmd.none)
+ ImageSet s b -> let (nm, nc) = Img.new b s in ({ model | image = nm }, Cmd.map ImageMsg nc)
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, imageNew = Set.insert i model.imageNew, imageState = Api.Normal }, Cmd.none)
- ImageLoaded e -> ({ model | imageState = Api.Error e }, Cmd.none)
- ImageSex i _ -> ({ model | imageSex = Just i }, Cmd.none)
- ImageVio i _ -> ({ model | imageVio = Just i }, Cmd.none)
+ ImageSelected f -> let (nm, nc) = Img.upload Api.Ch f in ({ model | image = nm }, Cmd.map ImageMsg nc)
+ ImageMsg m -> let (nm, nc) = Img.update m model.image in ({ model | image = nm }, Cmd.map ImageMsg nc)
TraitDel idx -> ({ model | traits = delidx idx model.traits }, Cmd.none)
TraitSel id spl -> ({ model | traitSelId = id, traitSelSpl = spl }, Cmd.none)
@@ -288,6 +274,7 @@ isValid : Model -> Bool
isValid model = not
( (model.name /= "" && model.name == model.original)
|| hasDuplicates (List.map (\v -> (v.vid, Maybe.withDefault 0 v.rid)) model.vns)
+ || not (Img.isValid model.image)
)
@@ -380,45 +367,25 @@ view model =
image =
div [ class "formimage" ]
- [ div [] [
- case model.image of
- Nothing -> text "No image."
- Just id -> img [ src (imageUrl id) ] []
- ]
+ [ div [] [ Img.viewImg model.image ]
, 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
+ , input ([ type_ "text", class "text", tabindex 10, value (Maybe.withDefault "" model.image.id), onInputValidation ImageSet ] ++ GCE.valImage) []
, 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."
- , if not (Set.member (Maybe.withDefault "" model.image) model.imageNew) then text "" else div []
- [ br [] []
- , text "Please flag this image: (see the ", a [ href "/d19" ] [ text "image flagging guidelines" ], text " for guidance)"
- , table []
- [ thead [] [ tr [] [ td [] [ text "Sexual" ], td [] [ text "Violence" ] ] ]
- , tr []
- [ td []
- [ label [] [ inputRadio "" (model.imageSex == Just 0) (ImageSex 0), text " Safe" ], br [] []
- , label [] [ inputRadio "" (model.imageSex == Just 1) (ImageSex 1), text " Suggestive" ], br [] []
- , label [] [ inputRadio "" (model.imageSex == Just 2) (ImageSex 2), text " Explicit" ]
- ]
- , td []
- [ label [] [ inputRadio "" (model.imageVio == Just 0) (ImageVio 0), text " Tame" ], br [] []
- , label [] [ inputRadio "" (model.imageVio == Just 1) (ImageVio 1), text " Violent" ], br [] []
- , label [] [ inputRadio "" (model.imageVio == Just 2) (ImageVio 2), text " Brutal" ]
- ]
+ , case Img.viewVote model.image of
+ Nothing -> text ""
+ Just v ->
+ div []
+ [ br [] []
+ , text "Please flag this image: (see the ", a [ href "/d19" ] [ text "image flagging guidelines" ], text " for guidance)"
+ , Html.map ImageMsg v
]
- ]
- ]
]
]
diff --git a/elm/Lib/Api.elm b/elm/Lib/Api.elm
index 3ad3f3aa..e09f1199 100644
--- a/elm/Lib/Api.elm
+++ b/elm/Lib/Api.elm
@@ -45,7 +45,6 @@ showResponse res =
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
diff --git a/elm/Lib/Image.elm b/elm/Lib/Image.elm
new file mode 100644
index 00000000..44ce8240
--- /dev/null
+++ b/elm/Lib/Image.elm
@@ -0,0 +1,162 @@
+module Lib.Image exposing (..)
+
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Html.Events exposing (..)
+import Process
+import Task
+import File exposing (File)
+import Lib.Html exposing (..)
+import Lib.Api as Api
+import Lib.Util exposing (imageUrl)
+import Gen.Api as GApi
+import Gen.Image as GI
+import Gen.ImageVote as GIV
+
+
+type State
+ = Normal
+ | Invalid
+ | NotFound
+ | Loading
+ | Error GApi.Response
+
+type alias Image =
+ { id : Maybe String
+ , img : Maybe GApi.ApiImageResult
+ , imgState : State
+ , saveState : Api.State
+ , saveTimer : Bool
+ }
+
+
+info : Maybe GApi.ApiImageResult -> Image
+info img =
+ { id = Maybe.map (\i -> i.id) img
+ , img = img
+ , imgState = Normal
+ , saveState = Api.Normal
+ , saveTimer = False
+ }
+
+
+-- Fetch image info from the ID
+new : Bool -> String -> (Image, Cmd Msg)
+new valid id =
+ ( { id = if id == "" then Nothing else Just id
+ , img = Nothing
+ , imgState = if id == "" then Normal else if valid then Loading else Invalid
+ , saveState = Api.Normal
+ , saveTimer = False
+ }
+ , if valid && id /= "" then GI.send { id = id } Loaded else Cmd.none
+ )
+
+
+-- Upload a new image from a form
+upload : Api.ImageType -> File -> (Image, Cmd Msg)
+upload t f =
+ ( { id = Nothing
+ , img = Nothing
+ , imgState = Loading
+ , saveState = Api.Normal
+ , saveTimer = False
+ }
+ , Api.postImage t f Loaded)
+
+
+type Msg
+ = Loaded GApi.Response
+ | MySex Int Bool
+ | MyVio Int Bool
+ | Save
+ | Saved GApi.Response
+
+
+update : Msg -> Image -> (Image, Cmd Msg)
+update msg model =
+ let
+ save m =
+ if m.saveTimer || Maybe.withDefault True (Maybe.map (\i -> i.token == Nothing || i.my_sexual == Nothing || i.my_violence == Nothing) m.img)
+ then (m, Cmd.none)
+ else ({ m | saveTimer = True }, Task.perform (always Save) (Process.sleep 1000))
+ in
+ case msg of
+ Loaded (GApi.ImageResult [i]) -> ({ model | id = Just i.id, img = Just i, imgState = Normal}, Cmd.none)
+ Loaded (GApi.ImageResult []) -> ({ model | imgState = NotFound}, Cmd.none)
+ Loaded e -> ({ model | imgState = Error e }, Cmd.none)
+
+ MySex v _ -> save { model | img = Maybe.map (\i -> { i | my_sexual = Just v }) model.img }
+ MyVio v _ -> save { model | img = Maybe.map (\i -> { i | my_violence = Just v }) model.img }
+
+ Save ->
+ case Maybe.map (\i -> (i.token, i.my_sexual, i.my_violence)) model.img of
+ Just (Just token, Just sex, Just vio) ->
+ ( { model | saveTimer = False, saveState = Api.Loading }
+ , GIV.send { votes = [{ id = Maybe.withDefault "" model.id, token = token, sexual = sex, violence = vio, overrule = False }] } Saved)
+ _ -> (model, Cmd.none)
+ Saved (GApi.Success) -> ({ model | saveState = Api.Normal}, Cmd.none)
+ Saved e -> ({ model | saveState = Api.Error e }, Cmd.none)
+
+
+
+isValid : Image -> Bool
+isValid img = img.imgState == Normal
+
+
+viewImg : Image -> Html m
+viewImg image =
+ case (image.imgState, image.img) of
+ (Loading, _) -> div [ class "spinner" ] []
+ (NotFound, _) -> b [ class "standout" ] [ text "Image not found." ]
+ (Invalid, _) -> b [ class "standout" ] [ text "Invalid image ID." ]
+ (Error e, _) -> b [ class "standout" ] [ text <| Api.showResponse e ]
+ (_, Nothing) -> text "No image."
+ (_, Just i) ->
+ label [ class "imghover", style "width" (String.fromInt i.width++"px"), style "height" (String.fromInt i.height++"px") ]
+ [ div [ class "imghover--visible" ]
+ [ img [ src (imageUrl i.id) ] []
+ , a [ href <| "/img/"++i.id ] <|
+ case (i.sexual_avg, i.violence_avg) of
+ (Just sex, Just vio) ->
+ -- XXX: These thresholds are subject to change, maybe just show the numbers here?
+ [ text <| if sex > 1.3 then "Explicit" else if sex > 0.4 then "Suggestive" else "Tame"
+ , text " / "
+ , text <| if vio > 1.3 then "Brutal" else if vio > 0.4 then "Violent" else "Safe"
+ , text <| " (" ++ String.fromInt i.votecount ++ ")"
+ ]
+ _ -> [ text "Not flagged" ]
+ ]
+ ]
+
+
+viewVote : Image -> Maybe (Html Msg)
+viewVote model =
+ let
+ vote i = table []
+ [ thead [] [ tr []
+ [ td [] [ text "Sexual ", if model.saveState == Api.Loading then span [ class "spinner" ] [] else text "" ]
+ , td [] [ text "Violence" ]
+ ] ]
+ , tfoot [] <|
+ case model.saveState of
+ Api.Error e -> [ tr [] [ td [ colspan 2 ] [ b [ class "standout" ] [ text (Api.showResponse e) ] ] ] ]
+ _ -> []
+ , tr []
+ [ td []
+ [ label [] [ inputRadio "" (i.my_sexual == Just 0) (MySex 0), text " Safe" ], br [] []
+ , label [] [ inputRadio "" (i.my_sexual == Just 1) (MySex 1), text " Suggestive" ], br [] []
+ , label [] [ inputRadio "" (i.my_sexual == Just 2) (MySex 2), text " Explicit" ]
+ ]
+ , td []
+ [ label [] [ inputRadio "" (i.my_violence == Just 0) (MyVio 0), text " Tame" ], br [] []
+ , label [] [ inputRadio "" (i.my_violence == Just 1) (MyVio 1), text " Violent" ], br [] []
+ , label [] [ inputRadio "" (i.my_violence == Just 2) (MyVio 2), text " Brutal" ]
+ ]
+ ]
+ ]
+ in case model.img of
+ Nothing -> Nothing
+ Just i ->
+ if i.token == Nothing then Nothing
+ else Just (vote i)