Anschlagswiederholung im Fullscreen

Windowsspezifisches Forum , API ,..
Beiträge, die plattformübergreifend sind, gehören ins 'Allgemein'-Forum.
Benubi
Beiträge: 186
Registriert: 22.10.2004 17:51
Wohnort: Berlin, Wedding

Anschlagswiederholung im Fullscreen

Beitrag von Benubi »

Hallo allerseits.

Ich würde gerne folgenden Code auf Linux/Mac portieren aber es läuft leider nicht wie ich dachte. Ich verwende alte PB Internals, um auf den Keyboard Buffer direkt zuzugreifen. Bei Windows 32/64 Bit ist die Syntax leicht verschieden (ein Unterstrich bei der Variable), aber wie es bei den anderen Platformen aussieht ist mir vollkommen unbekannt (leider). Vielleicht kann mir jemand helfen: siehe GetKeyboardBuffer().

Was dieser Code kann:

- Anschlagswiederholung mit einstellbarer Wiederholrate und Verzögerung

- zusätzlicher KeyboardHit() Befehl (Erster oder "wiederholter" Anschlag wenn Taste länger gedrückt wird)

- KeyboardInkey() reagiert dadurch sofort auf den Anschlag, und nicht erst wenn eine Taste losgelassen wurde

- keine Windows API (hoffentlich portierbar)

Das macht eine Fullscreen GUI bzw. das Text eintippen etwas intuitiver und flüssiger. Allerdings funktioniert das nur weil gedrückte Tasten "unterdrückt" bzw. ab dem nächsten Frame "losgelassen" werden, daher sollte man das nur während einer Texteingabe (z.B. im EditorGadget3D, Hiscores oder Game Console wenn KeyboardInkey() benutzt wird) nutzen und nicht wenn man durchgehend gedrückte Tasten für sein Programm braucht (z.B. wenn Cursor Tasten eine Spielfigur steuern sollen).

ExamineKeyboard2(Bool) - Wenn #True dann wird die Anschlagswiederholung genutzt, wenn #False gilt normales PB Verhalten.

Mit Anschlagswiederholung könnt Ihr durch einen langen Text schneller durch-scrollen z.B., wenn ihr die Bild auf/ab Tasten gedrückt haltet, oder schneller Text löschen mit Backspace etc. Daher liegt auch ein kleiner Demo Code bei, der aber auch nicht perfekt ist (wenn der Cursor ausserhalb des Sichtfeldes liegt, Bild auf/ab benutzen oder das Mausrad benutzen; man kann nicht mit Cursor Tasten durch den Text navigieren etc. geht um den Anschlag und nicht um ein voll funktionsfähigen EditorGadget Ersatz). Einfach die Backspace Taste gedrückt halten wenn die Demo startet oder Text eingeben wie ihr es gewohnt seit, "klimpern"...

Code: Alles auswählen

; Keyboardbuffer lib ex
; =====================
;
; KeyboardBufferRelease.pb
;
; (c) benubi, 2010-2012,2020-2022
; --------------------------
;
; 
; 
; IntitKeyboard2(ReleaseTime,RepeatTime) ; initialize Keyboard. Releasetime (first hit)=time between first key stroke and repeat. RepeatTime=time between simulated key stroke repetitions
;
; ExamineKeyboard2(boolRelease) ; if #True will release keys, if #False it won't change anything (normal ExamineKeyboard())
;
; KeyboardHit(#PB_Key_*) ; checks if the key has been hit "for the first time" or is "repeatedly" hit. ExamineKeyboard2(#True) must be called first
;
; ReleaseKeyboardKeys(ReleaseDelay, RepeatDelay) ; This procedure will be called internaly.


EnableExplicit

#Keyboard_Max = 256

Dim _Keyboard_LastPressed.i(#Keyboard_Max) ; Array enthält Zeitstempel für jede gedrückte Taste 
Define _KeyboardReleaseTime,_KeyboardRepeatTime
Structure __KeyboardBuffer
  B.B[#Keyboard_Max]  
EndStructure

; GetKeyboardBuffer() :
  
Procedure.i GetKeyboardBuffer() ; Returns a pointer to the current PureBasic KeyboardBuffer (256 Bytes)

  CompilerIf #PB_Compiler_Processor = #PB_Processor_x86
    !extrn _PB_Keyboard_KeyboardBuffer
    !MOV  DWORD EAX, _PB_Keyboard_KeyboardBuffer
  CompilerElseIf #PB_Compiler_Processor = #PB_Processor_x64
     !extrn PB_Keyboard_KeyboardBuffer
     !MOV QWORD RAX, PB_Keyboard_KeyboardBuffer
  CompilerEndIf 
  ProcedureReturn
EndProcedure

; ReleaseKeyboardKeys(ReleaseDelay,RepeatDelay) : time must be in ms
; must be called after ExamineKeyboard(). Has effect on KeyboardInkey(), KeyboardPushed(), KeyboardReleased(), Keyboardhit()
Procedure.i ReleaseKeyboardKeys(ReleaseDelay.i,RepeatDelay.i) ; Release keys after Release-Delay, Repeat release after Repeat-Delay
  Protected *Buffer.__KeyboardBuffer
  Protected e.i,i.i,rld.i,rpd.i
  Shared _Keyboard_LastPressed.i()
  *Buffer =  GetKeyboardBuffer()  
  If ReleaseDelay<=0
    Repeat
      _Keyboard_LastPressed(i)=0 
      i=i+1
    Until i>=#Keyboard_Max
    ReleaseDelay=1000
  EndIf 
  
  If RepeatDelay<=0
    RepeatDelay=1
  EndIf 
  
  If *Buffer
    
    e=ElapsedMilliseconds() 
    rpd = e+RepeatDelay
    rld = e+ReleaseDelay
    i=0
    Repeat 
      If *Buffer\b[i] ;*Buffer\b[i]
      ; ---------------------- PRESSED KEYS
        If _Keyboard_LastPressed(i)=0 
          _Keyboard_LastPressed(i)=-1 ; first hit  

          
        ElseIf _Keyboard_LastPressed(i)=-1
          _Keyboard_LastPressed(i)=rld
          *Buffer\B[i]=1
          
        ElseIf _Keyboard_LastPressed(i)=-2
          _Keyboard_LastPressed(i)=rpd
          *Buffer\B[i]=1

          
        ElseIf _Keyboard_LastPressed(i) <= e ; force release 
            _Keyboard_LastPressed(i)=-2  ; repeat delay
                                         ;         Debug "repeat start (pressed)"+Str(i)
            
        Else 
             *Buffer\b[i]=0 
             
        EndIf 
     ; -------------------- NOT PRESSED KEYS      
      ElseIf _Keyboard_LastPressed(i)>0
        _Keyboard_LastPressed(i) = 0
        
      ElseIf _Keyboard_LastPressed(i)=-1 ; process first hit (release)
        _Keyboard_LastPressed(i)=0;rld
        
      ElseIf  _Keyboard_LastPressed(i)=-2 ; process repeat hit (release)
        _Keyboard_LastPressed(i)=0;rpd
        
      Else 
         _Keyboard_LastPressed(i) = 0
      EndIf
    
      i=i+1
    Until i>=#Keyboard_Max
    ProcedureReturn 1
   Else 
    
     ProcedureReturn 0
   EndIf 
EndProcedure

; KeyboardHit(#PB_Key) : returns 1 on first keyboard "hit" for #PB_Key or 0
Procedure KeyboardHit(Key) ; Keyboard first hit, returns 1 if first hit or 0 if not pushed/already pushed last frame
  Shared _Keyboard_LastPressed.i()
  If key<0 Or key>=#Keyboard_Max
    ProcedureReturn 0 ; invalid
  ElseIf _Keyboard_LastPressed(Key)=-1 ;first hit
    ProcedureReturn 1
  Else 
    ProcedureReturn 0 ; no first hit
  EndIf 
EndProcedure

Procedure.i ExamineKeyboard2(Release) ; release: #True to release keys (key stroke repetition), #False: PureBasic default
  Shared _KeyboardReleaseTime,_KeyboardRepeatTime
  Protected result 
  result=ExamineKeyboard()
  If release And result
    ReleaseKeyboardKeys(_KeyboardReleaseTime,_KeyboardRepeatTime)
  EndIf 
  ProcedureReturn result    
EndProcedure

; InitKeyboardEx() wrapper procedure to use the original keyboard lib
Procedure InitKeyboard2(ReleaseTime,RepeatTime) ; ReleaseTime=Delay until first repetition -- RepeatTime=Delay between key repetitions
  Shared _KeyboardReleaseTime,_KeyboardRepeatTime
  _KeyboardReleaseTime=ReleaseTime
  _KeyboardRepeatTime=RepeatTime
  ProcedureReturn InitKeyboard()
EndProcedure



CompilerIf #PB_Compiler_IsMainFile
  
; =============================================================================================
; ----------- Demo
;   

  Dim _BorderColor(2)
  _BorderColor(0) = $EEEEEE
  _BorderColor(1) = $202020
  
  Dim _ElemColor.i(8)
  _ElemColor(0)=$8070A0
  _ElemColor(1)=$AABBCC
  _ElemColor(2)=$A0B0C0
  _ElemColor(3)=$A0B0F0
  _ElemColor(4)=$808080
  
  Dim _TxtColor.i(8)
  _TxtColor(0)=$8F8F
  _TxtColor(1)=$FFFF
  _TxtColor(2)=$EEEE
  _TxtColor(3)=$FFFF
  _TxtColor(4)=$8F8F
  
  
  Procedure WordWidth(*C.Character,*Len.Integer,Limit$)
    Protected totalWidth
    Protected len,*Z.Character
    If limit$="" 
      limit$=" "+#TAB$+#CRLF$
    EndIf 
    If *C
      While *C\c
     
        *Z = @Limit$
        While *Z\c
          If *Z\c = *C\c
            Break 2
          EndIf 
          *Z = *Z + SizeOf(Character)
        Wend  
        totalWidth = totalWidth + TextWidth(Chr(*C\c))
        len = len + 1
        *C = *C +SizeOf(Character)
      Wend 
      If *C\c And len=0
        len=1
        totalWidth=TextWidth(Chr(*C\c))
      EndIf 
      If *len
        *len\i=len
      EndIf  
    EndIf 
    ProcedureReturn totalWidth
  EndProcedure
  
  Procedure DrawBorder(x,y,width,height,type=0,color1=-1,color2=-1)
    Shared _BorderColor()
    Select type
      Case 0
        ; normal
        LineXY(x,y,x+width,y,_BorderColor(0)) ; top        
        LineXY(x,y,x,y+height,_BorderColor(0)) ; left       
        LineXY(x+width,y,x+width,y+height,_BorderColor(1)) ; right       
        LineXY(x,y+height,x+width,y+height,_BorderColor(1)) ; bottom        
        
      Case 1
        ; inverted (sunken)
        LineXY(x,y,x+width,y,_BorderColor(1)) ; top        
        LineXY(x,y,x,y+height,_BorderColor(1)) ; left       
        LineXY(x+width,y,x+width,y+height,_BorderColor(0)) ; right       
        LineXY(x,y+height,x+width,y+height,_BorderColor(0)) ; bottom        
        
      Case 2
        ; etched
        LineXY(x,y,x+width,y,_BorderColor(0)) ; top        
        LineXY(x,y,x,y+height,_BorderColor(0)) ; left       
        LineXY(x+width,y,x+width,y+height,_BorderColor(1)) ; right       
        LineXY(x,y+height,x+width,y+height,_BorderColor(1)) ; bottom        
        
        LineXY(x+1,y,x+width-2,y,_BorderColor(1)) ; top        
        LineXY(x+1,y,x,y+height-2,_BorderColor(1)) ; left       
        LineXY(x+width-2,y,x+width-2,y+height-2,_BorderColor(0)) ; right       
        LineXY(x+1,y+height,x+width,y+height-2,_BorderColor(0)) ; bottom        
        
        
    EndSelect    
    
  EndProcedure
Procedure.i DrawButton(Y,X,Width,Height,Text$,Flags=0,textcolor=-1,backgroundcolor=-1)
  Shared _ElemColor(),_TxtColor(),_BorderColor()
  Protected twidth,theight,halfwidth,halfheight
  Flags = Flags & 7
  If textcolor=-1
    textcolor=_TxtColor(Flags)
  EndIf 
  If backgroundcolor = -1
    backgroundcolor=_ElemColor(Flags)
  EndIf 
    Box(x,y,width,height,backgroundcolor)
    twidth=TextWidth(Text$)
    tHeight=TextHeight(Text$)
    halfwidth = (width - x)/2
    halfheight= (height- y)/2
    DrawText(2+x-halfwidth,2+y-halfheight,Text$,_BorderColor(1))
    DrawText(x-halfwidth,y-halfheight,Text$,textcolor)

EndProcedure

Procedure$ LoadText(FileName$,Type=#PB_Ascii)
  Protected fh,result$,len 
  fh=ReadFile(-1,FileName$)
  If fh
    result$=""
    While Not Eof(fh)
      result$=result$+ReadString(fh,Type)+#CR$
    Wend 
    CloseFile(fh)
  EndIf 
  ProcedureReturn result$ 
EndProcedure
Procedure.i DrawTextMultiLine(x,y,Text$,width,height,StartLine=0,Flags=0,*rX.Integer=0,*rY.Integer=0)
    Protected *C.Character
    Protected tx,ty,dx,dy,xmax,ymax,ly,nowrap,makeborder,wmax,processFullWord
    Protected iWordLen,iWordWidth,i,chr$
    *C=@Text$
    
    ly=TextHeight("M")
    ymax=height+y
    xmax=width+x
    While *C\c And StartLine>0
        While *C\c <> 13 And *C\c 
          *C=*C+SizeOf(Character)
        Wend  
        If *C\c = 13
         Startline=StartLine-1
         *C=*C+SizeOf(Character)
        EndIf 
    Wend   
    
    makeborder = Flags & 1
    nowrap     = Flags & 2
    
    If makeborder 
      LineXY(xmax,y,xmax,ymax,$222222)
      LineXY(x,ymax,xmax,ymax,$222222)
      LineXY(x,y,x,ymax,$bbbbbb)
      LineXY(x,y,xmax,y,$bbbbbb)
      x=x+2
      xmax=xmax-2
      y=y+2
      ymax=ymax-2
    EndIf 
    
    tx=x
    ty=y
    wmax=xmax-x
    ymax=ymax-ly
    While *C\c
     If ty>ymax 
      Break 
     EndIf 
     dx=WordWidth(*C,@iWordLen,"")
     If dx>wmax Or iWordLen=1
       processFullWord=1 ; draw word character by character
     ElseIf dx+tx>xmax 
       If nowrap  = 0
         processFullWord=2 ; draw on next line
        Else 
          processFullWord=1
       EndIf
     Else 
       processFullWord=0 ; draw full word
     EndIf 
          
     Select processFullWord
       Case 0
         ; draw full
         DrawText(tx,ty,PeekS(*C,iWordLen))
         tx = tx + dx

         If tx>xmax
           tx=x
           ty=ty+ly
           If ty>ymax
             Break 
           EndIf 
         EndIf 
         *C = *C + (iWordLen*SizeOf(Character))
         Continue
         
       Case 2
         ; draw on next line
         ty = ty + ly
         If ty>ymax
           Break 
         EndIf 
         DrawText(x,ty,PeekS(*C,iWordLen))
         tx = x +dx
         *C = *C +(iWordLen * SizeOf(Character))
         Continue
         
       Case 1
         i=0
         While i<iWordLen
           chr$=PeekS(*C,1)
           dx=TextWidth(Chr$)
          ; dy=TextHeight(Chr(*C\c))
           If nowrap  
              If *C\c=13
                ty=ty+ly
                tx=x
              EndIf 
           ElseIf tx+dx>xmax  Or *C\c = 13
            ty=ty+ly
            tx=x
           
          EndIf 
           
           If *c\c>=32 
            If tx+dx<=xmax
              DrawText(tx,ty,chr$)
            EndIf 
            tx=tx+dx 
           EndIf 
           
           If tx+dx>xmax And nowrap=0
            ty=ty+ly
            tx=x
           EndIf 
           i=i+1
           *C=*C+SizeOf(Character)
        Wend   
        Continue
        
      Default        
            Debug "ERROR"
            
     EndSelect
    
    Wend 
  
    If *rX
        *rX\i = tx
      EndIf 
      If *rY
        *ry\i = ty
      EndIf
      i=i+1
    
    ProcedureReturn ((tx & $FFFF)  | ((ty & $FFFF) << 16))
EndProcedure



Procedure OpenDesktopSizedScreen(Title$="PureBasic")
  Protected w,h,d,f
  
  If ExamineDesktops()
    
    w = DesktopWidth(0)
    h = DesktopHeight(0)
    d = DesktopDepth(0)
    f = DesktopFrequency(0)
    
    ProcedureReturn OpenScreen(w,h,d,Title$,#PB_Screen_NoSynchronization,f)
  EndIf 
EndProcedure


DisableExplicit

If InitSprite() And InitKeyboard2(700,10) And InitMouse() And OpenDesktopSizedScreen("KeyboardBufferRelease")
  
  KeyboardMode(#PB_Keyboard_International)
  StartLine.i=0
  TextMode.i=1
  cd.i=128
  dir.i=1
  xypos.i=0
  FullText$=""
  inkey$=""
   LoadFont(0,"Arial",16)
   FullText$ = LoadText(#PB_Compiler_File)

   
   StartLine=CountString(FullText$,#CR$)-15
   CreateSprite(1,16,16) 
   If StartDrawing(SpriteOutput(1))
     ; mouse-sprite


     Line(1,1,8,4,$8f8f8f)
     Line(1,1,4,8,$8f8f8f)
     Line(1,1,14,14,$8f8f8f)
     StopDrawing()
     TransparentSpriteColor(1,0)
   EndIf 
   If StartLine<0:StartLine=0:EndIf 
   
    Repeat
     If IsScreenActive() 
      FlipBuffers()
      ClearScreen(RGB(0, 0, 0))
      
     
      
      ExamineKeyboard2(#True)
      ;ReleaseKeyboardKeys(500,10) ; Zeichenpuffer vorbearbeiten

      inkey$=KeyboardInkey() 
      If inkey$<>Chr(#BS) And inkey$<>Chr(13); Wenn nicht Backspace
        FullText$ = FullText$ + inkey$ ; fügt das nächste Zeichen zum aktuellen Text (sofern vorhanden) hinzu
      Else 
      ;  FullText$ = Left(FullText$,Len(FullText$)-1)
      EndIf 
      If KeyboardReleased(#PB_Key_F1)
        TextMode=TextMode+1
        If TextMode>3
          TextMode=0
        EndIf 
      EndIf 
      If KeyboardHit(#PB_Key_F2)
        FullText$=""
        StartLine=0
      EndIf 
      If KeyboardReleased(#PB_Key_Home)
        StartLine=0
      EndIf 
      If KeyboardReleased(#PB_Key_End)
         StartLine=1+CountString(FullText$,#CR$)-(480/16)
      EndIf 
      If KeyboardReleased(#PB_Key_Return) Or KeyboardReleased(#PB_Key_PadEnter); wird nicht "wiederholt" wegen KeyboardHit()
        Fulltext$=FullText$+Chr(13)
      EndIf 
      If (KeyboardReleased(#PB_Key_PageUp) Or MouseWheel()>0) And StartLine > 0  ; Hoch-scrollen
        Startline=StartLine-1
        If StartLine<0:StartLine=0:EndIf 
        
      EndIf 
      If (KeyboardReleased(#PB_Key_PageDown) Or MouseWheel()<0) ; Runter-Scrollen
        If StartLine<CountString(FullText$,Chr(13))
          Startline=StartLine+1
        EndIf 
      EndIf 
      ; Wenn wir die 'Backspace'-Taste drücken, löschen wir das letzte Zeichen
      ;
      If KeyboardReleased(#PB_Key_Back)  Or KeyboardReleased(#PB_Key_Delete) Or inkey$=Chr(#BS); Rück-Taste
        FullText$ = Left(FullText$, Len(FullText$)-1)
      EndIf
    
    
      ; Ergebnis darstellen
      ;
      If StartDrawing(ScreenOutput())
        If IsFont(0)
          DrawingFont(FontID(0))
        EndIf 
        DrawingMode(1)
        If IsFont(0)
          DrawingFont(FontID(0))
        EndIf 
        FrontColor(RGB(128, 255, 0))
        DrawTextMultiLine(20, 20, "ESC zum beenden     F1 - Textmodus ändern    F2 - Text löschen"+#CRLF$+"Tasten gedrückt lassen, für Release-Effekt. Rück-,Bildauf/-ab,Eingabe-Tasten:"+#CRLF$,740,80)
        
        
        cd=cd+dir
        If cd>255
          cd=255
          dir=-1
        ElseIf cd<128
          cd=128
          dir=1
        EndIf 

      
      FrontColor(RGB(cd,cd,cd))
      Box(40,80,720,460,RGB(64,64,96))
        xypos=DrawTextMultiLine(40, 80, FullText$,720,460,StartLine,TextMode,@rx.i,@ry.i)
        
        b=b+7
        If b>=512
         b=0
         c=0
        ElseIf b>255
         c=511-b
        Else 
         c=b
       EndIf 
             
       
        DrawText(rx ,ry,"_",RGB(c,c,0))
        
        DrawText(0,0,"xypos x="+Str(rx)+" y="+Str(ry)+"  Textlength:"+Str(Len(FullText$))+"  Startline:"+Str(StartLine),$FF)
        If ry>570
          StartLine=StartLine+1
        EndIf 
        StopDrawing()
        
        ExamineMouse() 
        DisplayTransparentSprite(1,MouseX(),MouseY())
       
      EndIf
     EndIf 
    Until KeyboardPushed(#PB_Key_Escape) Or (MouseButton(1) And MouseX()<10 And MouseY()<10)
  EndIf  
CompilerEndIf