med-module 0.1.2.3 → 0.1.3
raw patch · 5 files changed
+63/−57 lines, 5 filesdep +HPDFdep +shell-utilitydep −hcg-minusdep −hpsdep ~bytestringdep ~filepathdep ~optparse-applicative
Dependencies added: HPDF, shell-utility
Dependencies removed: hcg-minus, hps
Dependency ranges changed: bytestring, filepath, optparse-applicative
Files
- Makefile +2/−2
- cabal.project.local +0/−9
- example/Animate.hs +46/−33
- example/Animate/Option.hs +11/−8
- med-module.cabal +4/−5
Makefile view
@@ -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 \
− cabal.project.local
@@ -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
example/Animate.hs view
@@ -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)
example/Animate/Option.hs view
@@ -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 }
med-module.cabal view
@@ -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,