src/Gui/digitdisplay.icl

   1 implementation module digitdisplay
   2
   3 import StdArray, StdClass, StdEnum, StdInt, StdList, StdMisc, StdReal, StdString
   4 import StdEnvExt
   5 import StdControl, StdControlAttribute, StdControlReceiver, StdId, StdPicture, StdPSt, StdReceiver
   6
   7 /*      A DigitDisplay displayId format size atts
   8                 is a Controls instance that displays a positive integral number of maximal format digits
   9                 in a given colour. Each digit has a given size.
  10         The following ControlAttribute-s are inherited:
  11                 ControlPos:     the layout position of the digit display control
  12                 ControlTip:     the tool tip text that must be displayed
  13         All other attributes are ignored.
  14 */
  15
  16 ::      DigitDisplay ls pst
  17  =      DigitDisplay DigitDisplayId DigitFormat DigitSize Colour [ControlAttribute *(ls,pst)]
  18 ::      DigitDisplayId
  19  =      {       customId        :: !Id
  20         ,       receiverId      :: !R2Id DigitDisplayMsgIn DigitDisplayMsgOut
  21         }
  22 ::      DigitDisplayMsgIn  = SetDigitValueIn Int | GetDigitValueIn
  23 ::      DigitDisplayMsgOut = SetDigitValueOut    | GetDigitValueOut Int
  24 ::      DigitFormat
  25  =      IntegerFormat !Int              // The number of digits
  26 ::      DigitSize                               // The size of one digit
  27  :== Size
  28
  29 openDigitDisplayId :: !*env -> (!DigitDisplayId,!*env) | Ids env
  30 openDigitDisplayId env
  31         # (id,  env) = openId env
  32         # (r2id,env) = openR2Id env
  33         = ({customId=id,receiverId=r2id},env)
  34
  35 ::      DigitDisplaySt
  36  =      {       value           :: !Int                         // The current value that is displayed
  37         }
  38 ::      DigitShapeTT
  39  =      {       horDigitBars:: ![RPoint2]               // The positions of the horizontal digitbars
  40         ,       verDigitBars:: ![RPoint2]               // The positions of the vertical   digitbars
  41         }
  42 ::      DigitBarTT
  43  =      {       horDigitBar     :: !PolygonShapeTT      // The horizontal `true type' polygon shape
  44         ,       verDigitBar     :: !PolygonShapeTT      // The vertical   `true type' polygon shape
  45         }
  46 ::      RPoint2                 =       {rx ::!Real,ry ::!Real}
  47 ::      RVector2                =       {rvx::!Real,rvy::!Real}
  48 ::      PolygonShapeTT  :== [RVector2]
  49
  50
  51 instance Controls DigitDisplay where
  52         controlToHandles (DigitDisplay {customId,receiverId} digitFormat digitSize colour atts) pst
  53                 = controlToHandles digitdisplay pst
  54         where
  55                 okDigitFormat           = validateDigitFormat digitFormat
  56                 okDigitSize                     = validateDigitSize digitSize
  57                 nrOfDigits                      = getNrOfDigits digitFormat
  58                 customControlSize       = { okDigitSize & w = okDigitSize.w*nrOfDigits }
  59                 initDisplaySt           = { value       = 0 }
  60                 digitdisplay            = { newLS       = initDisplaySt
  61                                                           , newDef      = CustomControl customControlSize (displaylook (format okDigitFormat 0))
  62                                                                                                         [ ControlId customId
  63                                                                                                         , ControlPen [PenBack Black,PenColour colour]
  64                                                                                                         : flatten [posAtt,tipAtt]
  65                                                                                                         ]
  66                                                                                         :+:
  67                                                                                   Receiver2 receiverId receiverfun []
  68                                                           }
  69
  70                 posAtt                          = case [att \\ att<-atts | isControlPos att] of
  71                                                                 [ ControlPos pos : _]   -> [ControlPos pos]
  72                                                                 _                                               -> []
  73                 tipAtt                          = case [att \\ att<-atts | isControlTip att] of
  74                                                                 [ ControlTip text : _]  -> [ControlTip text]
  75                                                                 _                                               -> []
  76                 digitbars                       = { horDigitBar = [ {rvx = dx,    rvy = ~dy}
  77                                                                                           , {rvx = 1.0-lx,rvy = 0.0}
  78                                                                                           , {rvx = dx,    rvy = dy}
  79                                                                                           , {rvx = ~dx,   rvy = dy}
  80                                                                                           , {rvx = lx-1.0,rvy = 0.0}
  81                                                                                           , {rvx = ~dx,   rvy = ~dy}
  82                                                                                           ]
  83                                                           , verDigitBar = [ {rvx = dx,    rvy = dy}
  84                                                                                           , {rvx = 0.0,   rvy = 0.5-ly}
  85                                                                                           , {rvx = ~dx,   rvy = dy}
  86                                                                                           , {rvx = ~dx,   rvy = ~dy}
  87                                                                                           , {rvx = 0.0,   rvy = ly-0.5}
  88                                                                                           , {rvx = dx,    rvy = ~dy}
  89                                                                                           ]
  90                                                           }
  91                 (hmargin,vmargin)       = (0.12,0.12)
  92                 (dx,dy)                         = (0.06,0.06)
  93                 (lx,ly)                         = (2.0*(hmargin+dx),vmargin+dy)
  94                 digitshapes         :: {!DigitShapeTT}
  95                 digitshapes                     = {shape0,shape1,shape2,shape3,shape4,shape5,shape6,shape7,shape8,shape9}
  96                 shape0                          = { horDigitBars = [a,c],   verDigitBars = [a,b,d,e] }
  97                 shape1                          = { horDigitBars = [],      verDigitBars = [d,e]     }
  98                 shape2                          = { horDigitBars = [a,b,c], verDigitBars = [b,d]     }
  99                 shape3                          = { horDigitBars = [a,b,c], verDigitBars = [d,e]     }
 100                 shape4                          = { horDigitBars = [b],     verDigitBars = [a,d,e]   }
 101                 shape5                          = { horDigitBars = [a,b,c], verDigitBars = [a,e]     }
 102                 shape6                          = { horDigitBars = [a,b,c], verDigitBars = [a,b,e]   }
 103                 shape7                          = { horDigitBars = [a],     verDigitBars = [d,e]     }
 104                 shape8                          = { horDigitBars = [a,b,c], verDigitBars = [a,b,d,e] }
 105                 shape9                          = { horDigitBars = [a,b,c], verDigitBars = [a,d,e]   }
 106                 [a,b,c,d,e:_]           = [ {rx=hmargin,    ry=vmargin}
 107                                                           , {rx=hmargin,    ry=0.5}
 108                                                           , {rx=hmargin,    ry=1.0-vmargin}
 109                                                           , {rx=1.0-hmargin,ry=vmargin}
 110                                                           , {rx=1.0-hmargin,ry=0.5}
 111                                                           ]
 112
 113                 receiverfun :: !DigitDisplayMsgIn !*(DigitDisplaySt,PSt .ps) -> (DigitDisplayMsgOut,(DigitDisplaySt,PSt .ps))
 114                 receiverfun (SetDigitValueIn newValue) (ddst,pst=:{io})
 115                         # ddst  = {ddst & value = okValue}
 116                         # io    = setControlLook customId True (True,displaylook (format okDigitFormat okValue)) io
 117                         = (SetDigitValueOut,(ddst,{pst & io=io}))
 118                 where
 119                         okValue = validateDigitValue okDigitFormat newValue
 120                 receiverfun GetDigitValueIn (ddst=:{value},pst)
 121                         = (GetDigitValueOut value,(ddst,pst))
 122
 123                 displaylook :: ![Digit] !SelectState !UpdateState !*Picture -> *Picture
 124                 displaylook digits _ _ picture
 125                         # picture       = unfill {zero & corner2={x=customControlSize.w,y=customControlSize.h}} picture
 126                         # picture       = sseq [fillPolygons {x=i*okDigitSize.w,y=0} digitshapes.[digit] \\ digit <- digits & i <- [0..]] picture
 127                         = picture
 128                 where
 129                         fillPolygons base {horDigitBars,verDigitBars} picture
 130                                 = sseq
 131                                         ( [fillAt (base + scaleRPoint2 okDigitSize posTT) {polygon_shape=map (scaleRVector2 okDigitSize) digitbars.horDigitBar} \\ posTT <- horDigitBars]
 132                                                 ++
 133                                           [fillAt (base + scaleRPoint2 okDigitSize posTT) {polygon_shape=map (scaleRVector2 okDigitSize) digitbars.verDigitBar} \\ posTT <- verDigitBars]
 134                                         ) picture
 135
 136         getControlType _ = "DigitDisplay"
 137
 138 getDigitDisplayValue :: !DigitDisplayId !(PSt .ps) -> (!Int,!PSt .ps)
 139 getDigitDisplayValue {receiverId} pst
 140         = case syncSend2 receiverId GetDigitValueIn pst of
 141                 ((SendOk,Just (GetDigitValueOut x)),pst) -> (x,pst)
 142                 other                                    -> sendError "getDigitDisplayValue"
 143
 144 setDigitDisplayValue :: !DigitDisplayId !Int !(PSt .ps) -> PSt .ps
 145 setDigitDisplayValue {receiverId} newValue pst
 146         = case syncSend2 receiverId (SetDigitValueIn newValue) pst of
 147                 ((SendOk,Just SetDigitValueOut),pst) -> pst
 148                 other                                -> sendError "setDigitDisplayValue"
 149
 150 sendError fName
 151         = abort (fName +++ ": wrong reply from DigitDisplay.\n")
 152
 153
 154 //      Validate format:
 155 validateDigitFormat :: !DigitFormat -> DigitFormat
 156 validateDigitFormat (IntegerFormat nrDigits)
 157         = IntegerFormat (setbetween nrDigits 1 maxNrDigits)
 158 where
 159         maxInt          = 0x7FFFFFFF
 160         maxNrDigits     = toInt (log10 (toReal maxInt))-1
 161
 162
 163 //      getNrOfDigits returns the number of digits to display:
 164 getNrOfDigits :: !DigitFormat -> Int
 165 getNrOfDigits (IntegerFormat nrDigits) = nrDigits
 166
 167 //      Validate digit size:
 168 validateDigitSize :: !DigitSize -> Size
 169 validateDigitSize {w,h}
 170         = {w=max 1 w,h=max 1 h}
 171
 172 //      Validate value according to valid format:
 173 validateDigitValue :: !DigitFormat !Int -> Int
 174 validateDigitValue (IntegerFormat nrDigits) x
 175         = setbetween x 0 (10^nrDigits-1)
 176
 177 //      Format integer values:
 178 ::      Digit   :== Int         // A digit is an int in [0..9]
 179
 180 class format a :: !DigitFormat !a -> [Digit]
 181
 182 instance format Int where
 183         format (IntegerFormat nrDigits) x
 184                 = getdigits nrDigits (abs x) []
 185         where
 186                 getdigits :: !Int !Int ![Digit] -> [Digit]
 187                 getdigits 0 _ digits
 188                         = digits
 189                 getdigits n x digits
 190                         = getdigits (n-1) (x / 10) [x rem 10 : digits]
 191
 192 digitsToString :: ![Digit] -> String
 193 digitsToString digits
 194         = {toChar (toInt '0'+d) \\ d<-digits}
 195
 196
 197 instance toString DigitFormat where
 198         toString (IntegerFormat nrDigits) = "(IntegerFormat " <+++ nrDigits <+++")"
 199
 200
 201 scaleRVector2 :: !Size !RVector2 -> Vector2
 202 scaleRVector2 {w,h} {rvx,rvy} = {vx=toInt ((toReal w)*rvx), vy=toInt ((toReal h)*rvy)}
 203
 204 scaleRPoint2 :: !Size !RPoint2 -> Point2
 205 scaleRPoint2 {w,h} {rx,ry} = {x=toInt ((toReal w)*rx), y=toInt ((toReal h)*ry)}