Mousewheel Graph Window Zoom

#pragma rtGlobals=3
#pragma version=1.30
#pragma ModuleName=ScrollToZoom

#define global

// key codes
// 2: shift; 4: option/alt; 8: command/ctrl
// On Windows, alt key is reserved for graph drag.
static constant kZoomKey=8
static constant kFasterKey=2
static constant kZoomSpeed=70
static constant kReverse=0 // reverse the direction of expansion

#ifdef global

static function AfterWindowCreatedHook(string win, variable type)
    if (type == 1)
        SetWindow $win hook(hScrollToZoom)=ScrollToZoom#hookScrollToZoom
    endif
    return 0   
end

#else

menu "Graph", dynamic
    ScrollToZoom#zoomMenu(), /Q, ScrollToZoom#toggleZoom()
end

static function /S zoomMenu()
    GetWindow kwTopWin hook(hScrollToZoom)
    return SelectString(strlen(s_value)>0, "", "!" + num2char(18)) + "Scroll-Zoom"
end

static function toggleZoom()
    GetWindow kwTopWin hook(hScrollToZoom)
    SetWindow kwTopWin hook(hScrollToZoom) = $SelectString(strlen(s_value)>0, "ScrollToZoom#hookScrollToZoom", "")
end

#endif

static function hookScrollToZoom(STRUCT WMWinHookStruct &s)
    if (s.eventCode == 22 && s.eventMod&kZoomKey) // mousewheel/touchpad + zoom key
        // figure out first horizontal and first vertical axes
        string strAxes = AxisList(s.WinName), axis = "", type = "", hAx = "", vAx = ""
        int fail = 2, i = 0
        int logH, logV
        make /D/free/N=3 wH, wV // free waves to hold axis minimum, maximum, axis value for mouse location, reverse axis flag
        do
            axis = StringFromList(i, strAxes)
            type = StringByKey("AXTYPE", AxisInfo(s.WinName, axis))
            if (strlen(hAx)==0 && (cmpstr(type, "bottom")==0 || cmpstr(type,"top")==0 || cmpstr(type[0,2],"/B=")==0 || cmpstr(type[0,2],"/T=")==0) )
                hAx = axis
                logH = NumberByKey("log(x)", AxisInfo(s.WinName, axis),"=")
                fail--
            elseif (strlen(vAx)==0 && (cmpstr(type, "left")==0 || cmpstr(type,"right")==0 || cmpstr(type[0,2],"/L=")==0 || cmpstr(type[0,2],"/R=")==0) )
                vAx = axis
                logV = NumberByKey("log(x)", AxisInfo(s.WinName, axis),"=")
                fail--
            endif
            i++
        while ( strlen(type) && (strlen(hAx)==0 || strlen(vAx)==0) )
        if (fail)
            return 0
        endif
        // It would be nice if GetAxis and SetAxis could accept a shorthand for
        // first horizontal or first vertical axis.
        // AxisValFromPixel is more flexible.
        GetAxis /W=$s.WinName/Q $hAx
        wH = {v_min, v_max, AxisValFromPixel(s.WinName, hAx, s.mouseLoc.h), v_min>v_max}
        GetAxis /W=$s.WinName/Q $vAx
        wV = {v_min, v_max, AxisValFromPixel(s.WinName, vAx, s.mouseLoc.v), v_min>v_max}
        wH = logH ? log(wH) : wH
        wV = logV ? log(wV) : wV   
        int rev=1-2*kReverse
        variable expansion = 1 - rev*s.wheelDy * kZoomSpeed/5000
        if (s.eventMod&kFasterKey)
            if (kFasterKey==2 && s.wheelDy==0)
                // this works when shift key also transforms wheel.dY to wheel.dX
                s.wheelDy = s.wheelDx
            endif
            expansion = 1 - rev*s.wheelDy * kZoomSpeed/500
        endif
        wH[0,1] = wH[2] - (wH[2] - wH[p]) * expansion
        wV[0,1] = wV[2] - (wV[2] - wV[p]) * expansion    
        wH = logH ? alog(wH) : WH
        wV = logV ? alog(wV) : wV
       
        // what can go wrong here?
        wavestats /Q/M=1 wH
        fail += V_numNaNs + V_numInfs
        wavestats /Q/M=1 wV
        if (fail + V_numNaNs + V_numInfs)
            return 0
        endif      
        if(wH[1]==wH[0] || wV[1] == wV[0])
            return 0
        endif
       
        // here we include a check that the axis direction does not become
        // reversed owing to some glitch in the calculation at extreme zoom
        // levels
        if (wH[1] > wH[0] && !wH[3])
            SetAxis /W=$s.WinName $hAx, wH[0], wH[1]
        elseif (wH[3])
            SetAxis /R/W=$s.WinName $hAx, wH[0], wH[1]
        endif
        if (wV[1] > wV[0] && !wV[3])
            SetAxis /W=$s.WinName $vAx, wV[0], wV[1]
        elseif (wV[3])
            SetAxis /R/W=$s.WinName $vAx, wV[0], wV[1]
        endif  
        return 0
    endif
end