diff --git a/hackage/brickbreaker/.gitignore b/hackage/brickbreaker/.gitignore new file mode 100644 index 0000000..697a2c6 --- /dev/null +++ b/hackage/brickbreaker/.gitignore @@ -0,0 +1,2 @@ +dist-newstyle +.ghc.environment.* diff --git a/hackage/brickbreaker/README.md b/hackage/brickbreaker/README.md new file mode 100644 index 0000000..928991e --- /dev/null +++ b/hackage/brickbreaker/README.md @@ -0,0 +1,13 @@ +# Brick Breaker + +Copyright Francesco Gazzetta +SPDX-License-Identifier: EUPL-1.2 + +Move the pointer to move the paddle. +The ball is lost if it moves past the paddle. +Try to destroy all bricks! + +Tip: the bottom of the ball has magical destructive properties, try to get it +above the bricks to destroy many at once. + +Adjust the `r` variable if the game is too big or too small for your screen diff --git a/hackage/brickbreaker/brickbreaker.cabal b/hackage/brickbreaker/brickbreaker.cabal new file mode 100644 index 0000000..cc1a6f2 --- /dev/null +++ b/hackage/brickbreaker/brickbreaker.cabal @@ -0,0 +1,23 @@ +cabal-version: 3.0 +name: brickbreaker +version: 0.1.0.0 + +common common + ghc-options: -Wall + build-depends: base + default-language: Haskell2010 + +executable brickbreaker + import: common + main-is: brickbreaker.unminified.hs + build-depends: gloss + +executable minified + import: common + main-is: brickbreaker.hs + build-depends: gloss + ghc-options: -Wno-missing-signatures + +executable minify + import: common + main-is: minify.hs diff --git a/hackage/brickbreaker/brickbreaker.hs b/hackage/brickbreaker/brickbreaker.hs old mode 100644 new mode 100755 index 4457489..bc58dcc --- a/hackage/brickbreaker/brickbreaker.hs +++ b/hackage/brickbreaker/brickbreaker.hs @@ -1,16 +1,19 @@ #!/usr/bin/env -S stack script --compile --resolver lts-20 --package gloss import Graphics.Gloss;import Graphics.Gloss.Interface.IO.Interact;r=20;main=play - FullScreen white 60(0,(0,-20),(8,16),[(x,y)|x<-[0,2..20],y<-[2,4..8]]) f g h; o - b c|b=color c$thickCircle 1 99|True=blank;f(p,(x,y),_,bs)=scale r r$o(y< -20) - red<>o(null bs)green<>line[(0,10),(22,10),(22,-11),(0,-11),(0,10)]<>line[(p-2,- - 10),(p+2,-10)]<>translate x y(circle 1)<>foldMap(\(x,y)->polygon[(x,y),(x+1.8,y - ),(x+1.8,y+1.8),(x,y+1.8)])bs;g(EventMotion(p,_))(_,b,bv,bs)=(p/r,b,bv,bs);g _ - s=s;h t(p,(x,y),(v,w),bs)=(p,(x+v*t,y+w*t),(v',w'),bs')where{bs'=filter(\(bx,by - )->bxx+2||byy+2)bs;(v',w')|y< -10&&y> -11&&x>p-2&&x20=(-abs v*signum x,w)|y>10||bs/=bs'=(v,-abs w)|True=(v,w)} + FullScreen white 60(0,(0,-20),(8,16),(,)<$>[0,2..20]<*>[2,4..8])f g h;o b c|b= + color c$thickCircle 1 99|True=blank;f(p,(x,y),_,bs)=scale r r$o(y< -20)red<>o( + null bs)green<>line[(0,10),(22,10),(22,-11),(0,-11),(0,10)]<>line[(p-2,-10),(p+ + 2,-10)]<>translate x y(circle 1)<>foldMap(\(x,y)->polygon[(x,y),(x+1.8,y),(x+ + 1.8,y+1.8),(x,y+1.8)])bs;g(EventMotion(p,_))(_,b,bv,bs)=(p/r,b,bv,bs);g _ s=s;h + t(p,(x,y),(v,w),bs)=(p,(x+v*t,y+w*t),(v',w'),bs')where{bs'=filter(\(bx,by)->bx< + x||bx>x+2||byy+2)bs;(v',w')|y< -10&&y> -11&&x>p-2&&x20=(-abs v*signum x,w)|y>10||bs/=bs'=(v,-abs w)|True=(v,w)} -- ^10 ------------------------------------------------------------------ 80> -- {- hackage-10-80/brickbreaker (fgaz) +Copyright Francesco Gazzetta +SPDX-License-Identifier: EUPL-1.2 + Move the pointer to move the paddle. The ball is lost if it moves past the paddle. Try to destroy all bricks! @@ -20,4 +23,61 @@ above the bricks to destroy many at once. Adjust the `r` variable if the game is too big or too small for your screen +Unminified version: + +#!/usr/bin/env -S stack script --compile --resolver lts-20 --package gloss + +-- Copyright Francesco Gazzetta +-- SPDX-License-Identifier: EUPL-1.2 + +import Graphics.Gloss; +import Graphics.Gloss.Interface.IO.Interact; + +-- Scaling factor +r :: Float +r = 20; + +type Position = (Float, Float) +type Velocity = (Float, Float) +-- paddle position, ball position, ball velocity, brick positions +type State = (Float, Position, Velocity, [Position]) + +main :: IO () +main = play FullScreen white 60 + (0, (0,-20), (8,16), (,) <$> [0,2..20] <*> [2,4..8]) + f g h; + +-- Colored overlay when b is true +o :: Bool -> Color -> Picture +o b c | b = color c $ thickCircle 1 99 + | True = blank; + +-- render +f :: State -> Picture +f (p, (x, y), _, bs) = scale r r $ + -- the win overlay (green) has to be drawn over the lose overlay (red), since + -- if the ball is lost after a win, it's still a win + o (y< -20) red <> + o (null bs) green <> + line [(0,10),(22,10),(22,-11),(0,-11),(0,10)] <> + line [(p - 2, -10), (p + 2, -10)] <> + translate x y (circle 1) <> + foldMap (\(x, y) -> polygon [(x,y),(x+1.8,y),(x+1.8,y+1.8),(x,y+1.8)]) bs; + +-- input +g :: Event -> State -> State +g (EventMotion (p, _)) (_, b, bv, bs) = (p/r, b, bv, bs); +g _ s = s; + +-- step +h :: Float -> State -> State +h t (p, (x, y), (v, w), bs) = (p, (x+v*t,y+w*t), (v',w'), bs') + where { + bs' = filter (\(bx, by) -> bx < x || bx > x+2 || by < y || by > y+2) bs; + (v', w') | y < -10 && y > -11 && x > p-2 && x < p+2 = ((x-p)*10, abs w) + | x < 0 || x > 20 = (-abs v * signum x,w) + | y > 10 || bs /= bs' = (v, -abs w) + | True = (v, w) + } + -} diff --git a/hackage/brickbreaker/brickbreaker.unminified.hs b/hackage/brickbreaker/brickbreaker.unminified.hs new file mode 100755 index 0000000..33aef55 --- /dev/null +++ b/hackage/brickbreaker/brickbreaker.unminified.hs @@ -0,0 +1,54 @@ +#!/usr/bin/env -S stack script --compile --resolver lts-20 --package gloss + +-- Copyright Francesco Gazzetta +-- SPDX-License-Identifier: EUPL-1.2 + +import Graphics.Gloss; +import Graphics.Gloss.Interface.IO.Interact; + +-- Scaling factor +r :: Float +r = 20; + +type Position = (Float, Float) +type Velocity = (Float, Float) +-- paddle position, ball position, ball velocity, brick positions +type State = (Float, Position, Velocity, [Position]) + +main :: IO () +main = play FullScreen white 60 + (0, (0,-20), (8,16), (,) <$> [0,2..20] <*> [2,4..8]) + f g h; + +-- Colored overlay when b is true +o :: Bool -> Color -> Picture +o b c | b = color c $ thickCircle 1 99 + | True = blank; + +-- render +f :: State -> Picture +f (p, (x, y), _, bs) = scale r r $ + -- the win overlay (green) has to be drawn over the lose overlay (red), since + -- if the ball is lost after a win, it's still a win + o (y< -20) red <> + o (null bs) green <> + line [(0,10),(22,10),(22,-11),(0,-11),(0,10)] <> + line [(p - 2, -10), (p + 2, -10)] <> + translate x y (circle 1) <> + foldMap (\(x, y) -> polygon [(x,y),(x+1.8,y),(x+1.8,y+1.8),(x,y+1.8)]) bs; + +-- input +g :: Event -> State -> State +g (EventMotion (p, _)) (_, b, bv, bs) = (p/r, b, bv, bs); +g _ s = s; + +-- step +h :: Float -> State -> State +h t (p, (x, y), (v, w), bs) = (p, (x+v*t,y+w*t), (v',w'), bs') + where { + bs' = filter (\(bx, by) -> bx < x || bx > x+2 || by < y || by > y+2) bs; + (v', w') | y < -10 && y > -11 && x > p-2 && x < p+2 = ((x-p)*10, abs w) + | x < 0 || x > 20 = (-abs v * signum x,w) + | y > 10 || bs /= bs' = (v, -abs w) + | True = (v, w) + } diff --git a/hackage/brickbreaker/minify.hs b/hackage/brickbreaker/minify.hs new file mode 100755 index 0000000..724f338 --- /dev/null +++ b/hackage/brickbreaker/minify.hs @@ -0,0 +1,106 @@ +#!/usr/bin/env runhaskell + +-- fgaz's minifier +-- +-- Copyright Francesco Gazzetta +-- SPDX-License-Identifier: EUPL-1.2 +-- +-- Like the other one, it needs explicit block syntax (semicolons and braces). +-- NOTE: It will split string literals containing spaces. + +import Data.List (isPrefixOf, foldl') +import Data.Char (isSpace, isAlphaNum, isAscii) +import Data.Function (on) + +main :: IO () +main = interact $ \text -> + let (shebang, program) = + if "#!" `isPrefixOf` text + then (Just $ takeWhile (/='\n') text, dropWhile (/='\n') text) + else (Nothing, text) + in maybe "" (<>"\n") shebang <> minify program <> "\n" + +minify :: String -> String +minify = mkLines + . filter (not . isSpace . head) + . groupBy' (not .: canTouch `on` characterClass) + . unlines + . filter (not . isExtra) + . lines + +-- NOTE: tweak as needed +isExtra :: String -> Bool +isExtra s = any ($ s) + [ isComment + , isType + , isSignature + ] + +isComment :: String -> Bool +isComment = isPrefixOf "--" . dropWhile isSpace + +isType :: String -> Bool +isType = isPrefixOf "type" + +isSignature :: String -> Bool +isSignature = elem "::" . words + +-- | Basically +-- unwords . fmap concat . groupBy' (canTouch `on` (characterClass . head)) +-- but splits the output into lines. +-- O(n^2) due to '<>' and 'last' in 'addToken', but inputs are going to be short +-- anyway. For now at least. +-- +-- TODO make it stream +mkLines :: [String] -> String +mkLines = fst . foldl' addToken ("", 0) + +addToken :: (String, Int) -> String -> (String, Int) +addToken (str, lineLen) token + | lineLen + length spacedToken > 80 = + if token `elem` [";", "{"] + then (str <> "\n", 0) + else (str <> "\n " <> token, length token + 1) + | otherwise = (str <> spacedToken, lineLen + length spacedToken) + where spacedToken + | null str || null token + || (canTouch `on` characterClass) (last str) (head token) + = token + | otherwise = " " <> token + +data CharacterClass = IdentifierOrLit | Operator | Dot | Special deriving Eq + +characterClass :: Char -> CharacterClass +characterClass '.' = Dot +characterClass c | isAlphaNum c = IdentifierOrLit + | c `elem` "\"'_" = IdentifierOrLit + | c `elem` "!#$%&*+/<=>?@\\^|-~:" = Operator + | not $ isAscii c = Operator + | c `elem` "[](),;{}" = Special + | isSpace c = Special +characterClass c = error $ "Unknown character: " ++ show c + +-- Check if splitting or joining the characters does not change their meaning +canTouch :: CharacterClass -> CharacterClass -> Bool +canTouch Special _ = True +canTouch _ Special = True +-- . is both used for operators and for qualified names +canTouch Dot _ = False +canTouch _ Dot = False +canTouch a b = a /= b + +-- Utilities +------------ + +(.:) :: (b -> c) -> (a1 -> a2 -> b) -> a1 -> a2 -> c +(.:) = (.).(.) + +-- | Like groupBy, but equality is not transitive +groupBy' :: (a -> a -> Bool) -> [a] -> [[a]] +groupBy' _ [] = [] +groupBy' eq (x:xs) | all (eq x) (take 1 xs) = + let (gr, grs) = case groupBy' eq xs of + gr':grs' -> (gr', grs') + [] -> ([], []) + in (x : gr) : grs + | otherwise = [x] : groupBy' eq xs diff --git a/hackage/brickbreaker/minify.sh b/hackage/brickbreaker/minify.sh new file mode 100755 index 0000000..a756429 --- /dev/null +++ b/hackage/brickbreaker/minify.sh @@ -0,0 +1,26 @@ +#!/bin/sh + +set -e + +runhaskell minify.hs < brickbreaker.unminified.hs > brickbreaker.hs + +cat >> brickbreaker.hs < -- +{- hackage-10-80/brickbreaker (fgaz) + +EOF + +tail -n+3 README.md >> brickbreaker.hs + +cat >> brickbreaker.hs <> brickbreaker.hs + +cat >> brickbreaker.hs <