(Xojo) Retinaディスプレイ対応、OS X Mavericks 判別

Retina Displayのサポートについては、そのものズバリのブログエントリがあり、最新版にはサンプルディレクトリにサンプルもある(Example Projects/Platform-Specific/OS X/RetinaDisplay/RetinaDisplay.Xojo_binary_project)。こいつを動かせばそのまま動くのだけども、新規に作成したプロジェクトにソースをコピペしてもなぜか動かなかったので、共有しておく。

• Xojo: Supporting Retina Displays

Retinaディスプレイへの対応方法

(元エントリにあるように)要するに、Info.plistに以下を追加して、Declare Function BackingScaleFactor をコールする。

<key>NSHighResolutionCapable</key>
<true/>

引数はWindowPtrなので、このコードはWindowのメソッドとしておく(もしくは呼び出す際にWindowを指定してやる必要がある)。要はマルチスクリーンのケースがあるので、Windowから判定するということなのだろう。

  #If TargetCocoa Then
    Try
      Soft Declare Function BackingScaleFactor Lib "AppKit" Selector "backingScaleFactor" (target As WindowPtr) As Double
      Return BackingScaleFactor(Self)
    Catch e As ObjCException
      Return 1
    End Try
  #Else
    Return 1
  #Endif

問題はこれをビルド時に追加するためのコードの場所で、これは、「挿入」→「Build Step」→「新しいIDEスクリプト実行手順」を作成して、そこに書くことになる。

  Dim appName As String = CurrentBuildAppName
  appName = ReplaceAll(appName, " ", "\ ") // Escape spaces for the command line
  
  Dim appPath As String = CurrentBuildLocation + "/" + appName + ".app"
  
  Dim command As String
  command = "/usr/bin/defaults write " + appPath + "/Contents/Info ""NSHighResolutionCapable"" YES"
  Call DoShellCommand(command)

Info.plistにXMLを直接書くのではなく、defaultsコマンドを使ってシェル経由で設定を追加している(この仕組みを使うと先に紹介したPerlスクリプトにUIを被せるような用途の際にPerlスクリプトやモジュールを自動的にパッケージに含められて便利)。

ところが、単にこれを書いただけでは正しく実行されない。ビルド設定のOS Xの「Build」の下にDragして配置することではじめて正しく動作します(こういうのがね、日本語マニュアルが無いってのが無駄な労力につながるってんだ)。

Mavericks(OS X10.9)の判別と、ついでにRetinaディスプレイの判別も初期化時に行う方法

ついでに、OS X10.9(Mavericks)の判別が必要になったので、これを行う方法と、マルチスクリーンを考慮しなければ初期化時にRetinaディスプレイ判別もできちゃわないだろうか、ということで、以下(どちらかといえばこっちが本題)。問答無用で、コードをそのまま貼っておく。AppのOpenイベントに書く。

OSのバージョン判定は素直に sw_vers -productVersion をシェルで叩く。その後、screencaptureコマンドを叩くのだけど、Retinaディスプレイだと生成されたキャプチャのピクセルが縦横ともに常に2倍になる。Mavericksかどうかでコマンドのパラメタが違うのは、Mavericks以前では screencapture の-R(ピクセル指定)が有効でないためです。

  #If TargetMacOS Then
    Dim IsMavericks, IsRetina As Boolean
    Dim sh As New Shell
    Dim GetOSVer As String = "sw_vers -productVersion"
    sh.Execute(GetOSVer)
    Dim Res As String = sh.ReadAll
    Dim vNum As Double = Val(Res)
    If vNum >= 10.9 Then
      IsMavericks = True
    End If
    Dim Temp,TestFile As FolderItem
    Temp = SpecialFolder.Temporary.Child( "com.alfasado.test.work" )
    if Temp.Exists = False Then
      Temp.CreateAsFolder
    End If
    Dim OrigWidth As Integer
    Dim CreateCapture As String
    If IsMavericks = True Then
      OrigWidth = 1
      CreateCapture = "cd " + Temp.ShellPath + "; screencapture -R 1,1,1,1" 
    Else
      OrigWidth = Screen(0).Width
      CreateCapture = "cd " + Temp.ShellPath + "; screencapture -x 1,1,1,1" 
    End If
    sh.Execute(CreateCapture)
    TestFile = Temp.Child( "1,1,1,1" )
    If TestFile.Exists Then
      Dim P As Picture
      P = Picture.Open(TestFile)
      If OrigWidth = P.Width Then
        IsRetina = False
      ElseIf OrigWidth * 2 = P.Width Then
        IsRetina = True
      End If
      TestFile.Delete
    End If
    Temp.Delete
    If IsRetina Then
      MsgBox "Retina"
    Else
      MsgBox "Not Retina"
    End If
    If IsMavericks Then
      MsgBox "Mavericks"
    Else
      MsgBox "Not Mavericks"
    End If
  #Endif

以前に本格的にREALBasic使ってたのってOS9の時代だったので。OS Xにすっかり変わっていることでシェルが活用できることが結構大きいな、と。何でもかんでもDeclareってのがパターンだったけど、Tarminal遣いの人にも色々と活用できる。こういう点ではUnix万歳、だね(screencaptureコマンドの仕様が将来変わるかもってのはあるけど、て、まぁあるだろな。互換性だけちゃんとしてくれれば動かなくなることはなかろう)。

関連

• アプリ開発に使えるMac OS Xのコマンド。
• Perlで書いたスクリプトにXojoでGUIを被せる。