I am new to ocaml and trying to move a circle using Graphics library of Ocaml.
This is what I did but it is not working. It should continue for infinite time because of "while true" but it is not working and I am not able to give an Input.
#load "graphics.cma";;
#load "unix.cma";;
Graphics.open_graph " 800x250";;
Graphics.remember_mode true;;
Graphics.set_color 100;;
Graphics.foreground;;
let player = [|40;80;10|];;
Graphics.fill_circle player.(0) player.(1) player.(2);;
let rec check button =
if button = 'w'
then
player.(0) <- player.(0) + 50;
Graphics.fill_circle player.(0) player.(1) player.(2);
while true do
let s = Graphics.wait_next_event [Graphics.Button_down; Graphics.Key_pressed]
and bo=Graphics.key_pressed ()
in if not bo then check s.Graphics.key;
done;;
Here is the cause of problems:
Graphics.fill_circle player.(0) player.(1) player.(2);
^^^^^^^
here should be a double semicolon
Without a second semicolon, the while expression was considered as
a part of check function, the proper indentation clarifies this:
let rec check button =
if button = 'w'
then
player.(0) <- player.(0) + 50;
Graphics.fill_circle player.(0) player.(1) player.(2);
while true do
let s = Graphics.wait_next_event [Graphics.Button_down; Graphics.Key_pressed]
and bo=Graphics.key_pressed ()
in if not bo then check s.Graphics.key;
done
So, you just defined a function check, and never called it, that's why nothing was happening.
Also, OCaml is a programming language, so it is better to try to write OCaml programs, not scripts. Put the following in a graph.ml file,
let player = [|40;80;10|]
let init () =
Graphics.open_graph " 800x250";
Graphics.remember_mode true;
Graphics.set_color 100;
Graphics.fill_circle player.(0) player.(1) player.(2)
let rec check button =
if button = 'w'
then
player.(0) <- player.(0) + 50;
Graphics.fill_circle player.(0) player.(1) player.(2)
let run () =
while true do
let s = Graphics.wait_next_event [
Graphics.Button_down;
Graphics.Key_pressed
] in
let bo = Graphics.key_pressed () in
if not bo then check s.Graphics.key;
done
let () =
init ();
run ()
Compile and run it with the following command
ocamlbuild -pkg graphics graph.native --
Related
Before refering to it, I have read OpenTK - fragment shader is not working (triangle is always black)
and it did not help.
I'm trying to do the 'hello triangle' tutorial, for OpenTK in F#. But my triangle is black instead of orange. I guess that it is somehow the fragment shader that is not working correctly but can't find out why. https://opentk.net/learn/chapter1/2-hello-triangle.html
Shader class
type Shader(vertexpath, fragmentpath) as shader =
let mutable handle = GL.CreateProgram()
let mutable disposed = false
let mutable vertexShader = GL.CreateShader(ShaderType.VertexShader)
let mutable fragmentShader = GL.CreateShader(ShaderType.FragmentShader)
do
// vertexshader
let mutable shaderSource = load vertexpath
let mutable vertexShader = GL.CreateShader ShaderType.VertexShader
GL.ShaderSource(vertexShader, shaderSource)
shader.CompileShader(vertexShader)
// fragmentshader
let mutable shaderSource = load fragmentpath
let mutable fragmentShader = GL.CreateShader ShaderType.VertexShader
GL.ShaderSource(vertexShader, shaderSource)
shader.CompileShader(fragmentShader)
GL.AttachShader(handle, vertexShader)
GL.AttachShader(handle, fragmentShader)
shader.LinkProgram(handle)
GL.DetachShader(handle, vertexShader)
GL.DetachShader(handle, fragmentShader)
GL.DeleteShader(fragmentShader)
GL.DeleteShader(vertexShader)
member _.Dispose() =
if not disposed then
GL.DetachShader(handle, vertexShader)
GL.DetachShader(handle, fragmentShader)
GL.DeleteShader(vertexShader)
GL.DeleteShader(fragmentShader)
GL.DeleteProgram(handle)
disposed <- true
member _.Use() = GL.UseProgram(handle)
member _.CompileShader shader =
let mutable code = 0
GL.CompileShader shader
let info = GL.GetShaderInfoLog(shader)
if System.String.IsNullOrEmpty info then
printfn $"{info}"
GL.GetShader(shader, ShaderParameter.CompileStatus, &code)
if code <> int All.True then
let infoLog = GL.GetShaderInfoLog shader
failwith $"Error occured whilst compiling Shader({shader}).\n\n{infoLog}"
member _.LinkProgram (program: int) =
let mutable code = 0
GL.LinkProgram program
let info = GL.GetProgramInfoLog(program)
if System.String.IsNullOrEmpty info then
printfn $"{info}"
GL.GetProgram(program, GetProgramParameterName.LinkStatus, &code)
if code <> int All.True then
failwith $"Error occurred whilst linking Program({program})"
where
let load (path: string) =
(new StreamReader(path, Encoding.UTF8)).ReadToEnd()
|> fun str ->
printfn $"{str}"
str
Window Class
type Window(width, height, ?title) as Win =
inherit
// diviation from code on github
GameWindow(
GameWindowSettings.Default,
new NativeWindowSettings()
)
let mutable title = defaultArg title ""
let vertices =
[|
-0.5f; -0.5f; 0.0f;
0.5f; -0.5f; 0.0f;
0.0f; 0.5f; 0.0f;
|]
// throw execption if not initiated
let mutable vertexBufferObject = -1
let mutable vertexArrayObject = -1
let mutable shader = new Shader("Shaders\shader.vert", "Shaders\shader.frag")
do
Win.Size <- (width, height)
Win.Title <- title
override _.OnLoad() =
base.OnLoad()
GL.ClearColor(0.2f, 0.3f, 0.3f, 1.0f)
vertexBufferObject <- GL.GenBuffer()
GL.BindBuffer(BufferTarget.ArrayBuffer, vertexBufferObject)
GL.BufferData(BufferTarget.ArrayBuffer, vertices.Length * 4, vertices, BufferUsageHint.StaticDraw)
vertexArrayObject <- GL.GenVertexArray()
GL.BindVertexArray(vertexArrayObject)
// shader not yet implemented??
GL.VertexAttribPointer(0, 3, VertexAttribPointerType.Float, false, 3 * 4, 0)
GL.EnableVertexAttribArray(0)
shader.Use()
override _.OnUnload() =
GL.BindBuffer(BufferTarget.ArrayBuffer, 0)
GL.BindVertexArray(0)
GL.UseProgram(0)
GL.DeleteBuffer(vertexBufferObject)
GL.DeleteVertexArray(vertexArrayObject)
shader.Dispose()
base.OnUnload()
override _.OnRenderFrame e =
base.OnRenderFrame e
GL.Clear(ClearBufferMask.ColorBufferBit)
shader.Use()
GL.BindVertexArray(vertexArrayObject)
GL.DrawArrays(PrimitiveType.Triangles, 0, 3)
Win.SwapBuffers()
override _.OnResize e =
base.OnResize e
GL.Viewport(0, 0, fst Win.Size, snd Win.Size)
override _.OnUpdateFrame e =
base.OnUpdateFrame e
if Win.KeyboardState.IsKeyDown(Keys.Escape) then
Win.Close()
the indentation is off, I know. Again the program runs without error except for the triangle not being the proper colour. Is have used https://github.com/opentk/LearnOpenTK/blob/master/Chapter1/2-HelloTriangle/Window.cs
and
https://github.com/opentk/LearnOpenTK/blob/master/Common/Shader.cs
to troubleshoot my code
The shader.vert and shader.frag are copy pasted from the git repo above.
I found the error, I was targeting the vertexshader object when compiling both shaders
In DBExt, you can change your connection with
DBSetOption profile=<profile name>
But is there a way to switch between connections like next or previous? Or would I have to make a vimscript function to deal with that?
Solved with a Vimscript:
let g:dbext_default_profile_one = '...'
let g:dbext_default_profile_two = '...'
let g:dbext_default_profile = 'one'
let s:dbext_profiles = ['one', 'two']
let s:current_profile_number = 0
function! Next_dbext_profile()
" Reset current_profile_number if too high
if s:current_profile_number >= len(s:dbext_profiles)
let s:current_profile_number = 0
endif
let l:exec_string = ':DBSetOption profile=' . s:dbext_profiles[s:current_profile_number]
echo l:exec_string
execute l:exec_string
let s:current_profile_number = s:current_profile_number + 1
endfunction
In Haskell you can say
main = do
let x = 5
print x
and this will not compile:
main = do
let x = 5
in print x
But if I am using explicit layout, this does not compile:
main = do {
let x = 5;
print x;
}
but this works:
main = do {
let x = 5
in print x;
}
Am I right? Is there anyplace I can read more about explicit layout and do and let notation? Section 3.14 of the Haskell 98 report seems to me to suggest that my third example should work, as it says I can write
do { let DECLS; stmts }
and it translates to
let DECLS in do { stmts }
The normative answer to your question can be found in the Haskell report's description of the layout rule.
Briefly, you need to place a semicolon between your let block and the next statement of the do block. That semicolon needs to lie outside of the let block. If you don't use layout for the let block, that's easy, just say:
let {x = 5};
However, if you do use layout for the let block, then the only way to close the let block is to start a line in a column before the column of x. So that means you'd have to write something like this:
main = do {
let x = 5
; print x;
}
Oh, and for your other example, again with layout a semicolon is getting inserted before the in, so your code desugars to:
main = do {
let {x = 5
};
in print x
}
I'searching for a function to close an opened Exceldocument.
That's how I open it:
let xlApp = new Excel.ApplicationClass()
let xlWorkBookInput = xlApp.Workbooks.Open(#"C:\Projects\Tool\Versuch\VersuchZuEditieren.xlsx")
let viewStateMachine state event =
match state, event with
| {State = _}, ConsumablesClicked vm ->
view.HandleModelChanged { Title = "My Title"; Comment = sprintf "" }
let TrackPosition = vm.TrackPosition
let xlWorkSheetInput = xlWorkBookInput.Worksheets.["Consumables"] :?> Excel.Worksheet
let array = vm.TubePosition.Split([|','|])
let arrayLength = array.Length
let addIndex = sprintf "%s%d"
let randomNumber = System.Random()
for i in 0 .. arrayLength - 1 do
xlWorkSheetInput.Cells.[startindex + i + 2, 1] <- vm.TrackPosition
xlWorkSheetInput.Cells.[startindex + i + 2, 2] <- array.[i]
let randomBarcodePart2 = randomNumber.Next(000000, 999999)
xlWorkSheetInput.Cells.[startindex+ i + 2, 3] <- sprintf "%s%06d" vm.FixBarcodePart randomBarcodePart2
startindex <- startindex + arrayLength
{ State = "Consumables" }
And here I will close it, but how?
From comments in the discussion, Excel documents can be closed with
xlApp.Workbooks.Close()
I'm writing up a series of graph-searching algorithms in F# and thought it would be nice to take advantage of parallelization. I wanted to execute several threads in parallel and take the result of the first one to finish. I've got an implementation, but it's not pretty.
Two questions: is there a standard name for this sort of function? Not a Join or a JoinAll, but a JoinFirst? Second, is there a more idiomatic way to do this?
//implementation
let makeAsync (locker:obj) (shared:'a option ref) (f:unit->'a) =
async {
let result = f()
Monitor.Enter locker
shared := Some result
Monitor.Pulse locker
Monitor.Exit locker
}
let firstFinished test work =
let result = ref Option.None
let locker = new obj()
let cancel = new CancellationTokenSource()
work |> List.map (makeAsync locker result) |> List.map (fun a-> Async.StartAsTask(a, TaskCreationOptions.None, cancel.Token)) |> ignore
Monitor.Enter locker
while (result.Value.IsNone || (not <| test result.Value.Value)) do
Monitor.Wait locker |> ignore
Monitor.Exit locker
cancel.Cancel()
match result.Value with
| Some x-> x
| None -> failwith "Don't pass in an empty list"
//end implentation
//testing
let delayReturn (ms:int) value =
fun ()->
Thread.Sleep ms
value
let test () =
let work = [ delayReturn 1000 "First!"; delayReturn 5000 "Second!" ]
let result = firstFinished (fun _->true) work
printfn "%s" result
Would it work to pass the CancellationTokenSource and test to each async and have the first that computes a valid result cancel the others?
let makeAsync (cancel:CancellationTokenSource) test f =
let rec loop() =
async {
if cancel.IsCancellationRequested then
return None
else
let result = f()
if test result then
cancel.Cancel()
return Some result
else return! loop()
}
loop()
let firstFinished test work =
match work with
| [] -> invalidArg "work" "Don't pass in an empty list"
| _ ->
let cancel = new CancellationTokenSource()
work
|> Seq.map (makeAsync cancel test)
|> Seq.toArray
|> Async.Parallel
|> Async.RunSynchronously
|> Array.pick id
This approach makes several improvements: 1) it uses only async (it's not mixed with Task, which is an alternative for doing the same thing--async is more idiomatic in F#); 2) there's no shared state, other than CancellationTokenSource, which was designed for that purpose; 3) the clean function-chaining approach makes it easy to add additional logic/transformations to the pipeline, including trivially enabling/disabling parallelism.
With the Task Parallel Library in .NET 4, this is called WaitAny. For example, the following snippet creates 10 tasks and waits for any of them to complete:
open System.Threading
Array.init 10 (fun _ ->
Tasks.Task.Factory.StartNew(fun () ->
Thread.Sleep 1000))
|> Tasks.Task.WaitAny
In case you are ok to use "Reactive extensions (Rx)" in your project, the joinFirst method can be implemented as:
let joinFirst (f : (unit->'a) list) =
let c = new CancellationTokenSource()
let o = f |> List.map (fun i ->
let j = fun() -> Async.RunSynchronously (async {return i() },-1,c.Token)
Observable.Defer(fun() -> Observable.Start(j))
)
|> Observable.Amb
let r = o.First()
c.Cancel()
r
Example usage:
[20..30] |> List.map (fun i -> fun() -> Thread.Sleep(i*100); printfn "%d" i; i)
|> joinFirst |> printfn "Done %A"
Console.Read() |> ignore
Update:
Using Mailbox processor :
type WorkMessage<'a> =
Done of 'a
| GetFirstDone of AsyncReplyChannel<'a>
let joinFirst (f : (unit->'a) list) =
let c = new CancellationTokenSource()
let m = MailboxProcessor<WorkMessage<'a>>.Start(
fun mbox -> async {
let afterDone a m =
match m with
| GetFirstDone rc ->
rc.Reply(a);
Some(async {return ()})
| _ -> None
let getDone m =
match m with
|Done a ->
c.Cancel()
Some (async {
do! mbox.Scan(afterDone a)
})
|_ -> None
do! mbox.Scan(getDone)
return ()
} )
f
|> List.iter(fun t -> try
Async.RunSynchronously (async {let out = t()
m.Post(Done out)
return ()},-1,c.Token)
with
_ -> ())
m.PostAndReply(fun rc -> GetFirstDone rc)
Unfortunately, there is no built-in operation for this provided by Async, but I'd still use F# asyncs, because they directly support cancellation. When you start a workflow using Async.Start, you can pass it a cancellation token and the workflow will automatically stop if the token is cancelled.
This means that you have to start workflows explicitly (instead of using Async.Parallel), so the synchronizataion must be written by hand. Here is a simple version of Async.Choice method that does that (at the moment, it doesn't handle exceptions):
open System.Threading
type Microsoft.FSharp.Control.Async with
/// Takes several asynchronous workflows and returns
/// the result of the first workflow that successfuly completes
static member Choice(workflows) =
Async.FromContinuations(fun (cont, _, _) ->
let cts = new CancellationTokenSource()
let completed = ref false
let lockObj = new obj()
let synchronized f = lock lockObj f
/// Called when a result is available - the function uses locks
/// to make sure that it calls the continuation only once
let completeOnce res =
let run =
synchronized(fun () ->
if completed.Value then false
else completed := true; true)
if run then cont res
/// Workflow that will be started for each argument - run the
/// operation, cancel pending workflows and then return result
let runWorkflow workflow = async {
let! res = workflow
cts.Cancel()
completeOnce res }
// Start all workflows using cancellation token
for work in workflows do
Async.Start(runWorkflow work, cts.Token) )
Once we write this operation (which is a bit complex, but has to be written only once), solving the problem is quite easy. You can write your operations as async workflows and they'll be cancelled automatically when the first one completes:
let delayReturn n s = async {
do! Async.Sleep(n)
printfn "returning %s" s
return s }
Async.Choice [ delayReturn 1000 "First!"; delayReturn 5000 "Second!" ]
|> Async.RunSynchronously
When you run this, it will print only "returning First!" because the second workflow will be cancelled.