Camlkit v0.2 & GNUstep (2)

前回報告した camlkitGS ライブラリを用いて、GNUstepのAppKit と CoreGraphics プログラムが実行できます。

[実行結果]
AppKit

CoreGraphics

AppKit プログラム
(dune init project で作成、その後libとtestを削除している。)

/bin
   dune
   main.ml

dune

(executable
 (public_name camlkitTest1)
 (name main)
   (flags -ccopt -L/usr/local/GNUstep/System/Library/Libraries -cclib -lgnustep-base -cclib -lgnustep-gui)
 (libraries
    camlkitGS.Foundation
    camlkitGS.AppKit))

main.ml

open Foundation
open Runtime
open AppKit

let win_width = 400.
let win_height = 300.

let app_window () =
  let win =
    alloc NSWindow.self
    |> NSWindow.initWithContentRect
      (CGRect.make ~x: 0. ~y: 0. ~width: win_width ~height: win_height)
      ~styleMask: Bitmask.(
        _NSWindowStyleMaskTitled +
        _NSWindowStyleMaskClosable +
        _NSWindowStyleMaskResizable)
      ~backing: _NSBackingStoreBuffered
      ~defer: false
  in
  win
  |> NSWindow.cascadeTopLeftFromPoint (CGPoint.init ~x:20. ~y:20.)
  |> ignore;
  win |> NSWindow.setTitle (new_string "Hello Caml");
  win |> NSWindow.makeKeyAndOrderFront nil;
  win

let make_button ~title ~frame ~target ~action =
  let btn = alloc NSButton.self |> NSButton.initWithFrame frame in
  btn |> NSControl.setTarget target;
  btn |> NSControl.setAction action;
  btn |> NSButton.setTitle title;
  btn

let main () =
  let _ = new_object "NSAutoreleasePool"
  and app = NSApplication.self |> NSApplicationClass.sharedApplication
  and win = app_window ()
  in
  let btn =
    make_button
      ~title:(new_string "Quit")
      ~target:app
      ~action:(selector "terminate:")
      ~frame:(CGRect.make
        ~x:10. ~y:(win_height -. 40.)
        ~width:100. ~height:30.)
  in
  win |> NSWindow.contentView |> NSView.addSubview btn;
  (*
  assert (app |> NSApplication.setActivationPolicy
    _NSApplicationActivationPolicyRegular);
  *)
    app |> NSApplication.activateIgnoringOtherApps true;
  NSApplication.run app

let () = main ()

CoreGraphics プログラム

/bin
   dune
   main.ml
   ovals.ml
   roundRects.ml

これは、gnustep/libs-opalのTestsにあるpdf.mサンプルです。

dune

(executable
   (public_name camlkitTest2)
   (name main)
   (flags -ccopt -L/usr/local/GNUstep/Local/Library/Libraries  -cclib -lgnustep-corebase -cclib -lopal)
   ;(flags -ccopt -L/usr/local/GNUstep/Local/Library/Libraries  -cclib -lopal)
   (libraries
     camlkit-base.runtime
     camlkitGS.CoreFoundation
     camlkitGS.CoreGraphics))

main.ml

open CoreFoundation
open CoreGraphics

open Runtime
open Objc

let _MyCGPDFContextCreateWithURL = Foreign.foreign "CGPDFContextCreateWithURL" ((ptr void) @-> (ptr void) @-> (ptr void) @-> returning (ptr CGContext.t))
let _MyCGPDFContextClose = Foreign.foreign "CGPDFContextClose" ((ptr CGContext.t) @-> returning void)
let _MyCGContextBeginTransparencyLayer = Foreign.foreign "CGContextBeginTransparencyLayer" ((ptr CGContext.t) @-> (ptr void) @-> returning void)

let pi = 3.141592

let _ = print_endline "Test CoreGraphics"
let str = "test.pdf"

let rec drawRect ctx rect =
   let origin = CGRect.origin rect
   and size = CGRect.size rect
   in
   let x = CGPoint.x origin
   and y = CGPoint.y origin
   and width  = CGSize.width size
   and height = CGSize.height size
   in
   _CGContextTranslateCTM ctx x y;
	_CGContextSetRGBFillColor ctx 0. 0. 0. 1.;
	_CGContextFillRect ctx (CGRect.make ~x:0. ~y:(height/.2.) ~width:width ~height:(height/.2.));

   _CGContextSetAlpha ctx 0.5;
   _MyCGContextBeginTransparencyLayer ctx null;
   

   let a = 0.9 *. width /. 4.
	and b = 0.3 *. height /.2.
	and count = 5
   in
   _CGContextSetRGBFillColor ctx 0. 0. 1. 1.;
   _CGContextSetRGBStrokeColor ctx 0. 0. 0. 1.;
   _CGContextSetLineWidth ctx 3.;
	_CGContextSaveGState ctx;
	_CGContextTranslateCTM ctx (width/.4.) (height/.2.);

   let r = CGRect.make ~x:(-.a) ~y:(-.b) ~width:(2.*.a) ~height:(2.*.b)
   in
   for i = 1 to 5 do
      Ovals.paintOval ctx r;
      Ovals.frameOval ctx r;
      _CGContextRotateCTM ctx (pi /. (Float.of_int count));
   done;

   _CGContextRestoreGState ctx;
   _CGContextEndTransparencyLayer ctx;

   _CGContextSetRGBFillColor ctx 1. 0. 0. 0.5;
	_CGContextSetRGBStrokeColor ctx 0. 0. 0. 1.;
	_CGContextSetLineWidth ctx 3.;
	_CGContextSaveGState ctx;
	_CGContextTranslateCTM ctx (width/.4. +. width/.2.) (height/.2.);

   for i = 1 to 5 do
      RoundRects.fillRoundedRect ctx r 20. 20.;
      RoundRects.strokeRoundedRect ctx r 20. 20.;
      _CGContextRotateCTM ctx (pi /. (Float.of_int count));
   done;
;;

let () =
   let nsurl =
      alloc NSURL.self |> NSURL.initFileURLWithPath (new_string str)
   in
   Printf.printf "nsurl\n";

   let ctx =
      _MyCGPDFContextCreateWithURL
         nsurl
         null
         null
   and rect = (CGRect.make ~x:0. ~y:(2.25*.72.) ~width:(8.5*.72.) ~height:(5.5*.72.))
   in
   Printf.printf "context\n";

   drawRect ctx rect;

   _MyCGPDFContextClose ctx;

ovals.ml

open CoreFoundation
open CoreGraphics

open Runtime
open Objc

let pi = 3.141592

let addOvalToPath ctx rect =
   _CGContextSaveGState ctx;

   let origin = CGRect.origin rect
   and size = CGRect.size rect
   in
   let x = CGPoint.x origin
   and y = CGPoint.y origin
   and width  = CGSize.width size
   and height = CGSize.height size
   in
   Printf.printf "addOvalToPath width  %f\n" width;
   Printf.printf "addOvalToPath height %f\n" height;

   let width2  = width/.2.
   and height2 = height/.2.
   in
   let matrix = _CGAffineTransformMake width2 0. 0. height2 (x+.width2) (y+.height2)
   in
   Printf.printf "addOvalToPath\n";
   
   _CGContextConcatCTM ctx matrix;
   _CGContextBeginPath ctx;
   _CGContextAddArc ctx 0. 0. 1. 0. (2.*.pi) 0;
   _CGContextRestoreGState ctx;
;;

let paintOval ctx rect =
   addOvalToPath ctx rect;
   _CGContextStrokePath ctx;
;;
let frameOval ctx rect =
   addOvalToPath ctx rect;
   _CGContextFillPath ctx;
;;

roundRects.ml

open CoreFoundation
open CoreGraphics

open Runtime
open Objc

let pi = 3.141592

let addOvalToPath ctx rect =
   _CGContextSaveGState ctx;

   let origin = CGRect.origin rect
   and size = CGRect.size rect
   in
   let x = CGPoint.x origin
   and y = CGPoint.y origin
   and width  = CGSize.width size
   and height = CGSize.height size
   in
   Printf.printf "addOvalToPath width  %f\n" width;
   Printf.printf "addOvalToPath height %f\n" height;

   let width2  = width/.2.
   and height2 = height/.2.
   in
   let matrix = _CGAffineTransformMake width2 0. 0. height2 (x+.width2) (y+.height2)
   in
   Printf.printf "addOvalToPath\n";
   
   _CGContextConcatCTM ctx matrix;
   _CGContextBeginPath ctx;
   _CGContextAddArc ctx 0. 0. 1. 0. (2.*.pi) 0;
   _CGContextRestoreGState ctx;
;;

let paintOval ctx rect =
   addOvalToPath ctx rect;
   _CGContextStrokePath ctx;
;;
let frameOval ctx rect =
   addOvalToPath ctx rect;
   _CGContextFillPath ctx;
;;

let addRoundedRectToPath ctx rect ovalWidth ovalHeight =

	if ovalWidth == 0. || ovalHeight == 0. then 
		_CGContextAddRect ctx rect
   else
	
	_CGContextSaveGState ctx;
   	_CGContextTranslateCTM ctx (_CGRectGetMinX rect) (_CGRectGetMinY rect);
	_CGContextScaleCTM ctx ovalWidth ovalHeight;

	let fw = (_CGRectGetWidth rect) /. ovalWidth
	and fh = (_CGRectGetHeight rect) /. ovalHeight
   in
	
	_CGContextMoveToPoint ctx fw (fh/.2.);
	_CGContextAddArcToPoint ctx fw fh (fw/.2.) fh 1.;
	_CGContextAddArcToPoint ctx 0. fh 0. (fh/.2.) 1.;
	_CGContextAddArcToPoint ctx 0. 0. (fw/.2.) 0. 1.;
	_CGContextAddArcToPoint ctx fw 0. fw (fh/.2.) 1.;
	
	_CGContextClosePath ctx;
	_CGContextRestoreGState ctx;
;;

let fillRoundedRect ctx rect ovalWidth ovalHeight =
	_CGContextBeginPath ctx;
	addRoundedRectToPath ctx rect ovalWidth ovalHeight;
	_CGContextFillPath ctx;
;;

let strokeRoundedRect ctx rect ovalWidth ovalHeight =
	_CGContextBeginPath ctx;
	addRoundedRectToPath ctx rect ovalWidth ovalHeight;
	_CGContextStrokePath ctx;
;;