{- Copyright 2012 Ken Takusagawa This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . -} module Main where { import System.Environment(getArgs) ; distance :: Double -> Double -> Double ; distance x y = sqrt(x*x+y*y) ; realspace :: Integer -> Double ; realspace i = ((fromIntegral i) - offset) * scale ; offset :: Double ; offset = (fromIntegral size)/2+0.5; ringscale :: Double ; ringscale = 9.5 ; scale :: Double ; scale = ringscale * 2/(fromIntegral size) ; inbullet :: Double -> Bool ; inbullet x = (x < (ringscale-1)) && (0==mod(round x) 2) && (x>0.75); fpointinbullet :: Double -> Double -> Bool ; fpointinbullet x y = inbullet $ distance x y ; pointinbullet :: Integer -> Integer -> Bool ; pointinbullet x y = fpointinbullet (realspace x) (realspace y) ; pbmheader :: String ; pbmheader = "P1\n" ++ show size ++ " " ++ show size ++ "\n" ; pixrange :: [Integer] ; pixrange = take (fromInteger size) $ enumFrom 0 ; pixel :: Bool -> String ; pixel x = if x then "1\n" else "0\n" ; pbmraster :: String ; pbmraster = concat $ do { x <- pixrange ; y <- pixrange ; return $ pixel $ target_plus_crosshairs x y } ;inbullet_test :: IO () ; inbullet_test = getArgs>>=print . inbullet . read . head ; linear_crosshairs :: Double -> Bool ; linear_crosshairs x = (abs x) < crosshair_halfwidth ; fcrosshairs :: Double -> Double -> Bool ; fcrosshairs x y = ((linear_crosshairs x) || (linear_crosshairs y)) && (distance x y > sqrt(2) * crosshair_halfwidth) ; narrowcrosshairs :: Double -> Double -> Bool ; narrowcrosshairs x y = fnarrow x y || fnarrow y x ; target_plus_crosshairs :: Integer -> Integer -> Bool ; target_plus_crosshairs fx fy = let { x = realspace fx ; y = realspace fy } in (fpointinbullet x y) {- || -} `xor` (narrowcrosshairs {- fcrosshairs -} x y) ; narrow1 :: Double -> Double ; narrow1 x = 1 - 1 / (x + 1) ; narrow :: Double -> Double ; narrow x = crosshair_halfwidth * (narrow1 $ x * 1) ; fnarrow :: Double -> Double -> Bool ; fnarrow x y = (abs y) < (narrow $ abs x ); crosshair_halfwidth = 0.5 {- /sqrt(2) -} ; xor :: Bool -> Bool -> Bool ; xor x y = (x || y) && not (x && y) ; ; size :: Integer ; size = 7200 ; ; main :: IO () ; main = putStr $ pbmheader ++ pbmraster ; }