Petitverse

'無いと始まらないけど、実装が面倒でなかなか実装できないサブルーチン置き場
VAR CINDEX=0
VAR STINDEX=1
VAR ENDINDEX=2
VAR INCINDEX=3
VAR MAXINDEX=4
VAR FLGINDEX=5

DEF MSB(N)
　IF 0==N THEN RETURN -1
　VAR OK=0,NG=32
　WHILE NG-OK>1
　　VAR MID=OK+NG>>1
　　IF N>>MID THEN
　　　OK=MID
　　ELSE
　　　NG=MID
　　ENDIF
　WEND
　RETURN OK
END

'棒グラフの描画
'RANGE[SINDEX]<=FUNC#(x)<RANGE[EINDEX]の範囲を描画
'RANGE[FLGINDEX] [0] 目盛描画の有無 [4:1] 描画色(数色から選択)
DEF PUTBARDB RANGE[],FUNC$,X,Y,W,H,DIVW,RNGH,UNI
　VAR I=RANGE[CNTINDEX]
　VAR S=RANGE[STINDEX],E=RANGE[ENDINDEX]
　VAR INC%=RANGE[INCINDEX]
　VAR FLG%=RANGE[FLGINDEX]
　VAR J
　IF 0==I THEN '初期化,枠目盛り描画
　　RANGE[INCINDEX]=1<<MSB(W-24)+1
　　RANGE[CNTINDEX]=RANGE[INCINDEX]>>1
　　IF 0==(FLG% AND 1) THEN
　　　FOR J=1 TO RNGH DIV 3-1
　　　　GPUTCHR X/8,(J*H/RNGH*3)+CEIL(Y/8)-4,FORMAT$("-%d",J*3),1,1
　　　NEXT J
　　　LOCATE CEIL(X/8),CEIL(Y/8)
　　　PRINT "dB"
　　　FOR J=1 TO (E-S)/DIVW
　　　　GPUTCHR J*DIVW*W/(E-S)-S-4,Y+H-7,FORMAT$("%d",(S+DIVW*J) DIV DIVW),1,1
　　　NEXT J
　　　GFILL (X+W)-LEN(UNI)*8,Y+H-8,X+W,Y+H,0
　　　GPUTCHR (X+W)-LEN(UNI)*8,Y+H-7,UNI,1,1
　　　GLINE X+25,Y+7,X+25,Y+H-9
　　　GLINE X+25,Y+H-9,X+W-1,Y+H-9
　　ENDIF
　ELSEIF INC% THEN
　　'描画
　　VAR COLOR
　　IF 0==FLG%>>1 THEN COLOR=#BLUE ELSEIF 1==FLG%>>1 THEN COLOR=#LIME ELSEIF 2==FLG%>>1 THEN COLOR=#YELLOW ELSEIF 3==FLG%>>1 THEN COLOR=MAGENTA ELSEIF 4==FLG%>>1 THEN COLOR=#CYAN ELSEIF 5==FLG%>>1 THEN COLOR=#RED

　　'CALLは遅いので、出来れば展開して直で書きたい
　　VAR LINE#=CALL(FUNC$,(E-S)*(I-1)/(W-24)+S)/RANGE[MAXINDEX]
　　GLINE I+23+X,Y+H-8,I+23+X,MIN(Y-LOG(LINE#,10)*10*(H-16)/RNGH,H+Y-8),COLOR