module KeyGfx(keyGfx) where
import Fudgets
import Data.Char(toUpper)

keyGfx :: a -> [Char] -> Drawing lbl Gfx
keyGfx a
gfx [Char]
k = Distance -> [Drawing lbl Gfx] -> Drawing lbl Gfx
forall lbl leaf. Distance -> [Drawing lbl leaf] -> Drawing lbl leaf
hboxD' Distance
12 [a -> Drawing lbl Gfx
forall a lbl. Graphic a => a -> Drawing lbl Gfx
g a
gfx,[Char] -> Drawing lbl Gfx
forall a lbl. Graphic a => a -> Drawing lbl Gfx
keyD ([Char] -> [Char]
keyCap [Char]
k)]
  where
    keyD :: a -> Drawing lbl Gfx
keyD a
c = Spacer -> Drawing lbl Gfx -> Drawing lbl Gfx
forall lbl leaf. Spacer -> Drawing lbl leaf -> Drawing lbl leaf
spacedD (Alignment -> Spacer
hAlignS Alignment
aRight Spacer -> Spacer -> Spacer
`compS` Distance -> Distance -> Spacer
hMarginS Distance
0 Distance
3) (Drawing lbl Gfx -> Drawing lbl Gfx)
-> Drawing lbl Gfx -> Drawing lbl Gfx
forall a b. (a -> b) -> a -> b
$
	     Distance -> [Drawing lbl Gfx] -> Drawing lbl Gfx
forall lbl leaf. Distance -> [Drawing lbl leaf] -> Drawing lbl leaf
hboxD' Distance
0 [Drawing lbl Gfx
forall lbl. Drawing lbl Gfx
diamondD,Spacer -> Drawing lbl Gfx -> Drawing lbl Gfx
forall lbl leaf. Spacer -> Drawing lbl leaf -> Drawing lbl leaf
spacedD Spacer
alignKeysS (Drawing lbl Gfx -> Drawing lbl Gfx)
-> Drawing lbl Gfx -> Drawing lbl Gfx
forall a b. (a -> b) -> a -> b
$ a -> Drawing lbl Gfx
forall a lbl. Graphic a => a -> Drawing lbl Gfx
g a
c]
    diamondD :: Drawing lbl Gfx
diamondD = Spacer -> Drawing lbl Gfx -> Drawing lbl Gfx
forall lbl leaf. Spacer -> Drawing lbl leaf -> Drawing lbl leaf
spacedD Spacer
vCenterS (Drawing lbl Gfx -> Drawing lbl Gfx)
-> Drawing lbl Gfx -> Drawing lbl Gfx
forall a b. (a -> b) -> a -> b
$ FlexibleDrawing -> Drawing lbl Gfx
forall a lbl. Graphic a => a -> Drawing lbl Gfx
g (FlexibleDrawing -> Drawing lbl Gfx)
-> FlexibleDrawing -> Drawing lbl Gfx
forall a b. (a -> b) -> a -> b
$ Size -> Bool -> Bool -> (Rect -> [DrawCommand]) -> FlexibleDrawing
FlexD Size
10 Bool
False Bool
False Rect -> [DrawCommand]
d
    d :: Rect -> [DrawCommand]
d (Rect Size
p (Point Distance
w Distance
h)) = [Shape -> CoordMode -> [Size] -> DrawCommand
FillPolygon Shape
Convex CoordMode
CoordModeOrigin
		      [Size
pSize -> Size -> Size
forall a. Num a => a -> a -> a
+Distance -> Distance -> Size
pP Distance
w2 Distance
0,Size
pSize -> Size -> Size
forall a. Num a => a -> a -> a
+Distance -> Distance -> Size
pP Distance
w Distance
h2,Size
pSize -> Size -> Size
forall a. Num a => a -> a -> a
+Distance -> Distance -> Size
pP Distance
w2 Distance
h,Size
pSize -> Size -> Size
forall a. Num a => a -> a -> a
+Distance -> Distance -> Size
pP Distance
0 Distance
h2]]
      where w2 :: Distance
w2 = Distance
w Distance -> Distance -> Distance
forall a. Integral a => a -> a -> a
`div` Distance
2
	    h2 :: Distance
h2 = Distance
h Distance -> Distance -> Distance
forall a. Integral a => a -> a -> a
`div` Distance
2

alignKeysS :: Spacer
alignKeysS = Size -> Spacer
minSizeS (Distance -> Distance -> Size
pP Distance
12 Distance
10) Spacer -> Spacer -> Spacer
`compS` Spacer
hCenterS
  -- This is a hack to make the keybord shortcuts align nicely in a column.
  -- It assumes that no character is wider than 12 pixels.

--ctrlkey = argFlag "menuctrlkey" False

keyCap :: [Char] -> [Char]
keyCap [Char]
k =
  case [Char]
k of
    [Char
c] -> [Char -> Char
toUpper Char
c]
    [Char]
"period" -> [Char]
"."
    [Char]
"comma" -> [Char]
","
    [Char]
"plus" -> [Char]
"+"
    [Char]
"minus" -> [Char]
"-"
    [Char]
"slash" -> [Char]
"/"
    [Char]
"asterisk" -> [Char]
"*"
    [Char]
"apostrophe" -> [Char]
"'"
    [Char]
"question" -> [Char]
"?"
    [Char]
"less" -> [Char]
"<"
    [Char]
"greater" -> [Char]
">"
    [Char]
_ -> [Char]
k -- ??