brickbreaker: add unminified version and minifier

hackage/brickbreaker/.gitignore

@@ -0,0 +1,2 @@
+dist-newstyle
+.ghc.environment.*

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

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

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
- )->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)}
+ 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||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)}
 -- ^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)
+  }
+
 -}

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)
+  }

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

hackage/brickbreaker/minify.sh

@@ -0,0 +1,26 @@
+#!/bin/sh
+
+set -e
+
+runhaskell minify.hs < brickbreaker.unminified.hs > brickbreaker.hs
+
+cat >> brickbreaker.hs <<EOF
+-- ^10 ------------------------------------------------------------------ 80> --
+{- hackage-10-80/brickbreaker (fgaz)
+
+EOF
+
+tail -n+3 README.md >> brickbreaker.hs
+
+cat >> brickbreaker.hs <<EOF
+
+Unminified version:
+
+EOF
+
+cat brickbreaker.unminified.hs >> brickbreaker.hs
+
+cat >> brickbreaker.hs <<EOF
+
+-}
+EOF