module VertScale (vertScale) where

import Tcl

vertScale = 
     do w <- window []
	title w "Vertical Scale Demonstration"
	l   <- label w [font "Helvetica 14", "wraplength" %% "3.5i",
			justify LeftJ, text msg]
	packAdd l [packV,packPadX 20]
	
	f1  <- frame w [borderwidth 10]
	packAdd f1 [packV]

	c   <- canvas w [width 50, borderwidth 0, 
                         height 50, highlightthickness 0]
	p   <- cpoly c polyCoords [fill "green", tags ["poly"]]
        ln  <- cline c lineCoords [fill "black", tags ["line"]]

	vsc <- vscale w [sca_length 284, sca_from 0, 
			 tickinterval 50, sca_to 250] 
	cset vsc [command (setHeight c p ln vsc)]

	packAdd c [packH,inFrame f1,fillY]
	packAdd vsc [packH,packAnchor NE,inFrame f1]
	setScale vsc 75

	return ()
      where
	polyCoords,lineCoords :: [Coord]
	polyCoords = [(0, 0), (1, 1), (2, 2)]
        lineCoords = [(0, 0), (1, 1), (2, 2), (0, 0)]

        msg =  "An arrow and a vertical scale are displayed below."
	    ++ "If you click or drag mouse button 1 in the scale, "
	    ++ "you can change the size of the arrow."
	    

setHeight :: Canvas -> CPoly -> CLine -> Scale -> GUI ()
setHeight c poly line vsc = 
     do height <- getScale vsc
	let h = height + 21
	    y = getY h
        drawArrow c h y
	return ()
     where
	getY h = if ((h - 30) < 21)
		    then 21
		    else (h - 30)

        drawArrow can hgt yvar = 
	     do	setCoords poly [(15,20),(35,20),(35,yvar),(45,yvar),
				(25,hgt),(5,yvar),(15,yvar),(15,20)]
		setCoords line [(15,20),(35,20),(35,yvar),(45,yvar),
			        (25,yvar),(5,yvar),(15,yvar),(15,20)]

		return ()

