media page now responsive to media width

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)
 

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")

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)
 

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 (w1, w2)
-  return (newPath, width)
+  return (newPath, iWidth, tWidth)
 
 writeOnDrive :: FileInfo -> UserId -> AlbumId -> Handler FP.FilePath
 writeOnDrive fil userId albumId = do

config/models

@@ -33,6 +33,7 @@ Medium
     owner UserId
     description Textarea
     tags Texts
+    width Int
     thumbWidth Int
     album AlbumId
     deriving Eq Show

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

templates/medium.hamlet

@@ -1,14 +1,14 @@
-<div id="header" class="item" data-width="800">
+<div id="header" class="item" data-width=#{dataWidth}>
   <div class="inner">
     <h1>#{mediumTitle medium}
- 
+    <p>
       by <a href=@{UserR ownerName}>#{ownerName}</a> from album <a href=@{AlbumR albumId}>#{albumTitle album}</a>
 
     <img src=#{mediumPath medium}>
 
 <div id="header" class="item" data-width="400">
   <div class="inner">
-    <div class="desc">
+    <p class="desc">
       Uploaded on: #{formatTime defaultTimeLocale "%A %F %H:%M" (mediumTime medium)}<br>
       Description:<br>
       #{mediumDescription medium}