SFont (empty) → 0.1

raw patch · 4 files changed

+122/−0 lines, 4 filesdep +SDLdep +Sprigdep +arraysetup-changed

Dependencies added: SDL, Sprig, array, base

Files

• Graphics/UI/SDL/SFont.hs +68/−0
• LICENSE +35/−0
• SFont.cabal +14/−0
• Setup.lhs +5/−0

@@ -0,0 +1,68 @@+-- A port of the SFont library for use with HSSDL+-- Liam O'Connor-Davis (liamoc@cse.unsw.edu.au)+-- Released under the BSD3 license++module Graphics.UI.SDL.SFont +   ( initFont+   , SFont+   , write+   , textWidth+   , textHeight+   , writeChar+   ) where++import Graphics.UI.SDL+import Graphics.UI.SDL.Sprig+import Data.Array+import Data.List (groupBy)+import Data.Char (ord)++data SFont = SFont { surface :: Surface +                   , charPos :: Array Int Int+                   } deriving (Show)++-- | Load a font from an SDL surface+initFont :: Surface -> IO SFont+initFont surface = do pinks <- let nums = [0..surfaceGetWidth surface] +                               in sequence (map isPink nums) >>= return . zip nums +                      let pos = ( map fst $ +                                  map head $ +                                  groupBy (\a b -> snd a == snd b) $ +                                  pinks ) ++ [surfaceGetWidth surface]+                       in return $ SFont surface $ listArray (0,length pos) pos+  where                   +    isPink x = do pink <- mapRGB (surfaceGetPixelFormat surface) 255 0 255+                  color <- getPixel surface x 0+                  return $ pink == color++-- | Write the specified text at the given coordinates on the surface+write :: Surface -> SFont -> (Int, Int) -> String -> IO ()+write surf sfont (x, y) str = let xpos = map (+x) $ scanl (+) 0 $ map (charWidth sfont) str +                                  ypos = repeat y+                                  crds = zip xpos ypos+                                  done = zip crds str+                              in sequence (map (uncurry $ writeChar surf sfont) done) >> return ()++writeChar :: Surface -> SFont -> (Int,Int) -> Char -> IO ()+writeChar dest font@(SFont src charPos) (x,y) c = let offset = (ord c - 33) * 2 + 1                       +                                                  in if all (inRange $ bounds charPos) [offset, offset+1] +                                                     then let cWidth = charWidth font c+                                                              cHeight = textHeight font+                                                              srcRect = Rect (charPos ! offset) 0 cWidth cHeight+                                                              dstRect = Rect x y cWidth cHeight+                                                           in blit src (Just srcRect) dest (Just dstRect) >> return ()+                                                     else return ()+charWidth :: SFont -> Char -> Int+charWidth (SFont _ charPos) c = let offset = (ord c - 33) * 2 + 1+                                in if all (inRange $ bounds charPos) [offset, offset+1]+                                   then (charPos ! (offset + 1)) - (charPos ! offset)+                                   else (charPos ! 1) - (charPos ! 0)++-- | Returns the width in pixels of a given string rendered in the given font+textWidth :: SFont -> String -> Int+textWidth sfont = sum . map (charWidth sfont) ++-- | Returns the height of the font.+textHeight :: SFont -> Int+textHeight (SFont surf _ ) = surfaceGetHeight surf - 1+

@@ -0,0 +1,35 @@+Copyright (c) 2004-2006, Liam O'Connor-Davis+All rights reserved.++Redistribution and use in source and binary forms,+with or without modification, are permitted provided+that the following conditions are met:++    * Redistributions of source code must retain+      the above copyright notice, this list of+      conditions and the following disclaimer.+    * Redistributions in binary form must reproduce+      the above copyright notice, this list of+      conditions and the following disclaimer in the+      documentation and/or other materials provided+      with the distribution.+    * Neither the name of Liam O'Connor-Davis nor the+      names of other contributors may be used to+      endorse or promote products derived from this+      software without specific prior written permission.+++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND+CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES+OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER+OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,+BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS+INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,+WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING+NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE+USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY+OF SUCH DAMAGE.

@@ -0,0 +1,14 @@+name:                SFont+version:             0.1+synopsis:            SFont SDL Bitmap Fonts+description:         A haskell port of Karl Bartel's bitmap SFont library+category:            Graphics+license:             BSD3+license-file:        LICENSE+author:              Liam O'Connor-Davis+maintainer:          liamoc@cse.unsw.edu.au+build-type:          Simple+cabal-version:       >=1.2+Library+  exposed-modules:     Graphics.UI.SDL.SFont+  build-depends:       base<5, SDL>=0.5.9, Sprig>=0.1, array>=0.2

@@ -0,0 +1,5 @@+#!/usr/bin/env runhaskell+> module Main where+> import Distribution.Simple+> main :: IO ()+> main = defaultMainWithHooks simpleUserHooks