1. Haskell / Говнокод #15821

    −107

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    12. 12
    13. 13
    14. 14
    15. 15
    16. 16
    17. 17
    18. 18
    19. 19
    20. 20
    21. 21
    22. 22
    23. 23
    24. 24
    25. 25
    26. 26
    27. 27
    28. 28
    29. 29
    30. 30
    31. 31
    32. 32
    33. 33
    34. 34
    35. 35
    36. 36
    37. 37
    38. 38
    39. 39
    40. 40
    41. 41
    42. 42
    43. 43
    44. 44
    45. 45
    import System.Exit
    import Graphics.UI.GLUT
    import Control.Monad
    import Control.Applicative
    import Control.Arrow
    import Control.Concurrent
    import Graphics.Rendering.OpenGL 
    import Data.IORef
    import Data.List
    import Data.Maybe
    initial = ((0,0),(0.005,-0.03),(0,0),([(-0.4,-0.9),(-0.4,-0.85),(0.4,-0.85),(0.4,-0.9),(-0.4,-0.9)],(0,0)),liftM2 (,) [-0.9,-0.7..0.9] [0.5,0.7,0.9])
    ws = dzip [(-1,-1),(-1,1),(1,1),(1,-1)] ; r = 0.1 :: GLfloat
    main = initialWindowSize $= Size 777 777 >> initialWindowPosition $= Position 100 100 >> initialDisplayMode $= [DoubleBuffered] >> createWindow "ursula" >> 
    	newIORef initial >>= \ior -> keyboardMouseCallback $= Just (kbd ior) >> displayCallback $= dlay ior >> idleCallback $= Just (anime ior) >> mainLoop
    dlay ior = clearColor $= Color4 1 1 1 1 >> clear [ColorBuffer] >> readIORef ior >>= drawDoxyq >> swapBuffers
    kbd _ (Char 'q') Down _ _ = exitWith ExitSuccess			
    kbd s (Char x) Down _ _   = modifyIORef' s $ \(a,b,t,(d,e),cs) -> (a,b,t,(d,(if x == '[' then -0.05 else if x == ']' then 0.05 else fst e,0)),cs)
    kbd _ _ _ _ _ = return ()
    draw c = renderPrimitive c . mapM_ (vertex . uncurry Vertex2)
    touch xy s xy' = guard ((xy ==== xy') <= r+r && (s .*. (xy.-.xy')) <= 0) >> Just (xy.-.xy')
    drawDoxyq ((x,y),_,(t,_),(bd,_),cs) = currentColor $= Color4 0.3 0.4 0.8 0 >> mapM_ (mapM_ (draw LineLoop) . sta) cs >> 
    	currentColor $= Color4 0.7 0.1 0.2 1 >> mapM_ (draw LineStrip) swa >> currentColor $= Color4 0 0 0 1 >> draw Polygon bd  where
    	swa = [[(x,y),(x + r/1.8*cos (th+pi/4),y + r/1.8*sin (th+pi/4)),(x + r/1.2*cos th,y + r/1.2*sin th)] | th <- [t,t+pi/2..t+1.6*pi]]
    	sta (x,y) = [[(x,y+r/2),(x-r/2,y-r/2),(x+r/2,y-r/2)],[(x+r/2,y+r/2-0.03),(x-r/2,y+r/2-0.03),(x,y-r/2-0.03)]]
    frame (xy,v,(tt,tr),(b,s),cs) = if snd xy <= r-0.99 || null cs then error "GAME OVER" else (xy.+.v',v',(tt+tr',tr'),(b',s'),cs') where 
    	v' = listy v (\us -> rV (2*negv v .>. foldl1' (.+.) us + tr/11) $ negv v) $ mapMaybe (cutSect xy v) (ws ++ dzip b') ++ mapMaybe (touch xy v) cs
    	s' = 0.93 *. if any ((1<=) . (*signum (fst s)) . fst) b then negv s else s
    	b' = map (.+.s') b ; cs' = filter (isNothing . touch xy v) cs
    	tr' = if v .=. v' then tr else (v' .>. v)/19
    listy d f x = if null x then d else f x
    rV t (x,y) = (x*cos t - y*sin t,y*cos t + x*sin t)
    anime ior = modifyIORef' ior frame >> threadDelay 30000 >> postRedisplay Nothing
    cutSect xy s c@(u,v) = guard (xy ./ l <= r && w `oncut` c && (s .*. (xy.-.w)) <= 0) >> Just (xy.-.w) where 
    	l = ln u (u.-.v) ; w = xy .-| l
    oncut u (v,w) = 0 <= (u.-.v) .*. (w.-.u) && 0 <= (u.-.w) .*. (u.-.w) && ((u.-.w) .<>. (v.-.w)) # 0
    ln xy w = (snd w,-fst w,w.<>.xy)
    (x,y) .-| (a,b,c) = ((b^2*x - a*c - a*b*y)/(a^2 + b^2),-(b*c + a*b*x - a^2*y)/(a^2 + b^2))
    p ./ ln = p ==== p .-| ln ; pop f (a,b) (c,d) = (f a c,f b d)		
    (.+.) = pop (+) ; (.-.) = pop (-)  ; (.=.) = (uncurry (&&) .) . pop (#) 
    (*.) = tmap . (*) ; (.*.) = (uncurry (+) .) . pop (*)
    (.<>.) = (uncurry (-) .) . (. uncurry (flip (,))) . pop (*) ; v .>. u = atan2 (v .<>. u) (v .*. u) 
    norm = sqrt . join (.*.) ; a ==== b = norm $ a.-.b ; negv = tmap negate
    infix 4 #,*. ; infix 3 .+.,==== ; infix 8 .>.
    x # y = abs (x-y) < 0.00001 ; tmap = join (***)
    dzipWith = (<*> drop 1) . zipWith ; dzip = dzipWith (,)

    Вся суть выразительности Haskell

    Запостил: jkhne4pijgberg, 22 Апреля 2014

    Комментарии (26) RSS

    • Просто здесь поработал Человек Обфускатор.
      Ответить
    • Я с тобой дружу.
      Ответить
    • Без сомнения на Хаскеле легко написать говнокод. На главную роль в этом играет человек:
      1) его неопытность - человек просто не умеет писать программы. Использует всякого рода функциональные плюшки там где они не уместны. Например АТД или туплы. В то время как нужны например объекты. Или адское поинт фри, да комбинаторы.
      2) функциональный калека - он начинает просто из-за того что это круто использовать всегда и везде всякого рода катаморфизмы и комбинаторы из разряда бесполезных.
      Ответить
      • ты себя к какой категории относишь?
        Ответить
        • Ты так говоришь, как-будто я знаю функциональные языки. Я абсолютно здоров.

          Ты ведь тот второй, что HaskellGovno или тот гуест, что на тему функциональщины отписывается все время или Yuuri или очередной аспект Борманда?
          Ответить
    • cleaned
      Ответить
    • Посмотрел кот. Все норм. Разве что смайлики упоротые в конце кота
      Ответить
    • Выражает бардак в голове автора.
      Ответить
    • У кого-нибудь заработало? У меня компилируется, но падает.
      ~ $ ghc has.hs
      [1 of 1] Compiling Main             ( has.hs, has.o )
      Linking has ...
      ~ $ ./has
      freeglut  ERROR:  Function <glutCreateWindow> called without first calling 'glutInit'.
      Ответить
    • jkhne4pijgberg - это не я, если что. Но одобряю.
      Ответить
    • Теперь я знаю, на каком языке предоставить заказчику исходники опнежл программы))) Жлобы должны страдать!
      Ответить
    • Нехуй функциональный язык было подстраивать под откровенно императивные задачи.
      Ответить
      • нормально хаскель для императивщины подходит, здесь просто всё обфусцированно и минимизировано
        Ответить
        • Потому он такое говно.
          Если б не подходил, не был бы таким говном.
          Ответить
          • Императивно - функциональный дуализм.
            Ответить
    • да это же мой арканоид
      Ответить
      • Это весь код или кусок?
        Ответить
        • весь
          так запусти же
          с сейчасной платформой работает
          Ответить
          • > с сейчасной платформой работает

            Ubuntu 14.04, ghc 7.6.3, haskell-platform-2013.2.0.0.debian3
            freeglut  ERROR:  Function <glutCreateWindow> called without first calling 'glutInit'.

            Не самая свежатина, но не из репы ставить лень. Так что лучше почини код.
            Ответить
            • чинится добавлением в начало main "getArgsAndInitialize >> ". Запустилось, в управление не вкурил (стрелки не работают, мышь тоже).
              Ответить
            • ставь видновс и не будет проблем
              я хз что за glutInit
              пробуй:
              http://ideone.com/YXBWZ7
              14. строчка
              Ответить

    Добавить комментарий