Second version of my Haskell code which I used to create an image with an array of colorful squares.

FastDegrade.hs

{-|
Module      :   FastDegrade
Description :   Creates an image with multiple squares of different colors.
Copyright   :   (c) Fabio Thomaz MOlinar, 2021
Maintainer  :   fabiomolinar@gmail.com
Stability   :   experimental

Second attempt at trying to make a module that create an image with multiple
squares of different colors on it. The first attempt, the module 'Degrade'
had a __terrible__ performance.

Now I understand the hip package better and I did some improvements in the code.

I also changed the approach. Instead of painting a canvas and then printing squares
on top of it at specific places (operation that requires accessing different indexes
of a list multiple times), this time the approach is to create a mathematical function
which will define the color based on the position in the Canvas. Then, to create the
image, I will simply call this function for each possible point of the canvas (once).

With the @Degrade@ module, it would take 6400s to draw 900 squares. With this module,
it takes 4s.
-}
module Squares.FastDegrade where

import Graphics.Image

type Rows = Int
type Columns = Int
type DrawingSize = (Rows, Columns)

type Margin = Int
type Spacing = Int
type SquareHeight = Int
type SquareWidth = Int
type DrawingSettings = (Margin, Spacing, SquareHeight, SquareWidth)

createXYImage :: DrawingSize        
    -> DrawingSettings                     
    -> (DrawingSize                             -- ^ Coloring function
        -> (Int, Int) 
        -> Pixel RGB Double)     
    -> Image RPU RGB Double                     -- ^ Image
createXYImage dSize dSettings cf = makeImageR RPU dSize $ drawSquares dSize dSettings cf

atMargin :: DrawingSize -> Margin
    -> (Int, Int)                               -- ^ Position (y, x)
    -> Bool                         
atMargin (dh, dw) m (y, x)                      -- Position (y, x) is zero based
    | x < m        = True
    | x >= dw - m  = True
    | y < m        = True
    | y >= dh - m  = True
    | otherwise    = False

atSquare :: DrawingSize -> DrawingSettings
    -> (Int, Int)                               -- ^ Position (y, x)
    -> Bool
atSquare (dh, dw) (m, s, sh, sw) (y, x)
    | atMargin (dh, dw) m (y, x)        = False
    | ssr s sh y' && ssr s sw x'        = True  -- Check if inside square in both dimensions
    | otherwise                         = False
    where
        x' = x - m                              -- Changing the coordinate system to match (0,0) with first upper-left corner square
        y' = y - m
        ssr s d p =                             -- ^ ssr = square space ratio. Function used to detect if point inside the square in one dimension
            r `div` d == r `div` (d + s)
            where
                r = p `rem` (s + d)             -- Need to use the remainder in order for ssr function to work

drawSquares :: DrawingSize
    -> DrawingSettings
    -> (DrawingSize                             -- ^ Coloring function
        -> (Int, Int) 
        -> Pixel RGB Double)
    -> ((Int, Int) -> Pixel RGB Double)
drawSquares (dh, dw) (m, s, sh, sw) cf (y, x)
    | atMargin (dh, dw) m (y, x)                = PixelRGB 1.0 1.0 1.0
    | atSquare (dh, dw) (m, s, sh, sw) (y, x)   = cf (dh, dw) (y, x)
    | otherwise                                 = PixelRGB 1.0 1.0 1.0      -- Otherwise, inside the spaces

-- Coloring functions

degrade :: DrawingSize
    -> (Int, Int)
    -> Pixel RGB Double
degrade (dh, dw) (y, x) = PixelRGB 0.0 (fromIntegral y) (fromIntegral x) / fromIntegral (max dh dw)