Skip to content

Commit

Permalink
New top-level "View > Snap" menu with hotkey support
Browse files Browse the repository at this point in the history
Relates to #498

The `View` menu now provides a top-level `Snap` setting that lets the user toggle snapping completely on or completely off (without losing individual snap-to settings).

This matches Photoshop's behavior and is mapped to the same hotkey, `Ctrl+Shift+;`.
  • Loading branch information
tannerhelland committed Apr 11, 2024
1 parent 7190cbe commit 6ea4170
Show file tree
Hide file tree
Showing 10 changed files with 98 additions and 42 deletions.
23 changes: 20 additions & 3 deletions Forms/MainWindow.frm
Original file line number Diff line number Diff line change
Expand Up @@ -1734,9 +1734,17 @@ Begin VB.Form FormMain
Index = 8
End
Begin VB.Menu MnuView
Caption = "Snap to canvas edges"
Caption = "Snap"
Index = 9
End
Begin VB.Menu MnuView
Caption = "Snap to"
Index = 10
Begin VB.Menu MnuSnap
Caption = "Canvas edges"
Index = 0
End
End
End
Begin VB.Menu MnuWindowTop
Caption = "Window"
Expand Down Expand Up @@ -3741,6 +3749,13 @@ Private Sub MnuSharpen_Click(Index As Integer)
End Select
End Sub

Private Sub MnuSnap_Click(Index As Integer)
Select Case Index
Case 0
Actions.LaunchAction_ByName "snap_canvasedge"
End Select
End Sub

Private Sub MnuSpecificZoom_Click(Index As Integer)
Select Case Index
Case 0
Expand Down Expand Up @@ -3829,7 +3844,7 @@ Private Sub MnuView_Click(Index As Integer)
Case 3
Actions.LaunchAction_ByName "view_zoomout"
Case 4
'zoom-to-value top-level menu
'zoom-to-value top-level
Case 5
'(separator)
Case 6
Expand All @@ -3839,7 +3854,9 @@ Private Sub MnuView_Click(Index As Integer)
Case 8
'(separator)
Case 9
Actions.LaunchAction_ByName "snap_canvasedge"
Actions.LaunchAction_ByName "snap_global"
Case 10
'snap-to top-level
End Select
End Sub

Expand Down
2 changes: 1 addition & 1 deletion Forms/Tools_Options.frm
Original file line number Diff line number Diff line change
Expand Up @@ -1206,7 +1206,7 @@ Private Sub cmdBarMini_OKClick()
End If

UserPrefs.SetPref_Long "Interface", "snap-distance", spnSnapDistance.Value
Tools_Move.SetSnapDistance spnSnapDistance.Value
Tools_Move.SetSnap_Distance spnSnapDistance.Value

UserPrefs.SetPref_Long "Transparency", "Alpha Check Mode", CLng(cboAlphaCheck.ListIndex)
UserPrefs.SetPref_Long "Transparency", "Alpha Check One", CLng(csAlphaOne.Color)
Expand Down
4 changes: 4 additions & 0 deletions Modules/Actions.bas
Original file line number Diff line number Diff line change
Expand Up @@ -1353,6 +1353,9 @@ Private Function Launch_ByName_MenuView(ByRef srcMenuName As String, Optional By
newState = Not FormMain.MainCanvas(0).GetStatusBarVisibility()
FormMain.MnuView(7).Checked = newState
FormMain.MainCanvas(0).SetStatusBarVisibility newState

Case "snap_global"
Interface.ToggleSnapOptions pdst_Global

Case "snap_canvasedge"
Interface.ToggleSnapOptions pdst_CanvasEdge
Expand Down Expand Up @@ -2002,6 +2005,7 @@ Public Sub BuildActionDatabase()
AddAction "zoom_1_16", vbNullString
AddAction "view_rulers", vbNullString
AddAction "view_statusbar", vbNullString
AddAction "snap_global", vbNullString
AddAction "snap_canvasedge", vbNullString
'AddAction "window_toolbox"
AddAction "window_displaytoolbox", vbNullString
Expand Down
1 change: 1 addition & 0 deletions Modules/Hotkeys.bas
Original file line number Diff line number Diff line change
Expand Up @@ -310,6 +310,7 @@ Public Sub InitializeDefaultHotkeys()
Hotkeys.AddHotkey vbKey3, vbShiftMask, "zoom_1_4"
Hotkeys.AddHotkey vbKey4, vbShiftMask, "zoom_1_8"
Hotkeys.AddHotkey vbKey5, vbShiftMask, "zoom_1_16"
Hotkeys.AddHotkey VK_OEM_1, vbCtrlMask Or vbShiftMask, "snap_global"

'Window menu
Hotkeys.AddHotkey vbKeyPageDown, , "window_next"
Expand Down
30 changes: 16 additions & 14 deletions Modules/Interface.bas
Original file line number Diff line number Diff line change
Expand Up @@ -391,18 +391,18 @@ Public Sub SyncUI_CurrentLayerSettings()
nonDestructiveResizeActive = (PDImages.GetActiveImage.GetActiveLayer.GetLayerCanvasXModifier <> 1#) Or (PDImages.GetActiveImage.GetActiveLayer.GetLayerCanvasYModifier <> 1#)

'If non-destructive resizing is active, the "reset layer size" menu (and corresponding Move Tool button) must be enabled.
Menus.SetMenuEnabled "layer_resetsize", nonDestructiveResizeActive
If (Menus.IsMenuEnabled("layer_resetsize") <> nonDestructiveResizeActive) Then Menus.SetMenuEnabled "layer_resetsize", nonDestructiveResizeActive

If (g_CurrentTool = NAV_MOVE) Then
toolpanel_MoveSize.cmdLayerAffinePermanent.Enabled = PDImages.GetActiveImage.GetActiveLayer.AffineTransformsActive(True)
End If

'Layer visibility
Menus.SetMenuChecked "layer_show", PDImages.GetActiveImage.GetActiveLayer.GetLayerVisibility()
If (Menus.IsMenuChecked("layer_show") <> PDImages.GetActiveImage.GetActiveLayer.GetLayerVisibility()) Then Menus.SetMenuChecked "layer_show", PDImages.GetActiveImage.GetActiveLayer.GetLayerVisibility()

'Layer rasterization depends on the current layer type
Menus.SetMenuEnabled "layer_rasterizecurrent", PDImages.GetActiveImage.GetActiveLayer.IsLayerVector
Menus.SetMenuEnabled "layer_rasterizeall", (PDImages.GetActiveImage.GetNumOfVectorLayers > 0)
If (Menus.IsMenuEnabled("layer_rasterizecurrent") <> PDImages.GetActiveImage.GetActiveLayer.IsLayerVector) Then Menus.SetMenuEnabled "layer_rasterizecurrent", PDImages.GetActiveImage.GetActiveLayer.IsLayerVector
If (Menus.IsMenuEnabled("layer_rasterizeall") <> (PDImages.GetActiveImage.GetNumOfVectorLayers > 0)) Then Menus.SetMenuEnabled "layer_rasterizeall", (PDImages.GetActiveImage.GetNumOfVectorLayers > 0)

End Sub

Expand Down Expand Up @@ -732,6 +732,8 @@ Public Sub SetUIGroupState(ByVal metaItem As PD_UI_Group, ByVal newState As Bool
'View (top-menu level)
Case PDUI_View
Menus.SetMenuEnabled "view_top", newState
Menus.SetMenuChecked "snap_global", Tools_Move.GetSnap_Global()
Menus.SetMenuChecked "snap_canvasedge", Tools_Move.GetSnap_CanvasEdge()

'ImageOps is all Image-related menu items; it enables/disables the Image, Layer, Select, Color, and Print menus.
' (This flag is very useful for items that require at least one open image to operate.)
Expand Down Expand Up @@ -1214,24 +1216,24 @@ End Sub
' To forcibly set to a specific state (instead of toggling), set the forceInsteadOfToggle param to TRUE.
Public Sub ToggleSnapOptions(ByVal snapTarget As PD_SnapTargets, Optional ByVal forceInsteadOfToggle As Boolean = False, Optional ByVal newState As Boolean = True)

'Convert the snap target into a menu index
Const IDX_BASE As Long = 9
Dim idxTarget As Long

'While calculating which on-screen menu to update, we also need to relay changes to two places:
' 1) the tools_move module (which handles actual snap calculations)
' 2) the user preferences file (to ensure everything is synchronized between sessions)
Select Case snapTarget
Case pdst_Global
If (Not forceInsteadOfToggle) Then newState = Not Tools_Move.GetSnap_Global()
Tools_Move.SetSnap_Global newState
UserPrefs.SetPref_Boolean "Interface", "snap-global", newState
Menus.SetMenuChecked "snap_global", newState

Case pdst_CanvasEdge
idxTarget = IDX_BASE + 0
If (Not forceInsteadOfToggle) Then newState = Not Tools_Move.GetSnapCanvasEdge()
Tools_Move.SetSnapCanvasEdge newState
If (Not forceInsteadOfToggle) Then newState = Not Tools_Move.GetSnap_CanvasEdge()
Tools_Move.SetSnap_CanvasEdge newState
UserPrefs.SetPref_Boolean "Interface", "snap-canvas-edge", newState
Menus.SetMenuChecked "snap_canvasedge", newState

End Select

'Update the target menu state
FormMain.MnuView(idxTarget).Checked = newState

End Sub

Public Function FixDPI(ByVal pxMeasurement As Long) As Long
Expand Down
18 changes: 13 additions & 5 deletions Modules/Menus.bas
Original file line number Diff line number Diff line change
Expand Up @@ -591,7 +591,9 @@ Public Sub InitializeMenus()
AddMenuItem "Show rulers", "view_rulers", 8, 6
AddMenuItem "Show status bar", "view_statusbar", 8, 7
AddMenuItem "-", "-", 8, 8
AddMenuItem "Snap to canvas edge", "snap_canvasedge", 8, 9
AddMenuItem "Snap", "snap_global", 8, 9
AddMenuItem "Snap to", "snap_top", 8, 10, allowInSearches:=False
AddMenuItem "Canvas edge", "snap_canvasedge", 8, 10, 0

'Window Menu
AddMenuItem "Window", "window_top", 9
Expand Down Expand Up @@ -1657,8 +1659,11 @@ End Function
'Helper check for resolving menu enablement by menu name. Note that PD *does not* enforce unique menu names; in fact, they are
' specifically allowed by design. As such, this function only returns the *first* matching entry, with the assumption that
' same-named menus are enabled and disabled as a group.
Public Function SetMenuChecked(ByRef mnuName As String, Optional ByVal isChecked As Boolean = True) As Boolean

Public Sub SetMenuChecked(ByRef mnuName As String, Optional ByVal isChecked As Boolean = True)

'Avoid redundant calls
If (Menus.IsMenuChecked(mnuName) = isChecked) Then Exit Sub

'Resolve the menu name into an index into our menu collection
Dim mnuIndex As Long
If GetIndexFromName(mnuName, mnuIndex) Then
Expand Down Expand Up @@ -1691,10 +1696,13 @@ Public Function SetMenuChecked(ByRef mnuName As String, Optional ByVal isChecked

End If

End Function
End Sub

Public Sub SetMenuEnabled(ByRef mnuName As String, Optional ByVal isEnabled As Boolean = True)


'Avoid redundant calls
If (Menus.IsMenuEnabled(mnuName) = isEnabled) Then Exit Sub

'Resolve the menu name into an index into our menu collection
Dim mnuIndex As Long
If GetIndexFromName(mnuName, mnuIndex) Then
Expand Down
43 changes: 33 additions & 10 deletions Modules/MoveTool.bas
Original file line number Diff line number Diff line change
Expand Up @@ -19,18 +19,19 @@ Attribute VB_Name = "Tools_Move"
Option Explicit

Public Enum PD_SnapTargets
pdst_CanvasEdge
pdst_Global = 0
pdst_CanvasEdge = 1
End Enum

#If False Then
Private Const pdst_CanvasEdge = 0
Private Const pdst_Global = 0, pdst_CanvasEdge = 1
#End If

'The move/size tool exposes a number of UI-only options (like drawing borders around active layers).
' To improve viewport performance, we cache those settings locally, and the viewport queries us instead
' of directly querying the associated UI elements.
Private m_DrawLayerBorders As Boolean, m_DrawCornerNodes As Boolean, m_DrawRotateNodes As Boolean
Private m_SnapToCanvasEdge As Boolean, m_SnapDistance As Long
Private m_SnapGlobal As Boolean, m_SnapToCanvasEdge As Boolean, m_SnapDistance As Long

'Same goes for various selection-related move settings (for moving selected pixels). These are simple
' flags whose value is relayed from the Move/Size options panel.
Expand Down Expand Up @@ -325,19 +326,37 @@ Public Function GetDrawLayerRotateNodes() As Boolean
GetDrawLayerRotateNodes = m_DrawRotateNodes
End Function

Public Function GetSnapCanvasEdge() As Boolean
GetSnapCanvasEdge = m_SnapToCanvasEdge
'Returns TRUE if *any* snap-to-edge behaviors are enabled. Useful for skipping all snap checks.
Public Function GetSnap_Any() As Boolean
GetSnap_Any = m_SnapGlobal
If m_SnapGlobal Then
GetSnap_Any = m_SnapToCanvasEdge
'TODO: OR against other snap options when added
End If
End Function

Public Function GetSnap_CanvasEdge() As Boolean
GetSnap_CanvasEdge = m_SnapToCanvasEdge
End Function

Public Function GetSnapDistance() As Long
Public Function GetSnap_Distance() As Long

GetSnapDistance = m_SnapDistance
GetSnap_Distance = m_SnapDistance

'Failsafe only; should never trigger
If (GetSnapDistance < 1) Then GetSnapDistance = 8
If (GetSnap_Distance < 1) Then GetSnap_Distance = 8

End Function

'Returns TRUE if the top-level "View > Snap" menu is checked. Note that the user can enable/disable
' individual snap targets regardless of this setting, but if this setting is FALSE, we must ignore all
' other snap options. (This is how Photoshop behaves; the top-level Snap setting is mapped to a
' keyboard accelerator so the user can quickly enable/disable snap behavior without losing current
' per-target snap settings.)
Public Function GetSnap_Global() As Boolean
GetSnap_Global = m_SnapGlobal
End Function

Public Sub SetDrawLayerBorders(ByVal newState As Boolean)
m_DrawLayerBorders = newState
End Sub
Expand All @@ -350,16 +369,20 @@ Public Sub SetDrawLayerRotateNodes(ByVal newState As Boolean)
m_DrawRotateNodes = newState
End Sub

Public Sub SetSnapCanvasEdge(ByVal newState As Boolean)
Public Sub SetSnap_CanvasEdge(ByVal newState As Boolean)
m_SnapToCanvasEdge = newState
End Sub

Public Sub SetSnapDistance(ByVal newDistance As Long)
Public Sub SetSnap_Distance(ByVal newDistance As Long)
m_SnapDistance = newDistance
If (m_SnapDistance < 1) Then m_SnapDistance = 1
If (m_SnapDistance > 255) Then m_SnapDistance = 255 'GIMP uses a 255 max value; that seems reasonable
End Sub

Public Sub SetSnap_Global(ByVal newState As Boolean)
m_SnapGlobal = newState
End Sub

'Relay functions for move selected pixels behavior
Public Function GetMoveSelectedPixels_DefaultCut() As Boolean
GetMoveSelectedPixels_DefaultCut = m_SelectionDefaultCut
Expand Down
14 changes: 7 additions & 7 deletions Modules/Tools.bas
Original file line number Diff line number Diff line change
Expand Up @@ -257,7 +257,7 @@ Private Sub SnapPointByMoving(ByRef srcPointF As PointFloat, ByRef dstPointF As
dstPointF = srcPointF

'Skip any further processing if the user hasn't enabled snapping
If (Not Tools_Move.GetSnapCanvasEdge()) Then Exit Sub
If (Not Tools_Move.GetSnap_Any()) Then Exit Sub

'Start by constructing a list of potential snap targets, based on current user settings.
Dim xSnaps() As SnapComparison, ySnaps() As SnapComparison, numXSnaps As Long, numYSnaps As Long
Expand Down Expand Up @@ -299,7 +299,7 @@ Private Sub SnapPointByMoving(ByRef srcPointF As PointFloat, ByRef dstPointF As

'Determine the minimum snap distance required for this zoom value.
Dim snapThreshold As Double
snapThreshold = Tools_Move.GetSnapDistance() * (1# / Zoom.GetZoomRatioFromIndex(PDImages.GetActiveImage.ImgViewport.GetZoomIndex))
snapThreshold = Tools_Move.GetSnap_Distance() * (1# / Zoom.GetZoomRatioFromIndex(PDImages.GetActiveImage.ImgViewport.GetZoomIndex))

'If the minimum value falls beneath the minimum snap distance, snap away!
If (minDistX < snapThreshold) Then dstPointF.x = xSnaps(idxSmallestX).cValue
Expand All @@ -316,7 +316,7 @@ Private Sub SnapRectByMoving(ByRef srcRectF As RectF, ByRef dstRectF As RectF)
dstRectF = srcRectF

'Skip any further processing if the user hasn't enabled snapping
If (Not Tools_Move.GetSnapCanvasEdge()) Then Exit Sub
If (Not Tools_Move.GetSnap_Any()) Then Exit Sub

'Start by constructing a list of potential snap targets, based on current user settings.
Dim xSnaps() As SnapComparison, ySnaps() As SnapComparison, numXSnaps As Long, numYSnaps As Long
Expand Down Expand Up @@ -376,7 +376,7 @@ Private Sub SnapRectByMoving(ByRef srcRectF As RectF, ByRef dstRectF As RectF)

'Determine the minimum snap distance required for this zoom value.
Dim snapThreshold As Double
snapThreshold = Tools_Move.GetSnapDistance() * (1# / Zoom.GetZoomRatioFromIndex(PDImages.GetActiveImage.ImgViewport.GetZoomIndex))
snapThreshold = Tools_Move.GetSnap_Distance() * (1# / Zoom.GetZoomRatioFromIndex(PDImages.GetActiveImage.ImgViewport.GetZoomIndex))

'If the minimum value falls beneath the minimum snap distance, snap away!
If (minDistX < snapThreshold) Then
Expand Down Expand Up @@ -406,7 +406,7 @@ Private Function GetSnapTargets_X(ByRef dstSnaps() As SnapComparison) As Long
GetSnapTargets_X = 0

'Canvas edges first
If Tools_Move.GetSnapCanvasEdge() Then
If Tools_Move.GetSnap_CanvasEdge() Then

'Ensure at space is available in the target array
If (UBound(dstSnaps) < GetSnapTargets_X + 1) Then ReDim Preserve dstSnaps(0 To GetSnapTargets_X * 2 - 1) As SnapComparison
Expand All @@ -429,7 +429,7 @@ Private Function GetSnapTargets_Y(ByRef dstSnaps() As SnapComparison) As Long
GetSnapTargets_Y = 0

'Canvas edges first
If Tools_Move.GetSnapCanvasEdge() Then
If Tools_Move.GetSnap_CanvasEdge() Then

'Ensure at space is available in the target array
If (UBound(dstSnaps) < GetSnapTargets_Y + 1) Then ReDim Preserve dstSnaps(0 To GetSnapTargets_Y * 2 - 1) As SnapComparison
Expand Down Expand Up @@ -463,7 +463,7 @@ Public Sub TransformCurrentLayer(ByVal curImageX As Double, ByVal curImageY As D
' the mouse pointer (e.g. the layer edges, which are not located at the mouse position), so we'll need to wait
' to snap until the transform has been applied to the underlying layer.
Dim srcPtF As PointFloat, snappedPtF As PointFloat
If Tools_Move.GetSnapCanvasEdge() Then
If Tools_Move.GetSnap_Any() Then

Select Case m_CurPOI
Case poi_CornerNW, poi_CornerNE, poi_CornerSW, poi_CornerSE
Expand Down
3 changes: 2 additions & 1 deletion Modules/UserPrefs.bas
Original file line number Diff line number Diff line change
Expand Up @@ -609,8 +609,9 @@ Public Sub LoadUserSettings()
Tools.SetToolSetting_HighResMouse UserPrefs.GetPref_Boolean("Tools", "HighResMouseInput", True)
m_CanvasColor = Colors.GetRGBLongFromHex(UserPrefs.GetPref_String("Interface", "CanvasColor", "#a0a0a0"))

Interface.ToggleSnapOptions pdst_Global, True, UserPrefs.GetPref_Boolean("Interface", "snap-global", True)
Interface.ToggleSnapOptions pdst_CanvasEdge, True, UserPrefs.GetPref_Boolean("Interface", "snap-canvas-edge", True)
Tools_Move.SetSnapDistance UserPrefs.GetPref_Long("Interface", "snap-distance", 8&)
Tools_Move.SetSnap_Distance UserPrefs.GetPref_Long("Interface", "snap-distance", 8&)

'Users can supply a (secret!) "UIFont" setting in the "Interface" segment if they
' want to override PD's default font object.
Expand Down
2 changes: 1 addition & 1 deletion PhotoDemon.vbp
Original file line number Diff line number Diff line change
Expand Up @@ -526,7 +526,7 @@ Description="PhotoDemon Photo Editor"
CompatibleMode="0"
MajorVer=9
MinorVer=1
RevisionVer=350
RevisionVer=352
AutoIncrementVer=1
ServerSupportFiles=0
VersionComments="Copyright 2000-2024 Tanner Helland - photodemon.org"
Expand Down

0 comments on commit 6ea4170

Please sign in to comment.