--- /dev/null
+implementation module digitdisplay\r
+\r
+import StdArray, StdClass, StdEnum, StdInt, StdList, StdMisc, StdReal, StdString\r
+import StdEnvExt\r
+import StdControl, StdControlAttribute, StdControlReceiver, StdId, StdPicture, StdPSt, StdReceiver\r
+\r
+/* A DigitDisplay displayId format size atts\r
+ is a Controls instance that displays a positive integral number of maximal format digits\r
+ in a given colour. Each digit has a given size.\r
+ The following ControlAttribute-s are inherited:\r
+ ControlPos: the layout position of the digit display control\r
+ ControlTip: the tool tip text that must be displayed\r
+ All other attributes are ignored.\r
+*/\r
+\r
+:: DigitDisplay ls pst\r
+ = DigitDisplay DigitDisplayId DigitFormat DigitSize Colour [ControlAttribute *(ls,pst)]\r
+:: DigitDisplayId\r
+ = { customId :: !Id\r
+ , receiverId :: !R2Id DigitDisplayMsgIn DigitDisplayMsgOut\r
+ }\r
+:: DigitDisplayMsgIn = SetDigitValueIn Int | GetDigitValueIn\r
+:: DigitDisplayMsgOut = SetDigitValueOut | GetDigitValueOut Int\r
+:: DigitFormat\r
+ = IntegerFormat !Int // The number of digits\r
+:: DigitSize // The size of one digit\r
+ :== Size\r
+\r
+openDigitDisplayId :: !*env -> (!DigitDisplayId,!*env) | Ids env\r
+openDigitDisplayId env\r
+ # (id, env) = openId env\r
+ # (r2id,env) = openR2Id env\r
+ = ({customId=id,receiverId=r2id},env)\r
+\r
+:: DigitDisplaySt\r
+ = { value :: !Int // The current value that is displayed\r
+ }\r
+:: DigitShapeTT\r
+ = { horDigitBars:: ![RPoint2] // The positions of the horizontal digitbars\r
+ , verDigitBars:: ![RPoint2] // The positions of the vertical digitbars\r
+ }\r
+:: DigitBarTT\r
+ = { horDigitBar :: !PolygonShapeTT // The horizontal `true type' polygon shape\r
+ , verDigitBar :: !PolygonShapeTT // The vertical `true type' polygon shape\r
+ }\r
+:: RPoint2 = {rx ::!Real,ry ::!Real}\r
+:: RVector2 = {rvx::!Real,rvy::!Real}\r
+:: PolygonShapeTT :== [RVector2]\r
+\r
+\r
+instance Controls DigitDisplay where\r
+ controlToHandles (DigitDisplay {customId,receiverId} digitFormat digitSize colour atts) pst\r
+ = controlToHandles digitdisplay pst\r
+ where\r
+ okDigitFormat = validateDigitFormat digitFormat\r
+ okDigitSize = validateDigitSize digitSize\r
+ nrOfDigits = getNrOfDigits digitFormat\r
+ customControlSize = { okDigitSize & w = okDigitSize.w*nrOfDigits }\r
+ initDisplaySt = { value = 0 }\r
+ digitdisplay = { newLS = initDisplaySt\r
+ , newDef = CustomControl customControlSize (displaylook (format okDigitFormat 0)) \r
+ [ ControlId customId\r
+ , ControlPen [PenBack Black,PenColour colour]\r
+ : flatten [posAtt,tipAtt]\r
+ ]\r
+ :+:\r
+ Receiver2 receiverId receiverfun []\r
+ }\r
+ \r
+ posAtt = case [att \\ att<-atts | isControlPos att] of\r
+ [ ControlPos pos : _] -> [ControlPos pos]\r
+ _ -> []\r
+ tipAtt = case [att \\ att<-atts | isControlTip att] of\r
+ [ ControlTip text : _] -> [ControlTip text]\r
+ _ -> []\r
+ digitbars = { horDigitBar = [ {rvx = dx, rvy = ~dy}\r
+ , {rvx = 1.0-lx,rvy = 0.0}\r
+ , {rvx = dx, rvy = dy}\r
+ , {rvx = ~dx, rvy = dy}\r
+ , {rvx = lx-1.0,rvy = 0.0}\r
+ , {rvx = ~dx, rvy = ~dy}\r
+ ]\r
+ , verDigitBar = [ {rvx = dx, rvy = dy}\r
+ , {rvx = 0.0, rvy = 0.5-ly}\r
+ , {rvx = ~dx, rvy = dy}\r
+ , {rvx = ~dx, rvy = ~dy}\r
+ , {rvx = 0.0, rvy = ly-0.5}\r
+ , {rvx = dx, rvy = ~dy}\r
+ ]\r
+ }\r
+ (hmargin,vmargin) = (0.12,0.12)\r
+ (dx,dy) = (0.06,0.06)\r
+ (lx,ly) = (2.0*(hmargin+dx),vmargin+dy)\r
+ digitshapes :: {!DigitShapeTT}\r
+ digitshapes = {shape0,shape1,shape2,shape3,shape4,shape5,shape6,shape7,shape8,shape9}\r
+ shape0 = { horDigitBars = [a,c], verDigitBars = [a,b,d,e] }\r
+ shape1 = { horDigitBars = [], verDigitBars = [d,e] }\r
+ shape2 = { horDigitBars = [a,b,c], verDigitBars = [b,d] }\r
+ shape3 = { horDigitBars = [a,b,c], verDigitBars = [d,e] }\r
+ shape4 = { horDigitBars = [b], verDigitBars = [a,d,e] }\r
+ shape5 = { horDigitBars = [a,b,c], verDigitBars = [a,e] }\r
+ shape6 = { horDigitBars = [a,b,c], verDigitBars = [a,b,e] }\r
+ shape7 = { horDigitBars = [a], verDigitBars = [d,e] }\r
+ shape8 = { horDigitBars = [a,b,c], verDigitBars = [a,b,d,e] }\r
+ shape9 = { horDigitBars = [a,b,c], verDigitBars = [a,d,e] }\r
+ [a,b,c,d,e:_] = [ {rx=hmargin, ry=vmargin}\r
+ , {rx=hmargin, ry=0.5}\r
+ , {rx=hmargin, ry=1.0-vmargin}\r
+ , {rx=1.0-hmargin,ry=vmargin}\r
+ , {rx=1.0-hmargin,ry=0.5}\r
+ ]\r
+ \r
+ receiverfun :: !DigitDisplayMsgIn !*(DigitDisplaySt,PSt .ps) -> (DigitDisplayMsgOut,(DigitDisplaySt,PSt .ps))\r
+ receiverfun (SetDigitValueIn newValue) (ddst,pst=:{io})\r
+ # ddst = {ddst & value = okValue}\r
+ # io = setControlLook customId True (True,displaylook (format okDigitFormat okValue)) io\r
+ = (SetDigitValueOut,(ddst,{pst & io=io}))\r
+ where\r
+ okValue = validateDigitValue okDigitFormat newValue\r
+ receiverfun GetDigitValueIn (ddst=:{value},pst)\r
+ = (GetDigitValueOut value,(ddst,pst))\r
+ \r
+ displaylook :: ![Digit] !SelectState !UpdateState !*Picture -> *Picture\r
+ displaylook digits _ _ picture\r
+ # picture = unfill {zero & corner2={x=customControlSize.w,y=customControlSize.h}} picture\r
+ # picture = sseq [fillPolygons {x=i*okDigitSize.w,y=0} digitshapes.[digit] \\ digit <- digits & i <- [0..]] picture\r
+ = picture\r
+ where\r
+ fillPolygons base {horDigitBars,verDigitBars} picture\r
+ = sseq\r
+ ( [fillAt (base + scaleRPoint2 okDigitSize posTT) {polygon_shape=map (scaleRVector2 okDigitSize) digitbars.horDigitBar} \\ posTT <- horDigitBars]\r
+ ++\r
+ [fillAt (base + scaleRPoint2 okDigitSize posTT) {polygon_shape=map (scaleRVector2 okDigitSize) digitbars.verDigitBar} \\ posTT <- verDigitBars]\r
+ ) picture\r
+ \r
+ getControlType _ = "DigitDisplay"\r
+\r
+getDigitDisplayValue :: !DigitDisplayId !(PSt .ps) -> (!Int,!PSt .ps)\r
+getDigitDisplayValue {receiverId} pst\r
+ = case syncSend2 receiverId GetDigitValueIn pst of\r
+ ((SendOk,Just (GetDigitValueOut x)),pst) -> (x,pst)\r
+ other -> sendError "getDigitDisplayValue"\r
+\r
+setDigitDisplayValue :: !DigitDisplayId !Int !(PSt .ps) -> PSt .ps\r
+setDigitDisplayValue {receiverId} newValue pst\r
+ = case syncSend2 receiverId (SetDigitValueIn newValue) pst of\r
+ ((SendOk,Just SetDigitValueOut),pst) -> pst\r
+ other -> sendError "setDigitDisplayValue"\r
+\r
+sendError fName\r
+ = abort (fName +++ ": wrong reply from DigitDisplay.\n")\r
+\r
+\r
+// Validate format:\r
+validateDigitFormat :: !DigitFormat -> DigitFormat\r
+validateDigitFormat (IntegerFormat nrDigits)\r
+ = IntegerFormat (setbetween nrDigits 1 maxNrDigits)\r
+where\r
+ maxInt = 0x7FFFFFFF\r
+ maxNrDigits = toInt (log10 (toReal maxInt))-1\r
+\r
+\r
+// getNrOfDigits returns the number of digits to display:\r
+getNrOfDigits :: !DigitFormat -> Int\r
+getNrOfDigits (IntegerFormat nrDigits) = nrDigits\r
+\r
+// Validate digit size:\r
+validateDigitSize :: !DigitSize -> Size\r
+validateDigitSize {w,h}\r
+ = {w=max 1 w,h=max 1 h}\r
+\r
+// Validate value according to valid format:\r
+validateDigitValue :: !DigitFormat !Int -> Int\r
+validateDigitValue (IntegerFormat nrDigits) x\r
+ = setbetween x 0 (10^nrDigits-1)\r
+\r
+// Format integer values:\r
+:: Digit :== Int // A digit is an int in [0..9]\r
+\r
+class format a :: !DigitFormat !a -> [Digit]\r
+\r
+instance format Int where\r
+ format (IntegerFormat nrDigits) x\r
+ = getdigits nrDigits (abs x) []\r
+ where\r
+ getdigits :: !Int !Int ![Digit] -> [Digit]\r
+ getdigits 0 _ digits\r
+ = digits\r
+ getdigits n x digits\r
+ = getdigits (n-1) (x / 10) [x rem 10 : digits]\r
+\r
+digitsToString :: ![Digit] -> String\r
+digitsToString digits\r
+ = {toChar (toInt '0'+d) \\ d<-digits}\r
+\r
+\r
+instance toString DigitFormat where\r
+ toString (IntegerFormat nrDigits) = "(IntegerFormat " <+++ nrDigits <+++")"\r
+\r
+\r
+scaleRVector2 :: !Size !RVector2 -> Vector2\r
+scaleRVector2 {w,h} {rvx,rvy} = {vx=toInt ((toReal w)*rvx), vy=toInt ((toReal h)*rvy)}\r
+\r
+scaleRPoint2 :: !Size !RPoint2 -> Point2\r
+scaleRPoint2 {w,h} {rx,ry} = {x=toInt ((toReal w)*rx), y=toInt ((toReal h)*ry)}\r
repositories / fp1415-soccerfun.git / blobdiff