rectangle.hs

#!/usr/bin/env stack
{- stack script --resolver lts-12.24 --package sdl2 -}

import Control.Concurrent
import SDL

main :: IO ()
main = do
  initialize [InitVideo]
  window <- createWindow mempty defaultWindow
  renderer <- createRenderer window (-1) defaultRenderer

  -- Draw a blue background
  rendererDrawColor renderer $= V4 0 0 255 255
  clear renderer

  -- Draw a green rectangle outline to a 100x60 texture
  rectTexture <- createTexture renderer RGBA8888 TextureAccessTarget (V2 100 60)
  rendererRenderTarget renderer $= Just rectTexture
  rendererDrawColor renderer $= V4 0 255 0 255
  drawRect renderer Nothing

  -- Copy the rectangle texture on top
  rendererRenderTarget renderer $= Nothing
  copyEx renderer rectTexture Nothing
    (Just (Rectangle (P (V2 100 100)) (V2 100 60))) 45 Nothing (V2 False False)

  -- Behold, it is black on the inside
  present renderer

  threadDelay 1000000

textureBlendMode rectTexture $= BlendAlphaBlend

#!/usr/bin/env stack
{- stack script --resolver lts-12.24 --package sdl2 -}

import Control.Concurrent
import Data.Function (fix)
import SDL

main :: IO ()
main = do
  initialize [InitVideo]
  window <- createWindow mempty defaultWindow
  renderer <- createRenderer window (-1) defaultRenderer

  -- Draw a blue background
  rendererDrawColor renderer $= V4 0 0 255 255
  clear renderer

  -- Draw a green rectangle outline to a 100x60 texture
  rectTexture <- createTexture renderer RGBA8888 TextureAccessTarget (V2 100 60)
  textureBlendMode rectTexture $= BlendAlphaBlend
  rendererRenderTarget renderer $= Just rectTexture
  rendererDrawColor renderer $= V4 0 255 0 255
  drawRect renderer Nothing

  -- Copy the rectangle texture on top
  rendererRenderTarget renderer $= Nothing
  copyEx renderer rectTexture Nothing
    (Just (Rectangle (P (V2 100 100)) (V2 100 60))) 45 Nothing (V2 False False)

  -- Behold, it is no longer black on the inside
  fix $ \loop -> do
    present renderer
    threadDelay 100000
    loop