{-# LINE 2 "./Graphics/UI/Gtk/Gdk/Keys.chs" #-}
{-# LANGUAGE OverloadedStrings #-}

{-# LINE 3 "./Graphics/UI/Gtk/Gdk/Keys.chs" #-}
-- -*-haskell-*-
-- GIMP Toolkit (GTK) Keys
--
-- Author : Jens Petersen
--
-- Created: 24 May 2002
--
-- Copyright (C) 2002-2005 Jens Petersen
--
-- This library is free software; you can redistribute it and/or
-- modify it under the terms of the GNU Lesser General Public
-- License as published by the Free Software Foundation; either
-- version 2.1 of the License, or (at your option) any later version.
--
-- This library is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-- Lesser General Public License for more details.
-- #prune

-- |
-- Maintainer : gtk2hs-users@lists.sourceforge.net
-- Stability : provisional
-- Portability : portable (depends on GHC)
--
-- A 'KeyVal' is a numeric value identifying a keyboard key. The defined
-- values can be found at <http:
-- The names of the keys are the names of the macros without the prefix.
--
module Graphics.UI.Gtk.Gdk.Keys (
  KeyVal,
  KeyCode,
  keyName,
  keyFromName,
  keyToChar,

  keyvalName,
  keyvalFromName,
  keyvalToChar,
  keyvalConvertCase,
  keyvalToUpper,
  keyvalToLower,
  keyvalIsUpper,
  keyvalIsLower,
  ) where

import Control.Monad (liftM)

import System.Glib.FFI
import System.Glib.UTFString


{-# LINE 55 "./Graphics/UI/Gtk/Gdk/Keys.chs" #-}

-- | Key values are the codes which are sent whenever a key is pressed or
-- released.
--
type KeyVal = Word32
type KeyCode = Word16

-- | Converts a key value into a symbolic name.
--
keyName :: KeyVal -> DefaultGlibString
keyName :: KeyVal -> DefaultGlibString
keyName KeyVal
k = IO DefaultGlibString -> DefaultGlibString
forall a. IO a -> a
unsafePerformIO (IO DefaultGlibString -> DefaultGlibString)
-> IO DefaultGlibString -> DefaultGlibString
forall a b. (a -> b) -> a -> b
$ KeyVal -> IO DefaultGlibString
keyvalName KeyVal
k

-- | Converts a key name to a key value.
--
keyFromName :: DefaultGlibString -> KeyVal
keyFromName :: DefaultGlibString -> KeyVal
keyFromName DefaultGlibString
k = IO KeyVal -> KeyVal
forall a. IO a -> a
unsafePerformIO (IO KeyVal -> KeyVal) -> IO KeyVal -> KeyVal
forall a b. (a -> b) -> a -> b
$ DefaultGlibString -> IO KeyVal
keyvalFromName DefaultGlibString
k

-- | Convert from a Gdk key symbol to the corresponding Unicode character.
--
keyToChar ::
    KeyVal -- ^ @keyval@ - a Gdk key symbol
 -> Maybe Char -- ^ returns the corresponding unicode character, or
               -- Nothing if there is no corresponding character.
keyToChar :: KeyVal -> Maybe Char
keyToChar KeyVal
k = IO (Maybe Char) -> Maybe Char
forall a. IO a -> a
unsafePerformIO (IO (Maybe Char) -> Maybe Char) -> IO (Maybe Char) -> Maybe Char
forall a b. (a -> b) -> a -> b
$ KeyVal -> IO (Maybe Char)
keyvalToChar KeyVal
k

keyvalName :: KeyVal -> IO DefaultGlibString
keyvalName :: KeyVal -> IO DefaultGlibString
keyvalName KeyVal
keyval = do
  Ptr CChar
strPtr <- CUInt -> IO (Ptr CChar)
gdk_keyval_name (KeyVal -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral KeyVal
keyval)
  if Ptr CChar
strPtrPtr CChar -> Ptr CChar -> Bool
forall a. Eq a => a -> a -> Bool
==Ptr CChar
forall a. Ptr a
nullPtr then DefaultGlibString -> IO DefaultGlibString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return DefaultGlibString
"" else Ptr CChar -> IO DefaultGlibString
forall s. GlibString s => Ptr CChar -> IO s
peekUTFString Ptr CChar
strPtr

keyvalFromName :: DefaultGlibString -> IO KeyVal
keyvalFromName :: DefaultGlibString -> IO KeyVal
keyvalFromName DefaultGlibString
keyvalName =
  (CUInt -> KeyVal) -> IO CUInt -> IO KeyVal
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CUInt -> KeyVal
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CUInt -> IO KeyVal) -> IO CUInt -> IO KeyVal
forall a b. (a -> b) -> a -> b
$
  DefaultGlibString -> (Ptr CChar -> IO CUInt) -> IO CUInt
forall s a. GlibString s => s -> (Ptr CChar -> IO a) -> IO a
forall a. DefaultGlibString -> (Ptr CChar -> IO a) -> IO a
withUTFString DefaultGlibString
keyvalName ((Ptr CChar -> IO CUInt) -> IO CUInt)
-> (Ptr CChar -> IO CUInt) -> IO CUInt
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
keyvalNamePtr ->
  Ptr CChar -> IO CUInt
gdk_keyval_from_name
{-# LINE 90 "./Graphics/UI/Gtk/Gdk/Keys.chs" #-}
    keyvalNamePtr

keyvalToChar :: KeyVal -> IO (Maybe Char)
keyvalToChar :: KeyVal -> IO (Maybe Char)
keyvalToChar KeyVal
keyval =
  CUInt -> IO CUInt
gdk_keyval_to_unicode (KeyVal -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral KeyVal
keyval)
  IO CUInt -> (CUInt -> IO (Maybe Char)) -> IO (Maybe Char)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CUInt
code -> if CUInt
code CUInt -> CUInt -> Bool
forall a. Eq a => a -> a -> Bool
== CUInt
0 then Maybe Char -> IO (Maybe Char)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Char
forall a. Maybe a
Nothing
                            else Maybe Char -> IO (Maybe Char)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Char -> IO (Maybe Char)) -> Maybe Char -> IO (Maybe Char)
forall a b. (a -> b) -> a -> b
$ Char -> Maybe Char
forall a. a -> Maybe a
Just (Char -> Maybe Char) -> Char -> Maybe Char
forall a b. (a -> b) -> a -> b
$ Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
code

-- | Obtains the upper- and lower-case versions of the keyval symbol. Examples of keyvals are GDK_a,
-- 'Enter', 'F1', etc.
keyvalConvertCase :: KeyVal -- ^ @symbol@ a keyval
                  -> (KeyVal, KeyVal) -- ^ @(lower, upper)@
                                        -- ^ lower is the lowercase version of symbol.
                                        -- ^ upper is uppercase version of symbol.
keyvalConvertCase :: KeyVal -> (KeyVal, KeyVal)
keyvalConvertCase KeyVal
keyval =
  IO (KeyVal, KeyVal) -> (KeyVal, KeyVal)
forall a. IO a -> a
unsafePerformIO (IO (KeyVal, KeyVal) -> (KeyVal, KeyVal))
-> IO (KeyVal, KeyVal) -> (KeyVal, KeyVal)
forall a b. (a -> b) -> a -> b
$
  (Ptr CUInt -> IO (KeyVal, KeyVal)) -> IO (KeyVal, KeyVal)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CUInt -> IO (KeyVal, KeyVal)) -> IO (KeyVal, KeyVal))
-> (Ptr CUInt -> IO (KeyVal, KeyVal)) -> IO (KeyVal, KeyVal)
forall a b. (a -> b) -> a -> b
$ \ Ptr CUInt
lowerPtr ->
  (Ptr CUInt -> IO (KeyVal, KeyVal)) -> IO (KeyVal, KeyVal)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CUInt -> IO (KeyVal, KeyVal)) -> IO (KeyVal, KeyVal))
-> (Ptr CUInt -> IO (KeyVal, KeyVal)) -> IO (KeyVal, KeyVal)
forall a b. (a -> b) -> a -> b
$ \ Ptr CUInt
upperPtr -> do
  CUInt -> Ptr CUInt -> Ptr CUInt -> IO ()
gdk_keyval_convert_case
{-# LINE 109 "./Graphics/UI/Gtk/Gdk/Keys.chs" #-}
    (fromIntegral keyval)
    Ptr CUInt
lowerPtr
    Ptr CUInt
upperPtr
  CUInt
lower <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
lowerPtr
  CUInt
upper <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
upperPtr
  (KeyVal, KeyVal) -> IO (KeyVal, KeyVal)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CUInt -> KeyVal
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
lower, CUInt -> KeyVal
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
upper)

-- | Converts a key value to upper case, if applicable.
keyvalToUpper :: KeyVal -- ^ @keyval@ a key value.
              -> KeyVal -- ^ returns the upper case form of keyval,
                          -- or keyval itself if it is already in upper case or it is not subject to case
keyvalToUpper :: KeyVal -> KeyVal
keyvalToUpper KeyVal
keyval =
  IO KeyVal -> KeyVal
forall a. IO a -> a
unsafePerformIO (IO KeyVal -> KeyVal) -> IO KeyVal -> KeyVal
forall a b. (a -> b) -> a -> b
$
  (CUInt -> KeyVal) -> IO CUInt -> IO KeyVal
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CUInt -> KeyVal
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CUInt -> IO KeyVal) -> IO CUInt -> IO KeyVal
forall a b. (a -> b) -> a -> b
$
  CUInt -> IO CUInt
gdk_keyval_to_upper
{-# LINE 124 "./Graphics/UI/Gtk/Gdk/Keys.chs" #-}
     (fromIntegral keyval)

-- | Converts a key value to lower case, if applicable.
keyvalToLower :: KeyVal -- ^ @keyval@ a key value.
              -> KeyVal -- ^ returns the lower case form of keyval,
                          -- or keyval itself if it is already in lower case or it is not subject to case
keyvalToLower :: KeyVal -> KeyVal
keyvalToLower KeyVal
keyval =
  IO KeyVal -> KeyVal
forall a. IO a -> a
unsafePerformIO (IO KeyVal -> KeyVal) -> IO KeyVal -> KeyVal
forall a b. (a -> b) -> a -> b
$
  (CUInt -> KeyVal) -> IO CUInt -> IO KeyVal
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CUInt -> KeyVal
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CUInt -> IO KeyVal) -> IO CUInt -> IO KeyVal
forall a b. (a -> b) -> a -> b
$
  CUInt -> IO CUInt
gdk_keyval_to_lower
{-# LINE 134 "./Graphics/UI/Gtk/Gdk/Keys.chs" #-}
     (fromIntegral keyval)

-- | Returns 'True' if the given key value is in upper case.
keyvalIsLower :: KeyVal
              -> Bool -- ^ returns 'True' if keyval is in upper case, or if keyval is not subject to case conversion.
keyvalIsLower :: KeyVal -> Bool
keyvalIsLower KeyVal
keyval =
  IO Bool -> Bool
forall a. IO a -> a
unsafePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$
  (CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$
  CUInt -> IO CInt
gdk_keyval_is_lower
{-# LINE 143 "./Graphics/UI/Gtk/Gdk/Keys.chs" #-}
     (fromIntegral keyval)

-- | Returns 'True' if the given key value is in upper case.
keyvalIsUpper :: KeyVal
              -> Bool -- ^ returns 'True' if keyval is in upper case, or if keyval is not subject to case conversion.
keyvalIsUpper :: KeyVal -> Bool
keyvalIsUpper KeyVal
keyval =
  IO Bool -> Bool
forall a. IO a -> a
unsafePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$
  (CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$
  CUInt -> IO CInt
gdk_keyval_is_upper
{-# LINE 152 "./Graphics/UI/Gtk/Gdk/Keys.chs" #-}
     (fromIntegral keyval)

foreign import ccall safe "gdk_keyval_name"
  gdk_keyval_name :: (CUInt -> (IO (Ptr CChar)))

foreign import ccall safe "gdk_keyval_from_name"
  gdk_keyval_from_name :: ((Ptr CChar) -> (IO CUInt))

foreign import ccall safe "gdk_keyval_to_unicode"
  gdk_keyval_to_unicode :: (CUInt -> (IO CUInt))

foreign import ccall safe "gdk_keyval_convert_case"
  gdk_keyval_convert_case :: (CUInt -> ((Ptr CUInt) -> ((Ptr CUInt) -> (IO ()))))

foreign import ccall safe "gdk_keyval_to_upper"
  gdk_keyval_to_upper :: (CUInt -> (IO CUInt))

foreign import ccall safe "gdk_keyval_to_lower"
  gdk_keyval_to_lower :: (CUInt -> (IO CUInt))

foreign import ccall safe "gdk_keyval_is_lower"
  gdk_keyval_is_lower :: (CUInt -> (IO CInt))

foreign import ccall safe "gdk_keyval_is_upper"
  gdk_keyval_is_upper :: (CUInt -> (IO CInt))