hs-captcha (empty) → 1.0
raw patch · 4 files changed
+199/−0 lines, 4 filesdep +basedep +bytestringdep +gdsetup-changed
Dependencies added: base, bytestring, gd, random
Files
- Graphics/Captcha.hs +149/−0
- LICENSE +22/−0
- Setup.hs +5/−0
- hs-captcha.cabal +23/−0
+ Graphics/Captcha.hs view
@@ -0,0 +1,149 @@+module Graphics.Captcha (makeCaptcha) where++import Data.ByteString+import Data.Char+import Graphics.GD+import System.Random+++main :: IO ()+main = do+ string <- makeRandomString+ image <- createInitialImage string+ chirpDoubleRandom image+ chirpDoubleRandom image+ image <- cropToFinalSize image+ Prelude.putStrLn string+ savePngFile "captcha.png" image+++makeCaptcha :: IO (String, ByteString)+makeCaptcha = do+ string <- makeRandomString+ image <- createInitialImage string+ chirpDoubleRandom image+ chirpDoubleRandom image+ image <- cropToFinalSize image+ byteString <- savePngByteString image+ return (string, byteString)+++makeRandomString :: IO String+makeRandomString = do+ let makeRandomLetter = do+ n <- randomRIO (0, 25)+ return $ chr (ord 'A' + n)+ mapM (\_ -> makeRandomLetter) [0..5]+++chirpDoubleRandom :: Image -> IO ()+chirpDoubleRandom image = do+ depth1 <- randomRIO (2.0, 5.0)+ period1 <- randomRIO (1, 6)+ period2 <- randomRIO (1, 6)+ depth2 <- randomRIO (2.0, 5.0)+ period3 <- randomRIO (1, 6)+ period4 <- randomRIO (1, 6)+ chirpVertically (makeChirpFunction depth1+ (fromIntegral captchaSize / period1)+ (fromIntegral captchaSize / period2))+ image+ chirpHorizontally (makeChirpFunction depth2+ (fromIntegral captchaSize / period3)+ (fromIntegral captchaSize / period4))+ image+++chirpHorizontally :: (Int -> Int) -> Image -> IO ()+chirpHorizontally chirpFunction image = do+ withImage (newImage (captchaSize, captchaSize))+ (\temporaryImage -> do+ copyRegion (0, 0) (captchaSize, captchaSize) image+ (0, 0) temporaryImage+ let shiftRow row amount+ = copyRegion (0, row) (captchaSize, 1) image+ (amount, row) temporaryImage+ shiftRows function+ = shiftRows' 0 function+ shiftRows' i function+ = if i == captchaSize+ then return ()+ else do+ shiftRow i (function i)+ shiftRows' (i+1) function+ shiftRows chirpFunction+ copyRegion (0, 0) (captchaSize, captchaSize) temporaryImage+ (0, 0) image)+++chirpVertically :: (Int -> Int) -> Image -> IO ()+chirpVertically chirpFunction image = do+ withImage (newImage (captchaSize, captchaSize))+ (\temporaryImage -> do+ copyRegion (0, 0) (captchaSize, captchaSize) image+ (0, 0) temporaryImage+ let shiftColumn column amount+ = copyRegion (column, 0) (1, captchaSize) image+ (column, amount) temporaryImage+ shiftColumns function+ = shiftColumns' 0 function+ shiftColumns' i function+ = if i == captchaSize+ then return ()+ else do+ shiftColumn i (function i)+ shiftColumns' (i+1) function+ shiftColumns chirpFunction+ copyRegion (0, 0) (captchaSize, captchaSize) temporaryImage+ (0, 0) image)+++makeChirpFunction :: Float -> Float -> Float -> Int -> Int+makeChirpFunction depth startingWaveLength endingWaveLength row+ = let waveLength = ((startingWaveLength * fromIntegral row)+ + (endingWaveLength * fromIntegral (captchaSize - row)))+ / fromIntegral captchaSize+ in floor $ depth * (sin $ (fromIntegral row) * ((2*pi) / waveLength))+++createInitialImage :: String -> IO Image+createInitialImage string = do+ image <- newImage (captchaSize, captchaSize)+ useFontConfig True+ drawFilledRectangle (0, 0) (captchaSize, captchaSize) 0xFFFFFF image+ ((left, top), _, (right, bottom), _)+ <- measureString fontName fontSize 0.0 (0, 0) string 0x000000+ width <- return $ right - left+ height <- return $ top - bottom+ originX <- return $ (captchaSize - width) `div` 2+ originY <- return $ (captchaSize + height) `div` 2+ drawString fontName fontSize 0.0 (originX, originY) string 0x000000 image+ return image+++cropToFinalSize :: Image -> IO Image+cropToFinalSize image = do+ result <- newImage finalSize+ copyRegion ((captchaSize - fst finalSize) `div` 2,+ (captchaSize - snd finalSize) `div` 2)+ finalSize+ image+ (0, 0)+ result+ return result+++fontName :: String+fontName = "Courier New"+++fontSize :: Double+fontSize = 22.0+++captchaSize :: Int+captchaSize = 192+++finalSize :: (Int, Int)+finalSize = (128, 64)
+ LICENSE view
@@ -0,0 +1,22 @@+Copyright (c) 2009 Dan Knapp++Permission is hereby granted, free of charge, to any person+obtaining a copy of this software and associated documentation+files (the "Software"), to deal in the Software without+restriction, including without limitation the rights to use,+copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the+Software is furnished to do so, subject to the following+conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES+OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT+HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,+WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR+OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,5 @@+#!/usr/bin/env runhaskell++import Distribution.Simple++main = defaultMain
+ hs-captcha.cabal view
@@ -0,0 +1,23 @@+name: hs-captcha+version: 1.0+cabal-version: >= 1.2+build-type: Simple+license: BSD3+license-file: LICENSE+copyright: Copyright (c) 2009 Dan Knapp+author: Dan Knapp+maintainer: dankna@gmail.com+homepage: http://www.dankna.com/software/+bug-reports: http://www.dankna.com/issues/create/+category: Graphics+synopsis: Generate images suitable for use as CAPTCHAs in online web-form security.+description:+ Generates images suitable for use as CAPTCHAs in online web-form security. Does not+ integrate with any web framework; simply exports a function that creates the image+ itself as a ByteString (containing a PNG), and the correct answer to the challenge as a+ String. HS-Captcha is designed to be as simple as possible to integrate in other+ frameworks.++Library+ exposed-modules: Graphics.Captcha+ build-depends: gd, bytestring, random, base >= 4.1 && < 5