8
2

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 1 year has passed since last update.

Phomemo 感熱紙プリンタへの Fortran からの出力 備忘録

Last updated at Posted at 2022-02-23

感熱紙プリンタ

感熱紙プリンタというのは、熱を加えると黒く変色する感熱紙に印字するプリンタで、レシートなどによく使われています。

そういうものを流用したと思われる小さな Bluetooth 感熱紙プリンタが多く売られています。その中の Phomemo M02S というものを入手したので、Fortran から出力を試みました。その備忘録として記録しておきます。

prnt.jpg
図 左から python プログラムによる画像出力、Fortran による作図例、Ubuntu 上で CUPS printer driver を定義して windows から Samba 経由で利用したもの(紙設定がうまくゆかない)。

phomemo M02S

phomemo 製品を選んだのは、github に python によるパソコンからの利用プログラムがいくつかあったことで、M02S を選んだのはドット密度が 300 dpi~12 dot/mm と細かかったことです。一般的なレシートプリンタと同じ 200 dpi~8 dot/mm の製品は少し値段が安くなっています。

なおプリンタへ渡せるデータ形式は、ESC/POS の白黒二値画像出力だけで、ASCII 文字も出せません。

他社製品

感熱紙プリンタには似たり寄ったりの製品が沢山あります。基本この手の製品はスマホから bluetooth で利用することが想定されていて、Phomemo 社の製品では、Android と iOS のアプリのみが提供されています。他社のものもスマホアプリだけを前面に出していますが、目立たないように Windows や Mac 用のプリンタドライバを提供していたりします。

ただし、他社の製品はプリンタへ送るデータ形式が独自のもので、利用がむずかしくなっていたりします。また github をみても何の解析もされていない製品もあります。

実用性?

実際に使ってみると M02S は一般的なレシートと同じ約 50mm 幅の感熱紙への出力で、描ける図が小さすぎて実用性には乏しい気がしました。しかしながら、最近 110mm 幅の感熱紙に対応した製品が出たようなので、こちらならばあるいは使い道があるかもしれません。

Github 上の参考リポジトリ

いずれも Ubuntu 上の Python 利用。

基本

Bluetooth と USB からの仮想シリアル接続法が書かれています。

Unix の CUPS ドライバも定義し、Ubuntu からは普通のプリンタとして利用できるようになっています。M02S から用いるには、多少の書き換えが必要です。また背後で処理する python のプログラムが import しているライブラリをあらかじめ install しておく必要があるようです(背後で動いているせいか普通では無警告でうまくいきません)。

Bluetooth の信号をリンバースエンジニアリングして、印字に必要な命令語を見つけたようです。

派生 300dpi 対応

文字可

独自のビットマップ Font で ASCII 文字が出せます。Bluetooth 接続のみ。

M02S 用

私の環境では動きませんでしたが、Andoroid アプリを逆コンパイルしてソースを見て、API のリストを作っています。

Fortran からの利用

Phomemo は Bluetooth や USB から仮想的にシリアル接続できるので、色々制限がありますがシリアルポートに出力する形で扱えます。これは Fortran でなくとも、どの言語からも利用できる方法です。

Fortran の場合、open 文で適切な仮想ファイルを開くことになります。

! Ubuntu bluetooth
    open(10, file = '/dev/rfcomm0', access = 'stream', action = 'readwrite')
! Ubuntu USB
!    open(10, file = '/dev/usb/lp0', access = 'stream', action = 'readwrite')
! windows USB
!    open(10, file = 'COM4', access = 'stream', action = 'readwrite')
! mac USB
!    open(10, file = '/dev/usb/cu.usbmodemA0xxxxxx', access = 'stream', action = 'readwrite')

今の所、この方法で Bluetooth から無線接続できたのは Ubuntu だけです。USB による有線接続ならば、Ubuntu/Windows/Mac の全てから利用できました。Fortran から Bluetooth 接続できるのは、Ubuntu だけでした。

付記:シリアルポートのオプション

Ubuntu のシリアルポートで改行コードの関係から、 z'0A' が z'0a'z'0d' に変換されることがあります。その場合 

stty -F /dev/ttyXXXX -onlcr

で抑止することが可能です。

最小プログラム例 (Windows 版)

10 dot 行毎に直線をひきます。

IMG_20220223_0003.jpg
Phomemo M02S は、横方向には最大 576 dot で 横幅 48mm の範囲で印字できます(12 dot/mm)。縦方向(紙送り方向)にも同じ 12 dot/mm で印字します。縦横比は 1:1 になります。

画像情報は、横方向に 0(白), 1(黒) 2諧調の印字情報を、1 dot 毎 1 bit で表わし左から右に並べて、8 bit 毎にまとめて上位から下位に向かって並べて 1 byte として、それをひたすら並べます。

はじめに画像の横幅、縦幅を与えることで、各行ごとのドット数や終了の行数が決まります。横幅は dot 数ではなく、byte 数で与えるので横幅の dot 数は 8 の倍数になります。

データは(縦ドット数 / 8x横ドット数)byte のデータを行の区切りも無くただひたすら並べます。

program test
    use, intrinsic :: iso_fortran_env     
    implicit none
    character, parameter :: ESC = achar(27) !z'1B'
    character, parameter :: GS  = achar(29) !z'1D'
    character, parameter :: US  = achar(31) !z'1F'
    integer(int16) :: iw, ih, kw, i, j

    open(10, file = 'COM3', access = 'stream', action = 'readwrite')
    iw = 576 
    ih = 100
    kw = iw / 8
    
! header  
    write(10) ESC, '@' ! initialize 

! BLOCK MARKER    
    write(10) GS, 'v0' ! raster image
    write(10) achar(0) ! mode
    write(10) kw, ih   ! image size
    do i = 1, ih
        do j = 1, kw
           if (mod(i, 10) == 0) then   
               write(10) achar(255) !z'FF' !draw black line 
           else
               write(10) achar(0)
           end if      
        end do
    end do
    
end program test

Windows で OPEN すべき COM の番号は、デバイスマネージャーから「ポート(COMとLPT)」を探せば分かります。
DeviceManeger.png

注意点

  • USB 接続の場合、命令を送ることは出来ましたが、プリンタからの応答を受信し出来ずフリーズしてしまいます。したがってプリンタの情報(電池残量など)を取ることが出来ませんでした。

  • WSL1/WSL2 とも Bluetooth および USB にカーネルが対応していないため、これらからは利用が出来ません。生の Ubuntu (Linux) を使う必要があります。WSL2 に関しては、ごく最近 USB が使える方法が示されていました。しかし、それに従って装置を認識するところまでは出来ましたが、うまく出力できませんでした。

  • 私は VMWARE 上の Ubuntu を利用しました。ただ、ホストと Bluetooth を共用するオプションが効かず、Bluetooth アダプタを占有する必要がありました。

  • Mac からは USB 接続だけが出来ました。下記の参考記事に従って、Mac の boot 時に仮想シリアル接続装置を認識させる必要があり、M02S のスイッチを入れた状態で立ち上げなければなりませんでした。また、接続が切れると boot からやり直す必要があります。なおベータ版のドライバを入れると、ホットプラグで認識はされるようになりますが、うまく出力できませんでした【悲報】。

  • Windows 上では、Fortran からの Bluetooth は利用できていませんが、Python からならば PyBluez ライブラリに依って bluetooth 利用が出来ます。しかしながら、PyBluez のインストールにかなりてこずりました。なお Mac では PyBluez がうまく動かず未解決です。

  • Ubuntu から bluetooth で接続する場合、z'0a' が linefeed として機能するようで問題が生じます。適当な代替 bit patterm (z'14') に置き換える必要があります。 USB の場合問題は生じません。M5 paper から bluetooth 経由で z'0a' を書かせても問題が起きないので、Ubuntu 上の rfcomm の問題だと思います。rfcomm は 0a を 0a0d に置き換えるらしく、これを避けるには、-r のオプションが必要だそうです。これを付けると問題は解決します。

API 補足

Phomemo の M シリーズのプリンタ制御 API は、上記の GitHub の内容を見ると分かります。ESC/POS に準拠しているわけではなく、命令のうち初期化とラスタービット・イメージを借りたようになっています。そのほかに独自拡張の API がいくつかあって、線の濃さを変えたり、プリンタの情報を取ってきたりしています。

プログラムする上では GitHub 上の情報で大体事足りるのですが、API に渡すパラメータの値はよく分からないなど、いくつか謎も残ります。

いずれにせよ、どうやるのか気になったので私も bluetooth 解析と Android APK 逆コンパイルに挑戦してみました。

blutooth 出力解析

この記事を読むと blutooth の出力解析を行って必要な API 情報を得たようです。

どうやるのか検索した所、以下の記事が引っかかったので、これを参考にやってみました。基本は Andorid 機のデバッグ用ログファイルに Bluetoorh 入出力が書かれるので、それを読むようです。

古いAndoroid 7 機に中華アプリを入れて、ホイホイ言われるままに進めました。なお中華アプリは初回起動時にプライバシー要件を読んで OK しろと促すのですが、その要件が白紙で1文字も書いていないというw (中華アプリが嫌な場合は、ESP/POS 汎用の bluetooth プリンタアプリがいくつか見つかるので、機能が劣るものの、それを利用することも可能です。)

Android 機で取った log はバイナリで、Windows に送って読み取ります。そうして log を見てみると、確かに GitHub 上の先人の解析に従って読み解けます。Protocol SPP 中の、Bluetooth SPP Packet を見れば良いようです。

しかし、いくつか先人の記述と違っている点もあることに気づきました。先人の解析は初期型のプリンタで、アプリもバージョンが進んでいるので、若干違っていても不思議ではありません。

APK 逆コンパイル

別の記事では、アプリを逆コンパイルしてソースを訪ねる方法で API を求めています。

どうやるのか検索して、以下の記事に従ってやってみました。

逆コンパイルされた java コードを探したところ phomemo\classes2-dex2jar\com\quyin\qyapi\printerx 以下に求める API があることが分かりました。なお Quyin は製造会社名のようです。こうして得られたソースコードが、上記 GitHub 記事の内容に従っていたので、手法を再現できたのではないかと思います。

補足事項

  • 先行解析で FOOTER と呼んでいる画像データ終了後の命令群は無くても良い。シリアル番号や電池残量などを取っているだけで、終端記号の役割はありません。

  • 1 block marker 当たりの画像データの最大行数を 256 としていますが、任意の 16 bit 整数値を取れます。ただし、バッファの関係か 4,000 dot 位で画像が切れるので、実質 3,000 dot 位毎に、別の block marker にする必要があります。

  • 先行解析では画像データ中に z'0a' が出ると、linefeed してしまうので置き換え必要とされていますが、 M02S では直っているようです。(firmware 1.0.2) これは Ubuntu rfcomm による bluetooth 接続時のみの問題でした。USB で接続するとこの問題は出ません。他の機器からの M02S への bluetooth 接続時も問題が起きません。 rfcomm 起動時に -r のオプションを付けることで解決します。

参考サイト:
http://debugitos.main.jp/index.php?Ubuntu/Bluetooth%E3%82%B7%E3%83%AA%E3%82%A2%E3%83%AB%E3%83%9D%E3%83%BC%E3%83%88

1to16.jpg
図 0~15 に当たるデータを 80 ドット間隔で書かせたもの。z'0a'(10) に当たるビット列(b'00001010')も書かれています。

program test
    use, intrinsic :: iso_fortran_env     
    implicit none
    character, parameter :: ESC = achar(27) !z'1B'
    character, parameter :: GS  = achar(29) !z'1D'
    character, parameter :: US  = achar(31) !z'1F'
    integer(int16) :: iw, ih, kw, i, j

    open(10, file = 'COM3', access = 'stream', action = 'readwrite')
    iw = 576 
    ih = 192
    kw = iw / 8
    
! header  
    write(10) ESC, '@' ! initialize 
    write(10) ESC, 'a', achar(1) ! justify ; 0:left, 1:center, 2:right

! concentration
    write(10) US, achar([17, 02, 03]) ! 01:thin, 03:middle, 04:thick 

! BLOCK MARKER    
    write(10) GS, 'v0' ! raster image
    write(10) achar(0) ! mode
    write(10) kw, ih   ! image size
    do i = 0, ih - 1
        do j = 1, kw
           if (mod(j, 10) == 0) then 
               write(10) achar(i / 12)   
           else
               write(10) achar(z'00')
           end if      
        end do
    end do
    
end program test
  • M02S の場合、HEADER 部分で印字濃度を指定できるほかに、印字濃度係数も変えられます。
    ++ setConcentrationCoefficiennt: 1f, 11, 37, i (i=64 標準、i=96 M02S 最濃)   
    ++ setConcentration: 1f, 11, 02, i (i=1 薄い、i=3 普通、i=4 濃い)

IMG_20220223_0001.jpg
図:左は薄い印字濃度:(64,1)。右は濃い印字濃度:(96,4)。

  • 黒は感熱紙の加熱に依るので、濃い画像はプリンタヘッドの過熱をもたらします。オーバーヒートするとプリンタはランプを点滅させて停止します。印字濃度:(96,4)の組み合わせの場合、長い画像の連続出力で約 90cm の出力で停止します。印字濃度:(64,1)の場合は約 210cm の出力で停止しました。なお出力途中で冷却のため Fortran プログラムを休止させると、出力が微妙にずれて白い線が入ったりします。

API 命令について

プリンタに送る命令については、先行解析にあるリストの通りなのですが、いくつか補足点を加えて必要な分だけをまとめます。

    character, parameter :: ESC = achar(27) !z'1B'
    character, parameter :: US  = achar(31) !z'1F'
    character, parameter :: GS  = achar(29) !z'1D'
    character, parameter :: NAK = achar(21) !z'15' 

印字関連命令

Initialize: ESC + '@'

ESP/POS のまま。

write(10) achar([27, 40]) 

Alignment: ESC + '2'

ESP/POS のままですが、機能しておらず常に中央寄せとなります。

定義上は

  • 左寄せ :ESC + '2' + 0
  • 中央寄せ:ESC + '2' + 1
  • 右寄せ :ESC + '2' + 2
write(10) achar([27, 97, 1]) 

Concentration Coefficiennt: US + z'11' + z'37'

Concentration に先行して現れます。公式アプリでは、デフォルト設定値が z'64'=100 で M02S 専用設定にすると z'96'=150 に設定されます。これと次項の setConcentration の関係は判然としませんが、名称からして係数と思われます。100, 150 以外の値が有効かも不明です。

write(10) achar([31, 17, 55, 100])  ! default 
!
write(10) achar([31, 17, 55, 150])  ! M02S dedicated

Concentration: US + z'11' + z'02'

印字の濃さを決めます。濃く設定するほど高温を加えることになるので、プリンタヘッドの過熱に留意が必要になります。アプリでは印字濃さに 2 が使われていませんが詳細不明です。

  • 印字薄い:US + z'11' + z'02' + z'01'
  • 印字普通:US + z'11' + z'02' + z'03'
  • 印字濃い:US + z'11' + z'02' + z'04'
    write(10) achar([31, 17, 02, 01]) ! weak
!
    write(10) achar([31, 17, 02, 03])  
!
    write(10) achar([31, 17, 02, 04]) ! thick

Raster bit image GS + 'v' + '0'

ESP/POS のままです。先行研究では y 方向に 256 行が最大行とされていますが、ESC/POS の規格ではそうなっていません。実際 256 行を超えても問題なく動きます。ただしプリンタのバッファの関係か 4000 行を超えたあたりでプリンタの動作が止まるので、それより少ない所でいったん切って、あらためて GS + 'v' + '0' のブロックを繰り返す必要があります。

定義から分かるように、横一列の行が単位になっています。つまり行ごとには濃度を変えて諧調をつけられることになります。

Phomemo M02 シリーズでは設定によらず中央寄せになるので、プリンタの最大ドット幅 576 ドットより小さい数を幅として与えると、中央部分のみに印字がなされます。

    write(10) achar([29, 118, 48])
    write(10) 0 ! mode: 0..3: 0:Normal, 1:Double-Width, 2:Double-Height, 3:Quadrupul 
    write(10) nx / 8, ny ! image size 16bit integer little endian
    write(10) data(:,:)  ! nx / 8 * ny bytes

feed line: z'0a'

改行します。約 1.37㎜ 紙送りされます。

write(10) achar(10)

feed lines: ESC + 'd'

後続する整数に比例して紙送りします。0.1 インチ単位で紙送りしているようです。

write(10) achar([27, 100, 10]) ! 1 inch ~ 2.54cm paper feed

情報問い合わせ命令

プリンタの状態を問い合わせる命令がいくつかあります。無操作時の電源自動オフまでの時間は設定も可能ですが、問い合わせと対にしてこの項目に入れておきます。

Bluetooth のデータ内容を見ると、意味のある戻り値の前に 1 byte の z'1a'
がついているのですが、Fortran の read 文で読むと、これは消えていて意味のある内容だけが読み取れます。理由はよく分かりません。

get_device_timer: US + z'11' + z'0e'

電源が切れるまでの秒数を返します。返り値は 2 byte little endian unsigned integer です。

integer(int16) :: itimer
!.......
write(10) achar([31, 17, 14])
read(10) itimer
print *, 'timer: ', itimer

set_device_timer: ESC + z'4E' + z'07'

引き続く 1 byte unsiged integer で電源が切れるまでの時間を設定します。

  • 整数値を i として 256 * i + 9 がセットされます。単位は秒数と思われます。ただし i = 0 の時、すなわち 9 がセットされた時は、自動で電源は切れなくなります。また i = 3 の時は、プリンタが応答しなくなります。(すべての i について応答性を調べていないので、ほかにもあるかもしれません。)
write(iw) achar([27, 78, 7, 0]) ! never goes off     

get_energy: US + z'11' + z'08'

電池の残量を返します。 返り値は 2 byte little endian unsigned integer です。宣伝内容をみると M02S の電池容量は 1,000mAh だと思われますが、満充電時に約 25,000 を返します。したがって戻り値を 250 で割ることで電池残量のパーセンテージが分かります。 どうも 16bit little endian とすると、下位バイトの値が常に 04 となるので、実際は 3byte 目しか意味がなく、これを 1byte 整数として読むと電池残量のパーセント値になるようです。これは 2byte 整数として読んで 256 で割るとパーセント値になることに相当します。何回か呼び出すと結構値がぶれるので有効数字的にもこの程度の精度の方がしっくりきます。電池残量が 10% を切るとプリンタのスイッチランプが点滅をはじめます。

integer(int16) :: ienergy

write(iw) achar([31, 17, 8])  
read(iw) ienergy
print *, ienergy / 25000.0 * 100, '%' 

paper status: US + z'11' + z'11'

返り値 2 byte で印字用紙や蓋の状態を返します。

M02S の内蓋には小さな穴があって紙の有無を見るセンサーがついているようです。また蓋の開閉も検知しているようです。

  •    蓋開き 1001 1001 0000 0101 (ランプ点滅)
  • 紙無し蓋閉じ 1000 1000 0000 0101 (ランプ点滅)
  • 紙有り蓋閉じ 1000 1000 0000 0110 (蓋閉じ直後)  
  • 紙有り蓋閉じ 1000 1001 0000 0110  
     

firmware: US + z'11' + z'07'

先行研究では、firmware 番号が x.y.z の形式として、返り値が z,y,x のように逆順で返ってくるとしていますが、Phomemo アプリの結果と照合すると、x,y,z の順で値を返してきています。現在の firmware の version は 1.0.2 となっています。返り値は 1byte unsigned integer 4つで、最初の 1 個は捨てます。

character :: firm(4)
!....
write(10) achar([31, 17, 07]) 
read(10) firm
print '(a, 3(i0:,"."))', ' firmware: ', iachar(firm(2)), iachar(firm(3)), iachar(firm(4))

serial number: US + z'11' + z'09'

返り値は 1 byte unsigned integer と 15 byte ASCII 文字です。最初の整数値には 8 が入っています。多分 15 byte の serial number 中の前半 8 byte が会社名などの共通部分で、残りが個々の機器を区別する番号であることを示しているのではないかと思われます。

character :: serial(16)
!......
write(10) achar([31, 17, 09])  
read(10) serial
print *, 'serial No.: ', serial(2:)

手順メモ

Ubuntu Bluetooth

$ sudo rfcomm -r connect 0 00:15:83:54:A2:7F
  Connected /dev/rfcomm0 to 00:15:83:54:A2:7F on channel 1
  Press CTRL-C for hangup

別窓で

$ sudo chmod 666 /dev/rfcomm0

Fortran

    open(10, file = '/dev/rfcomm0', access = 'stream', action = 'readwrite')

Ubuntu USB

$ sudo chmod 666 /dev/usb/lp0

Fortran

    open(10, file = '/dev/usb/lp0', access = 'stream', action = 'readwrite')

Windows USB

デバイスマネージャで、COM 番号を調べておく。

open(10, file = 'COM3', access = 'stream', action = 'readwrite')

Mac USB

boot 前にプリンタのスイッチを入れた状態で USB 接続。Mac を boot。

$ ls /dev/usb
cu.usbmodemA0xxxxxx .......

$ sudo chmod 666 /dev/usb/cu.usbmodemA0xxxxxx

fortran

    open(10, file = '/dev/usb/cu.usbmodemA0xxxxxx', access = 'stream', action = 'readwrite')

付録 出力例

figblue.jpg

プログラム

    module bw_m
        use, intrinsic :: iso_fortran_env
        implicit none
        character, parameter :: ESC = achar(27) !z'1B'
        character, parameter :: US  = achar(31) !z'1F'
        character, parameter :: GS  = achar(29) !z'1D'
        character, parameter :: NAK = achar(21) !z'15'

        type :: bw_t
            integer :: nx = 576 / 8, ny = 1  
            integer(int8), allocatable :: bw(:, :) 
        contains 
            procedure :: init => init_bw
            procedure :: pr => pr_bw
            procedure :: point => point_bw
            procedure :: dot => dot_bw
            procedure :: line => line_bw
            procedure :: line_rel => line_rel_bw
            procedure :: lines => lines_bw
        end type bw_t 

    contains   
    
        subroutine init_bw(pic, nx, ny)
            class (bw_t), intent(in out) :: pic 
            integer, intent(in) :: nx, ny
            allocate(pic%bw(nx / 8, ny))
            pic%nx = nx
            pic%ny = ny
            pic%bw = 0
        end subroutine init_bw

        subroutine pr_bw(pic, fn)
            class (bw_t), intent(in) :: pic 
            character (len = *), intent(in) :: fn
            character :: firmware(5), energy(3)
            integer :: iw, i, j
            associate(nx => pic%nx, ny => pic%ny)
                open(newunit = iw, file = fn, access = 'stream', action = 'readwrite')
            ! header  
                write(iw) ESC, '@' ! initialize 
                write(iw) ESC, 'a', achar(1) ! justify ; 0:left, 1:center, 2:right
                !                            ! M02S always stays center 
            ! concentration
              !  write(iw) US, achar(17), achar(02), achar(01) ! 04: concentration
                write(iw) NAK, achar(17), achar(02), achar(01) ! 04: concentration
              ! BLOCK MARKER 
                write(iw) GS, 'v0' ! raster image
                write(iw) achar(0) ! mode
                write(iw) int(nx / 8, int16), int(ny, int16)   ! int16 little endian
            ! usb
            !   write(iw) pic%bw

            !  rfcomm bug z'0a' feeds line; replace z'0a' with z'14' 
               write(iw) merge(pic%bw, 20_int8, pic%bw /= int(z'0a', int8))

            ! footer
            !    write(iw) ESC, 'd', achar(1)
            !    write(iw) US, achar(z'11'), achar(z'08')
            !    call sleep(5)
            !    read(iw) energy
            !    print '(3g0)', 'energy ', iachar(energy(2)) + 256 * iachar(energy(3))    
            !    write(iw) US, achar(z'11'), achar(z'0e')  
            !    write(iw) US, achar(z'11'), achar(z'07') 
            !    call sleep(3)
            !    read(iw) firmware
            !    print '(10a)', 'firmware version ', firmware(1), '.', firmware(2), '.', firmware(3) 
            !    write(iw) US, achar(z'11'), achar(z'09')  
                close(iw)
            end associate
        end subroutine pr_bw
 
        
        subroutine point_bw(pic, ix, iy)
            class (bw_t), intent(in out) :: pic
            integer     , intent(in) :: ix, iy
            integer :: jx, mx 
            if (ix > 0 .and. ix <= pic%nx .and. iy > 0 .and. iy <=pic%ny) then
                jx = (ix - 1) / 8 + 1
                mx = 7 - mod(ix - 1, 8)
                pic%bw(jx, iy) = ibset(pic%bw(jx, iy), mx)  
            end if 
        end subroutine point_bw      
       

        subroutine dot_bw(pic, ix, iy, nsize)
            class (bw_t), intent(in out) :: pic
            integer     , intent(in) :: ix, iy, nsize
            integer :: kx, ky
            do kx = -nsize/2, nsize/2
                do ky = -nsize/2, nsize/2
                    call pic%point(ix + kx, iy + ky)     
               end do     
            end do     
        end subroutine dot_bw 

        
        subroutine line_bw(pic, ix0, iy0, ix1, iy1, iwidth0)
            class (bw_t), intent(in out) :: pic
            integer      , intent(in) :: ix0, iy0, ix1, iy1
            integer, intent(in), optional :: iwidth0
            integer :: ix, iy, mx, my, iwidth = 1
            real :: dx, dy, x, y
            if (present(iwidth0)) iwidth = iwidth0
            mx = ix1 - ix0
            my = iy1 - iy0
            if (mx == 0 .and. my == 0) return 
            if (abs(mx) > abs(my)) then
                dy = my / real(mx)
                y  = iy0 
                do ix = 0, mx, sign(1, mx)
                    y = dy * ix
                    iy = nint(y)
                    call pic%dot(ix0 + ix, iy0 + iy, iwidth)
                end do    
            else   
                dx = mx / real(my)
                x  = ix0 
                do iy = 0, my, sign(1, my)
                    x = dx * iy
                    ix = nint(x)
                    call pic%dot(ix0 + ix, iy0 + iy, iwidth)
                end do    
             end if    
         end subroutine line_bw
        
         subroutine line_rel_bw(pic, ix, iy, ipen)
             class (bw_t), intent(in out) :: pic
             integer, intent(in) :: ix, iy, ipen
             integer, save :: kx = 0, ky = 0
             if (ipen == 1) call pic%line(kx, ky, kx + ix, ky - iy)
             kx = kx + ix 
             ky = ky - iy ! reverse y-axis diection
         end subroutine line_rel_bw 
 
        subroutine lines_bw(pic, pos, mag0) 
            class (bw_t), intent(in out) :: pic
            integer, intent(in) :: pos(:)
            integer, intent(in), optional :: mag0
            integer :: i, ix, iy, ipen
            integer, save :: mag = 1
            if (present(mag0)) mag = mag0
            do i = 1, size(pos) / 3
                ix   = pos(3 * i - 2) * mag
                iy   = pos(3 * i - 1) * mag
                ipen = pos(3 * i)
                call pic%line_rel(ix, iy, ipen)
            end do
        end subroutine lines_bw 

    end module bw_m
   
    
    program test
        use :: bw_m
        implicit none

        block
            type(bw_t) :: fig1
            integer :: nx = 576, ny = 126
            integer :: i, ix, iy
            real :: x(10000, 2)
            call fig1%init(nx, ny)
            call random_number(x)
            do i = 1, size(x, 1)
                call fig1%point(int(nx * x(i, 1)), int(ny * x(i, 2)))
            end do

            call fig1%line( 1,  1, nx,  1) 
            call fig1%line( 1,  1,  1, ny) 
            call fig1%line( 1, ny, nx, ny)        
            call fig1%line(nx,  1, nx, ny)
            call fig1%line( 1,  1, nx, ny ) 
            call fig1%line(nx,  1, 1,  ny) 
        
!            call nums_bw(fig1, 1)
         
            call fig1%pr('/dev/rfcomm1')
            call sleep(3) ! non-standard
        end block    
       
        block
            type(bw_t) :: fig2
            integer :: nx = 576, ny = 432
            integer :: ix, iy, nr, ix0, ix1, iy0, iy1
          
            call fig2%init(nx, ny)
            nr = 100
            do iy = 0, nr
                ix = sqrt(real(nr**2 - iy**2))
                ix0 = nx / 2 - ix
                ix1 = nx / 2 + ix
                iy0 = ny / 2 - iy
                iy1 = ny / 2 + iy
                call fig2%line(ix0, iy0, ix1, iy0)
                call fig2%line(ix0, iy1, ix1, iy1)
            end do    
            do ix = 1, 3 * nx / 18
                ix0 =  0 + ix
                ix1 = nx - ix
                iy0 = ny
                iy1 = 1
                call fig2%line(ix0, iy0, ix1, iy1)
                call fig2%line(ix1, iy0, ix0, iy1)
            end do    
            do ix = nx / 4, 6 * nx / 17
                ix0 =  0 + ix
                ix1 = nx - ix
                iy0 = ny
                iy1 = 1
                call fig2%line(ix0, iy0, ix1, iy1) 
                call fig2%line(ix1, iy0, ix0, iy1)
            end do    
            do ix = 7 * nx / 16, nx / 2
                ix0 =  0 + ix
                ix1 = nx - ix
                iy0 = ny
                iy1 = 1
                call fig2%line(ix0, iy0, ix1, iy1) 
                call fig2%line(ix1, iy0, ix0, iy1)
            end do    
            do iy = ny / 7, 5 * ny / 17
                ix0 =  1
                ix1 = nx
                iy0 =  1 + iy
                iy1 = ny - iy
                call fig2%line(ix0, iy0, ix1, iy1) 
                call fig2%line(ix1, iy0, ix0, iy1)
            end do    
            do iy = 8 * ny / 19, ny / 2
                ix0 =  1
                ix1 = nx
                iy0 =  1 + iy
                iy1 = ny - iy
                call fig2%line(ix0, iy0, ix1, iy1) 
                call fig2%line(ix1, iy0, ix0, iy1)
            end do    
            call fig2%pr('/dev/rfcomm1')
        end block
        call sleep(5)
        
        block
            type(bw_t) :: fig3
            integer :: nx = 576, ny = 432
            integer :: ix, iy, ix0, iy0, ix1, iy1
            real :: x, y, pi = 4 * atan(1.0)
            
            call fig3%init(nx, ny)
            call fig3%line( 1,  1, nx,  1) 
            call fig3%line( 1,  2, nx,  2) 
            call fig3%line( 1,  1,  1, ny) 
            call fig3%line( 2,  1,  2, ny) 
            call fig3%line( 1, ny, nx, ny)        
            call fig3%line( 1, ny - 1, nx, ny - 1)        
            call fig3%line(nx,  1, nx, ny)        
            call fig3%line(nx - 1,  1, nx - 1, ny)        
            call fig3%line( 1, ny/2, nx, ny/2)        
            call fig3%line( 1, ny/2 + 1, nx, ny/2 + 1)        
            
            ix0 = 1
            iy0 = int(300 * bessel_j0(0.0))  
            do ix = 1, nx - 1
                x = ix / 20.0
                y = 200 * bessel_j0(x)
                ix1 = ix + 1 
                iy1 = -int(y) + ny / 2
                call fig3%line(ix0, iy0, ix1, iy1)
                call fig3%line(ix0, iy0+1, ix1, iy1+1)
                call fig3%line(ix0, iy0-1, ix1, iy1-1)
                ix0 = ix1
                iy0 = iy1
            end do    

            ix0 = 1
            iy0 = int(300 * cos(-pi/4))  
            do ix = 1, nx - 1
                x = ix / 20.0
                y = 200 * sqrt(2 / (pi *x)) * cos(x - pi/4)
                ix1 = ix + 1 
                iy1 = -int(y) + ny / 2
                call fig3%line(ix0, iy0, ix1, iy1)
                call fig3%line(ix0, iy0+1, ix1, iy1+1)
                call fig3%line(ix0, iy0-1, ix1, iy1-1)
                ix0 = ix1
                iy0 = iy1
            end do    

            call fig3%pr('/dev/rfcomm1')
        end block
        
    end program test
8
2
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
8
2

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?