{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ViewPatterns #-}

{-| Draw command list

This is the low-level list of polygons that ImGui functions are filling.

At the end of the frame, all command lists are passed to your @ImGuiIO::RenderDrawListFn@ function for rendering.

Each dear imgui window contains its own ImDrawList.

You can use 'getWindowDrawList' to access the current window draw list and draw custom primitives.

You can interleave normal ImGui calls and adding primitives to the current draw list.

In single viewport mode, top-left is == @GetMainViewport()->Pos@ (generally @0,0@),
bottom-right is == @GetMainViewport()->Pos+Size@ (generally io.DisplaySize).

You are totally free to apply whatever transformation matrix to want to the data
(depending on the use of the transformation you may want to apply it to ClipRect as well!).

__Important__: Primitives are always added to the list and not culled (culling is done at higher-level by ImGui functions),
if you use this API a lot consider coarse culling your drawn objects.
-}

module DearImGui.Raw.DrawList
  ( DrawList(..)
  , new
  , destroy

    -- * Primitives

    -- $primitives
  , addLine

  , addRect
  , addRectFilled
  , addRectFilledMultiColor

  , addQuad
  , addQuadFilled

  , addTriangle
  , addTriangleFilled

  , addCircle
  , addCircleFilled

  , addNgon
  , addNgonFilled

  , addText_
  , addText

  , addPolyLine
  , addConvexPolyFilled

  , addBezierCubic
  , addBezierQuadratic

    -- ** Image primitives

    -- $image
  , addImage
  , addImageQuad
  , addImageRounded

    -- * Stateful path API

    -- $stateful
  , pathClear
  , pathLineTo
  , pathLineToMergeDuplicate
  , pathFillConvex
  , pathStroke

  , pathArcTo
  , pathArcToFast

  , pathBezierCubicCurveTo
  , pathBezierQuadraticCurveTo

  , pathRect

    -- * Advanced

  -- , addCallback
  , addDrawCmd
  , cloneOutput

    -- * Internal state

  , pushClipRect
  , pushClipRectFullScreen
  , popClipRect
  , getClipRectMin
  , getClipRectMax

  , pushTextureID
  , popTextureID
  )
  where

import Control.Monad.IO.Class
  ( MonadIO, liftIO )
import Foreign hiding (new)
import Foreign.C

-- dear-imgui
import DearImGui.Raw.Context
  ( imguiContext )
import DearImGui.Enums
import DearImGui.Structs

-- inline-c
import qualified Language.C.Inline as C

-- inline-c-cpp
import qualified Language.C.Inline.Cpp as Cpp

C.context (Cpp.cppCtx <> C.bsCtx <> imguiContext)
C.include "imgui.h"
Cpp.using "namespace ImGui"

-- | A single draw command list.
-- Generally one per window, conceptually you may see this as a dynamic "mesh" builder.
newtype DrawList = DrawList (Ptr ImDrawList)

new :: MonadIO m => m DrawList
new :: forall (m :: * -> *). MonadIO m => m DrawList
new = IO DrawList -> m DrawList
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  Ptr ImDrawList -> DrawList
DrawList (Ptr ImDrawList -> DrawList) -> IO (Ptr ImDrawList) -> IO DrawList
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Ptr ImDrawList)
[C.block|
    ImDrawList* {
      return IM_NEW(ImDrawList(GetDrawListSharedData()));
    }
  |]

destroy :: MonadIO m => DrawList -> m ()
destroy :: forall (m :: * -> *). MonadIO m => DrawList -> m ()
destroy (DrawList Ptr ImDrawList
drawList) = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  [C.block|
    void {
      IM_DELETE($(ImDrawList* drawList));
    }
  |]


pushClipRect :: MonadIO m => DrawList -> Ptr ImVec2 -> Ptr ImVec2 -> CBool -> m ()
pushClipRect :: forall (m :: * -> *).
MonadIO m =>
DrawList -> Ptr ImVec2 -> Ptr ImVec2 -> CBool -> m ()
pushClipRect (DrawList Ptr ImDrawList
drawList) Ptr ImVec2
clip_rect_min Ptr ImVec2
clip_rect_max CBool
intersect_with_current_clip_rect = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  [C.block|
    void {
      $(ImDrawList* drawList)->PushClipRect(
        *$(ImVec2* clip_rect_min),
        *$(ImVec2* clip_rect_max),
        $(bool intersect_with_current_clip_rect)
      );
    }
  |]

pushClipRectFullScreen :: MonadIO m => DrawList -> m ()
pushClipRectFullScreen :: forall (m :: * -> *). MonadIO m => DrawList -> m ()
pushClipRectFullScreen (DrawList Ptr ImDrawList
drawList) = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  [C.block|
    void {
      $(ImDrawList* drawList)->PushClipRectFullScreen();
    }
  |]

popClipRect :: MonadIO m => DrawList -> m ()
popClipRect :: forall (m :: * -> *). MonadIO m => DrawList -> m ()
popClipRect (DrawList Ptr ImDrawList
drawList) = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  [C.block|
    void {
      $(ImDrawList* drawList)->PopClipRect();
    }
  |]


getClipRectMin :: MonadIO m => DrawList -> m ImVec2
getClipRectMin :: forall (m :: * -> *). MonadIO m => DrawList -> m ImVec2
getClipRectMin (DrawList Ptr ImDrawList
drawList) = IO ImVec2 -> m ImVec2
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  (Ptr ImVec2 -> IO ()) -> IO ImVec2
forall a. Storable a => (Ptr a -> IO ()) -> IO a
C.withPtr_ \Ptr ImVec2
ptr ->
    [C.block|
      void {
        *$(ImVec2 * ptr) = $(ImDrawList* drawList)->GetClipRectMin();
      }
    |]

getClipRectMax :: MonadIO m => DrawList -> m ImVec2
getClipRectMax :: forall (m :: * -> *). MonadIO m => DrawList -> m ImVec2
getClipRectMax (DrawList Ptr ImDrawList
drawList) = IO ImVec2 -> m ImVec2
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  (Ptr ImVec2 -> IO ()) -> IO ImVec2
forall a. Storable a => (Ptr a -> IO ()) -> IO a
C.withPtr_ \Ptr ImVec2
ptr ->
    [C.block|
      void {
        *$(ImVec2 * ptr) = $(ImDrawList* drawList)->GetClipRectMax();
      }
    |]


pushTextureID :: MonadIO m => DrawList -> Ptr () -> m ()
pushTextureID :: forall (m :: * -> *). MonadIO m => DrawList -> Ptr () -> m ()
pushTextureID (DrawList Ptr ImDrawList
drawList) Ptr ()
userTextureIDPtr = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  [C.block|
    void {
      $(ImDrawList* drawList)->PushTextureID(
        $(void* userTextureIDPtr)
      );
    }
  |]

popTextureID :: MonadIO m => DrawList -> m ()
popTextureID :: forall (m :: * -> *). MonadIO m => DrawList -> m ()
popTextureID (DrawList Ptr ImDrawList
drawList) = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  [C.block|
    void {
      $(ImDrawList* drawList)->PopTextureID();
    }
  |]


{- $primitives
- For rectangular primitives, @p_min@ and @p_max@ represent the upper-left and lower-right corners.
- For circle primitives, use @num_segments == 0@ to automatically calculate tessellation (preferred).
  In older versions (until Dear ImGui 1.77) the 'addCircle' functions defaulted to num_segments == 12.
  In future versions we will use textures to provide cheaper and higher-quality circles.
  Use 'addNgon' and 'addNgonFilled' functions if you need to guaranteed a specific number of sides.
-}

addLine :: MonadIO m => DrawList -> Ptr ImVec2 -> Ptr ImVec2 -> ImU32 -> CFloat -> m ()
addLine :: forall (m :: * -> *).
MonadIO m =>
DrawList -> Ptr ImVec2 -> Ptr ImVec2 -> ImU32 -> CFloat -> m ()
addLine (DrawList Ptr ImDrawList
drawList) Ptr ImVec2
p1 Ptr ImVec2
p2 ImU32
col CFloat
thickness = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  [C.block|
    void {
      $(ImDrawList* drawList)->AddLine(
        *$(ImVec2* p1),
        *$(ImVec2* p2),
        $(ImU32 col),
        $(float thickness)
      );
    }
  |]


addRect :: MonadIO m => DrawList -> Ptr ImVec2 -> Ptr ImVec2 -> ImU32 -> CFloat -> ImDrawFlags -> CFloat -> m ()
addRect :: forall (m :: * -> *).
MonadIO m =>
DrawList
-> Ptr ImVec2
-> Ptr ImVec2
-> ImU32
-> CFloat
-> ImDrawFlags
-> CFloat
-> m ()
addRect (DrawList Ptr ImDrawList
drawList) Ptr ImVec2
p_min Ptr ImVec2
p_max ImU32
col CFloat
rounding ImDrawFlags
flags CFloat
thickness = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  [C.block|
    void {
      $(ImDrawList* drawList)->AddRect(
        *$(ImVec2* p_min),
        *$(ImVec2* p_max),
        $(ImU32 col),
        $(float rounding),
        $(ImDrawFlags flags),
        $(float thickness)
      );
    }
  |]

addRectFilled :: MonadIO m => DrawList -> Ptr ImVec2 -> Ptr ImVec2 -> ImU32 -> CFloat -> ImDrawFlags -> m ()
addRectFilled :: forall (m :: * -> *).
MonadIO m =>
DrawList
-> Ptr ImVec2
-> Ptr ImVec2
-> ImU32
-> CFloat
-> ImDrawFlags
-> m ()
addRectFilled (DrawList Ptr ImDrawList
drawList) Ptr ImVec2
p_min Ptr ImVec2
p_max ImU32
col CFloat
rounding ImDrawFlags
flags = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  [C.block|
    void {
      $(ImDrawList* drawList)->AddRectFilled(
        *$(ImVec2* p_min),
        *$(ImVec2* p_max),
        $(ImU32 col),
        $(float rounding),
        $(ImDrawFlags flags)
      );
    }
  |]

addRectFilledMultiColor :: MonadIO m => DrawList -> Ptr ImVec2 -> Ptr ImVec2 -> ImU32 -> ImU32 -> ImU32 -> ImU32 -> m ()
addRectFilledMultiColor :: forall (m :: * -> *).
MonadIO m =>
DrawList
-> Ptr ImVec2
-> Ptr ImVec2
-> ImU32
-> ImU32
-> ImU32
-> ImU32
-> m ()
addRectFilledMultiColor (DrawList Ptr ImDrawList
drawList) Ptr ImVec2
p_min Ptr ImVec2
p_max ImU32
col_upr_left ImU32
col_upr_right ImU32
col_bot_right ImU32
col_bot_left = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  [C.block|
    void {
      $(ImDrawList* drawList)->AddRectFilledMultiColor(
        *$(ImVec2* p_min),
        *$(ImVec2* p_max),
        $(ImU32 col_upr_left),
        $(ImU32 col_upr_right),
        $(ImU32 col_bot_right),
        $(ImU32 col_bot_left)
      );
    }
  |]


addQuad :: MonadIO m => DrawList -> Ptr ImVec2 -> Ptr ImVec2 -> Ptr ImVec2 -> Ptr ImVec2 -> ImU32 -> CFloat -> m ()
addQuad :: forall (m :: * -> *).
MonadIO m =>
DrawList
-> Ptr ImVec2
-> Ptr ImVec2
-> Ptr ImVec2
-> Ptr ImVec2
-> ImU32
-> CFloat
-> m ()
addQuad (DrawList Ptr ImDrawList
drawList) Ptr ImVec2
p1 Ptr ImVec2
p2 Ptr ImVec2
p3 Ptr ImVec2
p4 ImU32
col CFloat
thickness = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  [C.block|
    void {
      $(ImDrawList* drawList)->AddQuad(
        *$(ImVec2* p1),
        *$(ImVec2* p2),
        *$(ImVec2* p3),
        *$(ImVec2* p4),
        $(ImU32 col),
        $(float thickness)
      );
    }
  |]

addQuadFilled :: MonadIO m => DrawList -> Ptr ImVec2 -> Ptr ImVec2 -> Ptr ImVec2 -> Ptr ImVec2 -> ImU32 -> m ()
addQuadFilled :: forall (m :: * -> *).
MonadIO m =>
DrawList
-> Ptr ImVec2
-> Ptr ImVec2
-> Ptr ImVec2
-> Ptr ImVec2
-> ImU32
-> m ()
addQuadFilled (DrawList Ptr ImDrawList
drawList) Ptr ImVec2
p1 Ptr ImVec2
p2 Ptr ImVec2
p3 Ptr ImVec2
p4 ImU32
col = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  [C.block|
    void {
      $(ImDrawList* drawList)->AddQuadFilled(
        *$(ImVec2* p1),
        *$(ImVec2* p2),
        *$(ImVec2* p3),
        *$(ImVec2* p4),
        $(ImU32 col)
      );
    }
  |]


addTriangle :: MonadIO m => DrawList -> Ptr ImVec2 -> Ptr ImVec2 -> Ptr ImVec2 -> ImU32 -> CFloat -> m ()
addTriangle :: forall (m :: * -> *).
MonadIO m =>
DrawList
-> Ptr ImVec2
-> Ptr ImVec2
-> Ptr ImVec2
-> ImU32
-> CFloat
-> m ()
addTriangle (DrawList Ptr ImDrawList
drawList) Ptr ImVec2
p1 Ptr ImVec2
p2 Ptr ImVec2
p3 ImU32
col CFloat
thickness = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  [C.block|
    void {
      $(ImDrawList* drawList)->AddTriangle(
        *$(ImVec2* p1),
        *$(ImVec2* p2),
        *$(ImVec2* p3),
        $(ImU32 col),
        $(float thickness)
      );
    }
  |]

addTriangleFilled :: MonadIO m => DrawList -> Ptr ImVec2 -> Ptr ImVec2 -> Ptr ImVec2 -> ImU32 -> m ()
addTriangleFilled :: forall (m :: * -> *).
MonadIO m =>
DrawList -> Ptr ImVec2 -> Ptr ImVec2 -> Ptr ImVec2 -> ImU32 -> m ()
addTriangleFilled (DrawList Ptr ImDrawList
drawList) Ptr ImVec2
p1 Ptr ImVec2
p2 Ptr ImVec2
p3 ImU32
col = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  [C.block|
    void {
      $(ImDrawList* drawList)->AddTriangleFilled(
        *$(ImVec2* p1),
        *$(ImVec2* p2),
        *$(ImVec2* p3),
        $(ImU32 col)
      );
    }
  |]


addCircle :: MonadIO m => DrawList -> Ptr ImVec2 -> CFloat -> ImU32 -> CInt -> CFloat -> m ()
addCircle :: forall (m :: * -> *).
MonadIO m =>
DrawList -> Ptr ImVec2 -> CFloat -> ImU32 -> CInt -> CFloat -> m ()
addCircle (DrawList Ptr ImDrawList
drawList) Ptr ImVec2
center CFloat
radius ImU32
col CInt
num_segments CFloat
thickness = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  [C.block|
    void {
      $(ImDrawList* drawList)->AddCircle(
        *$(ImVec2* center),
        $(float radius),
        $(ImU32 col),
        $(int num_segments),
        $(float thickness)
      );
    }
  |]

addCircleFilled :: MonadIO m => DrawList -> Ptr ImVec2 -> CFloat -> ImU32 -> CInt -> m ()
addCircleFilled :: forall (m :: * -> *).
MonadIO m =>
DrawList -> Ptr ImVec2 -> CFloat -> ImU32 -> CInt -> m ()
addCircleFilled (DrawList Ptr ImDrawList
drawList) Ptr ImVec2
center CFloat
radius ImU32
col CInt
num_segments = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  [C.block|
    void {
      $(ImDrawList* drawList)->AddCircleFilled(
        *$(ImVec2* center),
        $(float radius),
        $(ImU32 col),
        $(int num_segments)
      );
    }
  |]


addNgon :: MonadIO m => DrawList -> Ptr ImVec2 -> CFloat -> ImU32 -> CInt -> CFloat -> m ()
addNgon :: forall (m :: * -> *).
MonadIO m =>
DrawList -> Ptr ImVec2 -> CFloat -> ImU32 -> CInt -> CFloat -> m ()
addNgon (DrawList Ptr ImDrawList
drawList) Ptr ImVec2
center CFloat
radius ImU32
col CInt
num_segments CFloat
thickness = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  [C.block|
    void {
      $(ImDrawList* drawList)->AddNgon(
        *$(ImVec2* center),
        $(float radius),
        $(ImU32 col),
        $(int num_segments),
        $(float thickness)
      );
    }
  |]

addNgonFilled :: MonadIO m => DrawList -> Ptr ImVec2 -> CFloat -> ImU32 -> CInt -> m ()
addNgonFilled :: forall (m :: * -> *).
MonadIO m =>
DrawList -> Ptr ImVec2 -> CFloat -> ImU32 -> CInt -> m ()
addNgonFilled (DrawList Ptr ImDrawList
drawList) Ptr ImVec2
center CFloat
radius ImU32
col CInt
num_segments = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  [C.block|
    void {
      $(ImDrawList* drawList)->AddNgonFilled(
        *$(ImVec2* center),
        $(float radius),
        $(ImU32 col),
        $(int num_segments)
      );
    }
  |]


addText_ :: MonadIO m => DrawList -> Ptr ImVec2 -> ImU32 -> CString -> CString -> m ()
addText_ :: forall (m :: * -> *).
MonadIO m =>
DrawList -> Ptr ImVec2 -> ImU32 -> CString -> CString -> m ()
addText_ (DrawList Ptr ImDrawList
drawList) Ptr ImVec2
pos ImU32
col CString
text_begin CString
text_end = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  [C.block|
    void {
      $(ImDrawList* drawList)->AddText(
        *$(ImVec2* pos),
        $(ImU32 col),
        $(char* text_begin),
        $(char* text_end)
      );
    }
  |]

addText :: MonadIO m => DrawList -> Ptr ImFont -> CFloat -> Ptr ImVec2 -> ImU32 -> CString -> CString -> CFloat -> Ptr ImVec4 -> m ()
addText :: forall (m :: * -> *).
MonadIO m =>
DrawList
-> Ptr ImFont
-> CFloat
-> Ptr ImVec2
-> ImU32
-> CString
-> CString
-> CFloat
-> Ptr ImVec4
-> m ()
addText (DrawList Ptr ImDrawList
drawList) Ptr ImFont
fontPtr CFloat
font_size Ptr ImVec2
pos ImU32
col CString
text_begin CString
text_end CFloat
wrap_width Ptr ImVec4
cpu_fine_clip_rect = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  [C.block|
    void {
      $(ImDrawList* drawList)->AddText(
        $(ImFont* fontPtr),
        $(float font_size),
        *$(ImVec2* pos),
        $(ImU32 col),
        $(char* text_begin),
        $(char* text_end),
        $(float wrap_width),
        $(ImVec4* cpu_fine_clip_rect)
      );
    }
  |]


addPolyLine :: MonadIO m => DrawList -> Ptr ImVec2 -> CInt -> ImU32 -> ImDrawFlags -> CFloat -> m ()
addPolyLine :: forall (m :: * -> *).
MonadIO m =>
DrawList
-> Ptr ImVec2 -> CInt -> ImU32 -> ImDrawFlags -> CFloat -> m ()
addPolyLine (DrawList Ptr ImDrawList
drawList) Ptr ImVec2
points CInt
num_points ImU32
col ImDrawFlags
flags CFloat
thickness = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  [C.block|
    void {
      $(ImDrawList* drawList)->AddPolyline(
        $(ImVec2* points),
        $(int num_points),
        $(ImU32 col),
        $(ImDrawFlags flags),
        $(float thickness)
      );
    }
  |]

addConvexPolyFilled :: MonadIO m => DrawList -> Ptr ImVec2 -> CInt -> ImU32 -> m ()
addConvexPolyFilled :: forall (m :: * -> *).
MonadIO m =>
DrawList -> Ptr ImVec2 -> CInt -> ImU32 -> m ()
addConvexPolyFilled (DrawList Ptr ImDrawList
drawList) Ptr ImVec2
points CInt
num_points ImU32
col = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  [C.block|
    void {
      $(ImDrawList* drawList)->AddConvexPolyFilled(
        $(ImVec2* points),
        $(int num_points),
        $(ImU32 col)
      );
    }
  |]


addBezierCubic
  :: MonadIO m
  => DrawList
  -> Ptr ImVec2 -> Ptr ImVec2 -> Ptr ImVec2 -> Ptr ImVec2 -- Positions (control points)
  -> ImU32
  -> CFloat
  -> CInt
  -> m ()
addBezierCubic :: forall (m :: * -> *).
MonadIO m =>
DrawList
-> Ptr ImVec2
-> Ptr ImVec2
-> Ptr ImVec2
-> Ptr ImVec2
-> ImU32
-> CFloat
-> CInt
-> m ()
addBezierCubic (DrawList Ptr ImDrawList
drawList) Ptr ImVec2
p1 Ptr ImVec2
p2 Ptr ImVec2
p3 Ptr ImVec2
p4 ImU32
col CFloat
thickness CInt
numSegments = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  [C.block|
    void {
      $(ImDrawList* drawList)->AddBezierCubic(
        *$(ImVec2* p1),
        *$(ImVec2* p2),
        *$(ImVec2* p3),
        *$(ImVec2* p4),
        $(ImU32 col),
        $(float thickness),
        $(int numSegments)
      );
    }
  |]

addBezierQuadratic
  :: MonadIO m
  => DrawList
  -> Ptr ImVec2 -> Ptr ImVec2 -> Ptr ImVec2 -- Positions (control points)
  -> ImU32
  -> CFloat
  -> CInt
  -> m ()
addBezierQuadratic :: forall (m :: * -> *).
MonadIO m =>
DrawList
-> Ptr ImVec2
-> Ptr ImVec2
-> Ptr ImVec2
-> ImU32
-> CFloat
-> CInt
-> m ()
addBezierQuadratic (DrawList Ptr ImDrawList
drawList) Ptr ImVec2
p1 Ptr ImVec2
p2 Ptr ImVec2
p3 ImU32
col CFloat
thickness CInt
numSegments = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  [C.block|
    void {
      $(ImDrawList* drawList)->AddBezierQuadratic(
        *$(ImVec2* p1),
        *$(ImVec2* p2),
        *$(ImVec2* p3),
        $(ImU32 col),
        $(float thickness),
        $(int numSegments)
      );
    }
  |]


{- $image
* Read FAQ to understand what @ImTextureID@ is.
* @p_min@ and @p_max@ represent the upper-left and lower-right corners of the rectangle.
* @uv_min@ and @uv_max@ represent the normalized texture coordinates to use for those corners.
  Using @(0,0)->(1,1)@ texture coordinates will generally display the entire texture.
-}

addImage
  :: MonadIO m
  => DrawList
  -> Ptr ()
  -> Ptr ImVec2 -> Ptr ImVec2 -- Positions
  -> Ptr ImVec2 -> Ptr ImVec2 -- UVs
  -> ImU32
  -> m ()
addImage :: forall (m :: * -> *).
MonadIO m =>
DrawList
-> Ptr ()
-> Ptr ImVec2
-> Ptr ImVec2
-> Ptr ImVec2
-> Ptr ImVec2
-> ImU32
-> m ()
addImage (DrawList Ptr ImDrawList
drawList) Ptr ()
userTextureIDPtr Ptr ImVec2
p_min Ptr ImVec2
p_max Ptr ImVec2
uv_min Ptr ImVec2
uv_max ImU32
col = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  [C.block|
    void {
      $(ImDrawList* drawList)->AddImage(
        $(void* userTextureIDPtr),
        *$(ImVec2* p_min),
        *$(ImVec2* p_max),
        *$(ImVec2* uv_min),
        *$(ImVec2* uv_max),
        $(ImU32 col)
      );
    }
  |]

addImageQuad
  :: MonadIO m
  => DrawList
  -> Ptr ()
  -> Ptr ImVec2 -> Ptr ImVec2 -> Ptr ImVec2 -> Ptr ImVec2 -- Positions
  -> Ptr ImVec2 -> Ptr ImVec2 -> Ptr ImVec2 -> Ptr ImVec2 -- UVs
  -> ImU32
  -> m ()
addImageQuad :: forall (m :: * -> *).
MonadIO m =>
DrawList
-> Ptr ()
-> Ptr ImVec2
-> Ptr ImVec2
-> Ptr ImVec2
-> Ptr ImVec2
-> Ptr ImVec2
-> Ptr ImVec2
-> Ptr ImVec2
-> Ptr ImVec2
-> ImU32
-> m ()
addImageQuad (DrawList Ptr ImDrawList
drawList) Ptr ()
userTextureIDPtr Ptr ImVec2
p1 Ptr ImVec2
p2 Ptr ImVec2
p3 Ptr ImVec2
p4 Ptr ImVec2
uv1 Ptr ImVec2
uv2 Ptr ImVec2
uv3 Ptr ImVec2
uv4 ImU32
col = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  [C.block|
    void {
      $(ImDrawList* drawList)->AddImageQuad(
        $(void* userTextureIDPtr),
        *$(ImVec2* p1),
        *$(ImVec2* p2),
        *$(ImVec2* p3),
        *$(ImVec2* p4),
        *$(ImVec2* uv1),
        *$(ImVec2* uv2),
        *$(ImVec2* uv3),
        *$(ImVec2* uv4),
        $(ImU32 col)
      );
    }
  |]

addImageRounded
  :: MonadIO m
  => DrawList
  -> Ptr ()
  -> Ptr ImVec2 -> Ptr ImVec2 -- Positions
  -> Ptr ImVec2 -> Ptr ImVec2 -- UVs
  -> ImU32
  -> CFloat
  -> ImDrawFlags
  -> m ()
addImageRounded :: forall (m :: * -> *).
MonadIO m =>
DrawList
-> Ptr ()
-> Ptr ImVec2
-> Ptr ImVec2
-> Ptr ImVec2
-> Ptr ImVec2
-> ImU32
-> CFloat
-> ImDrawFlags
-> m ()
addImageRounded (DrawList Ptr ImDrawList
drawList) Ptr ()
userTextureIDPtr Ptr ImVec2
p_min Ptr ImVec2
p_max Ptr ImVec2
uv_min Ptr ImVec2
uv_max ImU32
col CFloat
rounding ImDrawFlags
flags = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  [C.block|
    void {
      $(ImDrawList* drawList)->AddImageRounded(
        $(void* userTextureIDPtr),
        *$(ImVec2* p_min),
        *$(ImVec2* p_max),
        *$(ImVec2* uv_min),
        *$(ImVec2* uv_max),
        $(ImU32 col),
        $(float rounding),
        $(ImDrawFlags flags)
      );
    }
  |]

{- $stateful
Add points then finish with 'pathFillConvex' or 'pathStroke'.
-}

pathClear :: MonadIO m => DrawList -> m ()
pathClear :: forall (m :: * -> *). MonadIO m => DrawList -> m ()
pathClear (DrawList Ptr ImDrawList
drawList) = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  [C.block|
    void {
      $(ImDrawList* drawList)->PathClear();
    }
  |]

pathLineTo :: MonadIO m => DrawList -> Ptr ImVec2 -> m ()
pathLineTo :: forall (m :: * -> *). MonadIO m => DrawList -> Ptr ImVec2 -> m ()
pathLineTo (DrawList Ptr ImDrawList
drawList) Ptr ImVec2
pos = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  [C.block|
    void {
      $(ImDrawList* drawList)->PathLineTo(
        *$(ImVec2* pos)
      );
    }
  |]

pathLineToMergeDuplicate :: MonadIO m => DrawList -> Ptr ImVec2 -> m ()
pathLineToMergeDuplicate :: forall (m :: * -> *). MonadIO m => DrawList -> Ptr ImVec2 -> m ()
pathLineToMergeDuplicate (DrawList Ptr ImDrawList
drawList) Ptr ImVec2
pos = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  [C.block|
    void {
      $(ImDrawList* drawList)->PathLineToMergeDuplicate(
        *$(ImVec2* pos)
      );
    }
  |]

-- | Note: Anti-aliased filling requires points to be in clockwise order.
pathFillConvex :: MonadIO m => DrawList -> ImU32 -> m ()
pathFillConvex :: forall (m :: * -> *). MonadIO m => DrawList -> ImU32 -> m ()
pathFillConvex (DrawList Ptr ImDrawList
drawList) ImU32
col = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  [C.block|
    void {
      $(ImDrawList* drawList)->PathFillConvex(
        $(ImU32 col)
      );
    }
  |]

pathStroke :: MonadIO m => DrawList -> ImU32 -> ImDrawFlags -> CFloat -> m ()
pathStroke :: forall (m :: * -> *).
MonadIO m =>
DrawList -> ImU32 -> ImDrawFlags -> CFloat -> m ()
pathStroke (DrawList Ptr ImDrawList
drawList) ImU32
col ImDrawFlags
flags CFloat
thickness = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  [C.block|
    void {
      $(ImDrawList* drawList)->PathStroke(
        $(ImU32 col),
        $(ImDrawFlags flags),
        $(float thickness)
      );
    }
  |]


pathArcTo :: MonadIO m => DrawList -> Ptr ImVec2 -> CFloat -> CFloat -> CFloat -> CInt -> m ()
pathArcTo :: forall (m :: * -> *).
MonadIO m =>
DrawList
-> Ptr ImVec2 -> CFloat -> CFloat -> CFloat -> CInt -> m ()
pathArcTo (DrawList Ptr ImDrawList
drawList) Ptr ImVec2
center CFloat
radius CFloat
a_min CFloat
a_max CInt
num_segments = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  [C.block|
    void {
      $(ImDrawList* drawList)->PathArcTo(
        *$(ImVec2* center),
        $(float radius),
        $(float a_min),
        $(float a_max),
        $(int num_segments)
      );
    }
  |]

-- | Use precomputed angles for a 12 steps circle.
pathArcToFast :: MonadIO m => DrawList -> Ptr ImVec2 -> CFloat -> CInt -> CInt -> m ()
pathArcToFast :: forall (m :: * -> *).
MonadIO m =>
DrawList -> Ptr ImVec2 -> CFloat -> CInt -> CInt -> m ()
pathArcToFast (DrawList Ptr ImDrawList
drawList) Ptr ImVec2
center CFloat
radius CInt
a_min_of_12 CInt
a_max_of_12 = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  [C.block|
    void {
      $(ImDrawList* drawList)->PathArcToFast(
        *$(ImVec2* center),
        $(float radius),
        $(int a_min_of_12),
        $(int a_max_of_12)
      );
    }
  |]


pathBezierCubicCurveTo
  :: MonadIO m
  => DrawList
  -> Ptr ImVec2
  -> Ptr ImVec2
  -> Ptr ImVec2
  -> CInt
  -> m ()
pathBezierCubicCurveTo :: forall (m :: * -> *).
MonadIO m =>
DrawList -> Ptr ImVec2 -> Ptr ImVec2 -> Ptr ImVec2 -> CInt -> m ()
pathBezierCubicCurveTo (DrawList Ptr ImDrawList
drawList) Ptr ImVec2
p1 Ptr ImVec2
p2 Ptr ImVec2
p3 CInt
num_segments = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  [C.block|
    void {
      $(ImDrawList* drawList)->PathBezierCubicCurveTo(
        *$(ImVec2* p1),
        *$(ImVec2* p2),
        *$(ImVec2* p3),
        $(int num_segments)
      );
    }
  |]

pathBezierQuadraticCurveTo
  :: MonadIO m
  => DrawList
  -> Ptr ImVec2
  -> Ptr ImVec2
  -> CInt
  -> m ()
pathBezierQuadraticCurveTo :: forall (m :: * -> *).
MonadIO m =>
DrawList -> Ptr ImVec2 -> Ptr ImVec2 -> CInt -> m ()
pathBezierQuadraticCurveTo (DrawList Ptr ImDrawList
drawList) Ptr ImVec2
p1 Ptr ImVec2
p2 CInt
num_segments = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  [C.block|
    void {
      $(ImDrawList* drawList)->PathBezierQuadraticCurveTo(
        *$(ImVec2* p1),
        *$(ImVec2* p2),
        $(int num_segments)
      );
    }
  |]


pathRect :: MonadIO m => DrawList -> Ptr ImVec2 -> Ptr ImVec2 -> CFloat -> ImDrawFlags -> m ()
pathRect :: forall (m :: * -> *).
MonadIO m =>
DrawList
-> Ptr ImVec2 -> Ptr ImVec2 -> CFloat -> ImDrawFlags -> m ()
pathRect (DrawList Ptr ImDrawList
drawList) Ptr ImVec2
rect_min Ptr ImVec2
rect_max CFloat
rounding ImDrawFlags
flags = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  [C.block|
    void {
      $(ImDrawList* drawList)->PathRect(
        *$(ImVec2* rect_min),
        *$(ImVec2* rect_max),
        $(float rounding),
        $(ImDrawFlags flags)
      );
    }
  |]


-- | This is useful if you need to forcefully create a new draw call (to allow for dependent rendering / blending).
-- Otherwise primitives are merged into the same draw-call as much as possible.
addDrawCmd :: MonadIO m => DrawList -> m ()
addDrawCmd :: forall (m :: * -> *). MonadIO m => DrawList -> m ()
addDrawCmd (DrawList Ptr ImDrawList
drawList) = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  [C.block|
    void {
      $(ImDrawList* drawList)->AddDrawCmd();
    }
  |]

-- | Create a clone of the CmdBuffer/IdxBuffer/VtxBuffer.
cloneOutput :: MonadIO m => DrawList -> m DrawList
cloneOutput :: forall (m :: * -> *). MonadIO m => DrawList -> m DrawList
cloneOutput (DrawList Ptr ImDrawList
drawList) = IO DrawList -> m DrawList
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  Ptr ImDrawList -> DrawList
DrawList (Ptr ImDrawList -> DrawList) -> IO (Ptr ImDrawList) -> IO DrawList
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [C.block|
    ImDrawList* {
      return $(ImDrawList* drawList)->CloneOutput();
    }
  |]