簡約!? λカ娘 Rock!の紹介とHaskell製Androidアプリの解説

module CubeVertices where

import AndroidNdk

vertices :: [GLfloat]
vertices = [
    -- front
    -0.5, 0.5, 0.5, 
    -0.5, -0.5, 0.5, 
    0.5, 0.5, 0.5,
    0.5, 0.5, 0.5, 
    -0.5, -0.5, 0.5, 
    0.5, -0.5, 0.5,
    -- right
    0.5, 0.5, 0.5, 
--snip--
colors :: [GLfloat]
colors = [
    -- front
    0.0625,0.57421875,0.92578125,1.0,
    0.0625,0.57421875,0.92578125,1.0,
    0.0625,0.57421875,0.92578125,1.0,
    0.0625,0.57421875,0.92578125,1.0,
    0.0625,0.57421875,0.92578125,1.0,
    0.0625,0.57421875,0.92578125,1.0,
    -- right
    0.29296875,0.66796875,0.92578125,1.0,

engineDrawFrame :: AndroidEngine -> IO ()
engineDrawFrame enghs = do
  let disp  = engEglDisplay enghs
      surf  = engEglSurface enghs
      w     = fromIntegral $ engWidth enghs
      h     = fromIntegral $ engHeight enghs
      s     = engState enghs
      dx    = fromIntegral $ sStateDx s
      dy    = fromIntegral $ sStateDy s
      angle = sStateAngle s
  when (disp /= c_EGL_NO_DISPLAY) $ do
    c_glClear $ c_GL_COLOR_BUFFER_BIT .|. c_GL_DEPTH_BUFFER_BIT
    withArray vertices $ \vp -> withArray colors $ \cp -> do -- xxx heavy
      c_glEnableClientState c_GL_VERTEX_ARRAY
      c_glEnableClientState c_GL_COLOR_ARRAY
      c_glVertexPointer 3 c_GL_FLOAT 0 vp
      c_glColorPointer 4 c_GL_FLOAT 0 cp
      c_glRotatef ((sqrt (dx ** 2 + dy ** 2)) / 10.0) dy dx 0.0
      c_glDrawArrays c_GL_TRIANGLES 0 36
      c_glDisableClientState c_GL_VERTEX_ARRAY
      c_glDisableClientState c_GL_COLOR_ARRAY
    void $ c_eglSwapBuffers disp surf

eHandleInput :: AndroidEngine -> AInputEventType -> AMotionEventAction -> (Float, Float) -> IO (Maybe AndroidEngine)
eHandleInput eng = go
  where go AInputEventTypeMotion AMotionEventActionUp _ = return Nothing
        go AInputEventTypeMotion act (x,y) = do
          let stat = engState eng
              ox = if act == AMotionEventActionDown then x else fromIntegral $ sStateX stat
              oy = if act == AMotionEventActionDown then y else fromIntegral $ sStateY stat
          return (Just $ eng { engAnimating = 1
                             , engState = stat { sStateX  = truncate x
                                               , sStateY  = truncate y
                                               , sStateDx = truncate $ x - ox
                                               , sStateDy = truncate $ y - oy } })
        go _ _ _ = return Nothing

eHandleCmd :: (AndroidApp, AndroidEngine) -> AAppCmd -> IO (Maybe AndroidApp, Maybe AndroidEngine)
eHandleCmd (app, eng) = go
  where go AAppCmdSaveState = do
          sstat <- malloc
          poke sstat $ engState eng
          return (Just $ app { appSavedState = sstat
                             , appSavedStateSize = toEnum $ sizeOf $ engState eng }, Nothing)
        go AAppCmdInitWindow | appWindow app /= nullPtr = do
          (Just eng') <- initDisplayHs androidActs eng
          engineDrawFrame eng'
          return (Nothing, Just eng')
        go AAppCmdTermWindow = do
          eng' <- engineTermDisplay eng
          return (Nothing, Just eng')
        go AAppCmdGainedFocus | engAccelerometerSensor eng /= nullPtr = do
          c_ASensorEventQueue_enableSensor (engSensorEventQueue eng) (engAccelerometerSensor eng)
          c_ASensorEventQueue_setEventRate (engSensorEventQueue eng) (engAccelerometerSensor eng) ((1000 `div` 60) * 1000)
          return (Nothing, Nothing)
        go AAppCmdLostFocus = do
          when (engAccelerometerSensor eng /= nullPtr) $ void $
            c_ASensorEventQueue_disableSensor (engSensorEventQueue eng) (engAccelerometerSensor eng)
          let eng' = eng { engAnimating = 0 }
          engineDrawFrame eng'
          return (Nothing, Just eng')
        go _ = return (Nothing, Nothing)

androidActs :: AndroidNdkActs
androidActs = AndroidNdkActs { drawFrame = engineDrawFrame
                             , initDisplay = engineInitDisplay
                             , handleInput = eHandleInput
                             , handleCmd = eHandleCmd }

foreign export ccall "engineHandleInput" engineHandleInput :: FuncHandleInput
foreign import ccall "&engineHandleInput" p_engineHandleInput :: FunPtr FuncHandleInput
engineHandleInput :: FuncHandleInput
engineHandleInput = handleInputHs androidActs

foreign export ccall "engineHandleCmd" engineHandleCmd :: FuncHandleCmd
foreign import ccall "&engineHandleCmd" p_engineHandleCmd :: FunPtr FuncHandleCmd
engineHandleCmd :: FuncHandleCmd
engineHandleCmd = handleCmdHs androidAct

--snip--
foreign export ccall "androidMain" androidMain :: Ptr AndroidApp -> IO ()
androidMain :: Ptr AndroidApp -> IO ()
androidMain = androidMainHs androidActs p_engineHandleInput p_engineHandleCmd

void android_main(struct android_app* state) {
	app_dummy(); // Make sure glue isn't stripped.

	// Init & run Haskell code.
	int hsargc = 1;
	char *hsargv = "q";
	char **hsargvp = &hsargv;

	hs_init(&hsargc, &hsargvp);
	androidMain(state);
	hs_exit();
}