12.3 カラートーン

COLOR3 プログラムはトーンプリミティブを用いたカラー塗り分けの例です. 第10.3節のU2D7 プログラムではパターンだけで塗り分けていたのを, ここでは色で塗り分けて見ましょう. DO 20 のループでトーンパターン番号を各レベルに割り当てています. トーン番号が30999から85999までの56色 (濃青から, 緑, 黄, 橙, 赤まで)です. 下3桁を999としてべたぬりを指定しています. コンターは引かずに, トーンバーを右側につけています. ハードフィル(初期値)でぬりつぶしますから, 各ルーチンを呼ぶ順番に気をつける必要があります.

      PROGRAM COLOR3

      PARAMETER ( NX=21, NY=21 )
      PARAMETER ( XMIN=-10, XMAX=10, YMIN=-10, YMAX=10 )
      PARAMETER ( DX1=1, DX2=5, DY1=1, DY2=5 )
      PARAMETER ( KMAX=56, PMIN=0, PMAX=1 )
      REAL P(NX,NY), PI(2,KMAX+1)

      DO 10 J=1,NY
      DO 10 I=1,NX
        X = XMIN + (XMAX-XMIN)*(I-1)/(NX-1)
        Y = YMIN + (YMAX-YMIN)*(J-1)/(NY-1)
        P(I,J) = EXP( -X**2/64 -Y**2/25 )
   10 CONTINUE

      WRITE(*,*) ' WORKSTATION ID (I)  ? ;'
      CALL SGPWSN
      READ (*,*) IWS

      CALL GROPN( IWS )
      CALL GRFRM

      CALL GRSWND( XMIN, XMAX, YMIN, YMAX )
      CALL GRSVPT(  0.2,  0.8,  0.2,  0.8 )
      CALL GRSTRN( 1 )
      CALL GRSTRF

      DP = (PMAX-PMIN)/KMAX
      DO 20 K=1,KMAX
        TLEV1 = (K-1)*DP
        TLEV2 = TLEV1 + DP
        IPAT  = (29+K)*1000 + 999
        CALL UESTLV( TLEV1, TLEV2, IPAT )
   20 CONTINUE

      CALL UETONE( P, NX, NX, NY )
      CALL USDAXS

*-- トーンバー ----
      CALL GRSWND(  0.0, 1.0, PMIN, PMAX )
      CALL GRSVPT( 0.85, 0.9,  0.2,  0.8 )
      CALL GRSTRN( 1 )
      CALL GRSTRF

      DO 30 K=1,KMAX+1
        PI(1,K) = PMIN + (K-1)*DP
        PI(2,K) = PMIN + (K-1)*DP
   30 CONTINUE

      CALL UETONE( PI, 2, 2, KMAX+1 )

      CALL SLPVPR( 3 )
      CALL UZLSET( 'LABELYR', .TRUE. )
      CALL UZFACT( 0.8 )
      CALL UYSFMT( '(F4.1)' )
      CALL UYAXDV( 'R', 0.1, 0.2 )

      CALL GRCLS

      END

PROGRAM COLOR3