Archives

You are currently viewing archive for February 2009
Category: f#
Posted by: erik

#light
let regex s = new System.Text.RegularExpressions.Regex(s,System.Text.RegularExpressions.RegexOptions.Compiled)

let stringorregex (reg : obj) =
   match reg with
   | :? System.Text.RegularExpressions.Regex -> reg :?> System.Text.RegularExpressions.Regex
   | :? string -> System.Text.RegularExpressions.Regex (reg :?> string)
   | _ -> failwith "regular expression must be of type <regex> or <string>."

let (=~) reg str = (stringorregex reg).IsMatch(str)
let (^~) reg str = not ((stringorregex reg).IsMatch(str))

let (=~~) (reg : obj) str =
   let m = (stringorregex reg).Match(str)
   [0..m.Groups.Count - 1] |> List.map (fun x -> (m.Groups.Item(x)).Value)

let (=~~~) (reg : obj) str =
   let groups (m : System.Text.RegularExpressions.Match) = [0..m.Groups.Count - 1] |> List.map (fun x -> (m.Groups.Item(x)).Value)
   let m = ref ((stringorregex reg).Match(str))
   seq {
      while (!m).Success do
         yield groups (!m)
         m := (!m).NextMatch()
   }
 



Example usage


regex "d[a-z]g" =~ "the dog is brown" |> printf "%b\n"

prints: true


"d[a-z]g" ^~ "the dog is brown" |> printf "%b\n"

prints: false


let [_; the; pen; works; correctly] = "(\w+) (\w+) (\w+) (\w+)" =~~ "the pen works correctly"
printf "%s,%s,%s,%s\n" the pen works correctly

prints: the,pen,works,corectly


for i in "(\w+) (\w+)" =~~~ "james 12 charles 78 helmut 43" do
   printf "[%s,%s] " i.[1] i.[2]

prints: [james,12] [charles,78] [helmut,43]


".o" =~~~ "do you remember willo the wisp?"
   |> Seq.map (fun (x :: []) -> x)
   |> Seq.iter (printf "[%s] ")

prints: [do] [yo] [lo]


let split = (regex " ").Split("i fancy he is a bedlamite")
for word in split do printf "%s, " word

prints: i, fancy, he, is, a, bedlamite,


[1..100]
   |> List.map string
   |> List.filter ((=~) "1.+")
   |> List.iter (printf "%s,")

prints: 10,11,12,13,14,15,16,17,18,19,100,

Category: f#
Posted by: erik

previous: sdlSimple


ummmm...i thought i would highlight some things i learned while writing this library:



Importing functions from external c++ libraries


a couple of examples:

[<DllImport("libpcxf", EntryPoint="colour")>]
extern int colourC(byte r, byte g, byte b)

//useage:
let yellow = colourC(255uy, 255uy, 0uy)


[<DllImport("libpcxf")>]
extern unit setScreen(IntPtr pixels, int width, int height, int depth)

//usage:
let (screen : IntPtr) = Sdl.SDL_SetVideoMode(640, 480, 32, Sdl.SDL_DOUBLEBUF ||| Sdl.SDL_HWPALETTE)
let (surface : Sdl.SDL_Surface) = (Marshal.PtrToStructure(screen, typeof<Sdl.SDL_Surface>)) :?> Sdl.SDL_Surface
let buffer = surface.pixels
setScreen(buffer, sdlWidth, sdlHeight, sdlDepth)
 



Marshaling an array of structs from c++ to f#


'getPalette' is a c++ function that takes a file location as argument and returns an array of SDL_Color structs (which are 32-bit int's basically).
to access the returned array in f# it would seem you have to increment the returned pointer and reconstruct the array.

[<DllImport("libpcxf")>]
extern IntPtr getPalette(string pal)

let mutable (palette : IntPtr) = (getPalette(file))
let colours = [|0..255|] |> Array.map (fun i -> Sdl.SDL_Color())
for i in [0..255] do
   colours.[i] <- (Marshal.PtrToStructure(palette, typeof<Sdl.SDL_Color>) :?> Sdl.SDL_Color)
   palette <- IntPtr(palette.ToInt32() + sizeof<Sdl.SDL_Color>)
 



F# keywords are not allowed as method names


because 'type' is a f# reserved keyword i was unable to extract the event type from an sdl event structure with 'event.type'
i was able to overcome this by writing a short c# library that did this for me.

so:
(!event).type

became:
GetEventType.Get(!event)

using this c# dll:

using Tao.Sdl;
public class GetEventType {
        public static int Get(Sdl.SDL_Event e) {
                return e.type;
        }
}

i encountered a similar problem with the 'val' keyword which was solved using this dll:

using Tao.Sdl;
public class GetJaxisValue {
        public static short Get(Sdl.SDL_Event e) {
                return e.jaxis.val;
        }
}
 
if anyone knows of a superior way of handling this problem, i would like to know.



Overloaded functions


overloaded functions are not presently availible in f# but you can match on types which achieves a similar result:

let write c (data : obj) (x, y) =
   match data with
   | :? string -> writeString(x, y, (data :?> string), c)
   | :? int -> writeInt(x, y, (data :?> int), c)
   | :? double -> writeDouble(x, y, (data :?> double), c)
   | _ -> failwith "data type not supported."
 



Events


for those unfamiliar with SDL (www.libsdl.org) it requires you to create an infinite loop that listens for sdl events and reacts to them. this can be seen in the previous entry under 'sdl event loop'.

in this loop i convert the wanted native SDL events into f# events of the type union 'sdlevent':

type sdlevent =
   | KeyUp of int
   | KeyDown of int
   | MouseMove of int * int
   ...etc...

and fire them into the 'events' IEvent.

you can then listen for these events using the regular f# Event methods:

events |> Event.listen (fun e ->
   match e with
   | KeyDown x -> printf "%s pressed.\n" (scancodeToKey x)
   | KeyUp x -> printf "%s released.\n" (scancodeToKey x)
   | _ -> ()
)
 



Drawing


SdlSimple keeps a list of functions in 'drawevents' and executes each one on every iteration of the sdl event loop like so:
for (s, e) in drawevents do e()

you draw to the screen by adding a function that utilizes one or more drawing methods (pixel, line, write, rectangle, colour) to the 'drawevents' list using the 'drawfire' event firing function.

this will add the 'hello' function to the 'drawevents' list thus writing "hello" to the screen:

drawfire (Draw ("hello", (fun () ->
   write (colour 255 255 255) "hello" (100, 100)
)))

and this will remove it from the same list; erasing it from the screen:
drawfire (Erease "hello")



Event and drawing DSL's


this is most likely an abuse of the f# monad syntax but i believe it allows for a concise way of drawing and responding to simple events:

//draw monad:
type DrawMonad(name) =
   member this.Delay(f) = drawfire (Draw (name, f))
   member this.Zero() = ()
let draw = DrawMonad("draw")
let drawn name = DrawMonad(name)

//event monad:
type EventMonad(evnt) =
   member this.Delay(f) =
      events |> Event.listen (fun e ->
         match e with
         | x when x = evnt -> f()
         | _ -> ()
      )
   member this.Zero() = ()
let onevent e = EventMonad(e)

//clear the screen:
let cls (str : obj) =
   match str with
   | :? string -> drawfire (Erase (str :?> string))
   | _ -> drawfire (Erase "draw")
 

the above classes allow you to write code like this:

//draw a green triangle:
drawn "triangle" {
   let green = colour 0 255 0
   [(150, 100); (200, 200); (100, 200); (150, 100)] |> Seq.reduce (line green) |> ignore
}

//erease the triangle when 'enter' is pressed:
onevent (KeyDown 13) {
   cls "triangle"
}
 



Checking for a file in multiple locations


List.find returns the fist element for which the given function returns true and throws a 'KeyNotFoundException' if no such element exists.

try ["/usr/local/share/libpcxf/palette.gpl"; "/usr/share/libpcxf/palette.gpl"; "palette.gpl"]        
   |> List.find System.IO.File.Exists |> setPalette |> ignore with | _ -> ()
 

20/02: SdlSimple

Category: f#
Posted by: erik
previous: Compiling Game of Life
next: SdlSimple highlights

#light
#nowarn "9"

open System
open System.Runtime.InteropServices
open Microsoft.FSharp.NativeInterop
open Tao.Sdl

let println x = print_any x; printf "\n"

//external c libraries:
[<DllImport("libpcxf", EntryPoint="pixel")>]
extern unit internal pixelC(int x, int y, int colour)
[<DllImport("libpcxf", EntryPoint="colour")>]
extern int internal colourC(byte r, byte g, byte b)
[<DllImport("libpcxf")>]
extern unit internal setScreen(void *pixels, int width, int height, int depth)
[<DllImport("libpcxf")>]
extern unit internal loadFonts()
[<DllImport("libpcxf")>]
extern unit internal unloadFonts()
[<DllImport("libpcxf")>]
extern unit internal writeInt(int x, int y, int num, int colour)
[<DllImport("libpcxf")>]
extern unit internal writeString(int x, int y, string text, int colour)
[<DllImport("libpcxf")>]
extern unit internal writeDouble(int x, int y, double num, int colour)
[<DllImport("libpcxf", EntryPoint="line")>]
extern unit internal lineC(int x1, int y1, int x2, int y2, int colour)
[<DllImport("libpcxf", EntryPoint="rectangle")>]
extern unit internal rectangleC(int x1, int y1, int x2, int y2, int colour)
[<DllImport("libpcxf")>]
extern IntPtr internal getPalette(string pal)


//event union: (sdlFire fires these events)
type sdlevent =
   | KeyUp of int
   | KeyDown of int
   | MouseMove of int * int
   | MouseUp of int
   | MouseDown of int
   | JoyAxis1 of int * int
   | JoyAxis2 of int * int
   | JoyButtonDown1 of int
   | JoyButtonDown2 of int
   | JoyButtonUp1 of int
   | JoyButtonUp2 of int


//draw union:
type sdldraw =
   | Draw of string * (unit -> unit)
   | UnDraw of string
   | Erase of string

let mutable drawevents = []


//globals:
let mutable internal sdlHeight = 0
let mutable internal sdlWidth = 0
let mutable internal sdlDepth = 0
let mutable internal sdlFullScreen = false
let mutable internal sdlFire = (fun x -> ()) //fire events.
let mutable drawfire = (fun x -> ()) //fire draw event.
let mutable sdlScreen = IntPtr()
let mutable sdlBuffer = IntPtr()
let mutable (_, events) = Event.create<sdlevent>() //catch events.


//f# wrapers for pcxf functions:
let inline colour (r : int) (g : int) (b : int) =  colourC((byte) r, (byte) g, (byte) b)
let inline pixel c (x, y) = pixelC(x, y, c)
let inline line c (x1, y1) (x2, y2) = lineC(x1, y1, x2, y2, c); (x2, y2)
let inline rectangle c (x1, y1) (x2, y2) = rectangleC(x1, y1, x2, y2, c)

let write c (data : obj) (x, y) =
   match data with
   | :? string -> writeString(x, y, (data :?> string), c)
   | :? int -> writeInt(x, y, (data :?> int), c)
   | :? double -> writeDouble(x, y, (data :?> double), c)
   | _ -> failwith "data type not supported."

let writey data (x, y) = write (colour 255 255 255) data (x, y)


//set the palette for 8-bit colour mode:
let setPalette file =
   let mutable (palette : IntPtr) = (getPalette(file))
   let colours = [|0..255|] |> Array.map (fun i -> Sdl.SDL_Color())
   for i in [0..255] do
      colours.[i] <- (Marshal.PtrToStructure(palette, typeof<Sdl.SDL_Color>) :?> Sdl.SDL_Color)
      palette <- IntPtr(palette.ToInt32() + sizeof<Sdl.SDL_Color>)

   Sdl.SDL_SetPalette(sdlScreen, (int) (Sdl.SDL_LOGPAL ||| Sdl.SDL_PHYSPAL), colours, 0, 256)


//function to show the frames per second in top left corner:
let internal timer = new System.Diagnostics.Stopwatch()
let mutable internal milliseconds = (int64 0)
let mutable internal frames = 0
let mutable internal fps = 0

let internal showfps () =
   frames <- frames + 1
   if timer.ElapsedMilliseconds > milliseconds then
      fps <- frames
      milliseconds <- timer.ElapsedMilliseconds + (int64 1000)
      frames <- 0
      ()
   writey fps (10, 0)
   writey "fps" (40, 0)


//convert keyboard scancodes to helpfull key string:
let scancodeToKey sc =
   Sdl.SDL_GetKeyName(sc)


//draw monad:
type DrawMonad(name) =
   member this.Delay(f) = drawfire (Draw (name, f))
   member this.Zero() = ()
let draw = DrawMonad("draw")
let drawn name = DrawMonad(name)


//event monad:
type EventMonad(evnt) =
   member this.Delay(f) =
      events |> Event.listen (fun e ->
         match e with
         | x when x = evnt -> f()
         | _ -> ()
      )
   member this.Zero() = ()
let onevent e = EventMonad(e)


//clear the screen:
let cls (str : obj) =
   match str with
   | :? string -> drawfire (UnDraw (str :?> string))
   | _ -> drawfire (UnDraw "draw")


//start the sdl program loop in a seperate thread:
let internal sdlloop = async {

   let _ = Sdl.SDL_Init(Sdl.SDL_INIT_VIDEO ||| Sdl.SDL_INIT_JOYSTICK)

   let (screen : IntPtr) =
      if sdlFullScreen = true then
         Sdl.SDL_SetVideoMode(sdlWidth, sdlHeight, sdlDepth, Sdl.SDL_DOUBLEBUF ||| Sdl.SDL_HWPALETTE ||| Sdl.SDL_FULLSCREEN)
      else
         Sdl.SDL_SetVideoMode(sdlWidth, sdlHeight, sdlDepth, Sdl.SDL_DOUBLEBUF ||| Sdl.SDL_HWPALETTE)

   //get ponter to video memory from sdl and pass it to pcxf library:
   let (surface : Sdl.SDL_Surface) = (Marshal.PtrToStructure(screen, typeof<Sdl.SDL_Surface>)) :?> Sdl.SDL_Surface
   let buffer = surface.pixels
   sdlBuffer <- buffer
   sdlScreen <- screen
   setScreen(buffer, sdlWidth, sdlHeight, sdlDepth)
   loadFonts()

   //open and set palette if 8-bit colour is being used:
   if sdlDepth = 8 then
      try ["/usr/local/share/libpcxf/palette.gpl"; "/usr/share/libpcxf/palette.gpl"; "palette.gpl"]        
         |> List.find System.IO.File.Exists |> setPalette |> ignore with | _ -> ()

   //open any joysticks that are plugged in:
   let _ = Sdl.SDL_JoystickEventState(Sdl.SDL_ENABLE)
   for i in [0..Sdl.SDL_NumJoysticks() - 1] do
      let _ = Sdl.SDL_JoystickOpen(i)
      ()
   
   //create arrays of black for clearing the screen:
   let empty8 = Array.create (sdlWidth * sdlHeight) 0uy
   let empty16 = Array.create (sdlWidth * sdlHeight) 0s
   let empty32 = Array.create (sdlWidth * sdlHeight) 0

   //sdl event loop:
   let event = ref (Sdl.SDL_Event())
   let running = ref 1
   timer.Start()

   while !running = 1 do
      while Sdl.SDL_PollEvent(event) = 1 do
         match GetEventType.Get(!event) with
            | Sdl.SDL_KEYDOWN -> sdlFire (KeyDown (!event).key.keysym.sym)
            | Sdl.SDL_KEYUP ->  
               if (!event).key.keysym.sym = 27 then running := 0
               sdlFire (KeyUp (!event).key.keysym.sym)
            | Sdl.SDL_MOUSEMOTION -> sdlFire (MouseMove (int ((!event).motion.x),int ((!event).motion.y)))
            | Sdl.SDL_MOUSEBUTTONDOWN -> sdlFire (MouseDown (int (!event).button.button))
            | Sdl.SDL_MOUSEBUTTONUP -> sdlFire (MouseUp (int (!event).button.button))
            | Sdl.SDL_JOYAXISMOTION ->
               match (!event).jaxis.which with
               | 0uy -> sdlFire (JoyAxis1 ((int ((!event).jaxis.axis)), (int (GetJaxisValue.Get(!event)))))
               | 1uy -> sdlFire (JoyAxis2 ((int ((!event).jaxis.axis)), (int (GetJaxisValue.Get(!event)))))
               | _ -> failwith "SdlSimple only supports 2 joysticks at present. (this is easy to fix)"
            | Sdl.SDL_JOYBUTTONDOWN ->
               match (!event).jbutton.which with
                  | 0uy -> sdlFire (JoyButtonDown1 (int (!event).jbutton.button))
                  | 1uy -> sdlFire (JoyButtonDown2 (int (!event).jbutton.button))
                  | _ -> failwith "SdlSimple only supports 2 joysticks at present. (this is easy to fix)"
            | Sdl.SDL_JOYBUTTONUP ->
               match (!event).jbutton.which with
                  | 0uy -> sdlFire (JoyButtonUp1 (int (!event).jbutton.button))
                  | 1uy -> sdlFire (JoyButtonUp2 (int (!event).jbutton.button))
                  | _ -> failwith "SdlSimple only supports 2 joysticks at present. (this is easy to fix)"
            | _ -> ()

      if Sdl.SDL_MUSTLOCK(sdlScreen) = 1 then do Sdl.SDL_LockSurface(sdlScreen) |> ignore

      //clear the screen:
      match sdlDepth with
      | 8 -> Marshal.Copy(empty8, 0, buffer, (sdlWidth * sdlHeight))
      | 16 -> Marshal.Copy(empty16, 0, buffer, (sdlWidth * sdlHeight))
      | 24 -> Marshal.Copy(empty16, 0, buffer, (sdlWidth * sdlHeight))
      | 32 -> Marshal.Copy(empty32, 0, buffer, (sdlWidth * sdlHeight))
      | _ -> failwith "not a valid bit depth."

      for (s, e) in drawevents do e() //perform all draw events.

      if Sdl.SDL_MUSTLOCK(sdlScreen) = 1 then do Sdl.SDL_UnlockSurface(sdlScreen) |> ignore
      Sdl.SDL_Flip(sdlScreen) |> ignore

   //clean up:
   println "done."
   timer.Stop()
   unloadFonts()
   Sdl.SDL_Quit()
}


//setup sdl and various things:
let SdlSimpleSetup width height depth fs =

   sdlHeight <- height
   sdlWidth <- width
   sdlDepth <- try [8;16;24;32] |> List.find ((=) depth) with | _ -> 32
   sdlFullScreen <- fs
   
   //create events for sdl events and draw events:
   let fire, evs = Event.create<sdlevent>()
   sdlFire <- fire
   events <- evs
   let dfire, draw = Event.create<sdldraw>()
   drawfire <- dfire

   //listen for draw events and add/delete them from the drawevents list:
   draw |> Event.listen (fun e ->
      match e with
         | Draw (s, e) -> drawevents <- drawevents @ [(s, e)]
         | UnDraw x | Erase x -> drawevents <- drawevents |> List.filter (fun (s, e) -> s <> x)
   )

   drawfire (Draw ("fps", showfps)) //add showfps function to drawevents list.

   Async.Spawn sdlloop //spawn the sdl program loop in a seperate thread.

   System.Threading.Thread.Sleep 500
 


Category: f#
Posted by: erik
were you wondering why the code in the previous post will not compile? curious in what obscure dll file SdlSimple is located?
well it cannot be found because i made it the fuck up.

SdlSimple is a f# graphics library that uses SDL (www.libsdl.org) to create a window and draw to the screen. it is a project i underwent to learn f# and test the ease of which it interoperates with native c++ code. to achieve this end: SdlSimple uses functions stored in an ancient, unfinished c library called pcxf that i wrote many years ago for dos. if this sounds silly; thats because it probably is.

to compile the game of life example you will need these files:
linux
windows

source code will be in the next post but if you would like to compile it yourself you can get the complete source here
source to the pcxf library is here

previous: Game of Life
next: SdlSimple

14/02: Game of Life.

Category: f#
Posted by: erik
#light
open System
open Array

let width, height = 100, 100

let tick game =
   let number index =
      let X, Y = index % width, index / width
      [|(-1, -1); (0, -1); (1, -1); (1, 0); (1, 1); (0, 1); (-1, 1); (-1, 0)|]
         |> map (fun (x, y) -> X + x, Y + y)
         |> filter (fun (x, y) -> x > 0 && x < width && y > 0 && y < height)
         |> map (fun (x, y) -> y * width + x)
         |> map (fun i -> if game.[i] then 1 else 0)
         |> sum

   game |> mapi (fun i alive ->
      match (alive, number i) with
      | (true, n) when n < 2 -> false
      | (true, n) when n > 3 -> false
      | (true, _) -> true
      | (false, 3) -> true
      | (false, _) -> false
      | _ -> failwith "no."
   )

let random = Random()
let mutable life = [|0..width * height - 1|] |> map (fun _ -> random.Next() % 2 = 0)

open SdlSimple
SdlSimpleSetup (width * 2) (height * 2 + 10) 16 false

draw {
   let yellow = colour 255 255 0
   life |> zip [|0..width * height - 1|] |> filter (fun (_, a) -> a)
        |> iter (fun (i, _) -> pixel yellow (i % width * 2, i / width * 2 + 10))
   life <- tick life
}

//press 'enter' to restart game.
onevent (KeyDown 13) { life <- [|0..width * height - 1|] |> map (fun _ -> random.Next() % 2 = 0) }

Console.ReadLine() |> ignore
 

next: Compiling Game of Life