mbishop changed the topic of #ocaml to: Discussions about the OCaml programming language | http://caml.inria.fr/ | Grab OCaml 3.10.2 from http://caml.inria.fr/ocaml/release.html (featuring new camlp4 and more!)
<palomer_> oh my
<palomer_> there's a gnomecanvas module
<palomer_> wicked
hkBst has quit ["Konversation terminated!"]
Tetsuo has quit ["Leaving"]
CrawfordComeaux has quit ["http://www.mibbit.com ajax IRC Client"]
LordMetroid has joined #ocaml
Tetsuo has joined #ocaml
Tetsuo has quit [Client Quit]
structured has quit [Read error: 110 (Connection timed out)]
hardcopy has joined #ocaml
<palomer_> http://ocaml.pastebin.com/m5947a31b <--can anyone help me with this linking error?
Amorphous has quit [Read error: 110 (Connection timed out)]
Amorphous has joined #ocaml
LordMetroid has quit ["Leaving"]
jlouis has quit [Remote closed the connection]
rogo has left #ocaml []
pango has quit [Remote closed the connection]
Mr_Awesome has joined #ocaml
pango has joined #ocaml
seafood_ has joined #ocaml
<palomer_> can anyone check if they're getting the same link error?
<palomer_> http://ocaml.pastebin.com/m5947a31b <--can anyone help me with this linking error?
<palomer_> well...
<palomer_> looks like I have to get ocaml cvs and lablgtk cvs
<palomer_> oh boy
jdrake has joined #ocaml
<jdrake> Is there any pattern that matches when none of the others match?
<pango> palomer_: ocamlc -I +lablgtk2 -I -g lablgtk.cma lablgnomecanvas.cma gtkInit.cmo test.ml ?
<pango> jdrake: _
<jdrake> merci
<palomer_> YES!
* palomer_ hugs pango
<jdrake> I have implemented a basic line function in my code here, http://ocaml.p.tyk.nu/121 , and it starts at line 43 and would like some opinions on style or other ideas. It does not deal with angled lines very well yet.
<palomer_> hrmph
<palomer_> none of you would happen to know how to add a widget to a GnoCanvas.canvas, would you?
<jdrake> I am afraid I have never used it
<jdrake> But plant o eventually.
<palomer_> let's learn together!
<palomer_> http://ocaml.pastebin.com/mf34ddd2 <--here's my code so far
<jdrake> Why do you have a semicolon at the end?
<jdrake> Also, do you have a makefile for this?
<palomer_> yes, I do!
<palomer_> call the source file test.ml
<jdrake> Do you not use OCamlMakefile?
<palomer_> only for big projects
<palomer_> one file projects can be easily done with makefiles
<jdrake> ok, I see nothing in the window
<palomer_> yes, that's the problem!
<palomer_> you should see "BAR"
<palomer_> (in a textview)
<jdrake> umm, don't you have to add that stuff to the window?
<jdrake> ok, I see the one add
<jdrake> What is Gtext?
<palomer_> GText is the object interface to GtkText, I believe
<palomer_> I find it much easier to use
<palomer_> wee, got it to work
<jdrake> got it
<jdrake> let buffer = GText.buffer () in
<jdrake> let view = GText.view ~buffer:buffer ~packing:canvas#add ~show:true () in
<jdrake> Obviously more than one way
<palomer_> hmm
<jdrake> pango: hmm, merci. But what do you think of the choice of expression I did use? (not the algorithm itself, as that can be fixed)
<pango> jdrake: let m = (y2 - y1) / (x2 - x1) may be a correct mathematical formula, but it doesn't work well with ints
<jdrake> I am trying to do all integer
* palomer_ is in love with gnomecanvas
<pango> other than that, I think using an 'if' seems appropriate... match with a guard doesn't look in any way better
<jdrake> potentially so
<thelema> palomer_: pong
<jdrake> I find the code in that link of yours to be not immediately obvious; I prefer the functional style
<pango> I'm not sure why you're building the list of points coordinates (non tail-recursively, at that)
<jdrake> thelema: How are you?
<palomer_> thelema, crisis averted!
<palomer_> actually, I do have a question
<thelema> jdev: I'm all right.
<jdrake> pango: How would it be done correctly then?
<thelema> palomer_: go ahead.
<palomer_> I'm adding a textview to a gnomecanvas
<jdrake> thelema: I Am 'jdrake', not jdev :p
<pango> also, you probably want List.iter instead of List.map... building an unit list is not very useful
<palomer_> thelema, but, by default, it has size 0
<palomer_> GnoCanvas.widget ~widget:view canvas#root <-- nothing appears
<thelema> jdrake: grr, I can't just type "jd: xxx" and let my client autocomplete.
<palomer_> GnoCanvas.widget ~widget:view ~props:[`HEIGHT 100.0;`WIDTH 100.0] canvas#root <-- a 100x100 box in the middle of the canvas
<palomer_> GText.view ~buffer:buffer ~show:true ~packing:canvas#add () <--a widget sensibly placed at the top left, but now I have no way to move it
<pango> jdrake: problem with non-tail recursivity here is that stack will overflow with lines > few tens of thousand points
<jdrake> I must forget what tail recursivity is then
<pango> your algorithm is just tail-recursive "modulo cons", but OCaml doesn't optimize such case
<palomer_> thelema, so, the question is, how do I insert a textview into a gnome canvas and then move it around?
<jdrake> pango: I viewed it as being tail recursive because the last operation was a call to itself. What would be the correct way of doing this?
<pango> jdrake: it's not, the last operation is ::
<pango> between the result of self-call and (x, m*x+b) tuple
<jdrake> Is it possible to fix it?
<pango> jdrake: you can convert the call to tail-recursive using an accumulator
<pango> points will be in reverse order in the list, but in your case it doesn't really matter
<thelema> sorry, I went away.
<thelema> you want to move the textview around?
<jdrake> Isn't x an accumulator?
<pango> nope
<jdrake> What is an accumulator then?
<palomer_> thelema, actually, I'll want to move around an entry box
<thelema> jdrake: let sum l = match l with [] -> 0 | h :: t -> h + (sum t)
<thelema> this version has no accumulator
<thelema> next version has an accumulator
<thelema> let sum l acc = match l with [] -> acc | h :: t -> sum t (acc + h)
<jdrake> That just seems asinine
<pango> thelema: (missing 'rec', but that's a detail)
<jdrake> Is there a reason why ocaml doesn't optimise it?
<thelema> in the first sum, I do the + after I return from my function call.
<thelema> in the second, I do nothing after the function call - so instead of [call sum; ret], the compiler can optimize and do [jmp sum]
<palomer_> thelema, actually, scratch everything, everything solved
<thelema> palomer_: Glad I could help. :)
<palomer_> thelema, wait, there is a way you can help
<palomer_> item#move x y moves an item by x and y
<thelema> jdrake: as to automatically performing this optimization - it can't be done in the case of lists, as the order of operations matters.
<palomer_> how do I move to position x y?
<thelema> relative to what? screen? window? widget x?
<jdrake> ok, I shall change my code :-)
<jdrake> merci
<palomer_> thelema, the canvas
<palomer_> thelema, I'm not leaving root canvas coordinates
<thelema> biab
<palomer_> biab?
ulfdoz has quit [Remote closed the connection]
<jdrake> 'back in a bit'
<palomer_> ah
<jdrake> There does appear to be another problem in my code - patterns are not exhaustive :-(
<palomer_> got everything I need
<palomer_> wippy!
<palomer_> err
<palomer_> yippy
ulfdoz has joined #ocaml
<thelema> ok, back.
<thelema> you want to move a widget to an absolute position on the canvas, without keeping track of its current position...
<thelema> GnomeCanvas.Types.widget objects have properties x and y with their current x and y positions.
<palomer_> thelema, yeah
<palomer_> I can call #set [`X 300]
<palomer_> ok, here's a tough question
<palomer_> how do I get gnome canvas to automatically resize the widget according to its contents
<palomer_> if I use ~packing:canvas#add it does this
<thelema> resize itself?
<thelema> or resize contained widgets?
<palomer_> contained widgets
<palomer_> when I was using a standard window I would simply call some_window#set_resizable false
<palomer_> and then the window would change sizes depending upon what it contained
yangsx has left #ocaml []
<thelema> have you worked out the difference between #pack and #add?
<palomer_> err, I can't use pack or add
<palomer_> GnoCanvas.widget ~widget:vbox canvas#root <--I have to do something like this
<palomer_> bind that to a variable item
<palomer_> and then call item#set [`X 100.0] when I want to place it in position 100
<palomer_> gnomecanvas wants me to do something like let input_window = GnoCanvas.widget ~width:200.0 ~height:200.0 ~widget:vbox canvas#root in
<palomer_> but then the width and height are fixed
<thelema> well, widgets also have width and height properties, and I guess if you had to, you could query their requested size...
<palomer_> hrmph
<palomer_> wouldn't happen to know the names of the functions, would you?
<thelema> to query requested size?
<palomer_> yeah
<palomer_> Gobject.get GtkBaseProps.Widget.P.height_request vbox ; <--I'm thinking this should work
<palomer_> Unbound value GtkBaseProps.Widget.P.height_request <--ocaml thinks otherwise
sporkmonger has quit []
<thelema> try on the base widget - not the gnomecanvas widget.
<thelema> oh, yoy did...
<thelema> hmm, no references to gtk_widget_size_request in the lablgtk source...
<palomer_> I think this is an ocaml thing
<palomer_> let height_request : ([>`widget],_) property =
<palomer_> {name="height_request"; conv=Data.int} <--I'm using this
<palomer_> is height_request anywhere in the source?
<palomer_> I just hacked that up
<thelema> yes, gtkBaseProps has a height_request
<thelema> hmm, it should be GtkBaseProps.Widget.P.height_request... you got an unbound value error? hmmm
<palomer_> thelema, what's the source read?
<palomer_> I'll just copy paste
<thelema> let height_request : ([>`widget],_) property =
<thelema> {name="height-request"; conv=int}
<palomer_> ahh
<thelema> But Data and Gobject get [open]ed
<thelema> ah, - vs _
<palomer_> hrmph
<palomer_> could you paste the source of canvas#add ?
<palomer_> it's strange that widgets added with canvas#add get resized automatically
<thelema> inherited from GPack.layout, I think.
<palomer_> hrmphrmph
<palomer_> I would simply call canvas#root#get_items
<palomer_> but it returns a base_item
<palomer_> not an item!
hardcopy has quit []
<palomer_> heh
<palomer_> requesting the size simply returns the size that was originally set
<palomer_> so that's a dead end
Loki_ has quit [Read error: 113 (No route to host)]
Loki_ has joined #ocaml
<thelema> sorry, gotta sleep - already dropping off now. good night all
<palomer_> night
jdrake has quit ["Ex-Chat"]
palomer__ has joined #ocaml
structured has joined #ocaml
al-maisan has joined #ocaml
al-maisan has quit [Client Quit]
palomer_ has quit [Read error: 110 (Connection timed out)]
Yoric[DT] has joined #ocaml
Snark has joined #ocaml
CrawfordComeaux has joined #ocaml
CrawfordComeaux has quit [Client Quit]
Yoric[DT] has quit ["Ex-Chat"]
<palomer__> heh
<palomer__> I managed to hack my way out of trouble
<palomer__> so ugly!
<palomer__> I'm putting a vbox into an hbox into a vbox
<palomer__> why? because it works
<flux> perhaps some gtk-related forum (mailing list?) could point you a better way, even though you're dealing with it through the bindings
<palomer__> you sure gtk related mailing lists would accept ocaml code?
<palomer__> the functions are totally not the same
<flux> doesn't it all boil down to a set of widgets and operations you perform on them..
<flux> iow, you could just explain the problem (or the code)
<palomer__> good point
<palomer__> I've been trying to ask a gtk channel
<palomer__> with no success
ygrek has joined #ocaml
filp has joined #ocaml
coucou747 has joined #ocaml
seafood_ has quit []
Yoric[DT] has joined #ocaml
Tetsuo has joined #ocaml
marmottine has joined #ocaml
mamie_cracra has joined #ocaml
mamie_cracra has quit [Client Quit]
OChameau has joined #ocaml
al-maisan has joined #ocaml
bluestorm has joined #ocaml
Yoric[DT] has quit [Read error: 104 (Connection reset by peer)]
Yoric[DT] has joined #ocaml
marmottine has quit ["Quitte"]
ygrek has quit [Remote closed the connection]
smimram has joined #ocaml
smimou has quit [Read error: 110 (Connection timed out)]
ygrek has joined #ocaml
<flux> hah, the first time I get a pointless warning
<flux> I have a registration function, which returns a function to undo the registration
<flux> so val register : (unit -> unit) -> (unit -> unit)
<flux> now it happens that I have a place where I don't need to ever undo the registration, so i do ignore (register (..))
<flux> and now I get "Warning F: this function application is partial, some arguments may be missing"
<bluestorm> (ignore register) ?
<flux> what?
<bluestorm> ha, i see
<bluestorm> nothing
<bluestorm> let _ = register (...) in ... doesn't raise any warning
hkBst has joined #ocaml
<flux> yeah, I worked it around
Yoric[DT] has quit ["Ex-Chat"]
ygrek has quit [Remote closed the connection]
ygrek has joined #ocaml
yminsky_ has quit []
LordMetroid has joined #ocaml
l_a_m has quit [Read error: 104 (Connection reset by peer)]
Ramzi has quit [Read error: 110 (Connection timed out)]
al-maisan has quit ["Leaving."]
magthe has joined #ocaml
sporkmonger has joined #ocaml
l_a_m has joined #ocaml
Demitar has quit [Read error: 104 (Connection reset by peer)]
<munga> I want to parse regexp with camlp4 ... how can I convince the lexer to tokenize chars and not strings ?
Loki_ has quit [Read error: 113 (No route to host)]
<munga> I could use `CHARS(s,_) but then I've to write my regex as 'a''b'* ... (with ' ) that is pretty annoying ...
l_a_m has quit [Remote closed the connection]
l_a_m has joined #ocaml
LordMetroid has quit ["Leaving"]
mbishop has quit [Read error: 104 (Connection reset by peer)]
al-maisan has joined #ocaml
al-maisan has left #ocaml []
al-maisan has joined #ocaml
Snark has quit ["Ex-Chat"]
LordMetroid has joined #ocaml
postalchris has joined #ocaml
<munga> In the old camlp4 I could create a new lexer with Plexer.gmake ... can I do something similar in the new camlp4 ?
<flux> perhaps the mailing list would be more knowledgeable with this subject
<munga> that's true :)
<flux> however, if you do find out, I'm sure someone here would be interested in the solution :)
<flux> (I personally haven't diven into camlp4 yet)
LordMetroid has quit ["Leaving"]
coucou747 has quit ["bye ca veut dire tchao en anglais"]
<bluestorm> munga: you can plug a new lexer into the functor machinery
<munga> bluestorm: yes. I found recent thread about it... I'm trying to write a minimal lexer, but I'm a bit lost atm ... I'm trying to create a minimal grammar using Camlp4.PreCast.MakeGram(Lexer) where lexer is a custom module ...
<munga> but it's not as easy as it seems ...
<bluestorm> if you want more general information about the whole functor thing, you can see the Camlp4/PreCast.ml source
<munga> I'm looking at it now. what I don't understand is what I need and I don'
<munga> t need ..
<munga> I could just cpoy paste in an other module ...
<bluestorm> do you intend to use the OCaml grammar, or a specific (and hopefully simpler) one ?
<munga> I'm writing a very simple parser for regexp
<munga> I've the parser, the problem is that I need to tokenize chars and I don't want strings ...
<munga> so I don't want to extend the ocaml grammar... I just want to learn how to write a super simple parser with the camlp4 machinery
<munga> if you look at all the "calc" examples around, they always extend the ocaml grammar... I'm trying to write a very minimal version of it...
<bluestorm> if you have your lexer, Struct.Grammar.Static.Make(Lexer) will build an empty grammar
<bluestorm> then you use the EXTEND macro to define your grammar on top of that
<munga> yep. but the I also have to define a new camlp4_token with my tokens ... correct ?
twobitwork has joined #ocaml
<twobitwork> howdy
<bluestorm> munga: yes
<twobitwork> I'm having a hard time finding gui toolkits for ocaml... any suggestions?
<bluestorm> but that's included in the Lexer module
<bluestorm> twobitwork: lablgtk
<twobitwork> bluestorm: is it cross platform?
<bluestorm> yes, it's GTK
<twobitwork> ok, I just didn't know if the bindings were
<twobitwork> what about wxwindows?
<munga> it's in Camlp4.PreCast.ml .... that btw has a line like : type camlp4_token = Sig.camlp4_token == [ KEYWORD of string ... ];
<munga> what is the == bit ?
<bluestorm> hm
<munga> it's the revised syntax ... but I've nver seen it be4
<bluestorm> it's a re-exportation of the Sig.camlp4_token type
postalchris has quit [Read error: 110 (Connection timed out)]
<bluestorm> munga: i think that you do not have to use this camlp4_token type for your tokens
<bluestorm> it's a general token type that is used in the ocaml-grammar-handling part of camlp4, but i think you can use your own token type instead, as the Token signature do not recommend any specific type
<munga> shall I just open Sig ?
<orbitz> morning bluestorm
<munga> ok... I see
<munga> something like MYCHAR and I use this MYCHAR in my lexer ... I'll give it a try
<munga> well... no... I need to extend the camlp4_token ... otherwise the camlp4 machinery will get lost ... don't know. I don't understand it enough...
Loki_ has joined #ocaml
Axioplase has joined #ocaml
<munga> well, I've sent a msg on the ml. I hope we can come up with a small example ...
struk_atwork has joined #ocaml
munga has quit ["Leaving"]
pango has quit [Remote closed the connection]
pango has joined #ocaml
marmottine has joined #ocaml
filp has quit ["Bye"]
postalchris has joined #ocaml
acatout has quit [Remote closed the connection]
Linktim has joined #ocaml
Yoric[DT] has joined #ocaml
<Yoric[DT]> hi again
mbishop has joined #ocaml
al-maisan has quit ["Leaving."]
Loki_ has quit ["Leaving"]
Tetsuo has quit ["Leaving"]
magthe has quit ["Ex-Chat"]
acatout has joined #ocaml
<orbitz> hi
<orbitz> you don't eralize how much you miss currying until you use a langauge that lacks it
<orbitz> the worst is it's not like a giant miss, you just sorta grumble that now you have to make an anonymous function get what you want (or a whole function in somecases)
Linktim_ has joined #ocaml
<Smerdyakov> orbitz, you're talking about other languages with first-class closures?
<Smerdyakov> s/with/without
<orbitz> well python is the current language i'm using at work
<orbitz> it's closures are kinda broken
<Smerdyakov> Uh oh! You just hit jonafan's hot button!
<orbitz> uh-oh, what'd i do?!
<orbitz> does he <3 python or something?
<Smerdyakov> "It's" instead of "its."
<orbitz> oh my b
<orbitz> its closures are kinda broken
Jeff_123 has joined #ocaml
<Jeff_123> bleh! It really works now. http://forge.ocamlcore.org/frs/?group_id=23
<Jeff_123> just not native-code still. I always get linking errors.
<Yoric[DT]> I'm considering adding it to the Number module of Batteries Included.
<Jeff_123> I recommend it, mostly if you can manage to get it to link natively
<Jeff_123> I deleted the 1.1 release, I didn't include a readme or licensing info.
<Jeff_123> er, 1.0. It's 1.1 now
<Jeff_123> ld: duplicate symbol _camlUInt64__code_begin in uInt64.o and uInt64.o
<Jeff_123> collect2: ld returned 1 exit status
<Jeff_123> Error during linking
filp has joined #ocaml
OChameau has quit ["Leaving"]
<Jeff_123> the other thing is that the cma file I generate for use in the toplevel requires ocamlmklib, which doesn't seem to be included in the windows version of ocaml.
Linktim has quit [Read error: 110 (Connection timed out)]
Snrrrub has joined #ocaml
al-maisan has joined #ocaml
oavdeev has joined #ocaml
<mbishop> Is there a library for unsigned ints in OCaml?
<mbishop> like Int32, only unsigned
al-maisan has quit ["Leaving."]
<flux> jeff_123, argh, an archive that doesn't extract to its own directory!
* Yoric[DT] suggests excommunication.
* Yoric[DT] probably did the same idiocy with his lazy list module, of course.
<flux> ocaml doesn't support 64 bit unsigned literals, though? but should be fixable with a syntax extension :)
<flux> is there uint32lib, btw? because I could see that being useful too..
<mbishop> trying to get that to work, well it works, but prints signed int32, so every few random numbers are negative :/
ELIS has joined #ocaml
<mbishop> SML's WORD library provides unsigned ints, wish OCaml did the same :(
<ELIS> hi
<Yoric[DT]> mbishop: is to_string the only problem ?
<mbishop> Yoric[DT]: don't think so?
<mbishop> is there a better way to print them?
<Yoric[DT]> Just asking.
<ELIS> mbishop hello
<Yoric[DT]> If it's the only problem, I'm convinced you'll be able to solve it shortly :)
* mbishop isn't sure if that's the problem or not
ELIS has left #ocaml []
<Yoric[DT]> (by projecting onto Int64, if necessary...)
filp has quit [Remote closed the connection]
Tetsuo has joined #ocaml
ygrek has quit [Remote closed the connection]
comglz has joined #ocaml
Tetsuo has quit [Remote closed the connection]
rodge has joined #ocaml
Axioplase has quit ["Lost terminal"]
Linktim_ has quit [Remote closed the connection]
Proteus has joined #ocaml
sporkmonger_ has joined #ocaml
comglz has quit ["AddToFunc ExitFunction I Exec exec sudo halt"]
comglz has joined #ocaml
sporkmonger has quit [Read error: 110 (Connection timed out)]
bzzbzz has quit ["leaving"]
Axioplase has joined #ocaml
struk_atwork has quit [Read error: 104 (Connection reset by peer)]
marmottine has quit ["Quitte"]
<palomer__> hrmph
<palomer__> anyone know how to call queue_draw on a text view?
<palomer__> (or a window)
<palomer__> got it
<Yoric[DT]> Thanks.
<Yoric[DT]> I'll take a look tomorrow.
<gildor_> Yoric[DT]: seems that planet don't like wordpress media:title
<Yoric[DT]> Yeah.
<gildor_> i still need to fix things and then i will replace the official planet by this one
<Yoric[DT]> sorry, afk
<gildor_> you don't know how much trouble it cause too me ;-)
* gildor_ don't like python
jlouis has joined #ocaml
AxleLonghorn has joined #ocaml
AxleLonghorn has left #ocaml []
Tetsuo has joined #ocaml
* Yoric[DT] sympathizes with gildor_.
smimram has quit ["bli"]
smimou has joined #ocaml
jdrake has joined #ocaml
<jdrake> Why is it that ocaml needs special operators for floats and SML and Haskell do not?
Yoric[DT] has quit ["Ex-Chat"]
authentic has left #ocaml []
authentic has joined #ocaml
Axioplase has quit ["brb"]
oavdeev has quit ["Ex-Chat"]
<mbishop> jdrake: because they aren't overloaded in Ocaml
l_a_m has quit [Read error: 104 (Connection reset by peer)]
<Jeff_123> sorry about the zip file not extracting to a folder :)
<mbishop> Is there a library for unsigned 32bit integers for Ocaml?
<Jeff_123> no but I bet I could make minor changes to my uint64lib to do that.
<mbishop> well that would be nice, since I haven't found any others
Axioplase has joined #ocaml
comglz has quit ["bonne nuit all"]
Tetsuo has quit ["Leaving"]
Axioplase has quit ["/homerun"]
postalchris has quit [Read error: 110 (Connection timed out)]
<Jeff_123> mbishop - I just made the edits. It'll need testing though.
<Jeff_123> heehee it was so easy!
AxleLonghorn has joined #ocaml
AxleLonghorn has left #ocaml []
<mbishop> nice
<mbishop> packaged it somewhere? :P
<Jeff_123> sure just a sec
<mbishop> thanks