rhi/gallery
1
0
Fork 0
Code Issues 5 Pull requests 1 Releases Wiki Activity

put full dimensions on image

Browse source
This commit is contained in:
Rhiannon Morris 2020-08-09 01:22:00 +02:00
parent d8c22fef0f
commit 1e0b955029
5 changed files with 87 additions and 40 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
make-pages/Main.hs
View file

@ -51,7 +51,7 @@ main2 (SinglePage {file, dataDir, nsfw, output}) = do
info <- readYAML file info <- readYAML file
printV $ "contents" := info printV $ "contents" := info
let dir = takeDirectory $ makeRelative dataDir file let dir = takeDirectory $ makeRelative dataDir file
let page = SinglePage.make nsfw dir info page <- SinglePage.make nsfw dataDir dir info
writeOutput output page writeOutput output page
main2 (GalleryPage {files, prefix, index, output, dataDir}) = do main2 (GalleryPage {files, prefix, index, output, dataDir}) = do

101
make-pages/SinglePage.hs
View file

@ -10,7 +10,9 @@ import Data.Maybe (fromMaybe)
import qualified Data.Text as Strict import qualified Data.Text as Strict
import qualified Data.Text.Lazy as Lazy import qualified Data.Text.Lazy as Lazy
import qualified Data.Time.Calendar as Time 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 -- | 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)" " (probably a nsfw-only work without --nsfw set)"
make :: Bool -> FilePath -> Info -> Lazy.Text make :: Bool -- ^ nsfw?
make nsfw dir = toLazyText . make' nsfw dir -> 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' :: Bool -> FilePath -> FilePath -> Info -> IO Builder
make' nsfw dir info@(Info {date, title, artist}) = [b|@0 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> <!DOCTYPE html>
<html lang=en> <html lang=en>
<meta charset=utf-8> <meta charset=utf-8>
@ -50,7 +84,8 @@ make' nsfw dir info@(Info {date, title, artist}) = [b|@0
$buttonBar $buttonBar
<main> <main>
<figure id=mainfig> <figure id=mainfig
data-width=$^width0 data-height=$^height0>
$warning' $warning'
<a id=mainlink href="$@download0" title="download full version"> <a id=mainlink href="$@download0" title="download full version">
<img id=mainimg src="$@path0'" alt=""> <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> <a href=$@undir>back to gallery</a>
</footer> </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 -> Builder
makeArtist (Artist {name, url}) = makeArtist (Artist {name, url}) =
@ -114,7 +124,7 @@ makeDesc mdesc = ifJust mdesc \desc -> [b|@4
</section> </section>
|] |]
makeButtonBar :: Strict.Text -> [Image] -> Builder makeButtonBar :: Strict.Text -> [(Image, Size)] -> Builder
makeButtonBar title images = makeButtonBar title images =
case length images of case length images of
0 -> throw $ NoEligibleImages title 0 -> throw $ NoEligibleImages title
@ -126,14 +136,15 @@ makeButtonBar title images =
</ul> </ul>
</nav> </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 :: Int -> Image -> Size -> Builder
altButton i (Image {label, path, nsfw, warning}) = [b|@4 altButton i (Image {label, path, nsfw, warning}) (Size {width, height}) = [b|@4
<li$nsfwClass> <li$nsfwClass>
<input type=radio$checked id="$idLabel" name=variant <input type=radio$checked id="$idLabel" name=variant
autocomplete=off value="$@path'" autocomplete=off value="$@path'"
data-link="$@path"$warning'> data-link="$@path"$warning'
data-width=$^width data-height=$^height>
<label for="$idLabel"$nsfwLabelClass>$*label</label> <label for="$idLabel"$nsfwLabelClass>$*label</label>
|] |]
where where
@ -196,3 +207,21 @@ nth n = [b|$^n$suf|] where
| n `mod` 10 == 2 = "nd" | n `mod` 10 == 2 = "nd"
| n `mod` 10 == 3 = "rd" | n `mod` 10 == 3 = "rd"
| otherwise = "th" | 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)

1
make-pages/make-pages.cabal
View file

@ -61,6 +61,7 @@ executable make-pages
hashable ^>= 1.3.0.0, hashable ^>= 1.3.0.0,
HsYAML ^>= 0.2.1.0, HsYAML ^>= 0.2.1.0,
optparse-applicative ^>= 0.15.1.0, optparse-applicative ^>= 0.15.1.0,
process ^>= 1.6.8.2,
template-haskell ^>= 2.16.0.0, template-haskell ^>= 2.16.0.0,
text ^>= 1.2.3.1, text ^>= 1.2.3.1,
time >= 1.8.0.2 && < 1.10, time >= 1.8.0.2 && < 1.10,

2
script/single.js
View file

@ -43,6 +43,8 @@ function setImage(id, src, width, height, href, cw, firstLoad) {
} }
mainimg.src = src; mainimg.src = src;
mainfig.dataset.width = width;
mainfig.dataset.height = height;
mainlink.href = href; mainlink.href = href;
} }

17
style/shiny/single.css
View file

@ -9,16 +9,31 @@ body {
} }
#mainfig { #mainfig {
--border-thickness: 2px;
margin: 1em auto; margin: 1em auto;
width: min-content; width: min-content;
position: relative; position: relative;
overflow: hidden; overflow: hidden;
border: 2px solid var(--text-col); border: var(--border-thickness) solid var(--text-col);
border-radius: 1em; border-radius: 1em;
box-shadow: var(--text-shadow); box-shadow: var(--text-shadow);
background: hsl(340, 45%, 65%); 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 { #mainfig:focus-within {
box-shadow: var(--focus-box); box-shadow: var(--focus-box);
} }