Type tJoyRueck
	oben As String
	rechts As String
	unten As String
	links As String
End Type
Dim Shared JoyRueckNull As tJoyRueck

Declare Operator = (jr1 As tJoyRueck, jr2 As tJoyRueck) As Integer
Operator = (r1 As tJoyRueck, r2 As tJoyRueck) As Integer
	If r1.oben <> r2.oben Then Return 0
	If r1.rechts <> r2.rechts Then Return 0
	If r1.unten <> r2.unten Then Return 0
	If r1.links <> r2.links Then Return 0
	Return -1
End Operator

Operator <> (r1 As tJoyRueck, r2 As tJoyRueck) As Integer
	If r1.oben <> r2.oben Then Return -1
	If r1.rechts <> r2.rechts Then Return -1
	If r1.unten <> r2.unten Then Return -1
	If r1.links <> r2.links Then Return -1
	Return 0
End Operator

Type tMausRueck
	links As String
	mitte As String
	rechts As String
	vor As String
	zur As string
End Type
Dim Shared MausRueckNull As tMausRueck	

Operator = (r1 As tMausRueck, r2 As tMausRueck) As Integer
	If r1.links <> r2.links Then Return 0
	If r1.mitte <> r2.mitte Then Return 0
	If r1.rechts <> r2.rechts Then Return 0
	If r1.vor <> r2.vor Then Return 0
	If r1.zur <> r2.zur Then Return 0
	Return -1
End Operator

Operator <> (r1 As tMausRueck, r2 As tMausRueck) As Integer
	If r1.links <> r2.links Then Return -1
	If r1.mitte <> r2.mitte Then Return -1
	If r1.rechts <> r2.rechts Then Return -1
	If r1.vor <> r2.vor Then Return -1
	If r1.zur <> r2.zur Then Return -1
	Return 0
End Operator

Declare Function stringmod(text As String = "", modus As Integer = 0, _
                           mausrueck As tMausRueck = MausRueckNull, _
                           joyrueck As tJoyRueck = JoyRueckNull, _
                           zeiger As Any Ptr = 0) As String
Declare Function joysubst OverLoad () As Integer
Declare Function joysubst (oben As String, rechts As String, _
                           links As String, unten As String) As String
Declare Function joysubst (joyrueck As tJoyRueck) As String
Declare Function maussubst OverLoad (links As String = "", mitte As String = "", _
                                     rechts As String = "", vor As String = "", _
                                     zur As String = "" ) As String
Declare Function maussubst(mausrueck As tMausRueck) As String

Function stringmod(text As String = "", modus As Integer = 0, _
                           mausrueck As tMausRueck = MausRueckNull, _
                           joyrueck As tJoyRueck = JoyRueckNull, _
                           zeiger As Any Ptr = 0) As String
'die angabe von 'modus' ist optional, defaultwert ist 0
'modus0 --> normale funktion
'modus1 --> kehrt nach 'pfeil nach oben', 'pfeil nach unten', 'bild nach oben' und
'           'bild nach unten'zum hauptprogramm zurück
'modus2 --> behandelt joystickbewegungen wie pfeiltasten (oben, unten, rechts, links)
'modus4 --> setzt nur die variable 'vorigertext' und kehrt dann zurück
'modus8 --> setzt bei druck auf esc - taste code 27 (esc) vor den rückgabestring 

'wenn 'mausrueck' als 6-stelliger string mit den chr-codes der tasten (jeweils zweistellig für 
' links/rad/rechts) übergeben wird, werden mausklicks wie tastendrücke behandelt.

'wenn ein zeiger angegeben wird, wird die eingabeschleife auf ein unterprogramm mit der 
' angegebenen adresse umgeleitet. das unterprogramm kann optional einen string zurückgeben,
' der dann wie eine tastatureingabe behandelt wird.
    
  Dim As Integer ze, sp, co, gi, buttons, sperr, ms, mz, rad, tasten, laenge
  Dim As Single joyx, joyy
  Dim As String g, merken, txt, mauslinks, mausrechts, g2
  Dim plugin As Sub (adresse As Any Ptr, laenge As Any Ptr)
    
  Static As String vorigertext, g_rueck
  Static As Integer mausrad
     
  If (modus And 4) Then
  	vorigertext = text + " "
  	Return text
  EndIf
  
  If vorigertext = "" Then
  	vorigertext = " "
  EndIf
  
  txt = text + " "
  merken = txt
  co = Pos 'cursor offset
  ze = CsrLin
  sp = Len(txt) 'zeiger auf zeichen unter cursor
  sperr = 0
      
  Locate ze, co, 1
  Print txt;
  Locate ze, sp+co-1, 1
    
  Do
    'eingabe
    plugin = zeiger 'pointer auf plugin setzen
    If (zeiger <> 0) And (g_rueck = "") Then 'plugin aufrufen
    	g_rueck = String(200,Chr(0)) 'speicherplatz für rückgabestring reservieren
    	laenge = Len(g_rueck) 'maximale länge des rückgabestrings
    	plugin(StrPtr(g_rueck),@laenge) 'plugin aufrufen
      g_rueck = Left(g_rueck,laenge) 'rückgabestring in puffer übertragen
    EndIf
    
	    If (mausrueck <> MausRueckNull) Then
	  		g_rueck += maussubst(mausrueck)
	    EndIf
		     
	  	If (joyrueck <> JoyRueckNull) Then 'behandelt joystick wie tasten
		    g_rueck += joysubst(joyrueck)
	  	EndIf
           
    If g_rueck = "" Then
    	g = InKey
    Else 'rückgabestring abarbeiten
    	If Left(g_rueck,1) = Chr(255) Then 'steuerzeichen
    		g = Left(g_rueck,2) 'imitierter tastendruck
    		g_rueck = Mid(g_rueck,3) 'rückgabestring kürzen
    	Else 'normales zeichen
    		g = Left(g_rueck,1) 'imitierter tastendruck
    		g_rueck = Mid(g_rueck,2) 'rückgabestring kürzen
    	EndIf
    EndIf
        
    If Len(g) = 1 Then 'normales zeichen
    	If g[0] > 31 Then 'normaler buchstabe
        txt = Left(txt, sp - 1) + g + Mid(txt, sp)
        sp += 1
        Locate ze, co, 0
        Print txt;
        Locate ze, sp+co-1, 1
      Else 'steuerzeichen
        Select Case g[0] 
        	Case 8 ' Rücktaste
            If sp > 1 Then
              txt = Left(txt, sp - 2) + Mid(txt, sp)
              sp -= 1
              Locate ze, co, 0
              Print txt;
              Locate ze, sp+co-1, 1
            End If
          Case 13
            'return
          Case 27 'esc
            If (modus And 8) Then
            	txt = Chr$(27) + txt
            Else
            	txt = merken 'alter string
            EndIf
            g = Chr$(13) 'beenden
        	Case Else
            'Print "*"; g; "*"; ASC(g) 'code von unbekannter taste anzeigen
        End Select
      End If
    ElseIf Len(g) = 2 Then 'steuerzeichen
    	gi = g[1] 
      Select Case gi 'steuerzeichen
      	Case 75 'pfeil nach links -> cursor nach links
          If sp > 1 Then
            sp -= 1
            Locate ze, sp+co-1, 1
          End If
      	Case 77 'pfeil nach rechts -> cursor nach rechts
          If sp < Len(txt) Then
            sp += 1
            Locate ze, sp+co-1, 1
          ElseIf txt = " " Then 'vorherigen string setzen
          	txt = vorigertext
          	sp = Len(txt)
          	Print txt;
          	Locate ze, sp+co-1, 1
          End If
      	Case 14 'rücktaste -> zeichen vor cursor löschen
          If sp > 1 Then
            txt = Left$(txt, sp - 1) + Mid$(txt, sp)
            sp -= 1
            Locate ze, co, 0
            Print txt;
            Locate ze, sp+co-1, 1
          End If
      	Case 83 'entf -> zeichen hinter cursor löschen
          If sp < Len(txt) Then
            txt = Left$(txt, sp - 1) + Mid$(txt, sp + 1)
            Locate ze, co, 0
            Print txt;
            Locate ze, sp+co-1, 1
          End If
      	Case 71 'pos1 -> cursor an stringanfang setzen
          sp = 1
          Locate ze, sp+co-1, 1
      	Case 79 'ende -> cursor an stringende setzen
          sp = Len(txt)
          Locate ze, sp+co-1, 1
      	Case Else
      		If (modus And 1) Then
            txt = g + Chr$(ze) + Chr$(co) + txt 'steuerzeichen und cursorposition zurückgeben
            g = Chr$(13)
          EndIf
      End Select
    Else 'keine taste
    	Sleep 10 'zur ressourcenschonung
    End If
  Loop Until g = Chr$(13) 'return
		
  vorigertext = txt
  Return Left$(txt, Len(txt) - 1)
  Locate ze, sp+co-1, 0 'cursor aus
             
End Function

Function joysubst () As Integer
	
	Dim As Single joyx, joyy
	Dim As Integer buttons, ausgabe
	Static As Integer sperr = 0
	Static As Double sperrzeit
	
	ausgabe = 0 'defaultwert keine taste gedrückt
		
	If GetJoystick (0, buttons, joyx, joyy) Then
		'kein joystick
	Else
		If joyx < -.5 Then 'links
		  ausgabe = 4
		ElseIf joyx > .5 Then 'rechts
			ausgabe = 2
		EndIf
		If joyy < -.5 Then 'oben
			ausgabe = 1
		ElseIf joyy > .5 Then 'unten
			ausgabe = 3
		EndIf
	EndIf
	
	If ausgabe = 0 Then 'keine taste gedrückt, verzögerungszeit auf 0 setzen
		sperr = 0
	EndIf
schleife:	
	Select Case sperr 'verzögerungsmodi
		Case 0 'sofortige ausführung 
			If ausgabe Then 'taste gedrückt
				sperr = 1 'verzögerungsmodus
			  sperrzeit = Timer + 0.3 'verzögerung für 1. tastendruck
			EndIf
		Case 1 'taste wird gehalten
			If Timer > sperrzeit Then 'prüfen, ob verzögerungszeit abgelaufen ist
				sperr = 2 'wiederholmodus
				sperrzeit = Timer + 0.07 'verzögerungswert für wiederholrate
			Else 'verzögerungszeit noch nicht abgelaufen
				ausgabe = 0
			EndIf
		Case 2 'wiederholmodus
			If Timer > sperrzeit Then 'prüfen, ob verzögerungszeit abgelaufen ist
				sperrzeit = Timer + 0.07 'zeit für nächste wiederholschleife setzen
			Else 'zeit noch nicht abgelaufen
				ausgabe = 0
			EndIf
	End Select
	
	Return ausgabe
  
End Function

Function joysubst (oben As String, rechts As String, _
                   unten As String, links As String) As String
			
	Select Case joysubst()
		Case 0 'keine taste
			Return ""
		Case 1 'oben
			Return oben
		Case 2 'rechts
			Return rechts
		Case 3 'unten
			Return unten
		Case 4 'links
			Return links
	End Select
	
End Function

Function joysubst (joyrueck As tJoyRueck) As String
			
	Select Case joysubst()
		Case 0 'keine taste
			Return ""
		Case 1 'oben
			Return joyrueck.oben
		Case 2 'rechts
			Return joyrueck.rechts
		Case 3 'unten
			Return joyrueck.unten
		Case 4 'links
			Return joyrueck.links
	End Select
	
End Function

Function maussubst(mausrueck As tMausRueck) As String
	Return maussubst(mausrueck.links, mausrueck.mitte, mausrueck.rechts, _
	                 mausrueck.vor, mausrueck.zur)
End Function

Function maussubst (links As String = "", mitte As String = "", _
                    rechts As String = "", vor As String = "", _
                    zur As String = "") As String
	Dim As Integer ms, mz, rad, tasten
	Static As Integer mausrad
	
	GetMouse (ms,mz,rad,tasten) 'mauszeile holen
	If (tasten And 1) Then 'linke maustaste
		Function = links
	ElseIf (tasten And 4) Then 'mittlere maustaste
		Function = mitte
	ElseIf (tasten And 2) Then 'rechte maustaste
		Function = rechts
	EndIf
		    	
	If rad < mausrad Then
		Function = zur 'mausrad nach hinten
		mausrad = rad
	ElseIf rad > mausrad Then
		Function = vor 'mausrad nach vorne 
		mausrad = rad
	EndIf
	
	Do 'auf loslassen der maustaste warten
		GetMouse (ms,mz,rad,tasten)
	Loop While tasten

End Function