[Done] Problems with redrawing text

Post bugreports for the Mac OSX version here
mestnyi
Addict
Addict
Posts: 995
Joined: Mon Nov 25, 2013 6:41 am

[Done] Problems with redrawing text

Post by mestnyi »

when selecting text text redrawing problem. The text begins to jump.
Sorry that the example turned out to be a little big. :(

Code: Select all

EnableExplicit

;-
DeclareModule String
  EnableExplicit
  
  ;- STRUCTURE
  Structure Coordinate
    y.l[3]
    x.l[3]
    Height.l[3]
    Width.l[3]
  EndStructure
  
  Structure Mouse
    X.l
    Y.l
    Buttons.l
  EndStructure
  
  Structure Canvas
    Mouse.Mouse
    Gadget.l
    Window.l
    
    Input.c
    Key.l[2]
    
  EndStructure
  
  Structure Text Extends Coordinate
    ;     Char.c
    Len.l
    String.s[2]
    Change.b
    
    Lower.b
    Upper.b
    Pass.b
    Editable.b
    Numeric.b
    Wrap.b
    MultiLine.b
    
    CaretPos.l[2] ; [0] = Pos ; [1] = PosFixed
    
    Mode.l
  EndStructure
  
  Structure Gadget Extends Coordinate
    FontID.i
    Canvas.Canvas
    
    Text.Text[4]
    Color.l[3]
    
    
    fSize.l
    bSize.l
    Hide.b[2]
    Disable.b[2]
   
    Type.l
    InnerCoordinate.Coordinate
    
    Repaint.l
    
    List Items.Gadget()
    List Columns.Gadget()
  EndStructure
  
  
  ;- DECLARE
  Declare.s GetText(Gadget.l)
  Declare Gadget(Gadget, X.l, Y.l, Width.l, Height.l, Text.s, Flag.l=0)
  
  Declare SetFont(Gadget, FontID.i)
EndDeclareModule

Module String
  
  ;- PROCEDURE
  
  Procedure Caret(*This.Gadget, Reset=0)
    Protected Position.l =- 1, i.l, CaretPos.l, CursorX.i, Distance.f, MinDistance.f = Infinity()
    
    With *This
      If StartDrawing(CanvasOutput(\Canvas\Gadget)) 
        If \FontID : DrawingFont(\FontID) : EndIf
        
        ; get caret position
        For i=0 To \Text\Len
          CursorX = \Text\x + TextWidth(Left(\Text\String.s, i))
          Distance = (\Canvas\Mouse\X-CursorX)*(\Canvas\Mouse\X-CursorX)
          
          If MinDistance > Distance : MinDistance = Distance : Position = i : EndIf
        Next
        
        \Text\CaretPos = Position
        If Reset 
          \Text[2]\Len = 0
          \Text\CaretPos[1] = \Text\CaretPos 
        EndIf
        
        ; Если выделяем с право на лево
        If \Text\CaretPos[1] > \Text\CaretPos 
          CaretPos = \Text\CaretPos
          \Text[2]\Len = (\Text\CaretPos[1]-\Text\CaretPos)
        Else 
          CaretPos = \Text\CaretPos[1]
          \Text[2]\Len = \Text\CaretPos-\Text\CaretPos[1]
        EndIf
        
        \Text[1]\String.s = Left(\Text\String.s, CaretPos)
        
        If \Text[2]\Len
          \Text[2]\String.s = Mid(\Text\String.s, 1 + CaretPos, \Text[2]\Len)
          \Text[3]\String.s = Right(\Text\String.s, \Text\Len-(CaretPos + \Text[2]\Len))
        Else
          \Text[2]\String.s = ""
        EndIf
        
        \Text[1]\Width = TextWidth(\Text[1]\String.s) 
        \Text[2]\Width = TextWidth(\Text[2]\String.s)
        
        \Text[2]\X = \Text\X+\Text[1]\Width
        \Text[3]\X = \Text[2]\X+\Text[2]\Width
        
        StopDrawing()
      EndIf
    EndWith
    
    ProcedureReturn #True
  EndProcedure
  
  Procedure Draw(*This.Gadget)
    With *This
      If StartDrawing(CanvasOutput(\Canvas\Gadget))
        If \FontID : DrawingFont(\FontID) : EndIf
        Box(\X[1],\Y[1],\Width[1],\Height[1],\Color[0])
        
        \Text\Height = TextHeight("A")
        \Text[0]\Width = TextWidth(\Text\String.s)
        
        \Text\X = 3 
        \Text\Y = 3
        
        If \Text\String.s
          If \Text[2]\Len
            
            If \Text[1]\String.s
              DrawingMode(#PB_2DDrawing_Transparent)
              DrawText(\Text\X, \Text\Y, \Text[1]\String.s, $0B0B0B)
            EndIf
            
            If \Text[2]\String.s
              DrawingMode(#PB_2DDrawing_Default)
              DrawText(\Text[2]\X, \Text\Y, \Text[2]\String.s, $FFFFFF, $D77800)
            EndIf
            
            If \Text[3]\String.s
              DrawingMode(#PB_2DDrawing_Transparent)
              DrawText(\Text[3]\X, \Text\Y, \Text[3]\String.s, $0B0B0B)
            EndIf
            
          Else
            DrawingMode(#PB_2DDrawing_Transparent)
            DrawText(\Text\X, \Text\Y, \Text\String.s, $0B0B0B)
          EndIf
        EndIf
        
        If \Text\CaretPos=\Text\CaretPos[1] 
          DrawingMode(#PB_2DDrawing_XOr)             
          Line(\Text\X + \Text[1]\Width, \Text\Y, 1, \Text\Height, $FFFFFF)
        EndIf
        
        StopDrawing()
      EndIf
    EndWith  
  EndProcedure
  
  Procedure EditableCallBack(*This.Gadget, EventType.l)
    Protected Result
    
    If *This
      With *This
        If Not \Disable
          Select EventType
            Case #PB_EventType_MouseEnter
              SetGadgetAttribute(*This\Canvas\Gadget, #PB_Canvas_Cursor, #PB_Cursor_IBeam)
              
            Case #PB_EventType_LeftButtonDown
              Result = Caret(*This, 1)
              
            Case #PB_EventType_MouseMove
              If \Canvas\Mouse\Buttons & #PB_Canvas_LeftButton
                Result = Caret(*This)
              EndIf
              
          EndSelect
          
        EndIf
      EndWith
    EndIf
    
    ProcedureReturn Result
  EndProcedure
  
  Procedure CallBack()
    Protected *This.Gadget = GetGadgetData(EventGadget())
    
    With *This
      \Canvas\Mouse\X = GetGadgetAttribute(\Canvas\Gadget, #PB_Canvas_MouseX)
      \Canvas\Mouse\Y = GetGadgetAttribute(\Canvas\Gadget, #PB_Canvas_MouseY)
      \Canvas\Mouse\Buttons = GetGadgetAttribute(\Canvas\Gadget, #PB_Canvas_Buttons)
      
      If EditableCallBack(*This, EventType()) : Draw(*This) : EndIf
    EndWith
  EndProcedure
  
  ;- PUBLIC
  Procedure.s GetText(Gadget.l)
    Protected ScrollPos, *This.Gadget = GetGadgetData(Gadget)
    
    With *This
      If \Text\Pass
        ProcedureReturn \Text\String.s[1]
      Else
        ProcedureReturn \Text\String
      EndIf
    EndWith
  EndProcedure
  
  Procedure SetFont(Gadget, FontID.i)
    Protected *This.Gadget = GetGadgetData(Gadget)
    
    With *This
      \FontID = FontID
      Draw(*This)
    EndWith
  EndProcedure
  
  Procedure Gadget(Gadget, X.l, Y.l, Width.l, Height.l, Text.s, Flag.l=0)
    Protected *This.Gadget=AllocateStructure(Gadget)
    Protected g = CanvasGadget(Gadget, X, Y, Width, Height, #PB_Canvas_Keyboard) : If Gadget=-1 : Gadget=g : EndIf
    
    If *This
      With *This
        \Canvas\Gadget = Gadget
        \Width = Width
        \Height = Height
        \Type = #PB_GadgetType_String
        \FontID = GetGadgetFont(#PB_Default)
        
        ; Inner coordinae
        \X[2]=\bSize
        \Y[2]=\bSize
        \Width[2] = \Width-\bSize*2
        \Height[2] = \Height-\bSize*2
        
        ; Frame coordinae
        \X[1]=\X[2]-\fSize
        \Y[1]=\Y[2]-\fSize
        \Width[1] = \Width[2]+\fSize*2
        \Height[1] = \Height[2]+\fSize*2
        
        \Color[1] = $C0C0C0
        \Color[2] = $F0F0F0
        \Color[0] = $FFFFFF
        
        \Text\String.s[1] = Text.s
        
        \Text\String.s = Text.s
        
        \Text\CaretPos[1] =- 1
        \Text\Len = Len(\Text\String.s)
        
        SetGadgetData(Gadget, *This)
        BindGadgetEvent(Gadget, @CallBack())
        Draw(*This)
      EndIf
    EndWith
    
    ProcedureReturn Gadget
  EndProcedure
EndModule


;- EXAMPLE


LoadFont(0, "Courier", 20)
Define Event, Text.s = "Vertical and Horizontal" + #CRLF$ + "Centered Text in" + #CRLF$ + "Multiline StringGadget"

If OpenWindow(0, 0, 0, 605, 235, "StringGadget Flags", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  StringGadget(0, 8,  10, 290, 20, "Normal StringGadget...  ggggggggggggg dddddddddddd wwwwwwwwwww aaaaaaaaaaaaaa")
  
  String::Gadget(10, 300+8,  10, 290, 20, "Normal StringGadget...  ggggggggggggg dddddddddddd wwwwwwwwwww aaaaaaaaaaaaaa")
  
  Repeat 
    Event = WaitWindowEvent()
    
    Select Event
      Case #PB_Event_LeftClick  
        SetActiveGadget(0)
      Case #PB_Event_RightClick 
        SetActiveGadget(10)
    EndSelect
  Until Event = #PB_Event_CloseWindow
EndIf
Fred
Administrator
Administrator
Posts: 16619
Joined: Fri May 17, 2002 4:39 pm
Location: France
Contact:

Re: [Done] Problems with redrawing text

Post by Fred »

Fixed. The DrawText(), TextWidth() and TextHeight() types has been converted to double as OS X actually use double for text positioning... Took me a while to realize what was the issue as the code was working great on Windows/Linux

Code: Select all

EnableExplicit

;-
DeclareModule String
  EnableExplicit
  
  #PB_2DDrawing_NativeText = 1 << 9
  
  ;- STRUCTURE
  Structure Coordinate
    y.d[3]
    x.d[3]
    Height.d[3]
    Width.d[3]
  EndStructure
  
  Structure Mouse
    X.l
    Y.l
    Buttons.l
  EndStructure
  
  Structure Canvas
    Mouse.Mouse
    Gadget.l
    Window.l
    
    Input.c
    Key.l[2]
    
  EndStructure
  
  Structure Text Extends Coordinate
    ;     Char.c
    Len.l
    String.s[2]
    Change.b
    
    Lower.b
    Upper.b
    Pass.b
    Editable.b
    Numeric.b
    Wrap.b
    MultiLine.b
    
    CaretPos.l[2] ; [0] = Pos ; [1] = PosFixed
    
    Mode.l
  EndStructure
  
  Structure Gadget Extends Coordinate
    FontID.i
    Canvas.Canvas
    
    Text.Text[4]
    Color.l[3]
    
    
    fSize.l
    bSize.l
    Hide.b[2]
    Disable.b[2]
   
    Type.l
    InnerCoordinate.Coordinate
    
    Repaint.l
    
    List Items.Gadget()
    List Columns.Gadget()
  EndStructure
  
  
  ;- DECLARE
  Declare.s GetText(Gadget.l)
  Declare Gadget(Gadget, X.l, Y.l, Width.l, Height.l, Text.s, Flag.l=0)
  
  Declare SetFont(Gadget, FontID.i)
EndDeclareModule

Module String
  
  ;- PROCEDURE
  
  Procedure Caret(*This.Gadget, Reset=0)
    Protected Position.l =- 1, i.l, CaretPos.l, CursorX.i, Distance.f, MinDistance.f = Infinity()
    
    With *This
      If StartDrawing(CanvasOutput(\Canvas\Gadget))
        If \FontID : DrawingFont(\FontID) : EndIf
        
        ; get caret position
        For i=0 To \Text\Len
          CursorX = \Text\x + TextWidth(Left(\Text\String.s, i))
          Distance = (\Canvas\Mouse\X-CursorX)*(\Canvas\Mouse\X-CursorX)
          
          If MinDistance > Distance : MinDistance = Distance : Position = i : EndIf
        Next
        
        \Text\CaretPos = Position
        If Reset
          \Text[2]\Len = 0
          \Text\CaretPos[1] = \Text\CaretPos
        EndIf
        
        ; Если выделяем с право на лево
        If \Text\CaretPos[1] > \Text\CaretPos
          CaretPos = \Text\CaretPos
          \Text[2]\Len = (\Text\CaretPos[1]-\Text\CaretPos)
        Else
          CaretPos = \Text\CaretPos[1]
          \Text[2]\Len = \Text\CaretPos-\Text\CaretPos[1]
        EndIf
        
        \Text[1]\String.s = Left(\Text\String.s, CaretPos)
        
        If \Text[2]\Len
          \Text[2]\String.s = Mid(\Text\String.s, 1 + CaretPos, \Text[2]\Len)
          \Text[3]\String.s = Right(\Text\String.s, \Text\Len-(CaretPos + \Text[2]\Len))
        Else
          \Text[2]\String.s = ""
        EndIf
        
        \Text[1]\Width = TextWidth(\Text[1]\String.s)
        \Text[2]\Width = TextWidth(\Text[2]\String.s)
        
        \Text[2]\X = \Text\X+\Text[1]\Width
        \Text[3]\X = \Text[2]\X+\Text[2]\Width
        
        StopDrawing()
      EndIf
    EndWith
    
    ProcedureReturn #True
  EndProcedure
  
  Procedure Draw(*This.Gadget)
    With *This
      If StartDrawing(CanvasOutput(\Canvas\Gadget))
        If \FontID : DrawingFont(\FontID) : EndIf
        Box(\X[1],\Y[1],\Width[1],\Height[1],\Color[0])
        
        \Text\Height = TextHeight("A")
        \Text[0]\Width = TextWidth(\Text\String.s)
        
        \Text\X = 3
        \Text\Y = 3
        
        If \Text\String.s
          If \Text[2]\Len
            
            If \Text[1]\String.s
              DrawingMode(#PB_2DDrawing_Transparent|#PB_2DDrawing_NativeText)
              DrawText(\Text\X, \Text\Y, \Text[1]\String.s, $0B0B0B)
            EndIf
            
            If \Text[2]\String.s
              DrawingMode(#PB_2DDrawing_Default|#PB_2DDrawing_NativeText)
              DrawText(\Text[2]\X, \Text\Y, \Text[2]\String.s, $FFFFFF, $D77800)
            EndIf
            
            If \Text[3]\String.s
              DrawingMode(#PB_2DDrawing_Transparent|#PB_2DDrawing_NativeText)
              DrawText(\Text[3]\X, \Text\Y, \Text[3]\String.s, $0B0B0B)
            EndIf
            
          Else
            DrawingMode(#PB_2DDrawing_Transparent|#PB_2DDrawing_NativeText)
            DrawText(\Text\X, \Text\Y, \Text\String.s, $0B0B0B)
          EndIf
        EndIf
        
        If \Text\CaretPos=\Text\CaretPos[1]
          DrawingMode(#PB_2DDrawing_XOr|#PB_2DDrawing_NativeText)
          Line(\Text\X + \Text[1]\Width, \Text\Y, 1, \Text\Height, $FFFFFF)
        EndIf
        
        StopDrawing()
      EndIf
    EndWith
  EndProcedure
  
  Procedure EditableCallBack(*This.Gadget, EventType.l)
    Protected Result
    
    If *This
      With *This
        If Not \Disable
          Select EventType
            Case #PB_EventType_MouseEnter
              SetGadgetAttribute(*This\Canvas\Gadget, #PB_Canvas_Cursor, #PB_Cursor_IBeam)
              
            Case #PB_EventType_LeftButtonDown
              Result = Caret(*This, 1)
              
            Case #PB_EventType_MouseMove
              If \Canvas\Mouse\Buttons & #PB_Canvas_LeftButton
                Result = Caret(*This)
              EndIf
              
          EndSelect
          
        EndIf
      EndWith
    EndIf
    
    ProcedureReturn Result
  EndProcedure
  
  Procedure CallBack()
    Protected *This.Gadget = GetGadgetData(EventGadget())
    
    With *This
      \Canvas\Mouse\X = GetGadgetAttribute(\Canvas\Gadget, #PB_Canvas_MouseX)
      \Canvas\Mouse\Y = GetGadgetAttribute(\Canvas\Gadget, #PB_Canvas_MouseY)
      \Canvas\Mouse\Buttons = GetGadgetAttribute(\Canvas\Gadget, #PB_Canvas_Buttons)
      
      If EditableCallBack(*This, EventType()) : Draw(*This) : EndIf
    EndWith
  EndProcedure
  
  ;- PUBLIC
  Procedure.s GetText(Gadget.l)
    Protected ScrollPos, *This.Gadget = GetGadgetData(Gadget)
    
    With *This
      If \Text\Pass
        ProcedureReturn \Text\String.s[1]
      Else
        ProcedureReturn \Text\String
      EndIf
    EndWith
  EndProcedure
  
  Procedure SetFont(Gadget, FontID.i)
    Protected *This.Gadget = GetGadgetData(Gadget)
    
    With *This
      \FontID = FontID
      Draw(*This)
    EndWith
  EndProcedure
  
  Procedure Gadget(Gadget, X.l, Y.l, Width.l, Height.l, Text.s, Flag.l=0)
    Protected *This.Gadget=AllocateStructure(Gadget)
    Protected g = CanvasGadget(Gadget, X, Y, Width, Height, #PB_Canvas_Keyboard) : If Gadget=-1 : Gadget=g : EndIf
    
    If *This
      With *This
        \Canvas\Gadget = Gadget
        \Width = Width
        \Height = Height
        \Type = #PB_GadgetType_String
        \FontID = GetGadgetFont(#PB_Default)
        
        ; Inner coordinae
        \X[2]=\bSize
        \Y[2]=\bSize
        \Width[2] = \Width-\bSize*2
        \Height[2] = \Height-\bSize*2
        
        ; Frame coordinae
        \X[1]=\X[2]-\fSize
        \Y[1]=\Y[2]-\fSize
        \Width[1] = \Width[2]+\fSize*2
        \Height[1] = \Height[2]+\fSize*2
        
        \Color[1] = $C0C0C0
        \Color[2] = $F0F0F0
        \Color[0] = $FFFFFF
        
        \Text\String.s[1] = Text.s
        
        \Text\String.s = Text.s
        
        \Text\CaretPos[1] =- 1
        \Text\Len = Len(\Text\String.s)
        
        SetGadgetData(Gadget, *This)
        BindGadgetEvent(Gadget, @CallBack())
        Draw(*This)
      EndIf
    EndWith
    
    ProcedureReturn Gadget
  EndProcedure
EndModule


;- EXAMPLE


LoadFont(0, "Courier", 20)
Define Event, Text.s = "Vertical and Horizontal" + #CRLF$ + "Centered Text in" + #CRLF$ + "Multiline StringGadget"

If OpenWindow(0, 0, 0, 605, 235, "StringGadget Flags", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  StringGadget(0, 8,  10, 290, 20, "Normal StringGadget...  ggggggggggggg dddddddddddd wwwwwwwwwww aaaaaaaaaaaaaa")
  
  String::Gadget(10, 300+8,  10, 290, 20, "Normal StringGadget...  ggggggggggggg dddddddddddd wwwwwwwwwww aaaaaaaaaaaaaa")
  ;String::SetFont(10, GetGadgetFont(#PB_Default))
  Repeat
    Event = WaitWindowEvent()
    
    Select Event
      Case #PB_Event_LeftClick
        SetActiveGadget(0)
      Case #PB_Event_RightClick
        SetActiveGadget(10)
    EndSelect
  Until Event = #PB_Event_CloseWindow
EndIf
User avatar
STARGÅTE
Addict
Addict
Posts: 2067
Joined: Thu Jan 10, 2008 1:30 pm
Location: Germany, Glienicke
Contact:

Re: [Done] Problems with redrawing text

Post by STARGÅTE »

Fred wrote: Sun Feb 18, 2024 9:49 am Fixed. The DrawText(), TextWidth() and TextHeight() types has been converted to double as OS X actually use double for text positioning..
It may be that this change was necessary, but shouldn't it be noted in the change logs of PB 6.10?
Have you also changed DrawRotatedText to DrawRotatedText(X.d, Y.d, ...) ?

This change has no effect on windows right?
Under windows, a change of the text position by 0.5 has no visual effect.
Also TextWidth gives always non-fractional double values.
PB 6.01 ― Win 10, 21H2 ― Ryzen 9 3900X, 32 GB ― NVIDIA GeForce RTX 3080 ― Vivaldi 6.0 ― www.unionbytes.de
Lizard - Script language for symbolic calculations and moreTypeface - Sprite-based font include/module
Fred
Administrator
Administrator
Posts: 16619
Joined: Fri May 17, 2002 4:39 pm
Location: France
Contact:

Re: [Done] Problems with redrawing text

Post by Fred »

I will mention it in the change, you're right. No it only has effect on OSX, on Windows it will be no change.
Sergey
User
User
Posts: 19
Joined: Wed Jan 12, 2022 2:41 pm

Re: [Done] Problems with redrawing text

Post by Sergey »

PureBasic 6.10 beta 8, Windows 10 x64
The selection of right string gadget text gives such an effect
Image
Post Reply