----      Einfacher Taschenrechner  
--        bei MACOS-Systemen:    import EnableGUI  und den Aufruf aktivieren
--                     und Bibliothek bereitstellen
--       bei nicht MACOS-Systemen      import EnableGUI   und den Aufruf entfernen
--     
--        ist teilweise analog zum monadischen Stream-"Calculator"  



import Char
import Graphics.UI.WX
import EnableGUI -- MAC OS X spezifisch


main :: IO ()
main
  =    enableGUI >> -- MAC OS X spezifisch
       start calculator

calculator :: IO ()
calculator
  = do
       f      <- frame         [text := "WXHaskell-Taschenrechner",  clientSize := sz 800 600]
       status  <- variable [value := startState]
       zahlfeldwert  <-  variable [value := " "]
       zahlfeld <- entry f [text := "                            "]
       but0 <- button f [text := "0",on command := (digitDo  status zahlfeld zahlfeldwert   0 )]
       but1 <- button f [text := "1",on command := digitDo  status zahlfeld zahlfeldwert   1 ]
       but2 <- button f [text := "2",on command := digitDo  status zahlfeld zahlfeldwert    2 ]
       but3 <- button f [text := "3",on command := digitDo  status zahlfeld zahlfeldwert   3 ]
       but4 <- button f [text := "4",on command := digitDo  status zahlfeld zahlfeldwert    4]
       but5 <- button f [text := "5",on command := digitDo  status zahlfeld zahlfeldwert    5 ]
       but6 <- button f [text := "6",on command := digitDo  status zahlfeld zahlfeldwert   6 ]
       but7 <- button f [text := "7",on command := digitDo  status zahlfeld zahlfeldwert    7]
       but8 <- button f [text := "8",on command := digitDo  status zahlfeld zahlfeldwert   8]
       but9 <- button f [text := "9",on command := digitDo  status zahlfeld zahlfeldwert     9 ]
       butk <- button f [text := ".",on command := kommaDo  status zahlfeld zahlfeldwert     ]
       butc <- button f [text := "c", on command := clearDo  status zahlfeld zahlfeldwert     ]
       buteq <- button f [text := "=", on command := totalDo  status zahlfeld zahlfeldwert    ]
       butpm <- button f [text := "+-", on command := operDo  status zahlfeld zahlfeldwert   'n' ]
       butdiv <- button f [text := "/", on command := operDo  status zahlfeld zahlfeldwert     '/' ]
       butmal <- button f [text := "X", on command := operDo  status zahlfeld zahlfeldwert    '*' ]
       butplus <- button f [text := "+", on command := operDo  status zahlfeld zahlfeldwert   '+' ]
       butmin <- button f [text := "-", on command := operDo  status zahlfeld zahlfeldwert   '-' ]
       set f [layout :=  column 10  [floatCenter (widget zahlfeld)
                         ,floatCenter $
                         row 10 [widget butc, widget butpm,widget butdiv, widget butmal]
                         ,floatCenter $
                         row 10 [widget but7, widget but8, widget but9, widget butmin]
                         ,floatCenter $
                         row 10 [widget but4, widget but5, widget but6, widget butplus]
                         ,floatCenter $
                         row 10 [widget but1, widget but2, widget but3, widget buteq]
                         ,floatCenter $
                         row 10 [widget but0  , widget butk]
                         ]]

--  interner Status: ((letzte Aktion, Anzahl Stellen bei Komma), 
--                     gespeicherte Operation, 
--                      aktueller Wert)

statusvalue (_,_,x) = x
statusflag  ((x,_),_,_) = x
startState = ((" ",0),id, 0.0)
 
compOper x
   | x == '+'  = oper (+)
   | x == '-'  = oper (-)
   | x == '*'  = oper (*)
   | x == '/'  = oper (/)
   | x == 'n'  = oper (\x y -> (-x))


digitDo status zahlfeld zahlfeldwert  i  =
             do stwertalt <- varGet status
                varUpdate status (digit i)                           -- neu (update der Variablen direkt)
                wert <- varGet zahlfeldwert                          -- wert berechnen
                varSet zahlfeldwert (if  statusflag stwertalt == "t" then (show (floor i)) else (wert++ (show (floor i))))
                wert' <- varGet zahlfeldwert                         -- wert berechnen
                set zahlfeld   [text := wert' ]


clearDo status zahlfeld zahlfeldwert  =
          do varUpdate status clear
             varSet zahlfeldwert ""
             set zahlfeld  [text := ""]

totalDo status zahlfeld zahlfeldwert   =
          do varUpdate status total
             wert <- varGet status  -- varGet fuer Variablen, wert rausholen
             varSet zahlfeldwert (show (statusvalue wert))
             wert' <- varGet zahlfeldwert
             set zahlfeld [text := wert']

operDo status zahlfeld zahlfeldwert  otext  =
          do
               varUpdate status (compOper otext)
               varUpdate zahlfeldwert (\x -> x ++ [otext])
               wert' <- varGet zahlfeldwert
               set zahlfeld  [text := wert' ]

kommaDo status zahlfeld zahlfeldwert   =
              do
               varUpdate status  komma
               varUpdate zahlfeldwert (\x -> x ++ ['.'])
               wert' <- varGet zahlfeldwert
               set zahlfeld  [text := wert' ]

clear  (str,g, 0.0) =   (("c",0),id, 0.0)
clear  (str,g, z)    =  (("c",0), g, 0.0)

total  (_,g, z) =   (("t",0),id, g z)

digit d  ((str,dignum),g, z) =
         if str == "t" then  (("d",0),g, d)
         else if str == "." then  ((".", dignum+1),g, z  + (0.1^dignum)*d)
         else  (("d",0), g, z*10.0 + d)

komma   ((str,_), g, z) =
          if str == "d" ||   str == "c"  || str == " "  || str == "o"
          then   ((".",1),g, z)
           else  if  str == "t"
               then   ((".",1),g, 0.0)
                else   ((".",30),g, z)

oper o   (_,g, z) =   (("o",0), o (g z), 0.0)