Skip to content

Instantly share code, notes, and snippets.

@Mart-Bogdan
Last active August 29, 2015 14:01
Show Gist options
  • Save Mart-Bogdan/2d84172164c55df619a4 to your computer and use it in GitHub Desktop.
Save Mart-Bogdan/2d84172164c55df619a4 to your computer and use it in GitHub Desktop.
calculator.hs
import Foreign.Java
import Data.Maybe
import Foreign.Java.Bindings.Support
import Data.Int
import Data.Word
import Data.Maybe
import Foreign.Ptr
import Foreign.ForeignPtr
import Foreign.C.Types
import qualified Foreign.Java.JNI.Safe as JNI
import qualified Foreign.Java.JNI.Types as Core
import qualified Foreign.Java.Types as Types
import Foreign hiding (void)
import System.Win32.DebugApi(debugBreak)
main :: IO ()
main = do
initJava ["-XX:+CreateMinidumpOnCrash"]
runJava $ do
(Just jFrameClass) <- getClass "javax.swing.JFrame"
(Just jButtonClass) <- getClass "javax.swing.JButton"
(Just jGridLayoutClass) <- getClass "java.awt.GridLayout"
(Just jEventObject) <- getClass "java.util.EventObject"
setVisible <- jFrameClass `bindMethod` "setVisible" ::= boolean --> void
addComponent <- jFrameClass `bindMethod` "add" ::= object "java.awt.Component"
--> object "java.awt.Component"
setLocation <- jFrameClass `bindMethod` "setLocationRelativeTo" ::= object "java.awt.Component"
--> void
setSize' <- jFrameClass `bindMethod` "setSize" ::= int --> int --> void
let setSize obj (a, b) = setSize' obj a b
setLayout <- jFrameClass `bindMethod` "setLayout" ::= object "java.awt.LayoutManager"
--> void
addActionListener <- jButtonClass
`bindMethod` "addActionListener" ::= object "java.awt.event.ActionListener" --> void
getText <- jButtonClass `bindMethod` "getText" ::= string
getSource <- jEventObject `bindMethod` "getSource" ::= object "java.lang.Object"
(Just jButtonConstr) <- getConstructor jButtonClass $ string
(Just jGridLayoutConstr) <- getConstructor jGridLayoutClass $ int --> int
(Just jFrame) <- newObject jFrameClass
newObjectFrom jGridLayoutConstr 4 4 >>= setLayout jFrame
buttons <- mapM (newObjectFrom jButtonConstr)
[ "1", "2", "3", "*"
, "4", "5", "6", "-"
, "7", "8", "9", "·"
, "C", "0", "=", "÷" ]
mapM_ (addComponent jFrame) buttons
let action self method args= do
--io $ debugBreak
io $ putStrLn ""
io $ putStrLn "Let's have some fun!"
(Just arg) <- at args 0
ms <- toString method
argS <- toString arg
(Just source) <- getSource arg
(Just val) <- (getText source)
io $ putStrLn $ "button text: " ++ val
io $ putStrLn $ "\nmethod: " ++ ms
io $ putStrLn $ "args: " ++ argS
listener <- sushimaki2 "java.awt.event.ActionListener" action
mapM_ (flip addActionListener (Just listener) . fromJust) buttons
jFrame `setSize` (400, 300)
jFrame `setLocation` Nothing
jFrame `setVisible` True
type Callback = JObject
-> JObject
-> JArray Types.L
-> Java ()
wrap2 :: Callback-> IO (FunPtr WrappedFun)
wrap2 f = do
let func vm _self _method _args = do
--putStrLn $ "method: " ++ show ( toString _method)
putStrLn ""
putStrLn $ show _self
putStrLn $ show _method
putStrLn $ show _args
--let dummy _ =
_self' <- JNI.newGlobalRef vm _self
_method' <- JNI.newGlobalRef vm _method
_args' <- JNI.newGlobalRef vm _args
_pself <- newForeignPtr JNI.release _self'
_pmethod <- newForeignPtr JNI.release _method'
_pargs <- newForeignPtr JNI.release _args'
let self = Core.JObject _pself
let met = Core.JObject _pmethod
let args = Core.JArray 1 _pargs :: JArray Types.L
--let action = do
-- (Just arg) <- at args 0
-- argS <- toString arg
-- io $ putStrLn ""
-- io $ putStrLn $ "method: " ++ met
-- io $ putStrLn $ "args: " ++ argS
--runJava_ vm action
runJava_ vm $ f self met args
return nullPtr
func' <- wrap_ func
return func'
intify2 :: Callback -> IO Int64
intify2 = fmap (fromIntegral . ptrToIntPtr . castFunPtrToPtr) . wrap2
sushimaki2 :: String -> Callback -> Java JObject
sushimaki2 ifaceName func = do
iface <- getClass ifaceName >>= asObject . fromJust
(Just clazz) <- getClass "HFunction"
_success <- registerCallbacks clazz
makeFunction <- clazz `bindStaticMethod` "makeFunction"
::= object "java.lang.Class" --> long --> object "java.lang.Object"
(Just impl) <- io (intify2 func) >>= makeFunction (Just iface)
return impl
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment