fork download
copy 
  1. {-# LANGUAGE NoMonomorphismRestriction #-}
  2. import qualified Data.Set as S
  3.  
  4. main = narisavatKvadratiki
  5.  
  6. narisavatKvadratiki =
  7.     flip mapM_ [razmer,razmer-odin.. -razmer] $ \yKoordinata ->
  8.         flip mapM_ [-razmer..razmer] (\xKoordinata ->
  9.             putStr [if S.member [xKoordinata,yKoordinata] treugolnichki
  10.                        then chornayaTochka 
  11.                        else pusto
  12.                     ,pusto]) >> putChar novayaLiniya where
  13.     treugolnichki = S.fromList $ popravitj $ zaeboshitTreugolnichki 3 [[razmer*cos ugol,razmer*sin ugol] | ugol <- [pi/2,pi/2+2*pi/3,pi/2+4*pi/3]]
  14.     zaeboshitTreugolnichki glubina koordinati@[verx,levo,pravo]
  15.         | glubina==nolj = []
  16.         | otherwise = (obzmeitj koordinati >>= uncurry zaeboshitLiniyu) ++ 
  17.                       ([[verx,verxlevo,pravoverx],
  18.                         [verxlevo,levo,levopravo],
  19.                         [pravoverx,levopravo,pravo]] >>= zaeboshitTreugolnichki (glubina-odin)) where
  20.             [verxlevo,levopravo,pravoverx] = map (uncurry srednyaaTochka) (obzmeitj koordinati)
  21.  
  22. zaeboshitLiniyu odin dva = 
  23.     [zipWith (+) odin [dlina*cos ugol,dlina*sin ugol] | dlina <- [nolj,prirashenie..rasstojanie]] where
  24.         ugol = vicheslitUgol odin dva
  25.         rasstojanie = vicheslitRasstoyanie odin dva
  26.  
  27. vicheslitRasstoyanie [xKoordinata1,yKoordinata1] [xKoordinata2,yKoordinata2] = 
  28.     sqrt $ (xKoordinata1-xKoordinata2)^dva + (yKoordinata1-yKoordinata2)^dva
  29. vicheslitUgol [xKoordinata1,yKoordinata1] [xKoordinata2,yKoordinata2] = 
  30.     atan2 (yKoordinata2-yKoordinata1) (xKoordinata2-xKoordinata1)
  31. srednyaaTochka [xKoordinata1,yKoordinata1] [xKoordinata2,yKoordinata2] = 
  32.     [(xKoordinata1+xKoordinata2)/dva,(yKoordinata1+yKoordinata2)/dva]
  33.  
  34. obzmeitj spisok = zip spisok (tail spisok) ++ [(head spisok,last spisok)]
  35. popravitj = map (map round)
  36.  
  37. razmer = 20
  38. prirashenie = 0.3
  39. nolj:odin:dva:_ = [0..]
  40. nachalo = [nolj,nolj]
  41. [chornayaTochka,pusto,novayaLiniya] = "# \n"
Success #stdin #stdout 0s 6272KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
                                        #                                         
                                      # # #                                       
                                      #   #                                       
                                    # #   # #                                     
                                  # #       # #                                   
                                  #           #                                   
                                # #           # #                                 
                                # # #           #                                 
                              # #   # # # # # # # #                               
                              # # #           # # #                               
                            #     #           #     #                             
                          # #     # #       # #     # #                           
                          #         # #   # #         #                           
                        # #           #   #           # #                         
                        #             # # #             #                         
                      # # # # # # # # # # # # # # # # # # #                       
                      # #                               # #                       
                    #   # #                           # #   #                     
                  # #     #                           #     # #                   
                  #       # #                       # #       #                   
                # #         #                       #         # #                 
                #             #                   #             #                 
              # # # # # # # # # #               # #             # #               
              #               # #               # # # # # # # # # #               
            #   #             # # #           # # #             #   #             
          # #   # #         #     #           #     #         # #   # #           
          #       #       # #     # #       # #     # #       #       #           
        # #       # #     #         # #   # #         #     # #       # #         
        #           #   # #           #   #           # #   #           #         
      # #             # #             # # #             # #             # #       
      # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
https://ideone.com/mJPwt3
language:
Haskell (ghc 8.4.4)
created:
9 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!