Ich konnte das im Kern erfolgreich nach PureBasic übersetzen.
Falls noch jemand Diagonalen für Mausgesten benötigen sollte:
Code: Alles auswählen
;{ Disclaimer
; this code is the translation of the main-parts of the original python-code
; to PureBasic by schic
; the original is:
; "MooseGesture 0.1" a mouse gestures recognition library.
; Al Sweigart al@coffeeghost.net
; http://coffeeghost.net/2011/05/09/moosegesture-python-mouse-gestures-module
; Where "PointsList" is a List of x, y coordinate tuples, e.g. [(100, 200), (1234, 5678), ...]
; getGesture returns a List of integers For the recognized mouse gesture. the integers
; correspond To the 8 cardinal And diagonal directions:
;
; up-left up up-right
; 7 8 9
;
; left 4 6 right
;
; 1 2 3
; down-left down down-right
; Copyright (c) 2011, Al Sweigart
; All rights reserved.
;
; BSD-style license:
;
; Redistribution and use in source and binary forms, with or without
; modification, are permitted provided that the following conditions are met:
; * Redistributions of source code must retain the above copyright
; notice, this list of conditions and the following disclaimer.
; * Redistributions in binary form must reproduce the above copyright
; notice, this list of conditions and the following disclaimer in the
; documentation and/or other materials provided with the distribution.
; * Neither the name of the MooseGesture nor the
; names of its contributors may be used to endorse or promote products
; derived from this software without specific prior written permission.
;
; THIS SOFTWARE IS PROVIDED BY Al Sweigart "AS IS" AND ANY
; EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
; DISCLAIMED. IN NO EVENT SHALL Al Sweigart BE LIABLE FOR ANY
; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
; (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
; ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;}
Structure twoInt
int0.i
int1.i
EndStructure
; the integers-to-directions mapping matches the keypad:
; 7 8 9
; 4 6
; 1 2 3
#DOWNLEFT = 1
#DOWN = 2
#DOWNRIGHT = 3
#LEFT = 4
#RIGHT = 6
#UPLEFT = 7
#UP = 8
#UPRIGHT = 9
#NONE = 0
; This is the minimum distance the mouse must travel (in pixels) before a
; segment will be considered for stroke interpretation.
Global _MIN_SEG_LEN = 150;60
Global Dim _strokesStrings.s(9)
_strokesStrings(1)="DownLeft":_strokesStrings(2)="Down":_strokesStrings(3)="DownRight":_strokesStrings(4)="Left"
_strokesStrings(6)="Right":_strokesStrings(7)="UpLeft":_strokesStrings(8)="Up":_strokesStrings(9)="UpRight"
Procedure getDirection(*coord1.point, *coord2.point)
; Return the integer of one of the 8 directions this line is going in.
; coord1 And coord2 are (x, y) integers coordinates.
x1 = *coord1\x
y1 = *coord1\y
x2 = *coord2\x
y2 = *coord2\y
If x1 = x2 And y1 = y2
ProcedureReturn #NONE ; two coordinates are the same.
ElseIf x1 = x2 And y1 > y2
ProcedureReturn #UP
ElseIf x1 = x2 And y1 < y2
ProcedureReturn #DOWN
ElseIf x1 > x2 And y1 = y2
ProcedureReturn #LEFT
ElseIf x1 < x2 And y1 = y2
ProcedureReturn #RIGHT
EndIf
slope.f = (y2 - y1) / (x2 - x1)
; Figure out which quadrant the line is going in, And then
; determine the closest direction by calculating the slope
If x2 > x1 And y2 < y1 ; UP right quadrant
If slope > -0.4142
ProcedureReturn #RIGHT ; slope is between 0 And 22.5 degrees
ElseIf slope < -2.4142
ProcedureReturn #UP ; slope is between 67.5 And 90 degrees
Else
ProcedureReturn #UPRIGHT ; slope is between 22.5 And 67.5 degrees
EndIf
ElseIf x2 > x1 And y2 > y1 ; DOWN RIGHT quadrant
If slope > 2.4142
ProcedureReturn #DOWN
ElseIf slope < 0.4142
ProcedureReturn #RIGHT
Else
ProcedureReturn #DOWNRIGHT
EndIf
ElseIf x2 < x1 And y2 < y1 ; UP LEFT quadrant
If slope < 0.4142
ProcedureReturn #LEFT
ElseIf slope > 2.4142
ProcedureReturn #UP
Else
ProcedureReturn #UPLEFT
EndIf
ElseIf x2 < x1 And y2 > y1 ; DOWN LEFT quadrant
If slope < -2.4142
ProcedureReturn #DOWN
ElseIf slope > -0.4142
ProcedureReturn #LEFT
Else
ProcedureReturn #DOWNLEFT
EndIf
EndIf
EndProcedure
Procedure distance(*coord1.point, *coord2.point)
xdist = *coord1\x-*coord2\x
ydist = *coord1\y-*coord2\y
ProcedureReturn Sqr(xdist*xdist + ydist*ydist)
EndProcedure
Procedure.s getGesture(List myPointsList.point())
; creates a gesture as a List of directional integers, i.e. [2,6,4] for
; the down-left-right gesture.
;
; the points param is a List of tuples of XY points that make up the user's
; mouse gesture.
Protected NewList StrokesList.i()
Protected NewList strokeSegmentsList.twoInt()
Protected NewList DistancesList()
ElementsInPointsList = ListSize(myPointsList())
If Not ElementsInPointsList: ProcedureReturn "": EndIf
FirstElement(myPointsList())
Repeat
AddElement(DistancesList())
*thisPoint.point = @myPointsList()
DistancesList() = distance(*thisPoint, NextElement(myPointsList()))
Until ListIndex(myPointsList())+1 = ElementsInPointsList
; keeps getting points until we go past the min. segment length
; startSegPoint = 0
; while startSegPoint < Len(points)-1:
ElementsInDistancesList = ListSize(DistancesList())
FirstElement(DistancesList())
For startSegPoint=0 To ElementsInPointsList-1
segmentDist = 0
curDir = #NONE
consistent = #True
direction = #NONE
For curSegPoint=startSegPoint To ElementsInDistancesList-1
SelectElement(DistancesList(), curSegPoint)
segmentDist = segmentDist + DistancesList()
If segmentDist >= _MIN_SEG_LEN
; check if all points are going the same direction.
SelectElement(myPointsList(), startSegPoint)
Repeat
*thisPoint = @myPointsList()
direction = getDirection(*thisPoint, NextElement(myPointsList()))
If curDir = #NONE
curDir = direction
ElseIf Not direction = curDir
consistent = #False
Break
EndIf
Until ListIndex(myPointsList()) = curSegPoint
Break
EndIf
Next curSegPoint
If Not consistent
Continue
ElseIf (Not direction=#NONE And ( (Not ListSize(StrokesList())) Or (ListSize(StrokesList()) And Not StrokesList()=direction ) ))
AddElement(StrokesList())
StrokesList()=direction
AddElement(strokeSegmentsList())
strokeSegmentsList()\int0 = startSegPoint
strokeSegmentsList()\int1 = curSegPoint
ElseIf ListSize(strokeSegmentsList())
LastElement(strokeSegmentsList())
strokeSegmentsList()\int1 = curSegPoint
EndIf
Next startSegPoint
; make the stroke-numbers to a human readable textlist
If ListSize(StrokesList())
;Returns a String of space-delimited text characters that represent the
;strokes passed in. For example, "Down+Right+Left".
thisString$ = ""
ForEach StrokesList()
thisString$+_strokesStrings(StrokesList())+"+"
Next
ProcedureReturn Trim(thisString$, "+")
Else
ProcedureReturn ""
EndIf
EndProcedure
If OpenWindow(0, 100, 200, 800, 600, "Mousegesturetestwindow", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget)
myBackgroundGadget = CanvasGadget(#PB_Any, 0, 40, 800, 560)
myTextGadget = TextGadget(#PB_Any, 10,10,780,20, "gesticulate with your mouse (left mousebutton pressed)")
SetGadgetText(myTextGadget, "gesticulate with your mouse (left mousebutton pressed)")
NewList PointsList.point()
Repeat
event = WaitWindowEvent()
event_type = EventType()
If event_type = #PB_EventType_LeftButtonDown
mouseDown = #True
ClearList(PointsList())
gesture$ = ""
ElseIf event_type = #PB_EventType_LeftButtonUp
mouseDown = #False
gesture$ = getGesture(PointsList())
SetGadgetText(myTextGadget, "gesture: >"+gesture$+"<")
rancolor = RGB(Random(255), Random(255), Random(255))
ElseIf event_type = #PB_EventType_MouseMove And mouseDown
AddElement(PointsList())
PointsList()\x = WindowMouseX(0)
PointsList()\y = WindowMouseY(0)
If StartDrawing(CanvasOutput(myBackgroundGadget))
Circle(PointsList()\x, PointsList()\y-40, 10, rancolor)
StopDrawing()
EndIf
EndIf
If event = #PB_Event_CloseWindow
quit = 1
EndIf
Until quit = 1
EndIf
End
