diff --git a/Makefile b/Makefile --- a/Makefile +++ b/Makefile @@ -1,13 +1,13 @@ .SECONDARY: %.frames -%.ps: %.mmd? +%.pdf: %.mmd? cabal run animed -- --frame-pattern="/tmp/page-%04d.png" $< %.wav: %.mmd1 uade123 --panning=0.5 -f $@ $< # Resolution is one Postscript point (1/72 inch). -%.frames: %.ps +%.frames: %.pdf export width=$$(fgrep '%%DocumentMedia:' $< | head -n1 | cut -f3 -d' '); \ gs -sDEVICE=pnggray -sOutputFile=/tmp/page-%04d.png \ -dNOPAUSE -dBATCH -dTextAlphaBits=2 -dGraphicsAlphaBits=2 \ diff --git a/cabal.project.local b/cabal.project.local deleted file mode 100644 --- a/cabal.project.local +++ /dev/null @@ -1,9 +0,0 @@ --- packages: --- ~/programming/haskell-other/postscript-git --- ~/programming/haskell-other/hcg-minus --- ~/programming/haskell-other/hmt-base - - -flags: +buildExamples --- with-compiler: ghc-9.4.5 --- ghc-options: -j3 diff --git a/example/Animate.hs b/example/Animate.hs --- a/example/Animate.hs +++ b/example/Animate.hs @@ -11,8 +11,7 @@ import Sound.MED.Generic.Block(Note,Inst,Cmd,Val) import Sound.MED.Basic.Human(human) -import qualified Graphics.Ps as PS -import Data.Cg.Minus (Pt(Pt)) +import qualified Graphics.PDF as PDF import qualified Data.Array as Array import qualified Data.Foldable as Fold @@ -21,13 +20,14 @@ import qualified Data.List.Match as Match import qualified Data.List.HT as ListHT import qualified Data.List as List -import qualified Data.Monoid.HT as Mn import Data.Array (Array, listArray, (!)) import Data.Maybe.HT (toMaybe) import Data.Maybe (fromMaybe, isJust) import Data.Tuple.HT (mapSnd, fst3, thd3) import Text.Printf (printf) -import Data.Monoid (Any(Any,getAny), (<>)) +import Data.String (fromString) +import Data.Monoid (Any(Any,getAny)) +import Data.Complex (Complex((:+))) import qualified Control.Monad.Trans.Writer as MW import qualified Control.Monad.Trans.Class as MT @@ -81,7 +81,7 @@ List.intercalate ", " (map show maxCmdsPerTrack) let formattedLines = map (highlightLine maxCmdsPerTrack) strippedLines let textWidth = maximum $ map (length . snd) $ take numLines formattedLines - writePostscript (dropExtension file <.> "ps") + writePDF (dropExtension file <.> "pdf") (Option.font opt) (Option.height opt) (pre,post) textWidth $ zip (brightnesses (Option.fadeOut opt) durations) $ map (take (pre+1+post)) $ ListHT.tails $ @@ -277,43 +277,56 @@ in printf "%04X:%s" i $ punwords $ zipWith hTrack maxCmdsPerTrack ds -writePostscript :: +writePDF :: FilePath -> Option.Font -> Int -> (Int,Int) -> Int -> [(Double, [((Bool,Bool),String)])] -> IO () -writePostscript path font heightInt (pre,post) textWidth blocks = +writePDF path font heightInt (pre,post) textWidth blocks = do let height = fromIntegral heightInt width = fromIntegral textWidth * fontWidth + 2*left top = height - fontHeight - (height - fontHeight*(preR+1+postR))/2 left = 80 barWidth n = fromIntegral n * fontWidth + 2*barBorderH fontWidth = fontHeight * Option.fontRelativeWidth font - fontHeight = Option.fontHeight font + fontHeight = fromIntegral $ Option.fontHeight font barBorderH = 5 barBorderV = 3 postR = fromIntegral post preR = fromIntegral pre - in PS.ps path (PS.Paper PS.Pts (round width) (round height)) $ - map - (\(brightness,block) -> - flip (<>) - (PS.Fill (PS.greyGs brightness) $ - PS.rectangle (Pt 0 0) width height) $ - foldr (<>) - (PS.Fill (PS.greyGs (0.8*brightness)) - (PS.rectangle - (Pt (left-barBorderH) (top-preR*fontHeight-barBorderV)) - (barWidth $ length $ snd $ block!!pre) fontHeight)) $ - zipWith - (\y ((highlight,endOfBlock),line) -> - let fontName = Option.fontName font ++ Mn.when highlight "-Bold" - hline = - PS.Stroke (PS.greyGs 0) $ - PS.line [Pt (left-barBorderH) (y-barBorderV), - Pt (left-barBorderH+barWidth(length line)) - (y-barBorderV)] - in (if endOfBlock then (<>) hline else id) $ - (PS.Fill (PS.greyGs 0) $ - PS.MoveTo (Pt left y) <> - PS.Text (PS.Font fontName fontHeight) line)) - (iterate (subtract fontHeight) top) block) - blocks + rect = PDF.PDFRect 0 0 width height + grey brightness = PDF.Rgb brightness brightness brightness + rectangleBySize leftBottom extent = + PDF.Rectangle leftBottom (leftBottom+extent) + horizRule xl xr y = PDF.Line xl y xr y + normalFont <- + either (fail . show) return =<< PDF.mkStdFont (Option.fontNormal font) + highlightFont <- + either (fail . show) return =<< PDF.mkStdFont (Option.fontHighlight font) + PDF.runPdf path PDF.standardDocInfo rect $ + Fold.for_ blocks $ \(brightness,block) -> do + page <- PDF.addPage Nothing + PDF.drawWithPage page $ do + PDF.fillColor (grey brightness) + PDF.fill $ PDF.Rectangle (0:+0) (width:+height) + PDF.fillColor (grey (0.8*brightness)) + PDF.fill $ + rectangleBySize + ((left-barBorderH) :+ (top-preR*fontHeight-barBorderV)) + ((barWidth $ length $ snd $ block!!pre) :+ fontHeight) + Fold.for_ (zip (iterate (subtract fontHeight) top) block) $ + \(y, ((highlight,endOfBlock),line)) -> do + PDF.fillColor PDF.black + PDF.drawText $ do + PDF.setFont $ + PDF.PDFFont + (if highlight then highlightFont else normalFont) + (Option.fontHeight font) + PDF.textStart left y + PDF.renderMode PDF.FillText + PDF.displayText $ fromString line + PDF.strokeColor PDF.black + when endOfBlock $ + PDF.stroke $ + horizRule + (left - barBorderH) + (left - barBorderH + barWidth (length line)) + (y - barBorderV) diff --git a/example/Animate/Option.hs b/example/Animate/Option.hs --- a/example/Animate/Option.hs +++ b/example/Animate/Option.hs @@ -1,8 +1,11 @@ module Animate.Option where +import qualified Graphics.PDF as PDF + import Data.Monoid ((<>)) import qualified Options.Applicative as OP +import Shell.Utility.ParseArgument (parseNumber) import Control.Applicative(pure, liftA2, (<$>), (<*>)) @@ -86,12 +89,11 @@ fontParser :: OP.Parser Font fontParser = pure Font - <*> (OP.strOption $ - OP.long "font" <> - OP.metavar "NAME" <> - OP.value "Courier" <> - OP.help "PostScript Font name") - <*> (OP.option readNonNeg $ + <*> pure PDF.Courier + <*> pure PDF.Courier_Bold + <*> (OP.option + (OP.eitherReader $ + parseNumber "font height" (0<=) "non-negative") $ OP.long "font-height" <> OP.metavar "POINTS" <> OP.value 17 <> @@ -104,7 +106,8 @@ data Font = Font { - fontName :: String, - fontHeight :: Double, + fontNormal :: PDF.FontName, + fontHighlight :: PDF.FontName, + fontHeight :: Int, fontRelativeWidth :: Double } diff --git a/med-module.cabal b/med-module.cabal --- a/med-module.cabal +++ b/med-module.cabal @@ -1,5 +1,5 @@ Name: med-module -Version: 0.1.2.3 +Version: 0.1.3 Synopsis: Parse song module files from Amiga MED and OctaMED Description: MED (Music EDitor) and its successor OctaMED @@ -29,11 +29,10 @@ README.md Makefile src/Sound/MED/modules.sh - cabal.project.local Cabal-Version: >=1.10 Source-Repository this - Tag: 0.1.2.3 + Tag: 0.1.3 Type: darcs Location: https://hub.darcs.net/thielema/med-module @@ -126,8 +125,8 @@ If flag(buildExamples) Build-Depends: med-module, - hps >=0.21 && <0.22, - hcg-minus >=0.21 && <0.22, + HPDF >=1.6 && <1.7, + shell-utility >=0.1 && <0.2, optparse-applicative >=0.11 && <0.19, filepath >=1.3 && <1.5, array >=0.4 && <0.6,