I'm experimenting with the sample program at https://github.com/gtk2hs/gtk2hs/blob/master/gtk/demo/hello/World.hs, reproduced below:
-- A simple program to demonstrate Gtk2Hs.
module Main (Main.main) where
import Graphics.UI.Gtk
main :: IO ()
main = do
initGUI
-- Create a new window
window <- windowNew
-- Here we connect the "destroy" event to a signal handler.
-- This event occurs when we call widgetDestroy on the window
-- or if the user closes the window.
on window objectDestroy mainQuit
-- Sets the border width and tile of the window. Note that border width
-- attribute is in 'Container' from which 'Window' is derived.
set window [ containerBorderWidth := 10, windowTitle := "Hello World" ]
-- Creates a new button with the label "Hello World".
button <- buttonNew
set button [ buttonLabel := "Hello World" ]
-- When the button receives the "clicked" signal, it will call the
-- function given as the second argument.
on button buttonActivated (putStrLn "Hello World")
-- Gtk+ allows several callbacks for the same event.
-- This one will cause the window to be destroyed by calling
-- widgetDestroy. The callbacks are called in the sequence they were added.
on button buttonActivated $ do
putStrLn "A \"clicked\"-handler to say \"destroy\""
widgetDestroy window
-- Insert the hello-world button into the window.
set window [ containerChild := button ]
-- The final step is to display this newly created widget. Note that this
-- also allocates the right amount of space to the windows and the button.
widgetShowAll window
-- All Gtk+ applications must have a main loop. Control ends here
-- and waits for an event to occur (like a key press or mouse event).
-- This function returns if the program should finish.
mainGUI
If I build and run this on Mac OS X, Cmd-Q or the Quit command from the app's menu does not close the application. How do I trap this event and cause it to close the app?
Update
I've added a gtk3-mac-integration dependency to my project, an import Graphics.UI.Gtk.OSX to my source file and the following immediately after calling initGUI:
app <- applicationNew
on app willTerminate (return ())
I'm definitely missing something as this doesn't seem to do anything (see https://github.com/rcook/gtkapp/commit/8531509d0648ddb657633a33773c09bc5a576014).
Update no. 2
Thanks to #Jack Henahan and OSXDemo.hs, I now have a working solution:
-- A simple program to demonstrate Gtk2Hs.
module Main (Main.main) where
import Control.Exception
import Control.Monad
import Graphics.UI.Gtk
import Graphics.UI.Gtk.OSX
showDialog :: Window -> String -> String -> IO ()
showDialog window title message = bracket
(messageDialogNew (Just window) [] MessageInfo ButtonsOk message)
widgetDestroy
(\d -> do
set d [ windowTitle := title ]
void $ dialogRun d)
main :: IO ()
main = do
void initGUI
-- Create a new window
window <- windowNew
-- Here we connect the "destroy" event to a signal handler.
-- This event occurs when we call widgetDestroy on the window
-- or if the user closes the window.
void $ on window objectDestroy mainQuit
-- Sets the border width and tile of the window. Note that border width
-- attribute is in 'Container' from which 'Window' is derived.
set window [ containerBorderWidth := 10, windowTitle := "Hello World" ]
-- Creates a new button with the label "Hello World".
button <- buttonNew
set button [ buttonLabel := "Hello World" ]
-- When the button receives the "clicked" signal, it will call the
-- function given as the second argument.
void $ on button buttonActivated (putStrLn "Hello World")
void $ on button buttonActivated $ showDialog window "THE-TITLE" "THE-MESSAGE"
-- Gtk+ allows several callbacks for the same event.
-- This one will cause the window to be destroyed by calling
-- widgetDestroy. The callbacks are called in the sequence they were added.
void $ on button buttonActivated $ do
putStrLn "A \"clicked\"-handler to say \"destroy\""
widgetDestroy window
-- Insert the hello-world button into the window.
set window [ containerChild := button ]
-- The final step is to display this newly created widget. Note that this
-- also allocates the right amount of space to the windows and the button.
widgetShowAll window
app <- applicationNew
-- blockTermination: return True to prevent quit, False to allow
on app blockTermination $ do
putStrLn "blockTermination"
return False
-- willTerminate: handle clean-up etc.
on app willTerminate $ do
putStrLn "willTerminate"
menuBar <- menuBarNew
applicationSetMenuBar app menuBar
applicationReady app
-- All Gtk+ applications must have a main loop. Control ends here
-- and waits for an event to occur (like a key press or mouse event).
-- This function returns if the program should finish.
mainGUI
You need to send an NSApplicationWillTerminate signal.
willTerminate :: ApplicationClass self => Signal self (IO ())
willTerminate = Signal (connect_NONE__NONE "NSApplicationWillTerminate")
is how it's handled in gtk-mac-integration.
I want to copy any area in Canvas with x and y coordinates and then paste it to any Image.
In example:
Image image = Image.createImage(30, 20);
image.drawImage(canvas);
It is not possible to copy data from Canvas nor GameCanvas.
To achieve what you want, you have to use doublebuffering. Meaning, you have to use an Image bufferImg as your buffer to draw on, and then draw that bufferImg onto your Canvas.
That way, you can copy from the Image onto another Image like this:
bufferImg.getRGB(int[] rgbData, int offset, int scanlength, int x, int y, int width, int height);
and then
g.drawRGB(int[] rgbData, int offset, int scanlength, int x, int y, int width, int height, boolean processAlpha);
where g is the Graphics object of the 2nd Image you want to draw onto.
Using a doublebuffer like this will slow things down a bit on some devices of course, but you can't do it any other way if you want to be able to "extract" portions of the screen.
My problem is getting the pixels in a window. I can't find a way to do this. I using standard windows functions and Direct2D (not DirectDraw).
I am using standard initialization of new window:
WNDCLASS wc;
wc.style = CS_OWNDC;
wc.lpfnWndProc = WndProc;
wc.cbClsExtra = 0;
wc.cbWndExtra = 0;
wc.hInstance = hInstance;
wc.hIcon = LoadIcon(NULL, IDI_APPLICATION);
wc.hCursor = LoadCursor(NULL, IDC_ARROW); wc.hbrBackground = (HBRUSH)(6);
wc.lpszMenuName = 0;
wc.lpszClassName = L"WINDOW"; RegisterClass(&wc);
hWnd = CreateWindow(L"WINDOW", L"Game", WS_OVERLAPPEDWINDOW,100,100,1024,768,NULL,NULL,hInstance,NULL);
Then I create a D2D1factory object and draw the bitmap in the window:
HWND hWnd = NULL;
srand((unsigned int)time((time_t)NULL));
ID2D1Factory* factory = NULL;
ID2D1HwndRenderTarget* rt = NULL;
CoInitializeEx(NULL,COINIT_MULTITHREADED);
My_CreateWindow(&hWnd, hInstance);
My_CreateFactory(&hWnd, factory, rt);
D2D1CreateFactory(D2D1_FACTORY_TYPE_SINGLE_THREADED,&factory);
factory->CreateHwndRenderTarget(RenderTargetProperties(), HwndRenderTargetProperties(hWnd,SizeU(800,600)), &rt);
// tons of code
rt->BeginDraw(); rt->DrawBitmap(background[0], RectF(0,0,800,600));
rt->DrawBitmap(GIFHorse[(int)iterator],
RectF(0+MyX-100,0+MyY-100,100+MyX,100+MyY));
rt->DrawBitmap(Star[(int)iterator], RectF(0 + starX, 0 + starY, 50 + starX, 50+starY)); rt->EndDraw();
I need to calculate the hits (I am trying to make simple game). So that's why I need access to all pixels in window.
I'm thinking about using other algorithms, but they're harder to make and I want to start with something easier.
I know about the GetPixel() function, but I cant understand what I should use for HDC.
There is no simple and easy way to get to D2D pixels.
A simple collision detection can be implemented using geometries. If you have outlines of your objects in ID2D1Geometry objects you can compare them using ID2D1Geometry::CompareWithGeometry.
If you insist on the pixels, a way to access them is from the DC obtainable via IDXGISurface1::GetDC
In this case you need to use the DXGI surface render target and the swap chain instead of the hwnd render target.
Step by step:
D3D11CreateDeviceAndSwapChain gives you the swap chain.
IDXGISwapChain::GetBuffer gives you the DXGI surface.
ID2D1Factory::CreateDxgiSurfaceRenderTarget gives you the render target.
IDXGISurface1::GetDC gives you the DC. Read the remarks on this page!
The problem i have relates to the following piece of code:
module Main(main) where
import qualified Media.Streaming.GStreamer as GS
import Data.Maybe
import System.IO
import System.Exit
import System.Glib.MainLoop as Glib
import System.Glib.Signals as Glib
import System.Glib.Properties as Glib
makeElement:: String → String → IO GS.Element
makeElement elementType elementName = do
element ← GS.elementFactoryMake elementType (Just elementName)
case element of
Just element' → return element'
Nothing → do
hPutStrLn stdout ("Cannot create element!")
hFlush stdout
exitFailure
player = do
GS.init
pipeline ← GS.pipelineNew "video-stream"
source ← makeElement "v4l2src" "video-source"
color ← makeElement "ffmpegcolorspace" "video-color"
tee ← makeElement "tee" "stream-tee"
rQ ← makeElement "queue" "record-queue"
vQ ← makeElement "queue" "video-queue"
encoder ← makeElement "y4menc" "video-encoder"
rSink ← makeElement "filesink" "record-sink"
sink ← makeElement "ximagesink" "video-sink"
let elements = [source,color,encoder,rSink,vQ,rQ,sink,tee]
Glib.objectSetPropertyString "location" rSink "rec"
mapM_ (GS.binAdd (GS.castToBin pipeline)) elements
-- Request Pads from tee
dPad ← GS.elementGetRequestPad tee "src%d"
rPad ← GS.elementGetRequestPad tee "src%d"
-- Request Static Pads from queue
sDPad ← GS.elementGetStaticPad vQ "sink"
sRPad ← GS.elementGetStaticPad rQ "sink"
-- Link tee source to queue sink
GS.padLink (fromJust dPad) (fromJust sDPad)
GS.padLink (fromJust rPad) (fromJust sRPad)
GS.elementReleaseRequestPad tee $ fromJust dPad
GS.elementReleaseRequestPad tee $ fromJust rPad
GS.elementLink source color
GS.elementLink color tee
GS.elementLink vQ sink
GS.elementLink rQ encoder
GS.elementLink encoder rSink
GS.elementSetState pipeline GS.StatePlaying
main = do
loop ← Glib.mainLoopNew Nothing False
player
Glib.mainLoopRun loop
The code compiles fine, camera LED switches ON and the file is created but then NOTHING.
Without the tee and queue elements, the separate setup for recording/displaying video works just fine.Also, the same pipeline works perfectly if i test it with gst-launch.
I'm missing something here on how gstreamer works but i can't figure out what.
Also, if it helps, i'm building on ArchLinux using:
- GHC 7.0.3 ;
- gstreamer-bindings 0.12.1 ;
- gtk2hs 0.12.2 ;
- gstreamer 0.10.35-1 ;
- glib 1.2.10-9 .
RESOLVED
I found my solution, and what follows is a lengthy post but please, bear with me. I must share my frustration with someone.
After many more buggy tries i decided to go back to testing some setups using gst-launch.
This helped me to find out that after the queue element that buffers the part which goes to the filesink i needed another ffmpegcolorspace element to setup the correct video format i think.
At this point i was not going back to trying this thing out it Haskell again, i thought i needed to get 'closer' so i decided to try it in C.
As a side note , i don't know C , i can understand the syntax but that's about it...and for goodness sake i'm just now trying to learn Haskell.
To continue, i decided to also try using 'GS.elementGetCompatiblePad' on the tee element so i can be sure that the pads will link with the queue.
The C code i stitched together is this :
#include <gst/gst.h>
#include <glib.h>
int
main (int argc,char *argv[])
{
GstElement *pipeline, *source, *color, *color2 , *color3, *tee, *rQ, *vQ, *encoder, *fSink , *sink;
GMainLoop *loop;
loop = g_main_loop_new (NULL,FALSE);
/* initialize gstreamer */
gst_init(&argc,&argv);
/* creating elements */
pipeline = gst_pipeline_new("stream-pipeline");
source = gst_element_factory_make ("v4l2src","stream-source");
color = gst_element_factory_make ("ffmpegcolorspace","video-color");
tee = gst_element_factory_make ("tee","stream-tee");
rQ = gst_element_factory_make ("queue","record-queue");
vQ = gst_element_factory_make ("queue","video-queue");
encoder = gst_element_factory_make ("theoraenc","video-encoder");
fSink = gst_element_factory_make ("filesink","record-sink");
sink = gst_element_factory_make ("ximagesink","video-sink");
color2 = gst_element_factory_make ("ffmpegcolorspace","video-color2");
color3 = gst_element_factory_make ("ffmpegcolorspace","video-color3");
/*check that the elements were created */
if (!source || !color || !tee || !rQ || !vQ || !encoder || !fSink || !sink){
g_printerr("One element could not be created!");
return -1;
}
/*set file output location */
g_object_set(G_OBJECT (fSink),"location","rec",NULL);
gst_bin_add_many (GST_BIN(pipeline),
source,color,color2,color3,tee,rQ,vQ,encoder,fSink,sink,NULL);
/* get request pads */
GstPad *dPad, *rPad, *sDPad, *sRPad;
sDPad = gst_element_get_static_pad(vQ,"sink");
sRPad = gst_element_get_static_pad(rQ,"sink");
dPad = gst_element_get_compatible_pad(tee,sDPad,GST_CAPS_ANY);
rPad = gst_element_get_compatible_pad(tee,sRPad,GST_CAPS_ANY);
/*link pads*/
gst_pad_link(dPad,sDPad);
gst_pad_link(rPad,sRPad);
/*unref pads */
gst_object_unref(GST_OBJECT(dPad));
gst_object_unref(GST_OBJECT(rPad));
gst_object_unref(GST_OBJECT(sDPad));
gst_object_unref(GST_OBJECT(sRPad));
/*link elements */
gst_element_link(source,tee);
gst_element_link_many(rQ,color2,encoder,fSink,NULL);
gst_element_link_many(vQ,color3,sink),NULL;
/*set the pipeline state to playing */
gst_element_set_state(pipeline,GST_STATE_PLAYING);
g_main_loop_run (loop);
gst_element_set_state(pipeline,GST_STATE_NULL);
gst_object_unref(GST_OBJECT(pipeline));
return 0;
}
In order to use 'gst_element_get_compatible_pad' i had to first get static pads from the queue elements so i hand to switch those four related lines.
I try it out, and Abracadabra ...oh no, wait ... camera starts, the file is created and a window with the 'video' pops, but a black window that remains black!
No problem i say , run the program with gst-debug-level=5 ( =)) ) yea, right , try reading the whole output.I give up for the moment and i thought maybe it has something to do with the elements in my pipeline not working right together so i code another pipeline in C but this time something more simple just with audio files.
I had the same result so i decided tu debug again, this time with runlevel 3 and i started reading the whole thing,line by line.
Somewhere in there i found this:
trying to link stream-tee:src0 and record-queue:sink
trying to link stream-tee:src0 and video-queue:sink
something nasty is happening here
linked stream-tee:src0 and video-queue:sink,successful
trying to link stream-tee:src0 and record-queue:sink
src stream-tee:src0 was already linked with video-queue:sink
And it gives up!
I guess i must go back using gst_element_get_request_pad, but haven't i tried that already?
So i switch back to vim and replace all occurrences of 'gst_element_get_compatible_pad with the request counterpart like so:
sDPad = gst_element_get_static_pad(vQ,"sink");
sRPad = gst_element_get_static_pad(rQ,"sink");
dPad = gst_element_get_request_pad(tee,"src%d");
rPad = gst_element_get_request_pad(tee,"src%d");
I gaze upon this code and i say to myself 'you twit', this is where it all started; take a deep breath ; after all this is what the debugger complains about so i compile , i run, and Voila. I found my solution.
Those four lines had to be reversed, i had to first get a reference to the static pads and then request a reference to a 'request' pad on the tee element.
I go back to haskell a happy man.I implement my solution, compile, fire up,camera starts, the file is created and ... just like that..nothing, not even the black screen.
Filled with anger i just comment out the lines where i release the request pads and decide to compile and run once more, my neck started to hurt a while ago.
Again, by magic it all works , i have video on the screen and in the file.
I guess Haskell just likes to hold tighter and sometimes you have to just go with something that makes no sense. The gstreamer docs state clearly release,release,release.
The final haskell code:
module Main(main) where
import qualified Media.Streaming.GStreamer as GS
import Data.Maybe
import System.Exit
import System.Glib.MainLoop as Glib
import System.Glib.Signals as Glib
import System.Glib.Properties as Glib
makeElement:: String → String → IO GS.Element
makeElement elementType elementName = do
element ← GS.elementFactoryMake elementType (Just elementName)
case element of
Just element' → return element'
Nothing → do
putStrLn "Cannot create element!"
exitFailure
linkSPadToStaticSink::(GS.ElementClass object, GS.ElementClass elementT) ⇒ object → elementT → IO (Glib.ConnectId object)
linkSPadToStaticSink elSrc elSink = do
Glib.on elSrc GS.elementPadAdded (λpad → do
sinkPad ← GS.elementGetStaticPad elSink "sink"
GS.padLink pad (fromJust sinkPad)
return ∅)
player = do
GS.init
pipeline ← GS.pipelineNew "video-stream"
source ← makeElement "v4l2src" "video-source"
color ← makeElement "ffmpegcolorspace" "video-color"
color2 ← makeElement "ffmpegcolorspace" "video-color2"
tee ← makeElement "tee" "stream-tee"
rQ ← makeElement "queue" "record-queue"
vQ ← makeElement "queue" "video-queue"
encoder ← makeElement "y4menc" "video-encoder"
rSink ← makeElement "filesink" "record-sink"
sink ← makeElement "ximagesink" "video-sink"
let elements = [source,color,color2,encoder,rSink,vQ,rQ,sink,tee]
Glib.objectSetPropertyString "location" rSink "rec"
mapM_ (GS.binAdd (GS.castToBin pipeline)) elements
-- Get static pads from queue elements
sDPad ← GS.elementGetStaticPad vQ "sink"
sRPad ← GS.elementGetStaticPad rQ "sink"
-- Request pads from tee element
dPad ← GS.elementGetRequestPad tee "src%d"
rPad ← GS.elementGetRequestPad tee "src%d"
-- Link tee source to queue sink
GS.padLink (fromJust dPad) (fromJust sDPad)
GS.padLink (fromJust rPad) (fromJust sRPad)
GS.elementLink source color
GS.elementLink color tee
GS.elementLink vQ sink
GS.elementLink rQ color2
GS.elementLink color2 encoder
GS.elementLink encoder rSink
GS.elementSetState pipeline GS.StatePlaying
main = do
loop ← Glib.mainLoopNew Nothing False
player
Glib.mainLoopRun loop
Now i ask you, should/could i have seen this ?
Was it that obvious ?
I'm glad this will make me be more careful and look in not so obvious places but...eww.
In conclusion to all this, i learned about the gstreamer debug options, i learned that it whispers to me and i MUST listen. I learned about GDB being forced to used because when i began stitching C code all i got was a 'seg fault'.I learned to love lazy-eval and pure Haskell code. A little bit of Haskell, maybe a tiny bit of C and more experience.
'Lost' about half a day, three classes and several hours of sleep but after all...So it goes...
Can someone please point me in the right direction when it comes to changing properties of an element in Gtk2Hs.
For example, how do I change the background-color of a DrawingArea?
There are various methods for modifying a widget's style. For example to modify the background style you can use widgetModifyBg (corresponding to the C function gtk_widget_modify_bg()). In principle, if you change the style for one state (e.g. StateNormal) then you should also change it for the others.
Y would suggest you describe the styles you want in an RC file, and then load that file from your application, but it seems that functions like gtk_rc_parse() are not bound in gtk2hs.
Here's an example:
import Graphics.UI.Gtk
main = do
initGUI
window <- windowNew
window `onDestroy` mainQuit
drawingArea <- drawingAreaNew
window `containerAdd` drawingArea
widgetModifyBg drawingArea StateNormal (Color 0xffff 0 0)
widgetShowAll window
mainGUI
If you need to do custom drawing based on a widget's styles, you can do that using widgetGetState, the widgetStyle property and the styleGet* family of functions (e.g. styleGetText). Here's an example of that:
import Graphics.Rendering.Cairo
import Graphics.UI.Gtk hiding (fill)
import Graphics.UI.Gtk.Gdk.Events (Event(Expose))
expose widget rect = do
state <- widgetGetState widget
style <- widget `get` widgetStyle
(Color red green blue) <- styleGetText style state
drawWindow <- widgetGetDrawWindow widget
renderWithDrawable drawWindow $ do
moveTo 50 50
setFontSize 20
setSourceRGB (fromIntegral red / 0xffff)
(fromIntegral green / 0xffff)
(fromIntegral blue / 0xffff)
showText "O HAI"
fill
return False
main = do
initGUI
window <- windowNew
window `onDestroy` mainQuit
drawingArea <- drawingAreaNew
drawingArea `onExpose` \(Expose sent area region count) ->
expose drawingArea area
window `containerAdd` drawingArea
widgetShowAll window
mainGUI