Changeset 418 for trunk/Components

Timestamp:

Feb 25, 2019, 8:34:42 PM (6 years ago)

Author:

ataylor

Message:

Experimental new logic to try and fix DBCS text wrapping.

Location:

trunk/Components

Files:

• CanvasFontManager.pas (modified) (6 diffs)
• RichTextDocumentUnit.pas (modified) (7 diffs)
• RichTextLayoutUnit.pas (modified) (19 diffs)
• RichTextView.PAS (modified) (6 diffs)

trunk/Components/CanvasFontManager.pas

@@ -50 +50 @@
     lMaxCharInc: LONG;
     lMaxDescender: LONG;
+    lEmInc: LONG;
 
     destructor Destroy; override;
@@ -103 +104 @@
     function AverageCharWidth: longint;
     function MaximumCharWidth: longint;
-
+    function CJKCharWidth: longint;         // ALT
+    function CJKTextWidth(  const Length: longint; const S: PChar ): longint;
     function IsFixed: boolean;
 
@@ -391 +393 @@
       Font.lAveCharWidth := pfm^[ T ].lAveCharWidth;
       Font.lMaxCharInc := pfm^[ T ].lMaxCharInc;
+      Font.lEmInc := pfm^[ T ].lEmInc;
 
       Font.ID := -1; // and always shall be so...
@@ -825 +828 @@
   Result.lAveCharWidth := FontInfo.lAveCharWidth;
   Result.lMaxCharInc := FontInfo.lMaxCharInc;
+  Result.lEmInc := FontInfo.lEmInc;
 
   // Set style flags
@@ -1060 +1064 @@
   FCurrentFont.lMaxCharInc := fm.lMaxCharInc;
   FCurrentFont.lMaxDescender := fm.lMaxDescender;
+  FCurrentFont.lEmInc := fm.lEmInc;
 end;
 
@@ -1105 +1110 @@
   Result := FCurrentFont.FixedWidth;
 end;
+
+// ALT begins
+//
+// A 'default' average width for DBCS characters; probably not very accurate.
+// Should only be used as a fallback in case querying the actual string width
+// is impossible/fails.
+//
+function TCanvasFontManager.CJKCharWidth: longint;
+begin
+  EnsureMetricsLoaded;
+  if FCurrentFont.lMaxCharInc < FCurrentFont.lEmInc then
+    Result := FCurrentFont.lMaxCharInc * FontWidthPrecisionFactor
+  else
+    Result := FCurrentFont.lEmInc * FontWidthPrecisionFactor;
+end;
+
+// Get the render width of a CJK (Chinese/Japanese/Korean) character string.
+//
+function TCanvasFontManager.CJKTextWidth(  const Length: longint; const S: PChar ): longint;
+var
+  aptl: Array[ 0..TXTBOX_COUNT-1 ] Of PointL;
+begin
+  EnsureMetricsLoaded;
+  GpiQueryTextBox( FCanvas.Handle, Length, S^, TXTBOX_COUNT, aptl[0] );
+  // The pad of 2.1 per character was chosen through experimentation, since the
+  // actual returned value always seems too narrow. I have no idea why. (ALT)
+  Result := ( 2.1 + aptl[ TXTBOX_BOTTOMRIGHT ].x) * FontWidthPrecisionFactor;
+end;
+//
+// ALT ends
 
 procedure TCanvasFontManager.DrawString( Var Point: TPoint;

trunk/Components/RichTextDocumentUnit.pas

@@ -36 +36 @@
   end;
 
-  TTextElementType = ( teText, // a character
+  TTextElementType = ( teText,              // a character
                        teWordBreak,
-                       teLineBreak, // end of para
+                       teLineBreak,         // end of para
                        teTextEnd,
                        teImage,
-                       teStyle );
+                       teStyle,
+                       teWrapChar,          // A non-whitespace wrappable character (ALT)
+                       teLeadByte,          // DBCS lead byte (ALT)
+                       teSecondByte );      // DBCS secondary byte (ALT)
 
   TTextElement = record
@@ -113 +116 @@
                                 Buffer: PChar;
                                 BufferLength: longint ): longint;
+
+
+// ALT begins
+//
+
+// Check for special text element types and adjust value accordingly.
+procedure CheckSpecialElementType( const Character:   Char;
+                                   var   ElementType: TTextElementType;
+                                   var   InsideDBC:   Boolean;
+                                   const Codepage:    LongInt );
+
+// Returns true if the given byte value is a legally-wrappable single-byte
+// character under the given Asian codepage.
+function IsAsianWrapChar( const CharByte: Byte;
+                          const Codepage: LongInt ): boolean;
+
+// Returns true if the given byte value is the leading byte of a multi-byte
+// character under the given Asian codepage.
+function IsDBCSLeadByte( const CharByte: Byte;
+                         const Codepage: LongInt ): boolean;
+
+// Returns true if the given byte value is valid as a possible second byte of
+// a multi-byte character (this does not guarantee that it IS one, just that
+// it COULD be).
+function IsDBCSSecondByte( const CharByte: Byte;
+                           const Codepage: LongInt ): boolean;
+
+// Adjusts the character position to the beginning of any multi-byte character.
+procedure MoveToCharacterBoundary(     TextPointer: PChar;
+                                   var Index:       LongInt;
+                                   var Offset:      LongInt;
+                                       RowStart:    LongInt;
+                                       Codepage:    LongInt );
+//
+// ALT ends
+
 
 Implementation
@@ -349 +388 @@
 var
   TheChar: Char;
-  NextChar: char;
+  NextChar: Char;
 begin
   with Result do
@@ -356 +395 @@
     Character := TheChar;
     inc( TextPointer );
+
 
     case TheChar of
@@ -404 +444 @@
       end;
 
+//    '-': // ---- Hyphen (ALT)
+//      ElementType := teWrapChar;
+
       else
         ElementType := teText;
     end;
+
   end; // with
+
   NextElement := TextPointer;
 end;
@@ -485 +530 @@
         end;
       end
+
+//    '-': // ---- Hyphen (ALT)
+//      ElementType := teWrapChar;
+
       else
         ElementType := teText;
@@ -802 +851 @@
 end;
 
+// ALT begins
+//
+// Check for special text element types that depend on context.
+//
+procedure CheckSpecialElementType( const Character:   Char;
+                                   var   ElementType: TTextElementType;
+                                   var   InsideDBC:   Boolean;
+                                   const Codepage:    LongInt );
+var
+  CharByte: Byte;
+begin
+  if Codepage in [ 874, 932, 936, 942, 943, 949, 950, 1381, 1386 ] then
+  begin
+    CharByte := ord( Character );
+    if InsideDBC then
+    begin
+        InsideDBC := false;
+        // sanity check for corrupt text sequence (definitely not foolproof)
+        if IsDBCSSecondByte( CharByte, Codepage ) then
+          ElementType := teSecondByte
+        else
+          ElementType := teText;
+    end
+    else
+    begin
+      if IsAsianWrapChar( CharByte, Codepage ) then
+      begin
+        ElementType := teWrapChar;
+        InsideDBC := false;
+      end
+      else if IsDBCSLeadByte( CharByte, Codepage ) then
+      begin
+        ElementType := teLeadByte;
+        InsideDBC := true;
+      end;
+    end;
+  end;
+end;
+
+// Check if this (single-byte) character is a legal wrap point under certain
+// Asian codepages. This is really only used for Thai and for Japanese
+// half-width katakana; other DBCS languages use double-byte characters for all
+// their native glyphs.
+//
+function IsAsianWrapChar( const CharByte: Byte;
+                          const Codepage: LongInt ): boolean;
+begin
+    Result := false;
+
+    if ( CharByte < $80) then
+      exit;
+
+    case Codepage of
+      932, 942, 943:        // Japanese
+        if CharByte in [ $A2, $A6, $B1..$DD ] then
+          Result := true;
+      874:                  // Thai
+        Result := true;
+    end;
+end;
+
+// Check if this is the lead byte of a double-byte character. This is essential
+// to know in certain cases:
+//  - Nothing must ever be inserted between such a byte and the next byte
+//    (e.g. line break, tag, etc).
+//  - Cursor position must never be set between such a byte and the next byte.
+//  - Selection state must never change between such a byte and the next byte.
+//
+function IsDBCSLeadByte( const CharByte: Byte;
+                         const Codepage: LongInt ): boolean;
+begin
+    Result := false;
+
+    case Codepage of
+      932, 942, 943:        // Japanese
+        if CharByte in [ $81..$9F, $E0..$FC ] then
+          Result := true;
+      949:                  // Korean KSC
+        if CharByte in [ $85..$FE ] then
+          Result := true;
+      1381:                 // Chinese GB2312
+        if CharByte in [ $8C..$FE ] then
+          Result := true;
+      936, 950, 1386:       // Chinese BIG-5 or GBK
+        if CharByte in [ $81..$FE ] then
+          Result := true;
+    end;
+end;
+
+// Check to see if this byte is a valid second byte in a double-byte character.
+// (This doesn't guarantee that it IS such a byte, only that it COULD be. The
+// caller is assumed to know whether we're in a double byte character or not.)
+//
+function IsDBCSSecondByte( const CharByte: Byte;
+                           const Codepage: LongInt ): boolean;
+begin
+    Result := false;
+
+    case Codepage of
+      932, 936, 942, 943, 949, 950, 1386:
+        if CharByte >= $40 then
+          Result := true;
+      1381:
+        if CharByte >= $A1 then
+          Result := true;
+    end;
+end;
+
+// Given a string position, check to see if it's in the middle of a double-byte
+// character; if so, move back by one position so that we're sitting immediately
+// in front of the double-byte character instead.
+//
+procedure MoveToCharacterBoundary(     TextPointer: PChar;
+                                   var Index:       LongInt;
+                                   var Offset:      LongInt;
+                                       RowStart:    LongInt;
+                                       Codepage:    LongInt  );
+var
+  P:         PChar;
+  NextP:     PChar;
+  Element:   TTextElement;
+  InsideDBC: boolean;
+begin
+  if ( Offset > 0 ) and
+     ( Codepage in [ 932, 936, 942, 943, 949, 950, 1381, 1386 ]) then
+  begin
+    P := TextPointer + RowStart;
+    InsideDBC := false;
+
+    // Because parsing of byte types is state based, we must verify every
+    // byte's type from the beginning of the line until we reach the target.
+    while RowStart < Index do
+    begin
+      Element := ExtractNextTextElement( P, NextP );
+      CheckSpecialElementType( Element.Character, Element.ElementType, InsideDBC, Codepage );
+      P := NextP;
+      inc( RowStart );
+    end;
+{
+    // We've reached the target position, and the current parsing state should
+    // be correctly set. So now we can safely determine the target byte's type.
+    Element := ExtractNextTextElement( P, NextP );
+    CheckSpecialElementType( Element.Character, Element.ElementType, InsideDBC, Codepage );
+}
+    if InsideDBC then
+    begin
+      // If this the first byte of a double byte character, move back by one.
+      dec( Index );
+      dec( Offset );
+    end;
+  end;
+
+end;
+//
+// ALT ends
+
 Initialization
 End.

trunk/Components/RichTextLayoutUnit.pas

@@ -73 +73 @@
 
     FRichTextSettings: TRichTextSettings;
+
+    Codepage:    ULong;       // ALT
 
     // Drawing functions
@@ -169 +171 @@
 var
   DefaultFontSpec: TFontSpec;
+  CpSize:          ULong;       // ALT
 Begin
   Inherited Create;
@@ -199 +202 @@
                        DefaultFontSpec );
   FFontManager.DefaultFontSpec := DefaultFontSpec;
+
+  DosQueryCp( sizeof( Codepage ), Codepage, CpSize );       // ALT
 
   Layout;
@@ -284 +289 @@
   NextP: PChar;
   NextP2: PChar;
+  NextP3: PChar;
 
   WordStart: PChar;
@@ -307 +313 @@
 
   DoWrap: boolean;
+
+  InsideDBC:   Boolean;     // ALT
 
   // Nested procedure
@@ -383 +391 @@
   WordStarted := false;
   DisplayedCharsSinceFontChange := false;
+  InsideDBC := false;
 
   repeat
     CurrentElement := ExtractNextTextElement( P, NextP );
     assert( NextP > P );
+    CheckSpecialElementType( CurrentElement.Character, CurrentElement.ElementType, InsideDBC, Codepage );   // ALT
 
     OnBreak := false;
@@ -395 +405 @@
         CurrentCharWidth := FFontManager.CharWidth( ' ' );
         OnBreak := true;
+        InsideDBC := false;
       end;
 
@@ -404 +415 @@
         WordStart := NextP;
         WordX := 0;
+        InsideDBC := false;
 
         P := NextP;
@@ -413 +425 @@
       begin
         DoLine( P, NextP, WordStartX + WordX );
+        InsideDBC := false;
 
         // end of text, done
@@ -446 +459 @@
         CurrentCharWidth := FFontManager.CharWidth( CurrentElement.Character );
         WordStarted := true;
-      end;
+        InsideDBC := false;
+      end;
+
+      // ALT begins
+      //
+      teWrapChar:
+      begin
+        // This is a legal break character, but not a space (so we still display it).
+        CurrentCharWidth := FFontManager.CharWidth( CurrentElement.Character );
+
+        // Treat as the start of a new word (for the sake of wrapping).
+        WordStarted := true;
+        inc( WordStartX, WordX + CurrentCharWidth );
+        WordX := 0;
+        WordStart := NextP;
+      end;
+
+      teLeadByte:
+      begin
+        // Leading byte of a double-byte character.
+        // Get the complete character width for our wrapping calculations.
+        if ( NextP > P ) then
+          CurrentCharWidth := FFontManager.CJKTextWidth( 2, P )
+        else
+          CurrentCharWidth := FFontManager.CJKCharWidth;
+        WordStarted := true;
+      end;
+
+      teSecondByte:
+      begin
+        // Secondary byte of a double-byte character.
+        // The full character width was already assigned to the leading byte.
+        CurrentCharWidth := 0;
+
+        // We treat each double-byte character as a complete word for the sake
+        // of the wrapping algorithm.
+        inc( LineWordsCompleted );
+        WordStarted := true;
+        inc( WordStartX, WordX + CurrentCharWidth );
+        WordX := 0;
+        WordStart := NextP;
+      end;
+      //
+      // ALT ends
 
       teStyle:
       begin
+        InsideDBC := false;
         case CurrentElement.Tag.TagType of
           ttBeginLink:
@@ -582 +639 @@
        + WordX
        + CurrentCharWidth
-       >= WrapX then
+       >= WrapX  then
     begin
       // reached right hand side before finding end of word
@@ -588 +645 @@
         // always wrap after at least one word displayed
         DoWrap := true
-      else if not FRichTextSettings.AtLeastOneWordBeforeWrap then
+
+      else if ( CurrentElement.ElementType = teWrapChar ) or
+              ( CurrentElement.ElementType = teLeadByte ) then
+        DoWrap := true                                                  // ALT
+
+      else if ( not FRichTextSettings.AtLeastOneWordBeforeWrap ) then
         // only wrap during the first word, if the "at least 1 word" flag is not set.
         DoWrap := true;
@@ -606 +668 @@
 
           NextElement := ExtractNextTextElement( NextP, NextP2 );
+
+          // ALT
+          if InsideDBC then
+          begin
+            // we're in the middle of a double-byte character, so keep the next byte too
+            InsideDBC := false;
+            NextP := NextP2;
+            NextElement := ExtractNextTextElement( NextP2, NextP3 );
+            NextP2 := NextP3;
+          end;
+          // /ALT
+
           if NextElement.ElementType <> teLineBreak then
             // there is still more on the line...
@@ -645 +719 @@
         CurrentLine.Wrapped := true;
 
-        // take the width of the last space of the
-        // previous word off the line width
-        DoLine( WordStart, // current line ends at start of this word
-                WordStart, // next line starts at start of this word
-                WordStartX - FFontManager.CharWidth( ' ' ) );
-        if CurrentElement.ElementType = teImage then
-          if Bitmap <> nil then
-            if BitmapHeight > CurrentLine.Height then
-              CurrentLine.Height := BitmapHeight;
+
+        if ( CurrentElement.ElementType = teLeadByte ) or
+           ( CurrentElement.ElementType = teWrapChar ) then     // ALT
+        begin
+          // draw up to but not including this 'word' (ALT)
+          DoLine( WordStart,
+                  WordStart,
+                  WordStartX );
+        end
+        else
+        begin                                                   // ALT
+          // take the width of the last space of the
+          // previous word off the line width
+          DoLine( WordStart, // current line ends at start of this word
+                  WordStart, // next line starts at start of this word
+                  WordStartX - FFontManager.CharWidth( ' ' ) );
+          if CurrentElement.ElementType = teImage then
+            if Bitmap <> nil then
+              if BitmapHeight > CurrentLine.Height then
+                CurrentLine.Height := BitmapHeight;
+        end;                                                    // ALT
 
         // do NOT reset WordX to zero; as we are continuing
@@ -727 +813 @@
   NewMarginX: longint;
   StartedDrawing: boolean;
+  InsideDBC: boolean;       // ALT
 begin
   Line := FLines[ LineIndex ];
@@ -736 +823 @@
 
   StartedDrawing := false;
+  InsideDBC := false;       // ALT
 
   Link := '';
@@ -746 +834 @@
   begin
     Element := ExtractNextTextElement( P, NextP );
+    CheckSpecialElementType( Element.Character, Element.ElementType, InsideDBC, Codepage );   // ALT
 
     case Element.ElementType of
       teWordBreak,
       teText,
+      teLeadByte,           // ALT
+      teWrapChar,           // ALT
       teImage:
       begin
@@ -772 +863 @@
 
         // Now find out how wide the thing is
-        inc( X, GetElementWidth( Element ) );
+        if (( Element.ElementType = teLeadByte ) And ( EndP > P )) then    // ALT
+          inc( X, FFontManager.CJKTextWidth( 2, P ))
+        else
+          inc( X, GetElementWidth( Element ) );
 
         if X div FontWidthPrecisionFactor
@@ -1023 +1117 @@
     end;
 
-    teText, teWordBreak:
+    teText, teWordBreak, teWrapChar:        // ALT
       Result := FFontManager.CharWidth( Element.Character );
+
+    teLeadByte:                             // ALT - should not be reached
+      Result := FFontManager.CJKCharWidth;
+
+    teSecondByte:                           // ALT
+      Result := 0;
 
     else

trunk/Components/RichTextView.PAS

@@ -459 +459 @@
 
 Procedure TRichTextView.SetSelectionStartInternal( SelectionStart: longint );
+var
+  Offset: longint;     // ALT
 begin
   if SelectionStart = FSelectionStart then
@@ -468 +470 @@
       ClearSelection;
 
+  // ALT
+  Offset := FCursorOffset;
+  MovetoCharacterBoundary( FText, SelectionStart, FCursorOffset, Offset, FLayout.Codepage );
+
   FSelectionStart := SelectionStart;
   if FSelectionEnd = -1 then
@@ -479 +485 @@
   StartRedrawLine: longint;
   EndRedrawLine: longint;
+  Offset: longint;         // ALT
   OldClip: TRect;
 begin
   if SelectionEnd = FSelectionEnd then
     exit;
+
+  // ALT
+  Offset := FCursorOffset;
+  MovetoCharacterBoundary( FText, SelectionEnd, FCursorOffset, Offset, FLayout.Codepage );
 
   if FSelectionStart = -1 then
@@ -797 +808 @@
     // we haven't yet done a layout
     Layout;
+
 
 end;
@@ -2018 +2030 @@
                                            PreserveSelection: boolean );
 var
+//  P: PChar;                 // ALT
+//  NextP: PChar;             // ALT
+//  Element: TTextElement;    // ALT
+//  InsideDBC: boolean;       // ALT
+  RowStart: longint;        // ALT
   Index: longint;
 begin
   RemoveCursor;
+
+  Index := FLayout.GetCharIndex( FLayout.FLines[ Row ].Text ) + Offset;
+
+// ALT
+{
+  if ( Offset > 0 ) and
+     ( FLayout.Codepage in [ 932, 936, 942, 943, 949, 950, 1381, 1386 ]) then
+  begin
+    RowStart := FLayout.GetCharIndex( FLayout.FLines[ Row ].Text );
+    P := FText + RowStart;
+    InsideDBC := false;
+    while RowStart < Index do
+    begin
+      Element := ExtractNextTextElement( P, NextP );
+      CheckSpecialElementType( Element.Character, Element.ElementType, InsideDBC, FLayout.Codepage );
+      P := NextP;
+      inc( RowStart );
+    end;
+    Element := ExtractNextTextElement( P, NextP );
+    CheckSpecialElementType( Element.Character, Element.ElementType, InsideDBC, FLayout.Codepage );
+    if InsideDBC then
+    begin
+      dec( Index );
+      dec( Offset );
+    end;
+  end;
+}
+
+  RowStart := FLayout.GetCharIndex( FLayout.FLines[ Row ].Text );
+  MoveToCharacterBoundary( FText, Index, Offset, RowStart, FLayout.Codepage );  // ALT
+
   FCursorOffset := Offset;
   FCursorRow := Row;
-  Index := FLayout.GetCharIndex( FLayout.FLines[ Row ].Text ) + Offset;
+
   if PreserveSelection then
   begin
@@ -2047 +2095 @@
 
   Element := ExtractNextTextElement( P, NextP );
+
   P := NextP;
   while Element.ElementType = teStyle do