module Ted where

import Tcl

-- Ted: a simple text editor demo for TclHaskell
-- Chris Dornan (cdornan@cs.ucc.ie)



data Context = Ctx Window Menu Edit (GUIRef FileEditState)

data FileEditState = FES String Int


ted :: GUI ()
ted =
     do	w <- window []
	fr <- frame w []

 	e  <- edit  w [width  80, 
			   height 30, 
			   wrap NoWrap,
			   setgrid True,
			   font (ted_face 12)]
	vs <- vscroll e []
	hs <- hscroll e []

	rf <- newState (FES "" 12)

	m <- menu w [tearoff False]
	cset w [use_menu m]
	let ctx = Ctx w m e rf

	file_menu ctx
	edit_menu ctx

	packAdd e [inFrame fr,fillXY,expand True,packH]
	packAdd vs [inFrame fr,packH,fillY]
	packAdd fr [packV,fillXY,expand True]
	packAdd hs [packV,fillX]
 	focus e


-------------------------------------------------------------------------------
-- File Menu
-------------------------------------------------------------------------------

file_menu :: Context -> GUI ()
file_menu ctx@(Ctx w mp e rf) =
     do	m <- menu w [tearoff False]
	cascade mp m [wgt_label "File"]
	mbutton m [wgt_label "Clear",      command doClear]
	separator m
	mbutton m [wgt_label "Load...",    command doLoad]
	mbutton m [wgt_label "Save",       command doSave]
	mbutton m [wgt_label "Save As...", command doSaveAs]
	separator m
	mbutton m [wgt_label "Quit", command doQuit]
	change_fn ctx ""
	return ()
      where
	doLoad =
	     do fn <- getOpenFileName
		case fn of
		  Nothing -> return ()
		  Just f  -> do loadEdit e f
			        change_fn ctx f

	doSave =
	     do FES fn _ <- readState rf
		case fn of
		  "" -> doSaveAs
		  _  -> do saveEdit e fn

	doSaveAs =
	     do fn <- getSaveFileName 
		case fn of
		  Nothing -> return ()
		  Just f -> do saveEdit e f
                               change_fn ctx f

	doClear = resetEdit e "" >> change_fn ctx ""

	doQuit = destroy w

change_fn :: Context -> String -> GUI ()
change_fn (Ctx top _ _ rf) fn =
     do title top ttl
	modState rf (\(FES _ sz)->FES fn sz)
      where
	ttl = if null fn then "(no file)" else fn'

	fn' = reverse(takeWhile ('/'/=) (reverse fn))


-------------------------------------------------------------------------------
-- Edit Menu
-------------------------------------------------------------------------------

edit_menu :: Context -> GUI ()
edit_menu (Ctx w mp e _) =
     do m  <- menu w [tearoff False]
	cascade mp m [wgt_label "Edit"]
	fm <- menu w [tearoff False]
	mbutton m [wgt_label "Cut",   command (cutClipboard e)]
	mbutton m [wgt_label "Copy",  command (copyClipboard e)]
	mbutton m [wgt_label "Paste", command (pasteClipboard e)]
	separator m
	cascade m fm [wgt_label "font size"]
	bs <- mapM (sz_rb fm) size_l

	bindXY e "<3>" (\xy -> popup m xy)

        r <- mradio bs
	setRadio r sz0_n
	setSize sz0

	return ()
      where
	sz0    = size_l !! sz0_n
	sz0_n  = 2
	size_l = [8,10,12,18,24]

	sz_rb fm n = mradiobutton fm [wgt_label (show n), 
				      command (setSize n)]

	setSize sz = cset e [font (ted_face sz)]


-------------------------------------------------------------------------------
-- Ted Font
-------------------------------------------------------------------------------


ted_face :: Int -> String
ted_face sz = "*-courier-medium-r-normal--*-" ++ show sz ++ "0-*-*-*-*-*-*"

