SuperStrict

Framework BRL.GLMax2D
Import BRL.StandardIO
Import BRL.LinkedList
Import BRL.Retro

Graphics 800,600

TGesture.SetFunction(ParseGestData)
SetLineWidth 3
Repeat
   Cls
      SetColor 255,0,0
      TGesture.Update()
      TGesture.Draw()
      SetColor 255,255,255
      DrawText TGesture.Data()+", Points: "+TGesture._gest_points.Count(),12,12
   Flip
Until AppTerminate() Or KeyDown(KEY_ESCAPE)


Function ParseGestData(data:String)
   Select data
      Case "L";Notify "........"
      Case "DRU","DLU";Notify "Was willst du mit dem ~qU~q? :D"
      Case "LU";Notify "Banane???"
      Case "RD";Notify "Bye Bye!";End
      Default;Notify "Unbekannte Gestik: "+data
   EndSelect
EndFunction


Type TPoint
   Field x:Float
   Field y:Float
EndType

Type TGesture Abstract
   Global _gest_data:String
   Global _gest_tmp_x:Int
   Global _gest_tmp_y:Int
   Global _gest_points:TList = New TList
   Global _gest_tolerance:Int = 30
   Global _gest_mouse_press:Byte
   Global _check_func(data:String)
   
   Function SetFunction(func(data:String))
      _check_func = func
   EndFunction
   
   Function SetTolerance(tolerance:Int)
      _gest_tolerance = tolerance
   EndFunction
   
   Function Update()
      If MouseDown(MOUSE_LEFT)
         If Not _gest_mouse_press
            _gest_tmp_x = MouseX()
            _gest_tmp_y = MouseY()
            _gest_mouse_press = True
         EndIf
         AddPoint(_gest_tmp_x,_gest_tmp_y,MouseX(),MouseY())
      ElseIf _gest_mouse_press
         Check()
         _gest_mouse_press = False
      EndIf
   EndFunction
   
   Function Check()
      If Not _gest_data Then Return
      If _check_func Then _check_func(_gest_data)
      _gest_data = ""
      _gest_points.Clear()
   EndFunction
   
   Function AddPoint(x1:Float,y1:Float,x2:Float,y2:Float)
      Local data:String
      Local point:TPoint = New TPoint
      point.x = x1
      point.y = y1
      Local xdif:Float = x1-x2
      Local ydif:Float = y1-y2
      
      
      If Abs(xdif)<_gest_tolerance/2 And Abs(ydif)<_gest_tolerance/2
         Return
      EndIf
      
      _gest_points.AddLast point
      
      If Abs(xdif)>Abs(ydif)
         If xdif<0
            data = "R"
         Else
            data = "L"
         EndIf
      Else
         If ydif<0
            data = "D"
         Else
            data = "U"
         EndIf
      EndIf
      
      _gest_tmp_x = MouseX()
      _gest_tmp_y = MouseY()
      
      If Mid(_gest_data,_gest_data.length,1)<>data
         _gest_data:+data
      EndIf
   EndFunction
   
   Function Data:String()
      Return _gest_data
   EndFunction
   
   Function Draw()
      Local tmp_x:Float,tmp_y:Float,started:Byte
      For Local xy:TPoint=EachIn _gest_points
         If started
            DrawLine tmp_x,tmp_y,xy.x,xy.y
            tmp_x = xy.x
            tmp_y = xy.y
         Else
            tmp_x = xy.x
            tmp_y = xy.y
            started = True
         EndIf
      Next
      If started Then DrawLine tmp_x,tmp_y,MouseX(),MouseY()
   EndFunction
EndType

Framework brl.glmax2d
Import brl.standardio
Import brl.linkedlist
Import brl.retro
Graphics 1024,768


TGesture.SetFunction(ParseGestData)
SetLineWidth 3
Repeat
   Delay 10
   SetColor 255,0,0
   TGesture.Update()
   TGesture.Draw()
   SetColor 255,255,255
   DrawText TGesture.data()+", Points: "+TGesture._gest_points.count(),20,20
   Flip 0
   Cls
   
Until AppTerminate() Or KeyDown(KEY_ESCAPE)

Function ParseGestData(data:String)
   If  TGesture._gest_points.count()>200
      Notify "Was das den?"
      Return
   End If
   Global viering   'bei der vier und bei der sieben muss man kurz die maus loslassen, mir ist keine bessere
   Global siebning 'möglichkeit eingefallen, der rest da unten sind die Bewegungen
   Local viereck=Instr2(data,"URDL") And Not Instr2(data,"LDRUL") And Not Instr2(data,"RDLUR") And Not Instr(data,"RDLDR") And Not Instr(data,"LDRDL") And Not Instr(data,"LDRULRD") And Not Instr(data,"LDRUDL") And Not instr2(data,"UDL")
   Local kreis=Instr2(data,"LDRUL") Or Instr2(data,"RDLUR")And Not Instr2(data,"LDRULD") And Not Instr2(data,"ULU") And Not Instr(data,"RDLDR") And Not Instr2(data,"RDLRDL")
   Local eins=Instr2(data,"URD") And Not Instr(data,"RDL") And Not Instr2(data,"LDRUDL") And Not instr2(data,"UDL") And Not Instr(data,"DR")
   Local zwei=Instr(data,"RDLR") Or Instr(data,"RDLD")  And Not Instr(data,"RDLDR")
   Local drei=Instr2(data,"RDLRDL")
   Local vier=Instr(data,"DR")
   Local fuenf=Instr2(data,"LDRDL")
   Local sechs=Instr2(data,"LDRULD") And Not Instr2(data,"LDRULDL")
   Local sieben=Instr(data,"RD") And Not (Instr2(data,"RDLD") Or Instr2(data,"ULU"))
   Local acht=Instr2(data,"RDLD") Or Instr2(data,"ULU") Or instr2(data,"DLUR") And not(Instr2(data,"LDRUDL") Or Instr2(data,"LDRULDL"))
   Local neun=Instr2(data,"LDRUDL") Or Instr2(data,"LDRULDL")
   
   Select 1
      Case viereck And Not kreis And Not zwei
         Notify "Ein Viereck"
      Case kreis
         Notify "Ein Kreis oder ne Null"
      Case eins And Not kreis And Not viereck And Not drei
         Notify "Ne Eins"
      Case zwei And Not drei
         Notify "Ne Zwei"
      Case drei
         Notify "Ne Drei"
      Case vier
         viering=True
         Print "viering.."
      Case viering   
         If data="D"
            Notify "Ne Vier"
         End If
         viering =False
      Case fuenf
         Notify "Ne Fünf"
      Case sechs
         Notify "Ne Sechs"
      Case sieben
         siebning = True
         Print "siebning.."
      Case siebning
         If data="R"
            Notify "Ne Sieben"
         End If
         siebning=False
      Case acht
         Notify "Ne Acht"
      Case neun
         Notify "Ne Neun"
      Default
         viering=False
         siebning=False
         Select data
            Case "L" Notify "Strich nach links"      
            Case "D" Notify "Strich nach unten"      
            Case "U" Notify "Strich nach oben"   
            Case "R" Notify "Strich nach rechts"   
         EndSelect
   End Select

EndFunction

'---------------Die Funktion um zu Prüfen , ob ein Substring in irgendeiner Weise in einem String Auftritt---------'

Function Instr2(str$,sub$) ' diese Funktion prüft etwas tolleranter ob sub$ in str$ drin ist
   Local l:Int=Len(str)   '(geht recht viele möglichkeiten durch)'
   For i = 0 To l
      If Instr(str,sub)
         Return True
      End If
      pushString(str) 
   Next
   reversestring(sub)
   For i = 0 To l
      If Instr(str,sub)
         Return True
      endif
      pushString(str)
   Next
   reversestring(str)
   For i = 0 To l
      If Instr(str,sub)
         Return True
      End If
      pushString(str)
   Next
   reversestring(sub)
   For i = 0 To l
      If Instr(str,sub)
         Return True
      endif
      pushString(str)
   Next
End Function
'---------------------------Die funktionen hier werden nur für Instr2(str$,sub$) gebraucht-----------------------------'
Function StrToArray$[](str$)   'wandelt nen string zu einem array um
   Local l=Len(str)
   Local arr$[l]
   For Local i = 1 To l
      arr[i-1]=Mid(str,i,1)
   Next
   Return arr
End Function

Function ArrayToStr$(arr$[])  'das ganze rückgänging
   Local l=arr.length
   Local str$
   For Local i = 0 To l-1
      str:+arr[i]
   Next
   Return str
End Function

Function pushArray(arr$[] Var) 'schiebt das array einmal nach links
   l=arr.length
   tmp$=arr[0]
   For i = 0 To l-2
      arr[i]=arr[i+1]
   Next
   arr[l-1]=tmp
End Function

Function pushString(str$ Var) 'das selbe mit nem string
   Local arr$[]=strtoarray(str)
   pusharray(arr)
   str=arraytostr(arr)
End Function

Function ReverseString(str$ Var) ' liest ein string von hinten
   Local newstring$
   For i = Len(str)-1 To 0 Step -1
      newstring:+Mid(str,i+1,1)
   Next
   str=newstring
End Function

'------------------------------------------------------------------------------------------------------------'
'---------------------------------------------Gestik Klasse--------------------------------------------------'
'------------------------------------------------------------------------------------------------------------'

Type TPoint
   Field x:Float
   Field y:Float
EndType

Type TGesture Abstract
   Global _gest_data:String
   Global _gest_tmp_x:Int
   Global _gest_tmp_y:Int
   Global _gest_points:TList = New TList
   Global _gest_tolerance:Int = 20
   Global _gest_mouse_press:Byte
   Global _check_func(data:String)
   
   Function SetFunction(func(data:String))
      _check_func = func
   EndFunction
   
   Function SetTolerance(tolerance:Int)
      _gest_tolerance = tolerance
   EndFunction
   
   Function Update()
      If MouseDown(MOUSE_LEFT)
         If Not _gest_mouse_press
            _gest_tmp_x = MouseX()
            _gest_tmp_y = MouseY()
            _gest_mouse_press = True
         EndIf
         AddPoint(_gest_tmp_x,_gest_tmp_y,MouseX(),MouseY())
      ElseIf _gest_mouse_press
         check()
         _gest_mouse_press = False
      EndIf
   EndFunction
   
   Function check()
      If Not _gest_data Then Return
      If _check_func Then _check_func(_gest_data)
      _gest_points.Clear()
      Clear()
   EndFunction
   
   Function Clear()
      _gest_data = ""
   End Function
   
   Function AddPoint(x1:Float,y1:Float,x2:Float,y2:Float)
      Local data:String
      Local point:TPoint = New TPoint
      point.x = x1
      point.y = y1
      Local xdif:Float = x1-x2
      Local ydif:Float = y1-y2
      
    
      If Abs(xdif)<_gest_tolerance/2 And Abs(ydif)<_gest_tolerance/2
         Return
      EndIf
    
      _gest_points.AddLast point
      
      If Abs(xdif)>Abs(ydif)
         If xdif<0
            data = "R"
         Else
         data = "L"
       EndIf
      Else
         If ydif<0
            data = "D"
         Else
            data = "U"
         EndIf
      EndIf
    
    
      _gest_tmp_x = MouseX()
      _gest_tmp_y = MouseY()
    
      If Mid(_gest_data,_gest_data.length,1)<>data
       _gest_data:+data
      EndIf
   EndFunction
   
   Function data:String()
      Return _gest_data
   EndFunction
   
   Function Draw()
      Local tmp_x:Float,tmp_y:Float,Started:Byte
      For Local xy:TPoint=EachIn _gest_points
         If Started
            DrawLine tmp_x,tmp_y,xy.x,xy.y
            tmp_x = xy.x
            tmp_y = xy.y
         Else
            tmp_x = xy.x
            tmp_y = xy.y
            Started = True
         EndIf
      Next
      If Started Then DrawLine tmp_x,tmp_y,MouseX(),MouseY()
   EndFunction
EndType