第７章　コントロール処理

7.1　標準コントロール
7.2　コントロールの糊
7.3　コントロールレイアウト
7.4　コントロールのリサイズ
7.5　例

7.1　標準コントール

:: ControlWidth
 = PixelWidth   Int
 | TextWidth    String
 | ContentWidth String

PixelWidth代替部は、ピクセル数を単位とした幅を定義する。
TextWidth代替部は、コントロールが、ダイアログフォントで描かれる場合に
引数文字列の幅と全く同一の幅を持たなければならないということを指定する。
関連するコントロールがテキスト指向である場合、代替部ContentWidthは、
コントロールが、引数文字列を持っている場合のように幅を持たなければならない
ということを指定する。

7.1.1　ButtonControl

:: ButtonControl ls pst
 = ButtonControl String [ControlAttribute *(ls,pst)]

buttoncontrol
  = ButtonControl "A &Button && its text" []

7.1.2　CheckControl

::  CheckControl ls pst
 =  CheckControl [CheckControlItem *(ls,pst)] RowsOrColumns
                 [ControlAttribute *(ls,pst)]
::  RowsOrColumns
 =  Rows    Int
 |  Columns Int
::  CheckControlItem st
:== (String,Maybe ControlWidth,MarkState,IdFun st)

checkcontrol
  = CheckControl
  [  ("Check item &"+++toString i
     ,Nothing
     ,if (isOdd i) Mark NoMark
     ,id
     )
  \\ i<-[1..5]
  ]  (Columns 2) []

7.1.3　CustomButtonControl

:: CustomButtonControl ls pst
 = CustomButtonControl Size Look [ControlAttribute *(ls,pst)]
:: Size        = {w::!Int,h::!Int}
:: SelectState = Able | Unable
:: UpdateState = { oldFrame :: !ViewFrame
                 , newFrame :: !ViewFrame
                 , updArea  :: !UpdateArea
                 }
:: ViewFrame  :== Rectangle
:: UpdateArea :== [ViewFrame]
:: Look       :== SelectState -> UpdateState -> *Picture -> *Picture

custombuttoncontrol
  = CustomButtonControl {w=50,h=50} look []
where
  look Able {newFrame} picture
    # picture = setPenColour DarkGrey picture
    # picture = fill         newFrame picture
    # picture = setPenColour Black    picture
    # picture = draw         newFrame picture
    = picture
  look Unable {newFrame} picture
    # picture = setPenColour LightGrey picture
    # picture = fill newFrame picture
    = picture

7.1.4　CustomControl

:: CustomControl ls pst
 = CustomControl Size Look [ControlAttribute *(ls,pst)]
:: Size        = {w::!Int,h::!Int}
:: SelectState = Able | Unable
:: UpdateState = { oldFrame :: !ViewFrame
                 , newFrame :: !ViewFrame
                 , updArea  :: !UpdateArea
                 }
:: ViewFreme  :== Rectangle
:: UpdateArea :== [ViewFrame]
:: Look       :== SelectState -> UpdateState -> *Picture -> *Picture

custombuttoncontrol
  = CustomControl {w=50,h=50} look []
where
  look Able {newFrame} picture
    # picture = setPenColour DarkGrey picture
    # picture = fill         newFrame picture
    # picture = setPenColour Black    picture
    # picture = draw         newFrame picture
    = picture
  look Unable {newFrame} picture
    # picture = setPenColour LightGrey picture
    # picture = fill newFrame picture
    = picture

7.1.5　EditControl

:: EditControl ls pst
 = EditControl String ControlWidth NrLines
               [ControlAttribute *(ls,pst)]
:: NrLines  :== Int

editcontrol
  = EditControl "This is an EditControl"
                (PixelWidth 80) 3 []

7.1.6　PopUpControl

:: PopUpControl ls pst
 = PopUpControl [PopUpControlItem *(ls,pst)] Index
                [ControlAttribute *(ls,pst)]
:: PopUpControlItem st :== (String,IdFun st)
:: IdFun            st :== st -> st

popupcontrol
  = PopUpControl
     [  ("PopUpItem "+++toString i,id)
     \\ i<-[1..5]
     ]  1 []

7.1.7　RadioControl

::  RadioControl ls pst
 =  RadioControl [RadioControlItem *(ls,pst)] RowsOrColumns Index
                 [ControlAttribute *(ls,pst)]
::  RowsOrColumns
 =  Rows    Int
 |  Columns Int
RadioControlItem st
:== (String,Maybe ControlWidth,IdFun st)
::  IdFun st :== st -> st
::  Index    :== Int

radiocontrol
 = RadioControl
   [  ("RadioItem &"+++toString i
      ,Nothing
      ,id
      )
   \\ i<-[1..5]
   ] (Rows 2) 1 []

7.1.8　SliderControl

:: SliderControl ls pst
 = SliderControl Direction ControlWidth SliderState
                 (SliderAction     *(ls,pst))
                 [ControlAttribute *(ls,pst)]
:: Direction       = Horizontal | Vertical
:: SliderState     = { sliderMin   :: !Int
                     , sliderMax   :: !Int
                     , sliderThumb :: !Int
                     }
:: SliderAction st :== SliderMove -> st -> st
:: SliderMove      =   SliderIncSmall | SliderDecSmall
                   |   SliderIncLarge | SliderDecLarge
                   |   SliderThumb Int

図7.1:　SliderControlの領域

SliderDecSmall        decrement arrow
SliderIncSmall        increment arrow
SliderDecLarge        page down region
SliderIncLarge        page up region
SliderThumb           thumb move

slidercontrol
  = SliderControl Horizontal 200
              {sliderMin=(-100),sliderMax=100,sliderThumb=0}
              (\_ st->st) []

7.1.9　TextControl

:: TextControl ls pst
 = TextControl String [ControlAttribute *(ls,pst)]

textcontrol
  = TextControl "This is a TextControl" []

7.1.10　LayoutControl

:: LayoutControl  c ls pst
 = LayoutControl (c ls pst) [ControlAttribute *(ls,pst)]

instance Controls (LayoutControl c) | Controls c

7.1.11　CompoundControl

:: CompoundControl  c ls pst
 = CompoundControl (c ls pst) [ControlAttribute *(ls,pst)]

instance Controls (CompoundControl c) | Controls c

7.2　コントロールの糊

7.2.1　:+:

::  :+:  t1 t2 ls cs
 = (:+:) infixr 9 (t1 ls cs) (t2 ls cs)

instance Controls ((:+:) c1 c2) | Controls c1 & Controls c2

buttoncontrol
  = ButtonControl "A &Button && its text" []
editcontrol
  = EditControl "This is an EditControl" (PixelWidth 80) 3 []

7.2.2　ListLSとNilLS

:: ListLS t ls cs = ListLS [t ls cs]
:: NilLS    ls cs = NilLS

instance Controls (ListLS c) | Controls c
instance Controls NilLS

maxlength = maxList (map size labels)

maxlabel = hd (filter (\l -> size l==maxlength) labels)

ListLS
[  TextControl label [ControlWidth (ContentWidth maxlabel)
                     ,ControlPos   (Left,zero)
                     ]
   :+:
   EditControl "" (PixelWidth 100) 1 []
\\ label<-labels
]

labels = [ "A short label"
         , "A fairly long and verbose label"
         , "Another lengthy label"
         ]

図7.2:　リストの内包表記による糊付け

7.2.3　AddLSとNewLS

:: AddLS t ls cs = E. .new: { addLS :: new, addDef :: t *(new,ls) cs }

instance Controls (AddLS c) | Controls c

:: NewLS t ls cs = E. .new: { newLs :: new, newDef :: t new cs }

instance Controls (NewLS c) | Controls c

counter displayid
  = {newLS  = count0
    ,newDef = LayoutControl
              (   EditControl (toString count0) (ContentWidth "000") 1
                                    [ControlSelectState Unable
                                    ,ControlPos         (Left,zero)
                                    ,ControlId          displayid
                                    ]
              :+: ButtonControl "-" [ControlFunction (count (-1))]
              :+: ButtonControl "+" [ControlFunction (count 1)]
              )   [ControlHMargin   0 0
                  ,ControlVMargin   0 0
                  ,ControlItemSpace 0 0
                  ]
    }
where
  count0 = 0

  count :: Int (Int,PSt .l) -> (Int,PSt .l)
  count dx (count,pst=:{io})
    = ( count+dx
      , appPIO (setControlText displayid (toString (count+dx))) pst
      )

図7.3:　カウンタコントロール

7.3　コントロールレイアウト

::  ControlAttribute st
 =  ... | ControlPos ItemPos | ...
::  ItemPos
:== (ItemLoc,ItemOffset)
::  ItemLoc
 =  Fix
 |  LeftTop    | RightTop    | LeftBottom | RightBottom
 |  Left       | Center      | Right
 |  LeftOf Id  | RightTo Id  | Above Id   | Below Id
 |  LeftOfPrev | RightToPrev | AbovePrev  | BelowPrev
::  ItemOffset
 =  NoOffset
 |  OffsetVector Vector2
 |  OffsetFun    ParentIndex OffsetFun
::  ParentIndex
:== Int
::  OffsetFun
:== (ViewDomain,Point2) -> Vector2

instance zero ItemOffset

固定位置

　これは、ItemLocのFix代替部に過ぎない。Fixは、親オブジェクトのビュー領域の左上端値に、関連するコントロールの左上端を配置する。ItemOffsetは、ビュー領域内の実際の位置を決め、親オブジェクトのビュー領域の座標システム上に与えられる。コントロール層よりもむしろ、親オブジェクトの文書層にコントロールを'留めて'おきたい場合、このレイアウト属性を使用できる（セクション6.1.1参照）。ダイアログとレイアウトコントロールについては、文書層を持たないので、このレイアウト属性は、境界揃え属性LeftTopと同一である。ウィンドウ又は合成コントロールでは、ビューフレームをスクロールすると、固定位置を持つ全てのコントロールもスクロールすることになる。

境界揃え

　これらは、代替部LeftTop、RightTop、LeftBottomとRightBottomである。これらの属性は、親オブジェクトの現在のビューフレームの左上、右上、左下と右下の各々に、関連するコントロールを配置する。

行揃え

　これらは、代替部Left、CenterとRightである。これらの属性は、垂直位置にある以前に行揃えされた全てのコントロールの下及び、水平方向の親オブジェクトの現在のビューフレームに関して、左揃え、中揃え又は右揃えで、関連するコントロールを配置する。

関連位置

　これらは、代替部LeftOf、RightTo、Above、BelowとLeftOfPrev、RightToPrev、AbovePrevとBelowPrevである。最初の4つの代替部は、同一親オブジェクトの要素であるコントロールのIdを引数に持たなければならない。そうでなければ、実行時エラーが発生するだろう。後者の4つの代替部は、最初の4つによって定義できるが、あるコントロールを他のコントロールに関連して配置したいだけである場合には、そのコントロール用にId値を生成する必要がないという利点がある。あるコントロールを他のコントロールと関連して配置すれば、関連コントロールの木を構築しなければならない。つまり、循環参照は認められず、それは実行時エラーももたらすということである。

図7.4:　ビュー領域とビューフレーム


図7.5:　5つのコントロールのレイアウト木

7.3.1　固定位置でのレイアウト

図7.6:　(Fix,zero)でのレイアウト木

7.3.2　ビューフレーム境界でのレイアウト

図7.7:　LeftTop、RightTop、LeftBottomとRightBottomでのレイアウト木

7.3.3　行内のレイアウト

図7.8:　Left、CenterとRightでのレイアウト木

7.3.4　レイアウトオフセット

図7.9:　オフセットベクタを使用してコントロールをレイアウトする

7.3.5　前コントロールに関連するレイアウト

図7.10:　(a:+:b:+:c)の番号付けされたグラフ

7.4　コントロールのリサイズ

::  ControlAttribute st
 =  ... | ControlResize ControlResizeFunction | ...
::  ControlResizeFunction
:== Size -> Size -> Size -> Size

compound = CompoundControl
             (ListLS [custom,custom,custom]
             [ControlResize     compoundresize
             ,ControlViewSize   compoundsize
             ,ControlLook       True (\_ {newFrame}->draw newFrame)
             ,CompoundHMargin   0 0
             ,CompoundVMargin   0 0
             ,CompoundItemSpace 0 0
             ]
compoundsize = {w=60,h=75}
compoundresize _ _ newparentsize=:{w}
             = {newparentsize & w=w/3*3}

custom
 = CustomControl {w=compoundsize.w/3,h=6} crossbox
                 [ControlResize customresize]
customresize customsize _ {w}
 = {customsize & w=w/3}

図7.11:　3つのCustomControlsを持つCompoundControlのリサイズ

7.5　例

7.5.1　キースポッティング再訪

図7.12:　動作中のキースポッティングプログラム

spotting cid who x pst
    = appPIO (setControlLook cid True (True,look text)) pst
where
    text = who+++":"+++toString x

look text _ {newFrame} picture
    # picture        = unfill newFrame picture
    # picture        = draw   newFrame picture
    # (width,picture)= getPenFontStringWidth text picture
    = drawAt {x=(w-width)/2,y=h/2} text picture
where
    {w,h}            = rectangleSize newFrame

custom = CustomControl customsize (look "")
          [ ControlKeyboard (const True) Able
                            (noLS1 (spotting cid "Control"))
          , ControlId       cid
          , ControlResize   resize
          ]
resize oldCSize oldParentSize newParentSize
       = { w = oldCSize.w+newParentSize.w-oldParentSize.w
         , h = oldCSize.h+newParentSize.h-oldParentSize.h
         }

compound = CompoundControl custom
            [ ControlKeyboard (const True) Able
                              (noLS1 (spotting cid "Compound"))
            , ControlViewSize {w=customsize.w+2*margin
                              ,h=customsize.h+2*margin
                              }
            , ControlResize   resize
            , ControlLook     True (look "")
            ]

window = Window "keyspotting" compound
          [ WindowKeyboard (const True) Able
                           (noLS1 (spotting cid "Window"))
          , WindowViewSize {w=customsize.w+4*margin
                           ,h=customsize.h+4*margin
                           }
          , WindowHMargin  margin margin
          , WindowVMargin  margin margin
          , WindowClose    (noLS closeProcess)
          ]

module keyspotting

//  ********************************************************************************
//  Clean チュートリアル例示プログラム
//
//  このプログラムは、１つのCustomControlからなる１つのCompoundControl
//  からなる１つのウィンドウに送られるキーボード入力を監視する。
//  ********************************************************************************

import StdEnv,StdIO

Start :: *World -> *World
Start world
    # (cid,world)   = openId world
    # custom        = CustomControl customsize (look "")
                        [   ControlKeyboard (const True) Able
                                            (noLS1 (spotting cid "Control"))
                        ,   ControlId       cid
                        ,   ControlResize   resize
                        ]
    # compound      = CompoundControl custom
                        [   ControlKeyboard (const True) Able
                                            (noLS1 (spotting cid "Compound"))
                        ,   ControlViewSize {w=customsize.w+2*margin
                                            ,h=customsize.h+2*margin
                                            }
                        ,   ControlResize   resize
                        ,   ControlLook     True (look "")
                        ]
    # window        = Window "keyspotting" compound
                        [   WindowKeyboard  (const True) Able
                                            (noLS1 (spotting cid "Window"))
                        ,   WindowViewSize  {w=customsize.w+4*margin
                                            ,h=customsize.h+4*margin
                                            }
                        ,   WindowHMargin   margin margin
                        ,   WindowVMargin   margin margin
                        ,   WindowClose     (noLS closeProcess)
                        ]
    = startIO SDI Void (snd o openWindow Void window)
                        [ProcessClose closeProcess] world
where
    customsize  = {w=550,h=100}
    margin      = 10
    resize oldCSize oldParentSize newParentSize
         = { w = oldCSize.w+newParentSize.w-oldParentSize.w
           , h = oldCSize.h+newParentSize.h-oldParentSize.h
           }
    spotting cid who x pst
         = appPIO (setControlLook cid True (True,look text)) pst
    where
         text = who+++":"+++toString x
    look text _ {newFrame} picture
        # picture           = unfill newFrame picture
        # picture           = draw   newFrame picture
        # (width,picture)   = getPenFontStringWidth text picture
        = drawAt {x=(w-width)/2,y=h/2} text picture
    where
        {w,h}               = rectangleSize newFrame

7.5.2　マウススポッティング再訪

図7.13:　動作中のマウススポッティングプログラム

module mousespotting

//  ********************************************************************************
//  Clean チュートリアル例示プログラム
//
//  このプログラムは、CustomControlからなる１つのCompoundControlからなる
//　１つのウィンドウに送られるマウス入力を監視する。
//  ********************************************************************************

import StdEnv,StdIO

Start :: *World -> *World
Start world
    # (cid,world)   = openId world
    # custom        = CustomControl customsize (look "")
                        [   ControlMouse    (const True) Able
                                            (noLS1 (spotting cid "Control"))
                        ,   ControlId       cid
                        ,   ControlResize   resize
                        ]
    # compound      = CompoundControl custom
                        [   ControlMouse    (const True) Able
                                            (noLS1 (spotting cid "Compound"))
                        ,   ControlViewSize {w=customsize.w+2*margin
                                            ,h=customsize.h+2*margin
                                            }
                        ,   ControlResize   resize
                        ,   ControlLook     True (look "")
                        ]
    # window        = Window "mousespotting" compound
                        [   WindowMouse     (const True) Able
                                            (noLS1 (spotting cid "Window"))
                        ,   WindowViewSize  {w=customsize.w+4*margin
                                            ,h=customsize.h+4*margin
                                            }
                        ,   WindowHMargin   margin margin
                        ,   WindowVMargin   margin margin
                        ,   WindowClose     (noLS closeProcess)
                        ]
    = startIO SDI Void (snd o openWindow Void window)
                        [ProcessClose closeProcess] world
where
    customsize  = {w=550,h=100}
    margin      = 10
    resize oldCSize oldParentSize newParentSize
    = { w = oldCSize.w+newParentSize.w-oldParentSize.w
      , h = oldCSize.h+newParentSize.h-oldParentSize.h
      }
    spotting cid who x pst
        = appPIO (setControlLook cid True (True,look text)) pst
    where
        text    = who+++":"+++toString x
    look text _ {newFrame} picture
        # picture           = unfill newFrame picture
        # picture           = draw   newFrame picture
        # (width,picture)   = getPenFontStringWidth text picture
        = drawAt {x=(w-width)/2,y=h/2} text picture
    where
        {w,h}               = rectangleSize newFrame