diff --git a/appleKit.hs b/appleKit.hs new file mode 100644 index 0000000..f1dce3c --- /dev/null +++ b/appleKit.hs @@ -0,0 +1,57 @@ +{- + +install my lib: https://github.com/KonstantinDjairo/haskell-obj-c + +then: + + $ appleKit.hs -o hello \ + -package haskell-obj-c \ + -package libffi \ + -framework AppKit + + +-} + + +import Foreign.C.String (withCString) +import Foreign.LibFFI (argPtr, retPtr, retVoid, retCULong) +import Foreign.Ptr (castPtr) +import ObjC.Runtime + +main :: IO () +main = withAutoreleasePool $ do + loadFramework "AppKit" + + appClass <- getRequiredClass "NSApplication" + _ <- sendClassMsg appClass (mkSelector "sharedApplication") + (retPtr retVoid) [] + + alertClass <- getRequiredClass "NSAlert" + alertPtr <- sendClassMsg alertClass (mkSelector "new") + (retPtr retVoid) [] + let alert = RawId (castPtr alertPtr) + + stringClass <- getRequiredClass "NSString" + title <- makeString stringClass "Hello from Haskell" + detail <- makeString stringClass "RawId-only AppKit test." + + let RawId titlePtr = title + RawId detailPtr = detail + + _ <- sendRawMsg alert (mkSelector "setMessageText:") + retVoid [argPtr titlePtr] + + _ <- sendRawMsg alert (mkSelector "setInformativeText:") + retVoid [argPtr detailPtr] + + _ <- sendRawMsg alert (mkSelector "runModal") + retCULong [] + + pure () + +makeString :: Class -> String -> IO RawId +makeString cls s = + withCString s $ \cs -> do + ptr <- sendClassMsg cls (mkSelector "stringWithUTF8String:") + (retPtr retVoid) [argPtr cs] + pure (RawId (castPtr ptr)) \ No newline at end of file