From 7d3872d1e64931d4a3956401a6e01a4229fb5d65 Mon Sep 17 00:00:00 2001 From: nek0 Date: Wed, 14 Jan 2015 23:08:58 +0100 Subject: [PATCH] media page now responsive to media width --- Handler/AdminMediumSettings.hs | 1 + Handler/Medium.hs | 3 +++ Handler/MediumSettings.hs | 1 + Handler/Upload.hs | 18 ++++++++++-------- config/models | 1 + templates/medium.cassius | 2 +- templates/medium.hamlet | 8 ++++---- 7 files changed, 21 insertions(+), 13 deletions(-) diff --git a/Handler/AdminMediumSettings.hs b/Handler/AdminMediumSettings.hs index dbfa7e5..0f9d343 100644 --- a/Handler/AdminMediumSettings.hs +++ b/Handler/AdminMediumSettings.hs @@ -76,6 +76,7 @@ adminMediumSetForm medium = renderDivs $ Medium <*> pure (mediumOwner medium) <*> areq textareaField "Description" (Just $ mediumDescription medium) <*> areq tagField "Tags" (Just $ mediumTags medium) + <*> pure (mediumWidth medium) <*> pure (mediumThumbWidth medium) <*> pure (mediumAlbum medium) diff --git a/Handler/Medium.hs b/Handler/Medium.hs index 41e527c..19efcef 100644 --- a/Handler/Medium.hs +++ b/Handler/Medium.hs @@ -33,6 +33,9 @@ getMediumR mediumId = do (commentWidget, enctype) <- generateFormPost $ commentForm userId userSl mediumId Nothing comments <- runDB $ selectList [CommentOrigin ==. mediumId, CommentParent ==. Nothing] [Desc CommentTime] replies <- runDB $ selectList [CommentOrigin ==. mediumId, CommentParent !=. Nothing] [Desc CommentTime] + dataWidth <- case mediumWidth medium >= 750 of + True -> return 750 + False -> return $ (mediumWidth medium) + 53 formLayout $ do setTitle $ toHtml ("Eidolon :: Medium " `T.append` (mediumTitle medium)) $(widgetFile "medium") diff --git a/Handler/MediumSettings.hs b/Handler/MediumSettings.hs index 8f34bf9..7da6fce 100644 --- a/Handler/MediumSettings.hs +++ b/Handler/MediumSettings.hs @@ -51,6 +51,7 @@ mediumSettingsForm medium = renderDivs $ Medium <*> pure (mediumOwner medium) <*> areq textareaField "Description" (Just $ mediumDescription medium) <*> areq tagField "tags" (Just $ mediumTags medium) + <*> pure (mediumWidth medium) <*> pure (mediumThumbWidth medium) <*> pure (mediumAlbum medium) diff --git a/Handler/Upload.hs b/Handler/Upload.hs index e7613bb..078eb9a 100644 --- a/Handler/Upload.hs +++ b/Handler/Upload.hs @@ -55,7 +55,7 @@ postUploadR = do albRef <- runDB $ getJust (tempMediumAlbum temp) ownerId <- return $ albumOwner albRef path <- writeOnDrive fil ownerId (tempMediumAlbum temp) - (thumbPath, width) <- generateThumb path ownerId (tempMediumAlbum temp) + (thumbPath, iWidth, tWidth) <- generateThumb path ownerId (tempMediumAlbum temp) inAlbumId <- return $ tempMediumAlbum temp medium <- return $ Medium (tempMediumTitle temp) @@ -66,7 +66,8 @@ postUploadR = do (tempMediumOwner temp) (tempMediumDesc temp) (tempMediumTags temp) - width + iWidth + tWidth inAlbumId mId <- runDB $ I.insert medium inAlbum <- runDB $ getJust inAlbumId @@ -134,7 +135,7 @@ postDirectUploadR albumId = do albRef <- runDB $ getJust (tempMediumAlbum temp) refOwnerId <- return $ albumOwner albRef path <- writeOnDrive fil refOwnerId albumId - (thumbPath, width) <- generateThumb path ownerId albumId + (thumbPath, iWidth, tWidth) <- generateThumb path ownerId albumId medium <- return $ Medium (tempMediumTitle temp) ('/' : path) @@ -144,7 +145,8 @@ postDirectUploadR albumId = do (tempMediumOwner temp) (tempMediumDesc temp) (tempMediumTags temp) - width + iWidth + tWidth albumId mId <- runDB $ insert medium inAlbum <- runDB $ getJust albumId @@ -168,14 +170,14 @@ postDirectUploadR albumId = do setMessage "This Album does not exist" redirect $ AlbumR albumId -generateThumb :: FP.FilePath -> UserId -> AlbumId -> Handler (FP.FilePath, Int) +generateThumb :: FP.FilePath -> UserId -> AlbumId -> Handler (FP.FilePath, Int, Int) generateThumb path userId albumId = do newName <- return $ (FP.takeBaseName path) ++ "_thumb" ++ (FP.takeExtension path) newPath <- return $ "static" FP. "data" FP. (T.unpack $ extractKey userId) FP. (T.unpack $ extractKey albumId) FP. newName - width <- liftIO $ withMagickWandGenesis $ do + (iWidth, tWidth) <- liftIO $ withMagickWandGenesis $ do (_ , w) <- magickWand readImage w (decodeString path) w1 <- getImageWidth w @@ -185,8 +187,8 @@ generateThumb path userId albumId = do resizeImage w w2 h2 lanczosFilter 1 setImageCompressionQuality w 95 writeImage w (Just (decodeString newPath)) - return w2 - return (newPath, width) + return (w1, w2) + return (newPath, iWidth, tWidth) writeOnDrive :: FileInfo -> UserId -> AlbumId -> Handler FP.FilePath writeOnDrive fil userId albumId = do diff --git a/config/models b/config/models index 17f1d25..8c0c27c 100644 --- a/config/models +++ b/config/models @@ -33,6 +33,7 @@ Medium owner UserId description Textarea tags Texts + width Int thumbWidth Int album AlbumId deriving Eq Show diff --git a/templates/medium.cassius b/templates/medium.cassius index 25c839d..2a6ef39 100644 --- a/templates/medium.cassius +++ b/templates/medium.cassius @@ -1,7 +1,7 @@ img position: relative !important max-width: 100% !important - height: 28em !important + max-height: 28em !important width: auto !important .reply diff --git a/templates/medium.hamlet b/templates/medium.hamlet index d8f4d10..a8d0c86 100644 --- a/templates/medium.hamlet +++ b/templates/medium.hamlet @@ -1,14 +1,14 @@ -