PiSTARTERのペンタブのテスト

ペンタブのテストしてみました～ヾ(*´∀｀*)ﾉ

筆圧もとれてたのし～(≧∇≦)b

ソースはこちら：

'
' ペンタブレットテスト by みなつ
'                    2018年10月15日
'
option strict
acls
'var SW=640,SH=360
var SW=1280,SH=720
xscreen SW,SH

var TABW=31497,TABH=19686 'ペンタブの最大座標(PTH-450 Intuos5)
var xRatio=SW/TABW,yRatio=SH/TABH

var brushSize,brushMag=4,col=#white 'ブラシサイズと色

?"Z:ブラシ縮小 X:ブラシ拡大 D:消去"

loop
end

'ブラシのサイズを表すスプライトをセット
'-------------------------------------------------------
def setBrush
 gpage 0,3
 gcls
 brushSize=floor(pow(2,brushMag)*10)/10
 var s=brushSize/2
 gcircle s+1,s+1,s
 gpset s+1,s+1
 spset 0,0,0,s*2+2,s*2+2,#SPSHOW:sphome 0,s+1,s+1
 gpage 0,0
 locate 0,1:?format$("ブラシサイズ=%5.1f",brushSize)
end
 
'メインループ
'-------------------------------------------------------
def loop
 setBrush

 var x,y,pressure,side,dist,btn
 var tx,ty,tp'現在のペンの位置と筆圧
 var lx,ly,lp'一つ前のペンの位置と筆圧
 
 while 1
  tabletstat out x,y,pressure,side,dist,btn
  'locate 0,0:?format$("(%5d,%5d) pressure=%5d dist=%2d",x,y,pressure,dist)
  if dist==0 && pressure==0 then continue 'ペンがホバー距離より離れている

  'ペンが認識されているので、位置と筆圧を更新
  lx=tx:ly=ty:lp=tp
  tx=x*xRatio:ty=y*yRatio:tp=pressure

  spofs 0,tx,ty
  if dist<=17 && pressure>0 then
   drawLine lx,ly,lp,tx,ty,tp
  endif
  
  var k$=inkey$()
  if k$=="z" && brushMag>0.1 then dec brushMag,1/4:setBrush
  if k$=="x" then inc brushMag,1/4::setBrush
  if k$=="d" then gcls
 wend
end


'筆圧を補間して線を引く
'-------------------------------------------------------
def drawLine lx,ly,lp,tx,ty,tp
 var minPresure=300 'この筆圧以下は１ドットにする
 var dx=tx-lx,dy=ty-ly
 var i,l

 '初期筆圧
 var size0=brushSize*(lp-minPresure)/(2048-minPresure)
 var bsize0=max(0,min(brushSize/2,size0/2))

 '最終筆圧
 var size1=brushSize*(tp-minPresure)/(2048-minPresure)
 var bsize1=max(0,min(brushSize/2,size1/2))

 var dsize=bsize1-bsize0

 if abs(dx)>abs(dy) then
  l=abs(dx) '横長
 else
  l=abs(dy) '縦長
 endif

 if l==0 then return '前回のペン位置から動いていない

 for i=0 to l
  var t=i/l
  var x=lx+t*dx
  var y=ly+t*dy
  var s=bsize0+t*dsize

  if s<0.1 then
  elseif s<0.5 then
   gpset x,y
  elseif s<1 then
   gfill x-0.5,y-0/5,x+0.5,y+0.5
  else
   gcircle x,y,s,1
   gpaint  x,y,col,1
   gcircle x,y,s,col
  endif
 next
end