要旨

Windows の Win64 API 呼び出しにより、Fortran から直接 Bluetooth 機器にアクセスすることを試みた。実際に Bluetooth プリンタに出力できることを確かめた。

AI に頼んで一通り書いてもらい、それを元に不具合を人間が修正した。私は Bluetooth API に対して全く無知であったにも関わらず、比較的容易に実現できた。しかしながら Windows 構造体内部の memory alignment が不規則かつマニュアルに記述がなく、AI には解決できず手間取った。

派生型(構造体)の特殊な padding は Fortran 標準文法では統一的な実現が難しく、コンパイラ指示行に頼る必要があった。

目的

近年の大規模言語モデルに基づく AI の発達により、人間がプログラムを書く必要がなくなりつつある。未だ発達途上ではあるものの、他言語で書かれた API 呼び出し用のインターフェース生成などに特に効果的と思われる。

ここでは、Windows グラフィック API への AI 利用[^1] にならって、Windows Bluetooth API 呼び出しを AI 利用によって予備知識なし実現できるかを試し、AI 利用の可能性を実際に確かめてみる。

以前、Linux 上でシリアル・ポートに Bluetooth 機器を結び付けることで、Fortran からの Bluetooth プリンタへの出力を実現した[^2]が、この方法は Windows では出来なかった。今回、Win64 の Bluetooth API を利用することで、Bluetooth プリンタ出力を実現することにした。

方法

AI としては ChatGPT と Claude の無料枠を利用した。Fortran 処理系として Intel Fortran の ifx Version 2024.2.0 を用いた。Win64 では呼び出し規約が stdcall になってデフォルトのままで Windows API を呼び出せる。

AI にはまず windows の intel fortran で bluetooth にアクセスできるかを尋ねた。
次に RFCOMM で bluetooth 機器にアクセスする方法を尋ねた。

AI に対しては必要に応じて不具合について質問したり、C 言語による同等のプログラム例を出してもらうなどの利用も行った。

また Google や Bing のネット検索も随時利用した。

結果

AI は即座にプログラム例を示したが、そのままでは動かなかった。しかしダイナミック・ロードすべき DLL ライブラリや、呼び出すべき API などの選択は正しかった。予備知識の無い人間にとって、下調べも要らず大変な労力の節約になった。

また呼び出しのための interface も大半は適切な型付けで生成できていた。これらは、人間が手作業でやるには骨の折れる単純作業なので、とても労力の節約になった。

しかしながら、Windows の構造体を Fortran の派生型で表現するところには問題が多かった。API のマニュアル上は正しく構成要素を並べていても、実際の memory allocation は構造体毎に padding を入れていたり、padding なしに詰め詰めに構成要素を配置していたりしていて、AI も知らずネット検索で出てくるマニュアルでも記述を見つけられなかった。

構造体内の memory allocation の情報を得るには AI に C 言語による同等のプログラムを書いてもらい Visual studio 内の Windows API 定義ファイルを参照する必要があった。

この他に、ダイナミック・ロードした DLL 内の API ルーチンのアドレスを Fortran の関数ポインタに結び付けるところ、およびその呼び出しなどで文法上の間違いが多かった。これは人間が修正しても手間がかからなかった。

プログラム１　bluetooth 接続機器リスト

ペアリングされている機器が出力される。これによりアドレスが分かる。

注意すべき点は構造体 BLUETOOTH_DEVICE_INFO[^3] の最初の 4byte の dwsize のあとに 4byte の padding が入っていることで、intel fortran の bind(c) での padding は 4byte 刻みであるため、明示的に 4byte 分の記憶領域の確保が必要になる。

   type, bind(C) :: BLUETOOTH_DEVICE_INFO
        integer(c_int) :: dwSize
        integer(c_int) :: padding ! <---- needed padding of 4bytes 
        type(BLUETOOTH_ADDRESS) :: Address
        ....

出力

 Found device: Poooli_L3-3cf9
 Address:     00:15:82:93:3C:F9
 Found device: M02S
 Address:     00:15:83:54:A2:7F
続行するには何かキーを押してください . . .

プログラム２　Phomemo M02S 出力

Phomemo 社の Bluetooth printer M02S に直線を 10 本出力させる。

注意すべき点は、構造体 SOCKADDR_BTH で、最初の 2byte 変数 addressFamily のあと padding 無しで、8byte 変数 btAddr が配置されること。先に述べたように Intel Fortran は bind(c) の時は 4byte 刻みで padding を入れるので、このような配置は不可能になる。一方 bind(c) を外して sequence 属性をつけると padding 無しに詰め詰めで配置してくれるが、bind(c) を前提としている interface などを書き換える必要が出てくる。

ここでは、コンパイラ指示行により bind(c) 属性のまま padding 無しの記憶領域上の配置を実現することにした。[^4] （stackoverflow の質問に対する Steve Lionel のコメントより）

!DIR$ OPTIONS /ALIGN=(RECORDS=PACKED)  ! パディングを防ぐためのディレクティブ    
    type, bind(C) :: SOCKADDR_BTH
        integer(c_short) :: addressFamily
        integer(c_int64_t) :: btAddr
        integer(c_int) :: serviceClassId(4) = 0
        integer(c_int) :: port = -1 ! any port
    end type SOCKADDR_BTH
!DIR$ end OPTIONS

出力

 Winsock DLL loaded successfully
 Connected to device successfully
 Sent:                2 bytes
 Sent:                2 bytes
 Sent:                4 bytes
 Sent:                3 bytes
 Sent:                1 bytes
 Sent:                4 bytes
 Sent:                3 bytes
 Received:            3 bytes
1A 04 5F
 Connection closed successfully
 Winsock DLL unloaded
続行するには何かキーを押してください . . .

プログラム１のリスト

module Load_dll
    use, intrinsic :: iso_c_binding
    implicit none
    private
    public :: LoadLibrary, GetProcAddress, FreeLibrary, GetLastError
    ! Windows API functions ; load DLL
    interface
        function LoadLibrary(lpFileName) bind(C, name='LoadLibraryA')
            import
            type(c_ptr) :: LoadLibrary
            character(kind=C_CHAR), intent(in) :: lpFileName(*)
        end function LoadLibrary

        function GetProcAddress(hModule, lpProcName) bind(C, name='GetProcAddress')
            import
            type(C_FUNPTR) :: GetProcAddress
            type(c_ptr), value :: hModule
            character(kind=C_CHAR), intent(in) :: lpProcName(*)
        end function GetProcAddress

        function FreeLibrary(hModule) bind(C, name='FreeLibrary')
            import
            integer(C_INT) :: FreeLibrary
            type(c_ptr), value :: hModule
        end function FreeLibrary
        
                ! GetLastError関数のインターフェースを追加
        function GetLastError() bind(C, name="GetLastError")
            import
            integer(c_long) :: GetLastError
        end function GetLastError
    end interface    
end module Load_dll
    
module bluetooth_module
    use, intrinsic :: iso_c_binding
    use :: Load_dll
    implicit none

    ! 定数の定義
    integer, parameter :: BLUETOOTH_MAX_NAME_SIZE = 248
     
    ! 構造体の定義
    type, bind(C) :: BLUETOOTH_ADDRESS
        character(c_char) :: rgBytes(8) ! padded 2bytes definition 6bytes
    end type BLUETOOTH_ADDRESS

    type, bind(C) :: SYSTEMTIME
        integer(c_int16_t) :: wYear
        integer(c_int16_t) :: wMonth
        integer(c_int16_t) :: wDayOfWeek
        integer(c_int16_t) :: wDay
        integer(c_int16_t) :: wHour
        integer(c_int16_t) :: wMinute
        integer(c_int16_t) :: wSecond
        integer(c_int16_t) :: wMilliseconds
    end type SYSTEMTIME

    type, bind(C) :: BLUETOOTH_DEVICE_INFO
        integer(c_int) :: dwSize
        integer(c_int) :: padding ! <---- needed padding of 4bytes !BLUETOOTH_DEVICE_INFO_STRUCT
        type(BLUETOOTH_ADDRESS) :: Address
        integer(c_int) :: ulClassofDevice
        integer(c_int) :: fConnected
        integer(c_int) :: fRemembered
        integer(c_int) :: fAuthenticated
        type(SYSTEMTIME) :: stLastSeen
        type(SYSTEMTIME) :: stLastUsed
        character(c_char) :: szName(BLUETOOTH_MAX_NAME_SIZE*2) 
    end type BLUETOOTH_DEVICE_INFO
    
    type, bind(C) :: BLUETOOTH_DEVICE_SEARCH_PARAMS
        integer(c_long) :: dwSize
        integer(c_int) :: fReturnAuthenticated
        integer(c_int) :: fReturnRemembered
        integer(c_int) :: fReturnUnknown
        integer(c_int) :: fReturnConnected
        integer(c_long) :: fIssueInquiry
        integer(c_long) :: cTimeoutMultiplier
        type(c_ptr) :: hRadio
    end type BLUETOOTH_DEVICE_SEARCH_PARAMS

  ! 関数ポインタの定義
    type(c_funptr) :: BluetoothFindFirstDevice_ptr
    type(c_funptr) :: BluetoothFindNextDevice_ptr
    type(c_funptr) :: BluetoothFindDeviceClose_ptr

  ! 関数ポインタから実際の関数を呼び出すインターフェイス
    abstract interface
        function BluetoothFindFirstDeviceFunc(searchParams, deviceInfo) bind(C)
            use, intrinsic :: iso_c_binding
           import :: BLUETOOTH_DEVICE_SEARCH_PARAMS, BLUETOOTH_DEVICE_INFO
            type(BLUETOOTH_DEVICE_SEARCH_PARAMS), intent(in) :: searchParams
            type(BLUETOOTH_DEVICE_INFO), intent(out) :: deviceInfo
            type(c_ptr) :: BluetoothFindFirstDeviceFunc
        end function BluetoothFindFirstDeviceFunc
        function BluetoothFindNextDeviceFunc(hFind, deviceInfo) bind(C)
            use, intrinsic :: iso_c_binding
            import :: BLUETOOTH_DEVICE_INFO
            type(c_ptr), value :: hFind
            type(BLUETOOTH_DEVICE_INFO), intent(out) :: deviceInfo
            integer(c_int) :: BluetoothFindNextDeviceFunc
        end function BluetoothFindNextDeviceFunc
            
        function BluetoothFindDeviceCloseFunc(hFind) bind(C)
            use, intrinsic :: iso_c_binding
            type(c_ptr), value :: hFind
            integer(c_int) :: BluetoothFindDeviceCloseFunc
        end function BluetoothFindDeviceCloseFunc
    end interface
    
    procedure(BluetoothFindFirstDeviceFunc), pointer :: BluetoothFindFirstDevice
    procedure(BluetoothFindNextDeviceFunc), pointer :: BluetoothFindNextDevice
    procedure(BluetoothFindDeviceCloseFunc), pointer :: BluetoothFindDeviceClose
    type(c_ptr) :: dll_handle
     
    contains
     
    ! DLLのロードと関数ポインタの設定
    subroutine load_bluetooth_apis()
        use, intrinsic :: iso_c_binding
        implicit none
        integer(c_int)::iret
        dll_handle = LoadLibrary('bluetoothapis.dll'//C_NULL_CHAR)
        if (c_associated(dll_handle)) then
            BluetoothFindFirstDevice_ptr = GetProcAddress(dll_handle, 'BluetoothFindFirstDevice'//C_NULL_CHAR)
            BluetoothFindNextDevice_ptr = GetProcAddress(dll_handle, 'BluetoothFindNextDevice'//C_NULL_CHAR)
            BluetoothFindDeviceClose_ptr = GetProcAddress(dll_handle, 'BluetoothFindDeviceClose'//C_NULL_CHAR)
        else
            print *, "Failed to load bluetoothapis.dll"
        end if
        
        if (c_associated(BluetoothFindFirstDevice_ptr)) then
            call c_f_procpointer(BluetoothFindFirstDevice_ptr, BluetoothFindFirstDevice)
        else
            print *, "BluetoothFindFirstDevice not found"
        end if  
        
        if (c_associated(BluetoothFindNextDevice_ptr)) then
          call c_f_procpointer(BluetoothFindNextDevice_ptr, BluetoothFindNextDevice)
        else
            print *, "BluetoothFindNextDevic not found"
        end if
        
        if (c_associated(BluetoothFindDeviceClose_ptr)) then
            call c_f_procpointer(BluetoothFindDeviceClose_ptr, BluetoothFindDeviceClose)
        else
            print *, "BluetoothFindDeviceClose not found"
        end if  
     !  iret = FreeLibrary(dll_handle)
    end subroutine load_bluetooth_apis
end module bluetooth_module

program bluetooth_example
    use Load_dll
    use bluetooth_module
    implicit none
    
    type(BLUETOOTH_DEVICE_SEARCH_PARAMS), target :: searchParams
    type(BLUETOOTH_DEVICE_INFO), target :: deviceInfo
    type(c_ptr) :: hFind
    integer(c_int) :: result

  ! DLLのロード
    call load_bluetooth_apis()

  ! 検索パラメータの設定
    searchParams%dwSize = sizeof(searchParams)
    searchParams%fReturnAuthenticated = 1
    searchParams%fReturnRemembered = 1
    searchParams%fReturnUnknown = 1
    searchParams%fReturnConnected = 1
    searchParams%fIssueInquiry = 1
    searchParams%cTimeoutMultiplier = 1 !   1.28sec unit
    searchParams%hRadio = c_null_ptr

  ! デバイス情報の初期化
    deviceInfo%dwSize = c_sizeof(deviceInfo)
      
  ! デバイス検索の開始
    block
        integer :: k
        integer(c_long) :: error_code
        character(256):: error_message
        
        hFind = BluetoothFindFirstDevice(searchParams, deviceInfo)
        !  error_code = GetLastError()
        !  print *, 'error code', error_code
        if (c_associated(hFind)) then
      
            do
                do k = 1, BLUETOOTH_MAX_NAME_SIZE * 2, 2 ! szName is wide char array 
                    if (deviceInfo%szName(k) == achar(0) .and. deviceInfo%szName(k+1) == achar(0)) exit     
                end do    
                print *, "Found device: ", deviceInfo%szName(1:k-1)
                print '(a, *(z2.2:":"))', ' Address:     ', iachar(deviceInfo%Address%rgbytes(6:1:-1)) 
    
                result = BluetoothFindNextDevice(hFind, deviceInfo)
                if (result == 0) exit
            end do
            result = BluetoothFindDeviceClose(hFind)
        else
            print *, "No Bluetooth devices found."
        end if
    end block

    result = FreeLibrary(dll_handle)
end program bluetooth_example

プログラム２のリスト

module Load_dll
    use, intrinsic :: iso_c_binding
    implicit none
    private
    public :: LoadLibrary, GetProcAddress, FreeLibrary, GetLastError
    ! Windows API functions ; load DLL
    interface
        function LoadLibrary(lpFileName) bind(C, name='LoadLibraryA')
            import
            type(c_ptr) :: LoadLibrary
            character(kind=C_CHAR), intent(in) :: lpFileName(*)
        end function LoadLibrary

        function GetProcAddress(hModule, lpProcName) bind(C, name='GetProcAddress')
            import
            type(C_FUNPTR) :: GetProcAddress
            type(c_ptr), value :: hModule
            character(kind=C_CHAR), intent(in) :: lpProcName(*)
        end function GetProcAddress

        function FreeLibrary(hModule) bind(C, name='FreeLibrary')
            import
            integer(C_INT) :: FreeLibrary
            type(c_ptr), value :: hModule
        end function FreeLibrary
        
        function GetLastError() bind(C, name="GetLastError")
            import
            integer(c_long) :: GetLastError
        end function GetLastError
    end interface    
end module Load_dll

module bluetooth_connection
    use, intrinsic :: iso_c_binding
    use :: Load_dll
    implicit none

    ! 追加のDLLハンドルとプロシージャポインタ
    type(c_ptr) :: hWs2_32 = c_null_ptr
    type(c_funptr) :: pWSAStartup = c_null_funptr
    type(c_funptr) :: pWSACleanup = c_null_funptr
    type(c_funptr) :: pSocket = c_null_funptr
    type(c_funptr) :: pConnect = c_null_funptr
    type(c_funptr) :: pSend = c_null_funptr
    type(c_funptr) :: pRecv = c_null_funptr
    type(c_funptr) :: pClosesocket = c_null_funptr
    
    
    ! WSADATA 構造体の定義
    type, bind(C) :: WSADATA
        integer(c_short) :: wVersion
        integer(c_short) :: wHighVersion
        character(kind=c_char) :: szDescription(257)
        character(kind=c_char) :: szSystemStatus(129)
        integer(c_short) :: iMaxSockets
        integer(c_short) :: iMaxUdpDg
        type(c_ptr) :: lpVendorInfo
    end type WSADATA

    ! SOCKADDR_BTH構造体の定義
!DIR$ OPTIONS /ALIGN=(RECORDS=PACKED)  ! パディングを防ぐためのディレクティブ    
    type, bind(C) :: SOCKADDR_BTH
        integer(c_short) :: addressFamily
        integer(c_int64_t) :: btAddr
        integer(c_int) :: serviceClassId(4) = 0
        integer(c_int) :: port = -1 ! any port
    end type SOCKADDR_BTH
!DIR$ end OPTIONS
    
!    type :: SOCKADDR_BTH
!        sequence
!        integer(c_short) :: addressFamily
!        integer(c_int64_t) :: btAddr
!        integer(c_int) :: serviceClassId(4) = 0
!        integer(c_int) :: port = -1 ! any port
!    end type SOCKADDR_BTH

    abstract interface
    
        function WSAStartup_func(wVersionRequired, lpWSAData) bind(C)
            import
            integer(c_int) :: WSAStartup_func
            integer(c_short), value :: wVersionRequired
            type(c_ptr), value :: lpWSAData
        end function WSAStartup_func
                
        function WSACleanup_func() bind(C)
            import
            integer(c_int) :: WSACleanup_func
        end function WSACleanup_func
        
        function socket_func(af, type, protocol) bind(C)
            import
            integer(c_int) :: socket_func
            integer(c_int), value :: af, type, protocol
        end function socket_func

        function connect_func(s, name, namelen) bind(C)
            import
            integer(c_int) :: connect_func
            integer(c_int), value :: s
            type(c_ptr), value :: name
!            integer(c_int64_t), value :: name
            integer(c_int), value :: namelen
        end function connect_func

        function send_func(s, buf, len, flags) bind(C)
            import
            integer(c_int) :: send_func
            integer(c_int), value :: s
            type(c_ptr), value :: buf
            integer(c_int), value :: len, flags
        end function send_func

        function recv_func(s, buf, len, flags) bind(C)
            import
            integer(c_int) :: recv_func
            integer(c_int), value :: s
            type(c_ptr), value :: buf
            integer(c_int), value :: len, flags
        end function recv_func

        function closesocket_func(s) bind(C)
            import
            integer(c_int) :: closesocket_func
            integer(c_int), value :: s
        end function closesocket_func
    end interface
    
    procedure(WSAStartup_func), pointer :: WSAStartup
    procedure(WSACleanup_func), pointer :: WSACleanup
    procedure(socket_func), pointer :: blu_socket
    procedure(connect_func), pointer :: blu_connect
    procedure(send_func), pointer :: blu_send
    procedure(recv_func), pointer :: blu_recv
    procedure(closesocket_func), pointer :: blu_closesocket
    
contains
    subroutine load_winsock_dll()
        use iso_c_binding
        implicit none
        integer(c_int) :: status

        hWs2_32 = LoadLibrary("ws2_32.dll"//C_NULL_CHAR)
        if (.not. c_associated(hWs2_32)) then
            print *, "Failed to load ws2_32.dll"            
            return
        end if

        pWSAStartup = GetProcAddress(hWs2_32, "WSAStartup"//C_NULL_CHAR)
        pWSACleanup = GetProcAddress(hWs2_32, "WSACleanup"//C_NULL_CHAR)
        pSocket = GetProcAddress(hWs2_32, "socket"//C_NULL_CHAR)
        pConnect = GetProcAddress(hWs2_32, "connect"//C_NULL_CHAR)
        pSend = GetProcAddress(hWs2_32, "send"//C_NULL_CHAR)
        pRecv = GetProcAddress(hWs2_32, "recv"//C_NULL_CHAR)
        pClosesocket = GetProcAddress(hWs2_32, "closesocket"//C_NULL_CHAR)
    
        if (.not. c_associated(pWSAStartup) .or. &
            .not. c_associated(pWSACleanup) .or. &
            .not. c_associated(pSocket) .or. &
            .not. c_associated(pConnect) .or. &
            .not. c_associated(pSend) .or. &
            .not. c_associated(pRecv) .or. &
            .not. c_associated(pClosesocket)) then
            print *, "Failed to get Winsock function pointers"
            status = FreeLibrary(hWs2_32)
            hWs2_32 = c_null_ptr
            return
        end if

        print *, "Winsock DLL loaded successfully"
        
        call c_f_procpointer(pWSAStartup, WSAStartup)
        call c_f_procpointer(pWSACleanup, WSACleanup)
        call c_f_procpointer(pSocket, blu_socket)
        call c_f_procpointer(pConnect, blu_connect)
        call c_f_procpointer(pSend, blu_send)
        call c_f_procpointer(pRecv, blu_recv)
        call c_f_procpointer(pClosesocket, blu_closesocket)
    end subroutine load_winsock_dll

    function connect_to_device(btAddr) result(socket)
        use iso_c_binding
        implicit none
        integer(c_int64_t), intent(in) :: btAddr 
        integer(c_int) :: socket, status

        type(SOCKADDR_BTH), target :: sab
        integer(c_int) :: result
        ! 32bit little endian, 16bit little endian x 2, 8bit/4bit 
        !00001101-0000-1000-8000-00805F9B34FB
        integer(c_long), target :: iguid(4)=[z'00001101',z'10000000', z'80000080', z'FB349B5F']

        socket = blu_socket(32, 1, 3)  ! AF_BTH, SOCK_STREAM, BTHPROTO_RFCOMM
        if (socket == -1) then
            status = GetLastError()
            print *, "Failed to create socket", status
            return
        end if

        sab%addressFamily = 32  ! AF_BTH
        sab%btAddr = btAddr
        sab%serviceClassId = iguid
        sab%port = -1  ! any port
        result = blu_connect(socket, c_loc(sab), c_sizeof(sab))
        if (result == -1) then
            status = GetLastError()
            print *, "Failed to connect to device", status
            result = blu_closesocket(socket)
            socket = -1
        else
            print *, "Connected to device successfully"
        end if
    end function connect_to_device

    function send_data(socket, data, length) result(bytes_sent)
        use iso_c_binding
        implicit none
        integer(c_int), intent(in) :: socket
        character(kind=c_char), intent(in), target :: data(*)
        integer(c_int), intent(in) :: length
        integer(c_int) :: bytes_sent
    
        bytes_sent = blu_send(socket, c_loc(data), length, 0)
        if (bytes_sent == -1) then
            print *, "Failed to send data"
        end if
    end function send_data

    function receive_data(socket, buffer, buffer_size) result(bytes_received)
        use iso_c_binding
        implicit none
        integer(c_int), intent(in) :: socket
        character(kind=c_char), intent(out), target :: buffer(*)
        integer(c_int), intent(in) :: buffer_size
        integer(c_int) :: bytes_received

        bytes_received = blu_recv(socket, c_loc(buffer), buffer_size, 0)
        if (bytes_received == -1) then
            print *, "Failed to receive data"
        end if
    end function receive_data
!
    subroutine close_connection(socket)
        use iso_c_binding
        implicit none
        integer(c_int), intent(in) :: socket
        integer(c_int) :: result

        result = blu_closesocket(socket)
        if (result == -1) then
            print *, "Failed to close socket"
        else
            print *, "Connection closed successfully"
        end if
    end subroutine close_connection

    subroutine unload_winsock_dll()
        use iso_c_binding
        implicit none
        integer(c_int) :: result

        if (c_associated(hWs2_32)) then
            result = FreeLibrary(hWs2_32)
            hWs2_32 = c_null_ptr
            pSocket = c_null_funptr
            pConnect = c_null_funptr
            pSend = c_null_funptr
            pRecv = c_null_funptr
            pClosesocket = c_null_funptr
            print *, "Winsock DLL unloaded"
        end if
    end subroutine unload_winsock_dll

end module bluetooth_connection

program main
    use bluetooth_connection
    implicit none

    integer(c_int64_t) :: device_address
    integer(c_int) :: socket
    type(WSADATA), target :: wsa_data
    integer(c_int) :: res
    
    call load_winsock_dll()
    
    if (c_associated(hWs2_32)) then
        res = WSAStartup(int(z'0202', c_short), c_loc(wsa_data))
        if (res /= 0) then
            print *, "WSAStartup failed with error: ", res
        end if
        
    !    '00:15:83:54:A2:7F ! 実際のデバイスアドレスに置き換えてください
        device_address = z'00158354A27F' ! M02S channel 1
        socket = connect_to_device(device_address)
        
        if (socket /= -1) then
ESCPOS:     block
                use, intrinsic :: iso_fortran_env     
                character, parameter :: ESC = ACHAR(z'1B'), GS  = ACHAR(z'1D'), US  = ACHAR(z'1F')
                character, parameter :: INIT*2 = ESC // '@', BM*4 = GS // 'v' // '0' // achar(0)
                character, parameter :: ENGY*3 = US  // ACHAR(z'11') // ACHAR(z'08') 
                character(kind=c_char, len=100) :: send_buffer
                character(kind=c_char, len=100) :: recv_buffer
                integer(c_int) :: bytes_sent, bytes_received
                integer(int16) :: iw, ih, kw, i, j
 
                iw = 576 ! M02S width
                ih = 100
                kw = iw / 8
    
             ! header  
             ! initialize ESC @
                send_buffer = ESC // '@'
                bytes_sent = send_data(socket, send_buffer, len_trim(send_buffer))
                print *, "Sent:     ", bytes_sent, "bytes"
             ! justify ESC a nn ; 0:left, 1:center, 2:right
                send_buffer = ESC // 'a'
                bytes_sent = send_data(socket, send_buffer, len_trim(send_buffer))
                print *, "Sent:     ", bytes_sent, "bytes"
             ! concentration
             !  US x11 x02 nn ; 01:thin, 03:middle, 04:thick 
                send_buffer = US // achar(17) // achar(02) // achar(04)
                bytes_sent = send_data(socket, send_buffer, len_trim(send_buffer))
                print *, "Sent:     ", bytes_sent, "bytes"
 
             ! BLOCK MARKER    
             ! raster image ; GS, 'v0'
                send_buffer = GS // 'v0'
                bytes_sent = send_data(socket, send_buffer, len_trim(send_buffer))
                print *, "Sent:     ", bytes_sent, "bytes"
             ! mode ; 0  achar(0) 
                send_buffer = achar(0)
                bytes_sent = send_data(socket, send_buffer, len_trim(send_buffer))
                print *, "Sent:     ", bytes_sent, "bytes"
             ! image size (2byte 2byte) ; width height
                send_buffer(1:2) = TRANSFER(kw, '  ')
                send_buffer(3:4) = TRANSFER(ih, '  ')
                bytes_sent = send_data(socket, send_buffer, len_trim(send_buffer))
                print *, "Sent:     ", bytes_sent, "bytes"

                do i = 1, ih
                   ! do j = 1, kw
                    if (mod(i, 10) == 0) then   
                        send_buffer = repeat(achar(255), kw) !z'FF' !draw black line
                        bytes_sent = send_data(socket, send_buffer, len_trim(send_buffer))
                   !     print *, "Sent:     ", bytes_sent, "bytes"
                    else
                        send_buffer = repeat(achar(0), kw) !z'00' !draw white line
                        bytes_sent = send_data(socket, send_buffer, len_trim(send_buffer))
                   !     print *, "Sent:     ", bytes_sent, "bytes"
                    end if      
                   ! end do
                end do
            
              ! get battery info  
                send_buffer = ENGY
                bytes_sent = send_data(socket, send_buffer, len_trim(send_buffer))
                print *, "Sent:     ", bytes_sent, "bytes"

                bytes_received = receive_data(socket, recv_buffer, len_trim(recv_buffer))
                if (bytes_received > 0) then
                    print *, "Received: ", bytes_received, "bytes"
             !       print '(*(z2.2, 1x))', (iachar(recv_buffer(i:i)), i = 1,bytes_received) 
                    print *, transfer(recv_buffer(3:3), 0_int8), '%'
                end if
            end block ESCPOS
            
            call close_connection(socket)
        end if
        
        res = WSACleanup()
        call unload_winsock_dll()
    end if
end program main

結論

Windows 上の Intel Fortran を用いて Win64 Bluetooth API を利用して Bluetooth printer への通信ができた。AI を利用してプログラムを作成を試みた。Bluetooth 通信に必要な DLL や API などは、AI が正しく選択してくれた。また Fortran による interface 記述などもおおむね正しく生成してくれた。
しかしながら、AI は Windows 側の構造体の定義を memory alignment までは正しく再現できなかった。また Windows 構造体の定義は不規則で Fortran の標準文法内では対応が困難だった。

全体として AI は非常に強力なプログラミング・ツールであることが確かめられた。以前に bluetooth printer 用のプログラムを作成したときに、Fortran からの Windows Bluetooth API 利用について調べたが、実現方法は皆目見当がつかなかった。今回、何の下調べもなしに曖昧な質問をするだけで AI が瞬時にプログラムを生成してくれた。それはそのままでは実行不能であったが、これをひな形とすることで、比較的短時間で Bluetooth 利用を実現することができた。

近い将来、AI がさらに発達することで現時点では Fortran からの利用が難しいライブラリなどが簡便に利用できるようになることが期待される。

参照サイト

[^1] https://fortran66.hatenablog.com/entry/2024/07/10/230348
[^2] https://qiita.com/cure_honey/items/72124ff8effddc075e9b
[^3] https://learn.microsoft.com/ja-jp/windows/win32/api/bluetoothapis/ns-bluetoothapis-bluetooth_device_info_struct
[^4] https://stackoverflow.com/questions/68480633/is-there-any-equivalent-to-pragma-pack1-in-fortran-for-derived-types