diff --git a/demo/Demo01.hs b/demo/Demo01.hs --- a/demo/Demo01.hs +++ b/demo/Demo01.hs @@ -34,14 +34,14 @@ makePicture gtext = liftToPictureU $ execTraceDrawing (standardContext 14) $ render sctx strokelineF gtext where - sctx = makeRenderScaling (\x -> fromIntegral $ 2*x) - (\y -> fromIntegral $ 3*y) + sctx = makeRenderScalingCtx (\x -> fromIntegral $ 2*x) + (\y -> fromIntegral $ 3*y) makeBordered :: GreekText -> DPicture makeBordered gtext = liftToPictureU $ execTraceDrawing (standardContext 14) $ render sctx borderedF gtext where - sctx = makeRenderScaling (\x -> fromIntegral $ 6*x) - (\y -> fromIntegral $ 8*y) + sctx = makeRenderScalingCtx (\x -> fromIntegral $ 6*x) + (\y -> fromIntegral $ 8*y) diff --git a/src/Wumpus/Microprint.hs b/src/Wumpus/Microprint.hs deleted file mode 100644 --- a/src/Wumpus/Microprint.hs +++ /dev/null @@ -1,70 +0,0 @@ -{-# OPTIONS -Wall #-} - --------------------------------------------------------------------------------- --- | --- Module : Wumpus.Microprint --- Copyright : (c) Stephen Tetley 2010 --- License : BSD3 --- --- Maintainer : stephen.tetley@gmail.com --- Stability : unstable --- Portability : GHC --- --- MicroPrints --- --- \*\* WARNING \*\* - This module is out-of-date and is due a --- rethink. Teletype is no longer the recommended drawing style. --- --------------------------------------------------------------------------------- - -module Wumpus.Microprint - ( - - -- * Re-export all Microprint.Render - module Wumpus.Microprint.Render - - -- * Top level rendering functions - , renderTeletype - , renderTeletypeU - - -- * Re-export some from MicroPrint.DrawMonad - , Teletype - , Tile(..) - , Height - , linebreak - , setRGB - , char - , space - - ) where - - -import Wumpus.Microprint.Teletype -import Wumpus.Microprint.Render - -import Wumpus.Core -- package: wumpus-core -import Wumpus.Basic.Kernel -- package: wumpus-basic - -import Data.Maybe - - - --- | Build a picture from a Teletype drawing. --- --- This function returns Nothing if the picture is empty. --- -renderTeletype :: RenderScalingCtx -> DrawWordF -> Teletype a -> Maybe DPicture -renderTeletype sctx fn mf = - runDrawing (standardContext 24) $ drawTracing $ render sctx fn $ execTeletype mf - - --- | Build a picture from a Teletype - /unsafe/ version. --- --- This function throws a runtime error if the picture is empty. --- -renderTeletypeU :: RenderScalingCtx -> DrawWordF -> Teletype a -> DPicture -renderTeletypeU ctx fn mf = fromMaybe errK $ renderTeletype ctx fn mf - where - errK = error "renderTeletypeU - empty picture." - - diff --git a/src/Wumpus/Microprint/Datatypes.hs b/src/Wumpus/Microprint/Datatypes.hs --- a/src/Wumpus/Microprint/Datatypes.hs +++ b/src/Wumpus/Microprint/Datatypes.hs @@ -18,15 +18,34 @@ ( -- * Datatypes - - Tile(..) + DrawWordF + , RenderScalingCtx + , makeRenderScalingCtx + + , Tile(..) , Height , GreekText ) where -import Wumpus.Core +import Wumpus.Basic.Kernel -- package: wumpus-basic +import Wumpus.Core -- package: wumpus-core + + +-- | 'DrawWordF' : +-- +-- > colour * scaled_width * scaled_height -> char_count -> DLocGraphic +-- +type DrawWordF = RGBi -> Double -> Double -> Int -> DLocGraphic + + + +type RenderScalingCtx = ScalingContext Int Int Double + +makeRenderScalingCtx :: (Int -> Double) -> (Int -> Double) -> RenderScalingCtx +makeRenderScalingCtx fx fy = + ScalingContext { scale_in_x = fx, scale_in_y = fy } diff --git a/src/Wumpus/Microprint/Render.hs b/src/Wumpus/Microprint/Render.hs --- a/src/Wumpus/Microprint/Render.hs +++ b/src/Wumpus/Microprint/Render.hs @@ -16,10 +16,8 @@ module Wumpus.Microprint.Render ( - RenderScalingCtx - , makeRenderScaling - , DrawWordF - , greekF + + greekF , strokelineF , borderedF @@ -38,21 +36,10 @@ -------------------------------------------------------------------------------- -type RenderScalingCtx = ScalingContext Int Int Double -type RenderScalingT m a = ScalingT Int Int Double m a -makeRenderScaling :: (Int -> Double) -> (Int -> Double) -> ScalingContext Int Int Double -makeRenderScaling fx fy = - ScalingContext { scale_in_x = fx, scale_in_y = fy } --- | 'DrawWordF' : --- --- > colour * scaled_width * scaled_height -> char_count -> DLocGraphic --- -type DrawWordF = RGBi -> Double -> Double -> Int -> DLocGraphic - -- | Just a filled rectangle. -- greekF :: DrawWordF @@ -78,23 +65,24 @@ render :: RenderScalingCtx -> DrawWordF -> GreekText -> TraceDrawing Double () -render ctx wordDraw (hmax,xs) = - runScalingT ctx $ mstep hmax xs +render ctx wordDraw (hmax,xs) = mstep hmax xs where - mstep h (s:ss) = renderLine wordDraw h s >> mstep (h-1) ss + mstep h (s:ss) = renderLine ctx wordDraw h s >> mstep (h-1) ss mstep _ _ = return () -renderLine :: DrawWordF -> Int -> [Tile] - -> RenderScalingT (TraceDrawing Double) () -renderLine fn h ts = mstep 0 ts +renderLine :: RenderScalingCtx -> DrawWordF -> Int -> [Tile] + -> TraceDrawing Double () +renderLine ctx fn h ts = mstep 0 ts where - mstep x (Word rgb n:xs) = draw1 fn rgb n (x,h) >> mstep (x+n) xs + mstep x (Word rgb n:xs) = draw1 ctx fn rgb n (x,h) >> mstep (x+n) xs mstep x (Space n:xs) = mstep (x+n) xs mstep _ [] = return () -draw1 :: DrawWordF -> RGBi -> Int -> (Int,Int) - -> RenderScalingT (TraceDrawing Double) () -draw1 fn rgb n (x,y) = - scalePt x y >>= \pt -> scaleX n >>= \w -> unitY >>= \h -> - draw $ fn rgb w h n `at` pt +draw1 :: RenderScalingCtx -> DrawWordF -> RGBi -> Int -> (Int,Int) + -> TraceDrawing Double () +draw1 ctx fn rgb n (x,y) = + let pt = scalePt ctx x y + w = scaleX ctx n + h = unitY ctx + in draw $ fn rgb w h n `at` pt diff --git a/src/Wumpus/Microprint/Teletype.hs b/src/Wumpus/Microprint/Teletype.hs --- a/src/Wumpus/Microprint/Teletype.hs +++ b/src/Wumpus/Microprint/Teletype.hs @@ -19,9 +19,11 @@ ( Teletype - , runTeletype - , execTeletype +-- , runTeletype +-- , execTeletype + , renderTeletype + , Tile(..) , Height , linebreak @@ -32,11 +34,13 @@ ) where import Wumpus.Microprint.Datatypes +import Wumpus.Microprint.Render -import Wumpus.Core -- package: wumpus-core +import Wumpus.Core -- package: wumpus-core import Wumpus.Core.Colour ( black ) -import Wumpus.Basic.Utils.HList -- package: wumpus-basic +import Wumpus.Basic.Kernel -- package: wumpus-basic +import Wumpus.Basic.Utils.HList import Control.Applicative import Control.Monad @@ -89,6 +93,16 @@ execTeletype :: Teletype a -> GreekText execTeletype = snd . runTeletype + + + +-- | Build a picture from a Teletype drawing. +-- +-- This function returns Nothing if the picture is empty. +-- +renderTeletype :: RenderScalingCtx -> DrawWordF -> Teletype a + -> TraceDrawing Double () +renderTeletype sctx fn mf = render sctx fn $ execTeletype mf snocTip :: H Tile -> RGBi -> TileTip -> H Tile diff --git a/src/Wumpus/Microprint/VersionNumber.hs b/src/Wumpus/Microprint/VersionNumber.hs --- a/src/Wumpus/Microprint/VersionNumber.hs +++ b/src/Wumpus/Microprint/VersionNumber.hs @@ -22,7 +22,7 @@ -- | Version number -- --- > (0,13,0) +-- > (0,14,0) -- wumpus_microprint_version :: (Int,Int,Int) -wumpus_microprint_version = (0,13,0) +wumpus_microprint_version = (0,14,0) diff --git a/wumpus-microprint.cabal b/wumpus-microprint.cabal --- a/wumpus-microprint.cabal +++ b/wumpus-microprint.cabal @@ -1,5 +1,5 @@ name: wumpus-microprint -version: 0.13.0 +version: 0.14.0 license: BSD3 license-file: LICENSE copyright: Stephen Tetley @@ -15,15 +15,29 @@ A rudimentary tokenizer is provided, but it is largely untested. . - Version 0.9.0 adds some new functionality, but the API is - undercooked and is unsuitable for real use. The API will improve - as Wumpus-Basic improves... - . + \*\* WARNING \*\* - in future, this library might not be updated + to track revisions to Wumpus-Basic and Wumpus-Drawing. + Originally microprints seemed like a simple subject to use as a + testbed for developing Wumpus, however in practice the + Microprint library has not been valuable for this. To do the + subject justice, more effort has to be spent on tokenizing + (which does not contribute to advancing Wumpus) than drawing. + Eventually I intend to polish this library, but I do not expect + to do this soon. . \[1\] . Changelog: + . + v0.13.0 to v0.14.0: + . + * Updated to track changes to Wumpus-Basic and Wumpus-Drawing. . + * Removed the shim module @Wumpus.Microprint@ this was + prioritizing the Teletype drawing style, however this style + is now out-of-date and it may be dropped in future revisions + rather than revised. + . v0.12.0 to v0.13.0: . * Updated to track changes to Wumpus-Basic and Wumpus-Core. @@ -41,12 +55,12 @@ hs-source-dirs: src build-depends: base < 5, vector-space >= 0.6 && < 1.0, - wumpus-core == 0.41.0, - wumpus-basic == 0.14.0 + wumpus-core == 0.42.0, + wumpus-basic == 0.15.0, + wumpus-drawing == 0.1.0 exposed-modules: - Wumpus.Microprint, Wumpus.Microprint.Datatypes, Wumpus.Microprint.Teletype, Wumpus.Microprint.Render,