module Graphics.Window
import public Graphics.Window.Event
import Graphics.Window.Event.FromRaw as FromRaw
import Winit.FFI as FFI
import Data.Buffer
import Derive.Prelude
import System.FFI
%language ElabReflection
export
EventLoop : Type
EventLoop = FFI.RawEventLoop
public export
WindowId : Type
WindowId = FFI.RawWindowId
export
WindowEvent : Type
WindowEvent = FFI.RawWindowEvent
public export
WindowEventKind : Type
WindowEventKind = FFI.RawWindowEventKind
export
windowEventTag : WindowEvent -> FFI.RawWindowEventTag
windowEventTag = FFI.windowEventTag
-- Unsafe: `EventLoop` memory is only cleaned up when passed into `prim__runApp`
unsafeMkEventLoop : HasIO io => io EventLoop
unsafeMkEventLoop = primIO prim__mkEventLoop
namespace InitAction
public export
data T =
CreateWindow
initActionFromRaw : FFI.RawInitActionTag -> InitAction.T
initActionFromRaw tag = case tag of
0 => CreateWindow
tag => assert_total $ idris_crash $ "Unexpected InitAction tag: " ++ show tag
initActionToRaw : InitAction.T -> FFI.RawInitActionTag
initActionToRaw action = case action of
CreateWindow => 0
public export
record InitActions where
constructor MkInitActions
fst : InitAction.T
rest : List InitAction.T
initActionsToRaw : InitActions -> Ptr FFI.RawInitActions
initActionsToRaw actions =
let
MkInitActions fst rest = actions
fst = initActionToRaw fst
in case rest of
[] => FFI.initActionsSingleton fst
_ => assert_total $ idris_crash $ "TODO: non-empty InitActions.rest"
namespace EventAction
public export
data T =
CreateWindow |
CloseWindow |
Exit
eventActionToRaw : EventAction.T -> FFI.RawEventActionTag
eventActionToRaw action = case action of
CreateWindow => 0
CloseWindow => 1
Exit => 2
public export
record EventActions where
constructor MkEventActions
actions : List EventAction.T
-- Unsafe: `RawEventActions` memory is only cleaned up when passed into
-- `prim__runApp` event handler
%unsafe
unsafeEventActionsToRaw : EventActions -> Ptr FFI.RawEventActions
unsafeEventActionsToRaw actions =
let MkEventActions actions = actions
in case actions of
[] => FFI.eventActionsEmpty
[one] => FFI.eventActionsPush FFI.eventActionsEmpty $ eventActionToRaw one
_ => assert_total $ idris_crash $ "TODO: multiple EventActions"
export
runApp : HasIO io =>
(IO InitActions) -> (WindowId -> WindowEvent.T -> IO EventActions) -> io ()
runApp init onWindowEvent = do
eventLoop <- unsafeMkEventLoop
primIO $ FFI.prim__runApp
eventLoop
(toPrim $ initActionsToRaw <$> init)
(\windowId, event =>
let
event = FromRaw.windowEvent event
in
toPrim $ unsafeEventActionsToRaw <$> onWindowEvent windowId event
)