.delphi maniacs: 2014

2014年12月26日金曜日

CodeIQ 巨大な整数の演算に挑戦！の解答（TBcd の紹介）

Delphi / Appmethod Advent Calendar 2014 12/26 の記事です

CodeIQ 巨大な整数の演算に挑戦！の僕の解答です！

本来は、ちゃんと Advent Calendar 開催中に公開する予定でしたが、この問題の締め切りが 12/21 まで延びたので公開を延期していました。

問題の本文は

コラッツの問題が巨大な正の整数でも成り立つことを実証しましょう。

コラッツの問題が「9が50個連続する巨大な50桁の整数」でも成り立つこと(最終的に1になること)を確認できるWindows向けコンソールプログラムを作成してください。

ソースコードは、50行以内且つ、DelphiまたはAppmethodに標準搭載されているデータ型、クラス、ライブラリのみを使用して記述してください。

※コラッツの問題・・
  自然数nに対して、nが奇数なら3をかけて1を加える。
  偶数なら2で割る。
  この処理を繰り返すとすべての自然数が1になる。
  http://ja.wikipedia.org/wiki/コラッツの問題

でした。

これに対して、僕の最初の解答がこちら。

program CollatzMin;
uses
  Data.FmtBcd;
var
  Bcd: TBcd;
  Sup: Integer;
begin
  Bcd := StrToBcd(StringOfChar('9', 50));
  while (Bcd > 1) do
  begin
    Sup := Bcd.Precision and 1;
    if
      ((Bcd.Fraction[Bcd.Precision shr 1 + Sup - 1] shr (Sup shl 2) and 1) > 0)
    then
      Bcd := Bcd * 3 + 1
    else
      Bcd := Bcd / 2;
    Writeln(BcdToStr(Bcd));
  end;
  Readln;
end.

Delphi でお手軽に巨大な整数を扱うと言えばでおなじみの Data.FmtBcd を使いました。
本来は2進化10進数を扱うためのクラスです（2進化10進数についてはリンク先でどうぞ）。
このクラスを使うと 64 桁までの数に対応できます。
問題の本文にあるように今回は 50 桁なので、TBcd で余裕です。
TBcd には operator が定義されているので普通の数のように加減乗除できます。

TBcd を使った結果、上の解答になりました。

ですが、これ 3n + 1 って「必ず偶数になるんじゃね！」→「偶数なら２で割り切れるんじゃね！」と考えて最適化した結果が次のコードです。

program CollatzBcd;
uses
  Data.FmtBcd;
var
  N: TBcd;
  Od: Integer;
begin
  N := StrToBcd(StringOfChar('9', 50));
  while (N > 1) do
  begin
    Od := BcdPrecision(N) and 1;
    Od := N.Fraction[BcdPrecision(N) shr 1 + Od - 1] shr (Od shl 2) and 1;
    N := (N * (1 + Od shl 1) + Od) / 2;
    Writeln(BcdToStr(N));
  end;
  Readln;
end.

結構スッキリしました。
ただ、こちらのコードは最初の一回目の演算結果が表示されないのですが…
とはいえ、解答としてはオッケーでした。

Data パッケージにあるからなのか、あまり知られていない TBcd クラス。
かなり簡単に使えるので、知って置いて損は無いと思います。

：
：

最後に蛇足。
自前で整数演算を実装した物も提出していました。
こちらは、普通に乗算をして繰り上がりや繰り下がりの演算をするものです。

program CollatzBytes;
uses
  System.SysUtils;
const
  COUNT = 50;
  DIGIT = 9;
var
  Bytes: TBytes;
  i, H, L: Integer;
function ToString: String;
var
  i: Integer;
begin
  Result := '';
  for i := High(Bytes) downto Low(Bytes) do
    Result := Result + Bytes[i].ToString;
  Result := Result.TrimLeft(['0']);
end;
begin
  SetLength(Bytes, COUNT * 2);
  for i := 0 to COUNT - 1 do
    Bytes[i] := DIGIT;
 
  while (ToString.Length > 1) or (Bytes[0] > 1) do
  begin
    if (Odd(Bytes[0])) then
    begin
      H := 1;
      for i := Low(Bytes) to High(Bytes) do
      begin
        L := Bytes[i] * 3 + H;
        H := L div 10;
        Bytes[i] := L - H * 10;
      end;
    end
    else begin
      L := 0;
      for i := High(Bytes) downto Low(Bytes) do
      begin
        H := Bytes[i];
        Bytes[i] := Bytes[i] shr 1 + L;
        L := (H and 1) * 5;
      end;
    end;
    Writeln(ToString);
  end;
 
  Readln;
end.

こちらは４９行でギリギリでした！
{$APPTYPE CONSOLE} を入れたら５０行ちょうどでした！あぶない！

2014年12月24日水曜日

FireMonkey の Interface で提供されている機能をオーバーライドする方法

サンプルソースはこちら(GitHub)

Delphi / Appmethod Advent Calendar 2014 12/24 の記事です

12/24 00:43 頃追記！
inline 指令が意味ないとのことです！
ソース内に書きました！

みなさん！ FireMonkey 使ってますか！？
FireMonkey 使ってみると解るんですけど、痒いところに手が届かない事ありますよね！！
とはいえ、FireMonkey ではプラットフォームに依存するクラスは implementation の下に書いて、外出ししてないから置き換えられないよお！って事、良くありますよね。

ですが！ FireMonkey には、サービスを置き換えるための仕組みがあります。
クラスそのものを置き換える事はできないのですが、その実体を提供している IFMXxxxx として提供されているサービスを置き換えられます！
今回は、その手法を紹介します。

基本的にはどのサービスも置き換えられるのですが、ここでは簡単のために IFMXSystemFontService を置き換えてみました（必要なメソッドが２つしかないので）。
デフォルトのフォント名を書き換えることで、下記の図のように設計時と実行時のフォントが変わります。
（上が設計時、下が実行時）
わ、解りづらいｗｗｗ

詳しくは下記のソース内のコメントを参照してください！

unit FMX.SystemFontService;
 
interface
 
uses
  FMX.Platform;
 
type
  // TInterfacedObject と目的のサービスのインターフェースを継承する
  TFMXSystemFontServiceHook = class(TInterfacedObject, IFMXSystemFontService)
  private var
    // 元々 FMX が登録していたサービスを保持する変数
    FOrgFMXSystemFontService: IFMXSystemFontService;
  protected
    // コンストラクタの中でサービスを置き換える
    constructor Create;
  public
    // 置き換えたいサービスが実装すべきメソッド
    { IFMXSystemFontService }
    function GetDefaultFontFamilyName: String;
    function GetDefaultFontSize: Single; inline; // inline ついてはメソッド内に
  public
    // これを呼ぶとコンストラクタを呼べる！
    // 今回は Initialization で呼ぶ
    class procedure RegistService;
  end;
 
implementation
 
var
  // このサービスのインスタンスを保持する
  SystemFontServiceHook: TFMXSystemFontServiceHook = nil;
 
{ TFMXSystemFontServiceHook }
 
constructor TFMXSystemFontServiceHook.Create;
begin
  inherited;
 
  // オリジナルの Interface を取り出して自分自身と置き換えてしまう！
  if
    TPlatformServices.Current.SupportsPlatformService( // 取り出し
      IFMXSystemFontService,
      IInterface(FOrgFMXSystemFontService))
  then begin
    // オリジナルを削除
    TPlatformServices.Current.RemovePlatformService(IFMXSystemFontService);
    // 自分を登録しちゃう
    TPlatformServices.Current.AddPlatformService(IFMXSystemFontService, Self);
  end;
end;
 
function TFMXSystemFontServiceHook.GetDefaultFontFamilyName: String;
begin
  // 元々のサービスが返す値を変えちゃう！
  Result := 'メイリオ';
end;
 
function TFMXSystemFontServiceHook.GetDefaultFontSize: Single;
begin
  // 元々のサービスの値を返すこともできる
  // 置き換える予定の無いメソッドについては inline 指定をすると
  // 呼び出しオーバーヘッドが少なくなる
  // と思ったのですが、そんなことは無いそうです！！
  // 詳しくは、Lyna さんのこのツイートをご覧ください
  // https://twitter.com/lynatan/status/547410499164336128
  Result := FOrgFMXSystemFontService.GetDefaultFontSize;
end;
 
// Initialization で↓このメソッドを呼んでコンストラクタを呼び出す
// class constractor でも可能
// これによって、このユニットをプロジェクトを追加するだけで自動的に置き換わる！
class procedure TFMXSystemFontServiceHook.RegistService;
begin
  if (SystemFontServiceHook = nil) then
    SystemFontServiceHook := TFMXSystemFontServiceHook.Create;
end;
 
initialization
  TFMXSystemFontServiceHook.RegistService;
 
end.

ということで、本日はクリスマスイブです！
なのに、こんなブログを書きました！書いたのは２３日だけど！！

2014年12月22日月曜日

Delphi だけで、Android の Broadcast Receiver を実装する方法

サンプルソースはこちら(GitHub)

Delphi / Appmethod Advent Calendar 2014 12/22 の記事です

Delphi で Android 開発をしている３０００万人の皆さん！こんにちは！
今回は Delphi だけで Broadcast Receiver を実装する方法です。
思ってるより簡単に作れますが、はまりポイントも。

ソースにコメントを書いたので、詳しくは実際のソースをご覧ください！

uBroadcastReceiver ソース

unit uBraodcastReceiver;
 
interface
 
uses
  System.Classes
  , System.Generics.Collections
  , FMX.Platform
  , Androidapi.JNIBridge
  , Androidapi.JNI.App
  , Androidapi.JNI.Embarcadero
  , Androidapi.JNI.GraphicsContentViewText
  , Androidapi.JNI.JavaTypes
  , Androidapi.Helpers // XE6 では FMX.Helpers.Android にしてください
  ;
 
type
  // 直接 class(TJavaLocal, JFMXBroadcastReceiverListener) を定義するとダメ！
  // グローバル変数にインスタンスをつっこんでも削除されて、Broadcast 受信で
  // アプリが落ちる！
  // なので、TInterfacedObject を継承していないクラスから派生したクラスの
  // インナークラスとして JFMXBroadcastReceiverListener を定義する
  // このクラスは自動的に削除されないため、上手く動作する！
  TBroadcastReceiver = class
  public type
    // Broadcast Receiver を通知するイベント
    // JString にしているので、Intent.ACTION_XXX と equals で比較可能
    TBroadcastReceiverEvent = procedure(const iAction: JString) of object;
    // JFMXBroadcastReceiver を実装した JavaClass として Listener を定義
    TBroadcastReceiverListener =
      class(TJavaLocal, JFMXBroadcastReceiverListener)
    private var
      FBroadcastReceiver: TBroadcastReceiver;
    public
      constructor Create(const iBroadcastReceiver: TBroadcastReceiver);
      // Broadcast Receiver から呼び出されるコールバック
      procedure onReceive(context: JContext; intent: JIntent); cdecl;
    end;
  private var
    // つぎの２つは保存しないと消えて無くなる！
    FBroadcastReceiverListener: JFMXBroadcastReceiverListener;
    FReceiver: JFMXBroadcastReceiver;
    // 通知対象の ACTION を保持している変数
    FActions: TList<String>;
    // イベントハンドラ
    FOnReceived: TBroadcastReceiverEvent;
  protected
    constructor Create;
    // Broadcast Receiver の設定と解除
    procedure SetReceiver;
    procedure UnsetReceiver;
  public
    destructor Destroy; override;
    // 通知して欲しい ACTION の登録と削除
    procedure AddAction(const iActions: array of JString);
    procedure RemoveAction(const iAction: JString);
    procedure ClearAction;
    // Boradcast Receiver を受け取った時のイベント
    property OnReceived: TBroadcastReceiverEvent
      read FOnReceived write FOnReceived;
  end;
 
// Boradcast Receiver のインスタンスを返す
function BroadcastReceiver: TBroadcastReceiver;
 
implementation
 
uses
  System.UITypes
  , Androidapi.NativeActivity
  , FMX.Forms
  ;
 
// Braodcast Receiver の唯一のインスタンス
var
  GBroadcastReceiver: TBroadcastReceiver = nil;
 
function BroadcastReceiver: TBroadcastReceiver;
begin
  if (GBroadcastReceiver = nil) then
    GBroadcastReceiver := TBroadcastReceiver.Create;
 
  Result := GBroadcastReceiver;
end;
 
{ TBroadcastReceiver.TBroadcastReceiverListener }
 
constructor TBroadcastReceiver.TBroadcastReceiverListener.Create(
  const iBroadcastReceiver: TBroadcastReceiver);
begin
  inherited Create;
  FBroadcastReceiver := iBroadcastReceiver;
end;
 
procedure TBroadcastReceiver.TBroadcastReceiverListener.onReceive(
  context: JContext;
  intent: JIntent);
var
  JStr: String;
  Str: String;
 
  procedure CallEvent;
  var
    Action: String;
  begin
    // Broadcast は Delphi のメインスレッドで届くわけでは無いので
    // Synchronize で呼び出す
    Action := JStr;
    TThread.CreateAnonymousThread(
      procedure
      begin
        TThread.Synchronize(
          TThread.CurrentThread,
          procedure
          begin
            if (Assigned(FBroadcastReceiver.FOnReceived)) then
              FBroadcastReceiver.FOnReceived(StringToJString(Action));
          end
        );
      end
    ).Start;
  end;
 
begin
  // Broadcast を受け取ったら、このメソッドが呼ばれる！
  JStr := JStringToString(intent.getAction);
 
  for Str in FBroadcastReceiver.FActions do
    if (Str = JStr) then
      CallEvent;
end;
 
{ TReceiverListener }
 
procedure TBroadcastReceiver.AddAction(const iActions: array of JString);
var
  Str: String;
  JStr: String;
  Action: JString;
  OK: Boolean;
  Changed: Boolean;
begin
  Changed := False;
 
  for Action in iActions do
  begin
    OK := True;
 
    JStr := JStringToString(Action);
 
    for Str in FActions do
      if (Str = JStr) then
      begin
        OK := False;
        Break;
      end;
 
    if (OK) then begin
      FActions.Add(JStr);
      Changed := True;
    end;
  end;
 
  if (Changed) then
    SetReceiver;
end;
 
procedure TBroadcastReceiver.ClearAction;
begin
  FActions.Clear;
  UnsetReceiver;
end;
 
constructor TBroadcastReceiver.Create;
begin
  inherited;
 
  FActions := TList<String>.Create;
 
  // Boardcast Receiver を設定
  SetReceiver;
end;
 
destructor TBroadcastReceiver.Destroy;
begin
  // Broadcast Receiver を解除
  UnsetReceiver;
 
  FActions.DisposeOf;
 
  inherited;
end;
 
procedure TBroadcastReceiver.RemoveAction(const iAction: JString);
var
  i: Integer;
  JStr: String;
begin
  JStr := JStringToString(iAction);
 
  for i := 0 to FActions.Count - 1 do
    if (FActions[i] = JStr) then
    begin
      FActions.Delete(i);
      SetReceiver;
      Break;
    end;
end;
 
procedure TBroadcastReceiver.SetReceiver;
var
  Filter: JIntentFilter;
  Str: String;
begin
  if (FReceiver <> nil) then
    UnsetReceiver;
 
  // Intent Filter を作成
  Filter := TJIntentFilter.JavaClass.init;
 
  for Str in FActions do
    Filter.addAction(StringToJString(Str));
 
  // TBroadcastReceiverListener を実体とした BroadcastReceiver を作成
  FBroadcastReceiverListener := TBroadcastReceiverListener.Create(Self);
  FReceiver :=
    TJFMXBroadcastReceiver.JavaClass.init(FBroadcastReceiverListener);
 
  try
    // レシーバーとして登録
    SharedActivityContext.getApplicationContext.registerReceiver(
      FReceiver,
      Filter);
  except
  end;
end;
 
procedure TBroadcastReceiver.UnsetReceiver;
begin
  // アプリケーションが終了中でなければ、BroadcastReceiver を解除
  if
    (FReceiver <> nil) and
    (not (SharedActivityContext as JActivity).isFinishing)
  then
    try
      SharedActivityContext.getApplicationContext.unregisterReceiver(FReceiver);
    except
    end;
 
  FReceiver := nil;
end;
 
initialization
finalization
  if (GBroadcastReceiver <> nil) then
    GBroadcastReceiver.DisposeOf;
 
end.

使用方法

type
  // JString は Androidapi.JNI.JavaTypes に
  // JIntent は Androidapi.JNI.GraphicsContentViewText に
  // JStringToString は Androidapi.Helpers に
  // それぞれ定義されています
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    procedure Received(const iAction: JString);
  public
  end;
 
var
  Form1: TForm1;
 
implementation
 
uses
  uBraodcastReceiver;
 
{$R *.fmx}
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  BroadcastReceiver.OnReceived := Received;
 
  // スクリーン ON / OFF を受け取るように設定
  BroadcastReceiver.AddAction(
    [
      TJIntent.JavaClass.ACTION_SCREEN_OFF,
      TJIntent.JavaClass.ACTION_SCREEN_ON
    ]
  );
end;
 
procedure TForm1.Received(const iAction: JString);
begin
  Log.d('Broadcast Received = ' + JStringToString(iAction));
end;

2014年12月15日月曜日

CodeIQ 第7回デスマコロシアムの解（Pascal でのショートコーディング）

Delphi / Appmethod Advent Calendar 2014 12/15 の記事です

CodeIQ というリクルートのサイトで、@tbpgr さんによって不定期開催されている「デスマコロシアム」というコードゴルフ（短いコードを競うもの）大会があります。
このデスマコロシアムは ideone で採点されるので、なんと！ Free Pascal（fpc）が言語に入っているのです。
CodeIQ で Pascal が使えるのは非常に珍しい…

ちなみに fpc は Object Pascal というか Delphi 互換（を目指している）なので、Delphi を持っている場合は ideone よりも簡単に try & error で色々チャレンジできます。
しかし！Pascal はとても解りやすく書けるためショートコーディングには向きません！
／(^o^)＼
まあ、そんなこと言っても始まらないので、ショートコーディングのポイントをいくつか紹介します。

デスマコロシアムの問題

今回の問題は…

下記の文字列を標準出力せよ

>++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.>+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.>+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.>++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.>++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.>+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.>+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.>++++++++++++++++++++++++++++++++.>+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.>+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.>++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.>+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.>+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.>+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.>+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.>+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.>+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++.

でした。
解る人には解りますが、これは brainf*ck のコードです。
なので、これを brainf*uck で走らせると

deathma colosseum

という文字列を出力するコードだと解ります。
なので、これは

">"+(文字コード分の"+")+"."

を出力すればいいという事になります。

より詳しい解説はオフィシャルの CodeIQ MAGAZIN をご覧ください。

解答

僕の解答は次の通り。
fpc で 77 文字に纏まりました。
そのコードがこちら。

for PChar(@argc)^in'deathma colosseum'do Write(^~,StringOfChar('+',argc),'.')

０．文字の字詰め

これは当然ですが出来る限り字を詰めて書きます。
文字列のシングルクオートの後は空白をいれずに予約語を書けたり、ポインタ逆参照演算子でも予約語を書けます。
他にも整数などの数についてもできます。
これは前提条件なので０番です。

１．for-in-do

fpc なので for-in-do 文が使えます（GNU Pascal や Pure Pascal では使えません）。
コードにあるように即値で文字列を書けるので、それだけでも短くなります。
ただ、１つ注意が必要なのは Delphi では、PChar(@argc)^ とは書けません！
Delphi のコンパイラの方が厳格なので E1019 が発生します。
Delphi 使うと簡単に書けるよ！っていっておきながらコレ！

２．定義済み変数

Delphi では System.pas などに定義済み変数がいくつか定義されています。
それと同じように fpc にも定義済み変数があります。
使い出がありそうなのは…

変数名	型	本来の意味
argc	Integer	引数の数
argv	PPChar	引数へのポインタ(256 byte 確保済み)
envp	PPChar	環境ブロックへのポインタ(256 byte 確保済み)

これらを使うと var ブロックを書く必要がありません！
ただ変数名が長いので変数がたくさん出てくる場合は var ブロックを書いた方が短くなるかもしれません。

３．コントロールコードの記述

Pascal にはコントロールコードを直接記述する記法が存在します。
プレフィクスとして "^" を付けると、その後に続く文字の ASCII コードから $40 を引いたものが、その値となります。
たとえば ^A とすると #$01 が返ります。
現在の実装だと文字コードから単純に $40 引くだけなので、上手くいけば 1byte コードを短くできます。
今回は運良く ">" が "~" の $40 前だったのでコレを使いました。

４．標準関数の使用

fpc では System.pas に StringOfChar が定義されているので、そのまま使えます。
また、System.pas に定義されていないもの、他のユニットに定義されているものも使えます。
他のコードゴルフでは解りませんが、デスマコロシアムでは include, import はコードの文字数に入らないため、uses も文字数に入りません！
なので、実は uses StrUtils; としておけば、StringOfChar より２文字短い DupeString が使えます。
これを忘れて、そのまま出してしまいましたが…

５．型名

今回は var ブロックを使いませんでしたが、使う場合は型名に気をつけます。
たとえば Integer は７文字ですが、Byte, Word は４文字です。
このように型名だけで３文字も変わるので、必要なとき以外は Integer を使わないようにします。

６．関数名への代入

今回は関数・手続きを使いませんでしたが、使う場合は戻り値の返し方にもテクニックがあります。
元々 Pascal の関数が値を返す方法は Result 変数ではなく、関数名に戻り値を代入する方法でした。
ただ、これだと再帰関数を作るのが難しかったため、Result 変数が Turbo Pascal で導入されました。
ですが、関数名に戻り値を代入するのは、未だに有効な書き方です。
これを使うと…

function p: Byte;
begin
  p := 1;
end

このように書けるため Result を使うよりも短く書けます。

７．文字列の取り出し方

Delphi だと次のように文字列の一部を取り出せます。

Writeln('deathma colosseum'[1]);

ですが fpc では、このコードはエラーになります。
では、文字列をいったん const や var に入れないと使えないのか、というと、そうでもありません。
fpc では、こんな風にするとコンパイルが通ります。

Writeln(('deathma colosseum')[1]);

８．Delphi だけの技

Delphi では、function / procedure をクロージャとしていきなり書けます。
括弧の使い方の妙技ですね！これを使うとコードを短く出来る可能性があります。

Writeln((function:String begin Result:='deathma colosseum'end)());

もう１つ class / record helper が使えます。
fpc も将来的に使えるようになるっぽいです。

GNU Pascal での解

GNU Pascal (gpc) での解も載せて起きます。

var i,j:Byte;
for i:=1to 17do begin Write('>');for j:=1to Ord(('deathma colosseum')[i])do Write('+');Write('.');end

デスマコロシアムでは元々書いてある部分（program ideone; begin end.）は文字数に入りません。
なので、上記のコードも、それらは省いてあります。
gpc 版でも上記の５番と７番のテクニックを使っています。

まとめ

と、僕が知る限りのショートコーディングのテクニックを紹介しました！
コードゴルフで Pascal が躍進するきっかけになればいいなと思っています！

ちなみに、現在（2014/12/15）デスマコロシアム第８回が開催されています。
腕に自信のある方々は、ご参加されてみたらいかがでしょう？
多くの言語があるので、Pascal 以外でも楽しいと思いますよ！

2014年12月1日月曜日

OSX / iOS のデリゲートを全部取得する！

Delphi Advent Calendar 2014 12/01 の記事です。

2014/12/16 追記！

Twitter で @wyvern77 氏に "MethodNameAttribute" 属性を使えば Objective-C 本来の名前を指定できるぞ！と教えていただきました。
また、@owlsperspective 氏に、属性をまとめたページを教えてもらいました！
これによると、Macapi.ObjectiveC ユニットに MethodNameAttribute 属性が定義されていて、それをメソッドの属性にしてやればいいようです。
実は、まだ試していないのですが、とりあえず追記です！
もっといい方法を教えてください、と書いたかいがあった！
----- 追記ここまで ------------------------------

OSX / iOS 開発で必須になるのが Delegate。
もちろん FireMonkey だけでことが足りるなら必要ありませんが！

いわゆるデリゲートは、Delphi のメソッドポインタ（イベント）と同じで、オブジェクトへのポインタと関数へのポインタの両方を持つものとして、定義されてるみたい（wikipedia）です。

でも、OSX / iOS ではデリゲートは「委譲」（delegation）の方の意味合いが大きいです。
実際に、どういう時に使われるかというと OS が提供している機能の拡張手段だったりオブジェクト同士の通信だったりします。
そして、もちろんイベントにも使われる訳です。
たとえば、UIWebView のイベントハンドラとしての UIWebViewDelegate は

-webView:shouldStartLoadWithRequest:navigationType:
-webViewDidStartLoad:
-webViewDidFinishLoad:
-webView:didFailLoadWithError:

こんなメソッド（メッセージ）が定義されています。
で、こういった Delegate を Delphi で実装するのは、Interface の定義と TOCLocal から継承した２つのクラスが必要です。
FireMonkey では、こんな感じで定義されてます。

UIWebViewDelegate = interface(IObjectiveC)
  ['{25E7C20B-68A2-4011-9D7F-B97647BD48C0}']
  procedure webView(webView: UIWebView; didFailLoadWithError: NSError); 
    cdecl; overload;
  function webView(
    webView: UIWebView;
    shouldStartLoadWithRequest: NSURLRequest; 
    navigationType: UIWebViewNavigationType): Boolean; cdecl; overload;
  procedure webViewDidFinishLoad(webView: UIWebView); cdecl;
  procedure webViewDidStartLoad(webView: UIWebView); cdecl;
end;
 
 
TiOSWebViewDelegate = class (TOCLocal, UIWebViewDelegate)
public
  procedure webView(webView: UIWebView; didFailLoadWithError: NSError); 
    overload; cdecl;
  function webView(
    webView: UIWebView; 
    shouldStartLoadWithRequest: NSURLRequest; 
    navigationType: UIWebViewNavigationType): Boolean; overload; cdecl;
  procedure webViewDidFinishLoad(webView: UIWebView); cdecl;
  procedure webViewDidStartLoad(webView: UIWebView); cdecl;
end;

で、あとは、下記のようにすればイベントが呼ばれます。

FDelegate := TiOSWebViewDelegate.Create;
FWebView.setDelegate(FDelegate.GetObjectID);

というか一般的なデリゲートの作り方と使い方は、むしろ Team J の「FireMonkey iOS - event delegateの使い方のサンプル」の記事の方が詳しいので、そちらをご覧ください。

ここからが本題。

実はですね、上記の方法では特定のデリゲートしか使えないのです。
ここで、問題になるのは、Object Pascal と Objective-C の文法・実行方法の違いです。
どういうことかというと、Objective-C では、メソッドとして見えるものはメッセージであり、メッセージは、そのパラメータを含めて１つのメッセージを構成しているということです。
つまり、引数の名前さえ違っていれば、別のメソッドとしてとらえられるということです。たとえば、上記の UIWebViewDelegate でいえば

■Objective-C

- (BOOL)webView:(UIWebView *)webView
  shouldStartLoadWithRequest:(NSURLRequest *)request
  navigationType:(UIWebViewNavigationType)navigationType
 
-(void)webView:(UIWebView *)webView
  didFailLoadWithError:(NSError *)error

こんな風に定義されているものが

■Object Pascal

procedure webView(
  webView: UIWebView; 
  didFailLoadWithError: NSError); cdecl; overload;
 
function webView(
  webView: UIWebView; 
  shouldStartLoadWithRequest: NSURLRequest; 
  navigationType: UIWebViewNavigationType): Boolean; cdecl; overload;

こうなるわけですが、ここで見てほしいのが "overload" です。
Objective-C では、メッセージはパラメータの引数の型ではなく、メッセージの名前とパラメータの名前で特定されます。
ですが、Object Pascal では、同じメソッド名の場合、引数の型が異なっている必要があります。
で、この違いがもたらす結果ですが…もうおわかりでしょうか。

たとえば、WebViewFrameDelegate は

-webView:didStartProvisionalLoadForFrame:
-webView:didFinishLoadForFrame:
-webView:didCommitLoadForFrame:
-webView:willCloseFrame:
-webView:didChangeLocationWithinPageForFrame:

こんな感じで、引き数名は全部違うものの型は全部 WebViewFrame です！！
Object Pascal で実装すると…

WebFrameLoadDelegate = interface(IObjectiveC)
  procedure webView(
    sender: WebView;
    didStartProvisionalLoadForFrame: WebFrame); overload; cdecl;
  procedure webView(
    sender: WebView;
    didFinishLoadForFrame: WebFrame); overload; cdecl;
  procedure webView(
    sender: WebView;
    didCommitLoadForFrame: WebFrame); overload; cdecl;
  procedure webView(
    sender: WebView;
    willCloseFrame: WebFrame); overload; cdecl;
  procedure webView(
    sender: WebView;
    didChangeLocationWithinPageForFrame: WebFrame); overload; cdecl;
end

こうなります。しかし、引数の型が全部同じなので、コンパイラに怒られます！
これは困った…
FireMonkey では、どうやってるんだ！と思って調べたところ

UIPickerViewDelegate = interface(IObjectiveC)
//  procedure pickerView(
//    pickerView: UIPickerView;
//    didSelectRow: NSInteger;
//    inComponent: NSInteger); cdecl; overload;
//  function pickerView(
//    pickerView: UIPickerView;
//    rowHeightForComponent: NSInteger): Single; cdecl; overload;
  function pickerView(
    pickerView: UIPickerView; 
    titleForRow: NSInteger; 
    forComponent: NSInteger): NSString; cdecl; overload;
//  function pickerView(
//    pickerView: UIPickerView;
//    viewForRow: NSInteger;
//    forComponent: NSInteger;
//    reusingView: UIView): UIView; cdecl; overload;
end;

まさかのコメントアウト！！！ oh...

で、ググったりしたものの解決策がなかったため、いろいろ考えました末に思いついたのが

type TBar = type TFoo;

構文！
この構文を使うと、別の型として同じ型を定義できます。
そう！これを使えば！

type
  WebFrame2 = type WebFrame;
  WebFrame3 = type WebFrame;
  WebFrame4 = type WebFrame;
  WebFrame5 = type WebFrame;
 
  WebFrameLoadDelegate = interface(IObjectiveC)
    procedure webView(
      sender: WebView;
      didStartProvisionalLoadForFrame: WebFrame); overload; cdecl;
    procedure webView(
      sender: WebView;
      didFinishLoadForFrame: WebFrame2); overload; cdecl;
    procedure webView(
      sender: WebView;
      didCommitLoadForFrame: WebFrame3); overload; cdecl;
    procedure webView(
      sender: WebView;
      willCloseFrame: WebFrame4); overload; cdecl;
    procedure webView(
      sender: WebView;
      didChangeLocationWithinPageForFrame: WebFrame5); overload; cdecl;
  end

こんな感じで定義できます！
もちろん、コンパイラに怒られません！
そして、ちゃんと OS からコールバックされます。

これで、全部のデリゲートを受け取れる！と思いきや、もう１つ問題がある事お気づきでしょうか？

それは、予約語の問題、です。

Object Pascal では様々な言葉が予約語になっていますが、その中で群を抜いて他の言語で使われるのが

type

です。
OSX / iOS でもパラメータ名として type が使われている事があります（もちろん他の予約語が使われている事も）。
たとえば、NSEvent には

@property(readonly) NSEventType type

というプロパティが定義されています。

ですが、これにはとても簡単に対処できます。
Object Pascal には、予約語を予約語として認識させないプレフィクスがあります。

それは、& です。

& を予約語の前につければ、コンパイラは予約語として扱いません。
先ほどの NSEvent の FireMonkey での実装は

NSEvent = interface(NSObject)
  function &type: NSEventType; cdecl;
end;

こうなっています。
これで、予約語の問題も簡単に回避できました！

で、これらを駆使して Macapi.WebView.pas ができあがりました。
このソースの中の WevViewFrameDelegate の部分で type 構文が使われています。

これで全部のデリゲートを使用可能になりました。

ちなみに、ググっても見つからなかったのですが、これよりもよい方法をご存じでしたら教えてください！

登録: 投稿 (Atom)