cap gallery images to 2000px

This commit is contained in:
Rhiannon Morris 2022-05-16 10:25:16 +02:00
parent 40631ceac5
commit e7384bc1ed
5 changed files with 38 additions and 64 deletions

View file

@ -10,6 +10,7 @@ ROOT := https://gallery.niss.website
SMALL := 200
MEDW := 1000
MEDH := 1200
BIG := 2000
MAKEPAGES := $(TMPDIR)/make-pages
@ -51,6 +52,9 @@ $(TMPDIR)/%_small.png: $(DATADIR)/%.png
$(TMPDIR)/%_med.png: $(DATADIR)/%.png
$(call resize,$(MEDW),$(MEDH),>)
$(TMPDIR)/%_big.png: $(DATADIR)/%.png
$(call resize,$(BIG),$(BIG),>)
$(TMPDIR)/%_small.jpg: $(DATADIR)/%.jpg
$(call resize,$(SMALL),$(SMALL),^,-gravity center -crop 1:1+0)
@ -58,6 +62,9 @@ $(TMPDIR)/%_small.jpg: $(DATADIR)/%.jpg
$(TMPDIR)/%_med.jpg: $(DATADIR)/%.jpg
$(call resize,$(MEDW),$(MEDH),>)
$(TMPDIR)/%_big.jpg: $(DATADIR)/%.jpg
$(call resize,$(BIG),$(BIG),>)
$(MAKEPAGES): make-pages/*.hs make-pages/make-pages.cabal
echo "[make-pages]"

View file

@ -1,7 +1,7 @@
module Depend
(dependSingle, dependSingle',
dependGallery, dependGallery',
thumbFile, pageFile)
thumbFile, pageFile, bigFile)
where
import BuilderQQ hiding (CanBuild (..))
@ -34,7 +34,10 @@ dependSingle' yamlDir info prefix build nsfw =
dir = build </> prefix </> yamlDir
page = dir </> "index.html"
deps = unwords $ map (dir </>) $
thumbFile (thumbnail info) : map pageFile paths ++ paths ++ dls ++ extras
thumbFile (thumbnail info) :
map pageFile paths ++
map bigFile paths ++
dls ++ extras
dependGallery :: GalleryInfo
-> FilePath -- ^ index file

View file

@ -7,7 +7,7 @@ module Info
GalleryInfo (..), GalleryFilters (..), ArtistFilter (..), NsfwFilter (..),
IndexInfo (..),
readArtistFilter, matchArtist, readNsfwFilter, matchNsfw, matchFilters,
NoThumb (..), getThumb, thumbFile, pageFile,
NoThumb (..), getThumb, thumbFile, pageFile, bigFile,
-- ** Reexports
Date (..), Day (..), Text)
where
@ -238,6 +238,11 @@ pageFile f
| takeExtension f == ".gif" = f
| otherwise = addSuffix "_med" f
bigFile :: FilePath -> FilePath
bigFile f
| takeExtension f == ".gif" = f
| otherwise = addSuffix "_big" f
addSuffix :: String -> FilePath -> FilePath
addSuffix suf path =
let (pre, ext) = splitExtension path in

View file

@ -12,9 +12,7 @@ import Data.List (sort)
import Data.Maybe (fromMaybe)
import qualified Data.Text as Strict
import qualified Data.Text.Lazy as Lazy
import System.FilePath (joinPath, splitPath, (</>))
import qualified System.Process as Proc
import Text.Read (readMaybe)
import System.FilePath (joinPath, splitPath)
import qualified Data.HashSet as Set
import Data.Traversable
@ -39,8 +37,8 @@ make root prefix nsfw dataDir dir info =
toLazyText <$> make' root prefix nsfw dataDir dir info
make' :: Text -> FilePath -> Bool -> FilePath -> FilePath -> Info -> IO Builder
make' root prefix nsfw dataDir dir info@(Info {date, title, artist, bg}) = do
images <- withSizes (dataDir </> dir) $ imagesFor nsfw info
make' root prefix nsfw _dataDir dir info@(Info {date, title, artist, bg}) = do
let images = imagesFor nsfw info
let undir = joinPath (replicate (length (splitPath dir)) "..")
@ -49,12 +47,10 @@ make' root prefix nsfw dataDir dir info@(Info {date, title, artist, bg}) = do
let formattedDate = formatLong date
let buttonBar = makeButtonBar title $ addIds images
let (image0@(Image {path = path0, download = download0'}),
Size {width = width0, height = height0}) : otherImages
= #all images
let download0 = fromMaybe path0 download0'
let image0@(Image {path = path0, download = download0'}) : otherImages =
#all images
let download0 = fromMaybe (bigFile path0) download0'
let path0' = pageFile path0
let tinyCls = if any (tiny . #second) images then [b| class=tiny|] else ""
let descSection = makeDesc $ descFor nsfw info
let tagsList = makeTags undir $ tagsFor nsfw info
@ -62,8 +58,9 @@ make' root prefix nsfw dataDir dir info@(Info {date, title, artist, bg}) = do
let updates = sort $ updatesFor nsfw info
let updatesList = makeUpdates updates
let makePrefetch (Image {path}) = [b|<link rel=prefetch href=$path>|]
let prefetches = map (makePrefetch . #first) otherImages
let makePrefetch (Image {path}) = [b|<link rel=prefetch href=$path'>|]
where path' = bigFile path
let prefetches = map makePrefetch otherImages
let makeWarning w = [b|@0
<figcaption id=cw aria-role=button tabindex=0>
@ -136,7 +133,7 @@ make' root prefix nsfw dataDir dir info@(Info {date, title, artist, bg}) = do
$2.buttonBar
<main>
<figure id=mainfig data-width=$width0 data-height=$height0$tinyCls>
<figure id=mainfig>
$warning'
<a id=mainlink href="$download0" title="download full version">
<img id=mainimg src="$path0'" alt="">
@ -199,14 +196,14 @@ makeDesc (LongDesc fs) = [b|@0
</div>
|]
addIds :: Traversable t => t (Image, a) -> t (Image, a, Text)
addIds :: Traversable t => t Image -> t (Image, Text)
addIds = snd . mapAccumL makeId Set.empty where
makeId used (img, x) = (Set.insert newId used, (img, x, newId)) where
makeId used img = (Set.insert newId used, (img, newId)) where
newId = head $ filter (\i -> not $ i `Set.member` used) ids
ids = [toStrictText [b|$label$i|] | i <- "" : map show [0::Int ..]]
label = escId $ #label img
makeButtonBar :: Strict.Text -> Images' (Image, Size, Text) -> Builder
makeButtonBar :: Strict.Text -> Images' (Image, Text) -> Builder
makeButtonBar title images =
case images of
Uncat [] -> throw $ NoEligibleImages title
@ -233,27 +230,25 @@ makeButtonBar title images =
<ul class="buttonbar bb-choice">
$2.elems
</ul> |]
where elems = map (\(img,sz,i) -> altButton img sz i) imgs
where elems = map (\(img,i) -> altButton img i) imgs
flatten :: [(Text, [(Image, Size, Text)])] -> [(Image, Size, Text)]
flatten :: [(Text, [(Image, a)])] -> [(Image, Text)]
flatten cats =
addIds [(img {label = cat}, sz) | (cat, is) <- cats, (img, sz, _) <- is]
addIds [(img {label = cat}) | (cat, is) <- cats, (img, _) <- is]
altButton :: Image -> Size -> Text -> Builder
altButton img size i = [b|@0
altButton :: Image -> Text -> Builder
altButton img i = [b|@0
<li$nsfwClass>
<input type=radio name=variant id="$i" value="$path'"
data-link="$link"$warning'
data-width=$width data-height=$height>
data-link="$link"$warning'>
<label for="$i"$nsfwLabelClass>$label</label>
|]
where
Image {label, path, nsfw, warning, download} = img
Size {width, height} = size
nsfwClass = if nsfw then [b| class=nsfw|] else ""
nsfwLabelClass = if nsfw then [b| class=nsfw-label|] else ""
path' = pageFile path
link = fromMaybe path download
link = fromMaybe (bigFile path) download
warning' = ifJust warning \(escAttr -> w) -> [b| data-warning="$w"|]
makeTags :: FilePath -> [Strict.Text] -> Builder
@ -309,23 +304,3 @@ makeUpdate (Update {date, desc}) = [b|@8
<dd>$desc
|]
where date' = formatSlash date
data Size = Size {width, height :: !Int} deriving (Eq, Show)
tiny :: Size -> Bool
tiny (Size {width, height}) = width < 250 || height < 250
imageSize :: FilePath -> FilePath -> IO Size
imageSize dir img = do
-- "[0]" to get the first frame of an animation
-- otherwise it prints a pair for each frame
let filename = (dir </> img) ++ "[0]"
output <- Proc.readProcess "identify" ["-format", "(%W,%H)", filename] ""
case readMaybe output of
Just (width, height) -> pure $ Size {width, height}
Nothing -> fail $ "couldn't understand identify output:\n" ++ output
withSizes :: Traversable t => FilePath -> t Image -> IO (t (Image, Size))
withSizes dir = traverse \img -> do
size <- imageSize dir $ #path img
pure (img, size)

View file

@ -23,22 +23,6 @@
background: hsl(340, 45%, 65%);
}
#mainfig:not(.tiny)::after {
content: 'click for full (' attr(data-width) '×' attr(data-height) ')';
position: absolute;
top: calc(0px - var(--border-thickness));
right: calc(0px - var(--border-thickness));
padding: 0.15em 1.25em 0.15em 0.75em;
font-size: 70%;
font-weight: 700;
background: hsl(0, 0%, 0%, 50%);
border: var(--border-thickness) solid var(--text-col);
border-bottom-left-radius: 0.5em;
}
#mainfig:focus-within {
box-shadow: var(--focus-box);
}