put full dimensions on image
This commit is contained in:
parent
d8c22fef0f
commit
1e0b955029
5 changed files with 87 additions and 40 deletions
|
|
@ -51,7 +51,7 @@ main2 (SinglePage {file, dataDir, nsfw, output}) = do
|
|||
info <- readYAML file
|
||||
printV $ "contents" := info
|
||||
let dir = takeDirectory $ makeRelative dataDir file
|
||||
let page = SinglePage.make nsfw dir info
|
||||
page <- SinglePage.make nsfw dataDir dir info
|
||||
writeOutput output page
|
||||
|
||||
main2 (GalleryPage {files, prefix, index, output, dataDir}) = do
|
||||
|
|
|
|||
|
|
@ -10,7 +10,9 @@ import Data.Maybe (fromMaybe)
|
|||
import qualified Data.Text as Strict
|
||||
import qualified Data.Text.Lazy as Lazy
|
||||
import qualified Data.Time.Calendar as Time
|
||||
import System.FilePath (joinPath, splitPath)
|
||||
import System.FilePath (joinPath, splitPath, (</>))
|
||||
import qualified System.Process as Proc
|
||||
import Text.Read (readMaybe)
|
||||
|
||||
|
||||
-- | e.g. only nsfw images are present for a non-nsfw page
|
||||
|
|
@ -23,11 +25,43 @@ instance Show NoEligibleImages where
|
|||
" (probably a nsfw-only work without --nsfw set)"
|
||||
|
||||
|
||||
make :: Bool -> FilePath -> Info -> Lazy.Text
|
||||
make nsfw dir = toLazyText . make' nsfw dir
|
||||
make :: Bool -- ^ nsfw?
|
||||
-> FilePath -- ^ data dir
|
||||
-> FilePath -- ^ subdir of datadir containing this @info.yaml@
|
||||
-> Info -> IO Lazy.Text
|
||||
make nsfw dataDir dir info = toLazyText <$> make' nsfw dataDir dir info
|
||||
|
||||
make' :: Bool -> FilePath -> Info -> Builder
|
||||
make' nsfw dir info@(Info {date, title, artist}) = [b|@0
|
||||
make' :: Bool -> FilePath -> FilePath -> Info -> IO Builder
|
||||
make' nsfw dataDir dir info@(Info {date, title, artist}) = do
|
||||
images <- withSizes (dataDir </> dir) $ imagesFor nsfw info
|
||||
|
||||
let undir = joinPath (replicate (length (splitPath dir)) "..")
|
||||
|
||||
let artistTag = ifJust artist makeArtist
|
||||
|
||||
let formattedDate = formatDate date
|
||||
|
||||
let buttonBar = makeButtonBar title images
|
||||
let (image0@(Image {path = path0, download = download0'}),
|
||||
Size {width = width0, height = height0})
|
||||
= head images
|
||||
let download0 = fromMaybe path0 download0'
|
||||
let path0' = pageFile path0
|
||||
|
||||
let descSection = makeDesc $ descFor nsfw info
|
||||
let tagsList = makeTags undir $ tagsFor nsfw info
|
||||
let linksList = extLinks $ linksFor nsfw info
|
||||
|
||||
let makePrefetch (Image {path}) = [b|<link rel=prefetch href=$@path>|]
|
||||
let prefetches = map (makePrefetch . #first) $ tail images
|
||||
|
||||
let warning' = ifJust (#warning image0) \w -> [b|@4
|
||||
<figcaption id=cw aria-role=button tabindex=0>
|
||||
<span id=cw-text>cw: <b>$*w</b></span>
|
||||
</figcaption>
|
||||
|]
|
||||
|
||||
pure [b|@0
|
||||
<!DOCTYPE html>
|
||||
<html lang=en>
|
||||
<meta charset=utf-8>
|
||||
|
|
@ -50,7 +84,8 @@ make' nsfw dir info@(Info {date, title, artist}) = [b|@0
|
|||
$buttonBar
|
||||
|
||||
<main>
|
||||
<figure id=mainfig>
|
||||
<figure id=mainfig
|
||||
data-width=$^width0 data-height=$^height0>
|
||||
$warning'
|
||||
<a id=mainlink href="$@download0" title="download full version">
|
||||
<img id=mainimg src="$@path0'" alt="">
|
||||
|
|
@ -70,31 +105,6 @@ make' nsfw dir info@(Info {date, title, artist}) = [b|@0
|
|||
<a href=$@undir>back to gallery</a>
|
||||
</footer>
|
||||
|]
|
||||
where
|
||||
artistTag = ifJust artist makeArtist
|
||||
|
||||
formattedDate = formatDate date
|
||||
|
||||
buttonBar = makeButtonBar title images
|
||||
image0 = head images
|
||||
path0 = #path image0
|
||||
download0 = fromMaybe path0 (#download image0)
|
||||
path0' = pageFile path0
|
||||
|
||||
images = imagesFor nsfw info
|
||||
descSection = makeDesc $ descFor nsfw info
|
||||
tagsList = makeTags undir $ tagsFor nsfw info
|
||||
linksList = extLinks $ linksFor nsfw info
|
||||
|
||||
prefetches = map makePrefetch $ tail images
|
||||
makePrefetch (Image {path}) = [b|<link rel=prefetch href=$@path>|]
|
||||
|
||||
warning' = ifJust (#warning image0) \w -> [b|@4
|
||||
<figcaption id=cw aria-role=button tabindex=0>
|
||||
<span id=cw-text>cw: <b>$*w</b></span>
|
||||
</figcaption>
|
||||
|]
|
||||
undir = joinPath (replicate (length (splitPath dir)) "..")
|
||||
|
||||
makeArtist :: Artist -> Builder
|
||||
makeArtist (Artist {name, url}) =
|
||||
|
|
@ -114,7 +124,7 @@ makeDesc mdesc = ifJust mdesc \desc -> [b|@4
|
|||
</section>
|
||||
|]
|
||||
|
||||
makeButtonBar :: Strict.Text -> [Image] -> Builder
|
||||
makeButtonBar :: Strict.Text -> [(Image, Size)] -> Builder
|
||||
makeButtonBar title images =
|
||||
case length images of
|
||||
0 -> throw $ NoEligibleImages title
|
||||
|
|
@ -126,14 +136,15 @@ makeButtonBar title images =
|
|||
</ul>
|
||||
</nav>
|
||||
|]
|
||||
where alts = map (uncurry altButton) $ zip [0..] images
|
||||
where alts = map (\(i, (im, sz)) -> altButton i im sz) $ zip [0..] images
|
||||
|
||||
altButton :: Int -> Image -> Builder
|
||||
altButton i (Image {label, path, nsfw, warning}) = [b|@4
|
||||
altButton :: Int -> Image -> Size -> Builder
|
||||
altButton i (Image {label, path, nsfw, warning}) (Size {width, height}) = [b|@4
|
||||
<li$nsfwClass>
|
||||
<input type=radio$checked id="$idLabel" name=variant
|
||||
autocomplete=off value="$@path'"
|
||||
data-link="$@path"$warning'>
|
||||
data-link="$@path"$warning'
|
||||
data-width=$^width data-height=$^height>
|
||||
<label for="$idLabel"$nsfwLabelClass>$*label</label>
|
||||
|]
|
||||
where
|
||||
|
|
@ -196,3 +207,21 @@ nth n = [b|$^n$suf|] where
|
|||
| n `mod` 10 == 2 = "nd"
|
||||
| n `mod` 10 == 3 = "rd"
|
||||
| otherwise = "th"
|
||||
|
||||
|
||||
data Size = Size {height, width :: !Int} deriving (Eq, Show)
|
||||
|
||||
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 :: FilePath -> [Image] -> IO [(Image, Size)]
|
||||
withSizes dir = traverse \img -> do
|
||||
size <- imageSize dir $ #path img
|
||||
pure (img, size)
|
||||
|
|
|
|||
|
|
@ -61,6 +61,7 @@ executable make-pages
|
|||
hashable ^>= 1.3.0.0,
|
||||
HsYAML ^>= 0.2.1.0,
|
||||
optparse-applicative ^>= 0.15.1.0,
|
||||
process ^>= 1.6.8.2,
|
||||
template-haskell ^>= 2.16.0.0,
|
||||
text ^>= 1.2.3.1,
|
||||
time >= 1.8.0.2 && < 1.10,
|
||||
|
|
|
|||
|
|
@ -43,6 +43,8 @@ function setImage(id, src, width, height, href, cw, firstLoad) {
|
|||
}
|
||||
|
||||
mainimg.src = src;
|
||||
mainfig.dataset.width = width;
|
||||
mainfig.dataset.height = height;
|
||||
mainlink.href = href;
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -9,16 +9,31 @@ body {
|
|||
}
|
||||
|
||||
#mainfig {
|
||||
--border-thickness: 2px;
|
||||
|
||||
margin: 1em auto;
|
||||
width: min-content;
|
||||
position: relative;
|
||||
overflow: hidden;
|
||||
border: 2px solid var(--text-col);
|
||||
border: var(--border-thickness) solid var(--text-col);
|
||||
border-radius: 1em;
|
||||
box-shadow: var(--text-shadow);
|
||||
background: hsl(340, 45%, 65%);
|
||||
}
|
||||
|
||||
#mainfig::after {
|
||||
content: attr(data-width) ' × ' attr(data-height);
|
||||
|
||||
position: absolute;
|
||||
top: calc(0px - var(--border-thickness));
|
||||
right: calc(0px - var(--border-thickness));
|
||||
padding: 0.15em 0.75em;
|
||||
|
||||
background: hsl(0, 0%, 0%, 50%);
|
||||
border: var(--border-thickness) solid var(--text-col);
|
||||
border-bottom-left-radius: 1em;
|
||||
}
|
||||
|
||||
#mainfig:focus-within {
|
||||
box-shadow: var(--focus-box);
|
||||
}
|
||||
|
|
|
|||
Loading…
Reference in a new issue