diff options
| author | Kenichi Handa | 1999-12-15 00:34:01 +0000 |
|---|---|---|
| committer | Kenichi Handa | 1999-12-15 00:34:01 +0000 |
| commit | d0da93b3a1c4a3751fefcb085e88c1ee70128a79 (patch) | |
| tree | df73b3f39022872b9cdd15d7f17ae0adb540d6b9 | |
| parent | 653b6bad9869ae61b054229921d2d4392f5b77cd (diff) | |
| download | emacs-d0da93b3a1c4a3751fefcb085e88c1ee70128a79.tar.gz emacs-d0da93b3a1c4a3751fefcb085e88c1ee70128a79.zip | |
Define encode-composition-rule and find-composition
for Emacs 20.4 and the earlier versions.
(ps-mule-init-external-library): Just require a feature for
external libraries.
(ps-mule-prologue): Postscript code modified for new composition.
(ps-mule-find-wrappoint): New arg COMPOSITION.
(ps-mule-plot-string): Delete code for composite characaters.
(ps-mule-plot-composition): New funcion.
(ps-mule-prepare-font-for-components): New function.
(ps-mule-plot-components): New function.
(ps-mule-composition-prologue-generated): Renamed from
ps-mule-cmpchar-prologue-generated.
(ps-mule-composition-prologue): New named from
ps-mule-cmpchar-prologue. Modified for new composition.
(ps-mule-plot-rule-cmpchar, ps-mule-plot-cmpchar,
ps-mule-prepare-cmpchar-font): Deleted.
(ps-mule-string-encoding): New arg NO-SETFONT.
(ps-mule-bitmap-prologue): In Postscript code of BuildGlyphCommon,
check Composing, not Cmpchar
(ps-mule-initialize): Set ps-mule-composition-prologue-generated
to nil.
(ps-mule-begin-job): Check existence of new composition.
| -rw-r--r-- | lisp/ps-mule.el | 478 |
1 files changed, 306 insertions, 172 deletions
diff --git a/lisp/ps-mule.el b/lisp/ps-mule.el index 13eeb9909be..014913fc59c 100644 --- a/lisp/ps-mule.el +++ b/lisp/ps-mule.el | |||
| @@ -163,7 +163,24 @@ | |||
| 163 | (defun ps-mule-string-char (string idx) | 163 | (defun ps-mule-string-char (string idx) |
| 164 | (string-to-char (substring string idx))) | 164 | (string-to-char (substring string idx))) |
| 165 | (defun ps-mule-next-index (string i) | 165 | (defun ps-mule-next-index (string i) |
| 166 | (+ i (charset-bytes (char-charset (string-to-char string))))))) | 166 | (+ i (charset-bytes (char-charset (string-to-char string))))) |
| 167 | )) | ||
| 168 | |||
| 169 | ;; For Emacs 20.4 and the earlier version. | ||
| 170 | (eval-and-compile | ||
| 171 | (when (and (boundp 'mule-version) | ||
| 172 | (string< mule-version "5.0")) | ||
| 173 | (defun encode-composition-rule (rule) | ||
| 174 | (if (= (car rule) 4) (setcar rule 10)) | ||
| 175 | (if (= (cdr rule) 4) (setcdr rule 10)) | ||
| 176 | (+ (* (car rule) 12) (cdr rule))) | ||
| 177 | (defun find-composition (pos &rest ignore) | ||
| 178 | (let ((ch (char-after pos))) | ||
| 179 | (if (eq (char-charset ch) 'composition) | ||
| 180 | (let ((components (decompose-composite-char ch 'vector t))) | ||
| 181 | (list pos (ps-mule-next-point pos) components | ||
| 182 | (integerp (aref components 1)) nil | ||
| 183 | (char-width ch)))))))) | ||
| 167 | 184 | ||
| 168 | (defvar ps-mule-font-info-database | 185 | (defvar ps-mule-font-info-database |
| 169 | nil | 186 | nil |
| @@ -496,7 +513,7 @@ See the documentation of `ps-mule-get-font-spec' for FONT-SPEC's meaning." | |||
| 496 | (let ((func (nth 3 slot))) | 513 | (let ((func (nth 3 slot))) |
| 497 | (if func | 514 | (if func |
| 498 | (progn | 515 | (progn |
| 499 | (or (featurep (nth 1 slot)) (require (nth 1 slot))) | 516 | (require (nth 1 slot)) |
| 500 | (ps-output-prologue (funcall func)))) | 517 | (ps-output-prologue (funcall func)))) |
| 501 | (setcar (nthcdr 2 slot) t))))) | 518 | (setcar (nthcdr 2 slot) t))))) |
| 502 | 519 | ||
| @@ -645,10 +662,17 @@ STRING should contain only ASCII characters." | |||
| 645 | end | 662 | end |
| 646 | } def | 663 | } def |
| 647 | 664 | ||
| 648 | %% Set the specified non-ASCII font to use. It doesn't install | 665 | /CurrentFont false def |
| 649 | %% Ascent, etc. | 666 | |
| 667 | %% Set the specified font to use. | ||
| 668 | %% For non-ASCII font, don't install Ascent, etc. | ||
| 650 | /FM { % fontname |- -- | 669 | /FM { % fontname |- -- |
| 651 | findfont setfont | 670 | /font exch def |
| 671 | font /f0 eq font /f1 eq font /f2 eq font /f3 eq or or or { | ||
| 672 | font F | ||
| 673 | } { | ||
| 674 | font findfont setfont | ||
| 675 | } ifelse | ||
| 652 | } bind def | 676 | } bind def |
| 653 | 677 | ||
| 654 | %% Show vacant box for characters which don't have appropriate font. | 678 | %% Show vacant box for characters which don't have appropriate font. |
| @@ -665,10 +689,10 @@ STRING should contain only ASCII characters." | |||
| 665 | } for | 689 | } for |
| 666 | } bind def | 690 | } bind def |
| 667 | 691 | ||
| 668 | %% Flag to tell if we are now handling a composite character. This is | 692 | %% Flag to tell if we are now handling a composition. This is |
| 669 | %% defined here because both composite character handler and bitmap font | 693 | %% defined here because both composition handler and bitmap font |
| 670 | %% handler require it. | 694 | %% handler require it. |
| 671 | /Cmpchar false def | 695 | /Composing false def |
| 672 | 696 | ||
| 673 | %%%% End of Mule Section | 697 | %%%% End of Mule Section |
| 674 | 698 | ||
| @@ -682,11 +706,18 @@ STRING should contain only ASCII characters." | |||
| 682 | (ps-output-prologue ps-mule-prologue) | 706 | (ps-output-prologue ps-mule-prologue) |
| 683 | (setq ps-mule-prologue-generated t))) | 707 | (setq ps-mule-prologue-generated t))) |
| 684 | 708 | ||
| 685 | (defun ps-mule-find-wrappoint (from to char-width) | 709 | (defun ps-mule-find-wrappoint (from to char-width &optional composition) |
| 686 | "Find the longest sequence which is printable in the current line. | 710 | "Find the longest sequence which is printable in the current line. |
| 687 | 711 | ||
| 688 | The search starts at FROM and goes until TO. It is assumed that all characters | 712 | The search starts at FROM and goes until TO. |
| 689 | between FROM and TO belong to a charset in `ps-mule-current-charset'. | 713 | |
| 714 | Optional 4th arg COMPOSITION, if non-nil, is information of | ||
| 715 | composition starting at FROM. | ||
| 716 | |||
| 717 | If COMPOSTION is nil, it is assumed that all characters between FROM | ||
| 718 | and TO belong to a charset in `ps-mule-current-charset'. Otherwise, | ||
| 719 | it is assumed that all characters between FROM and TO belong to the | ||
| 720 | same composition. | ||
| 690 | 721 | ||
| 691 | CHAR-WIDTH is the average width of ASCII characters in the current font. | 722 | CHAR-WIDTH is the average width of ASCII characters in the current font. |
| 692 | 723 | ||
| @@ -696,12 +727,17 @@ Returns the value: | |||
| 696 | 727 | ||
| 697 | Where ENDPOS is the end position of the sequence and RUN-WIDTH is the width of | 728 | Where ENDPOS is the end position of the sequence and RUN-WIDTH is the width of |
| 698 | the sequence." | 729 | the sequence." |
| 699 | (if (eq ps-mule-current-charset 'composition) | 730 | (if (or composition (eq ps-mule-current-charset 'composition)) |
| 700 | ;; We must draw one char by one. | 731 | ;; We must draw one char by one. |
| 701 | (let ((run-width (* (char-width (char-after from)) char-width))) | 732 | (let ((run-width (if composition |
| 733 | (nth 5 composition) | ||
| 734 | (* (char-width (char-after from)) char-width)))) | ||
| 702 | (if (> run-width ps-width-remaining) | 735 | (if (> run-width ps-width-remaining) |
| 703 | (cons from ps-width-remaining) | 736 | (cons from ps-width-remaining) |
| 704 | (cons (ps-mule-next-point from) run-width))) | 737 | (cons (if composition |
| 738 | (nth 1 composition) | ||
| 739 | (ps-mule-next-point from)) | ||
| 740 | run-width))) | ||
| 705 | ;; We assume that all characters in this range have the same width. | 741 | ;; We assume that all characters in this range have the same width. |
| 706 | (setq char-width (* char-width (charset-width ps-mule-current-charset))) | 742 | (setq char-width (* char-width (charset-width ps-mule-current-charset))) |
| 707 | (let ((run-width (* (chars-in-region from to) char-width))) | 743 | (let ((run-width (* (chars-in-region from to) char-width))) |
| @@ -751,13 +787,9 @@ the sequence." | |||
| 751 | (ps-output-string (ps-mule-string-ascii string)) | 787 | (ps-output-string (ps-mule-string-ascii string)) |
| 752 | (ps-output " S\n")) | 788 | (ps-output " S\n")) |
| 753 | 789 | ||
| 790 | ;; This case is obsolete for Emacs 21. | ||
| 754 | ((eq ps-mule-current-charset 'composition) | 791 | ((eq ps-mule-current-charset 'composition) |
| 755 | (let* ((ch (char-after from)) | 792 | (ps-mule-plot-composition from (ps-mule-next-point from) bg-color)) |
| 756 | (width (char-width ch)) | ||
| 757 | (ch-list (decompose-composite-char ch 'list t))) | ||
| 758 | (if (consp (nth 1 ch-list)) | ||
| 759 | (ps-mule-plot-rule-cmpchar ch-list width font-type) | ||
| 760 | (ps-mule-plot-cmpchar ch-list width t font-type)))) | ||
| 761 | 793 | ||
| 762 | (t | 794 | (t |
| 763 | ;; No way to print this charset. Just show a vacant box of an | 795 | ;; No way to print this charset. Just show a vacant box of an |
| @@ -769,15 +801,99 @@ the sequence." | |||
| 769 | (charset-width ps-mule-current-charset)))))) | 801 | (charset-width ps-mule-current-charset)))))) |
| 770 | wrappoint)) | 802 | wrappoint)) |
| 771 | 803 | ||
| 804 | ;;;###autoload | ||
| 805 | (defun ps-mule-plot-composition (from to &optional bg-color) | ||
| 806 | "Generate PostScript code for ploting composition in the region FROM and TO. | ||
| 807 | |||
| 808 | It is assumed that all characters in this region belong to the same | ||
| 809 | composition. | ||
| 810 | |||
| 811 | Optional argument BG-COLOR specifies background color. | ||
| 812 | |||
| 813 | Returns the value: | ||
| 814 | |||
| 815 | (ENDPOS . RUN-WIDTH) | ||
| 816 | |||
| 817 | Where ENDPOS is the end position of the sequence and RUN-WIDTH is the width of | ||
| 818 | the sequence." | ||
| 819 | (let* ((composition (find-composition from nil nil t)) | ||
| 820 | (wrappoint (ps-mule-find-wrappoint | ||
| 821 | from to (ps-avg-char-width 'ps-font-for-text) | ||
| 822 | composition)) | ||
| 823 | (to (car wrappoint)) | ||
| 824 | (font-type (car (nth ps-current-font | ||
| 825 | (ps-font-alist 'ps-font-for-text))))) | ||
| 826 | (if (< from to) | ||
| 827 | ;; We can print this composition in the current line. | ||
| 828 | (let ((components (nth 2 composition))) | ||
| 829 | (ps-mule-plot-components | ||
| 830 | (ps-mule-prepare-font-for-components components font-type) | ||
| 831 | (if (nth 3 composition) "RLC" "RBC")))) | ||
| 832 | wrappoint)) | ||
| 833 | |||
| 834 | ;; Prepare font of FONT-TYPE for printing COMPONENTS. By side effect, | ||
| 835 | ;; change character elements in COMPONENTS to the form: | ||
| 836 | ;; ENCODED-STRING or (FONTNAME . ENCODED-STRING) | ||
| 837 | ;; and change rule elements to the encoded value (integer). | ||
| 838 | ;; The latter form is used if we much change font for the character. | ||
| 839 | |||
| 840 | (defun ps-mule-prepare-font-for-components (components font-type) | ||
| 841 | (let ((len (length components)) | ||
| 842 | (i 0) | ||
| 843 | elt) | ||
| 844 | (while (< i len) | ||
| 845 | (setq elt (aref components i)) | ||
| 846 | (if (consp elt) | ||
| 847 | ;; ELT is a composition rule. | ||
| 848 | (setq elt (encode-composition-rule elt)) | ||
| 849 | ;; ELT is a glyph character. | ||
| 850 | (let* ((charset (char-charset elt)) | ||
| 851 | (font (or (eq charset ps-mule-current-charset) | ||
| 852 | (if (eq charset 'ascii) | ||
| 853 | (format "/f%d" ps-current-font) | ||
| 854 | (format "/f%02x-%d" | ||
| 855 | (charset-id charset) ps-current-font)))) | ||
| 856 | str) | ||
| 857 | (setq ps-mule-current-charset charset | ||
| 858 | str (ps-mule-string-encoding | ||
| 859 | (ps-mule-get-font-spec charset font-type) | ||
| 860 | (char-to-string elt) | ||
| 861 | 'no-setfont)) | ||
| 862 | (if (stringp font) | ||
| 863 | (setq elt (cons font str) ps-last-font font) | ||
| 864 | (setq elt str)))) | ||
| 865 | (aset components i elt) | ||
| 866 | (setq i (1+ i)))) | ||
| 867 | components) | ||
| 868 | |||
| 869 | (defun ps-mule-plot-components (components tail) | ||
| 870 | (let ((elt (aref components 0)) | ||
| 871 | (len (length components)) | ||
| 872 | (i 1)) | ||
| 873 | (ps-output "[ ") | ||
| 874 | (if (stringp elt) | ||
| 875 | (ps-output-string elt) | ||
| 876 | (ps-output (car elt) " ") | ||
| 877 | (ps-output-string (cdr elt))) | ||
| 878 | (while (< i len) | ||
| 879 | (setq elt (aref components i) i (1+ i)) | ||
| 880 | (ps-output " ") | ||
| 881 | (cond ((stringp elt) | ||
| 882 | (ps-output-string elt)) | ||
| 883 | ((consp elt) | ||
| 884 | (ps-output (car elt) " ") | ||
| 885 | (ps-output-string (cdr elt))) | ||
| 886 | (t ; i.e. (integerp elt) | ||
| 887 | (ps-output (format "%d" elt))))) | ||
| 888 | (ps-output " ] " tail "\n"))) | ||
| 889 | |||
| 772 | ;; Composite font support | 890 | ;; Composite font support |
| 773 | 891 | ||
| 774 | (defvar ps-mule-cmpchar-prologue-generated nil) | 892 | (defvar ps-mule-composition-prologue-generated nil) |
| 775 | 893 | ||
| 776 | (defconst ps-mule-cmpchar-prologue | 894 | (defconst ps-mule-composition-prologue |
| 777 | "%%%% Composite character handler | 895 | "%%%% Character compositition handler |
| 778 | /CmpcharWidth 0 def | 896 | /RelativeCompositionSkip 0.4 def |
| 779 | /CmpcharRelativeCompose 0 def | ||
| 780 | /CmpcharRelativeSkip 0.4 def | ||
| 781 | 897 | ||
| 782 | %% Get a bounding box (relative to currentpoint) of STR. | 898 | %% Get a bounding box (relative to currentpoint) of STR. |
| 783 | /GetPathBox { % str |- -- | 899 | /GetPathBox { % str |- -- |
| @@ -793,159 +909,169 @@ the sequence." | |||
| 793 | grestore | 909 | grestore |
| 794 | } bind def | 910 | } bind def |
| 795 | 911 | ||
| 796 | %% Beginning of composite char. | 912 | %% Apply effects (underline, strikeout, overline, box) to the |
| 797 | /BC { % str xoff width |- -- | 913 | %% rectangle specified by TOP BOTTOM LEFT RIGHT. |
| 798 | /Cmpchar true def | 914 | /SpecialEffect { % -- |- -- |
| 799 | /CmpcharWidth exch def | 915 | currentpoint dup TOP add /yy exch def BOTTOM add /YY exch def |
| 800 | currentfont /RelativeCompose known { | 916 | dup LEFT add /xx exch def RIGHT add /XX exch def |
| 801 | /CmpcharRelativeCompose currentfont /RelativeCompose get def | 917 | %% Adjust positions for future shadowing. |
| 802 | } { | 918 | Effect 8 and 0 ne { |
| 803 | /CmpcharRelativeCompose false def | 919 | /yy yy Yshadow add def |
| 804 | } ifelse | 920 | /XX XX Xshadow add def |
| 805 | /bgsave bg def /bgcolorsave bgcolor def | 921 | } if |
| 806 | /Effectsave Effect def | 922 | Effect 1 and 0 ne { UnderlinePosition Hline } if % underline |
| 807 | gsave % Reflect effect only at first | 923 | Effect 2 and 0 ne { StrikeoutPosition Hline } if % strikeout |
| 808 | /Effect Effect 1 2 add 4 add 16 add and def | 924 | Effect 4 and 0 ne { OverlinePosition Hline } if % overline |
| 809 | /f0 findfont setfont ( ) 0 CmpcharWidth getinterval S | 925 | bg { % background |
| 810 | grestore | 926 | true |
| 811 | /Effect Effectsave 8 32 add and def % enable only shadow and outline | 927 | Effect 16 and 0 ne {SpaceBackground doBox} { xx yy XX YY doRect} ifelse |
| 812 | false BG | 928 | } if |
| 813 | gsave | 929 | Effect 16 and 0 ne { false 0 doBox } if % box |
| 814 | SpaceWidth mul 0 rmoveto dup GetPathBox S | 930 | } def |
| 815 | /RIGHT currentpoint pop def | ||
| 816 | grestore | ||
| 817 | /y currentpoint exch pop def | ||
| 818 | /HIGH URY y add def /LOW LLY y add def | ||
| 819 | } bind def | ||
| 820 | 931 | ||
| 821 | %% End of composite char. | 932 | %% Show STR with effects (shadow, outline). |
| 822 | /EC { % -- |- -- | 933 | /ShowWithEffect { % str |- -- |
| 823 | /bg bgsave def /bgcolor bgcolorsave def | 934 | Effect 8 and 0 ne { dup doShadow } if |
| 824 | /Effect Effectsave def | 935 | Effect 32 and 0 ne { true doOutline } { show } ifelse |
| 825 | /Cmpchar false def | 936 | } def |
| 826 | CmpcharRelativeCompose false eq { | ||
| 827 | CmpcharWidth SpaceWidth mul 0 rmoveto | ||
| 828 | } { | ||
| 829 | RIGHT currentpoint exch pop moveto | ||
| 830 | } ifelse | ||
| 831 | } bind def | ||
| 832 | 937 | ||
| 833 | %% Rule base composition | 938 | %% Draw COMPONETS which have the form [ font0? [str0 xoff0 yoff0] ... ]. |
| 834 | /RBC { % str xoff gref nref |- -- | 939 | /ShowComponents { % compoents |- - |
| 835 | /nref exch def /gref exch def | 940 | LEFT 0 lt { LEFT neg 0 rmoveto } if |
| 941 | { | ||
| 942 | dup type /nametype eq { % font | ||
| 943 | FM | ||
| 944 | } { % [ str xoff yoff ] | ||
| 945 | gsave | ||
| 946 | aload pop rmoveto ShowWithEffect | ||
| 947 | grestore | ||
| 948 | } ifelse | ||
| 949 | } forall | ||
| 950 | RIGHT 0 rmoveto | ||
| 951 | } def | ||
| 952 | |||
| 953 | %% Show relative composition. | ||
| 954 | /RLC { % [ font0? str0 font1? str1 ... fontN? strN ] |- -- | ||
| 955 | /components exch def | ||
| 956 | /Composing true def | ||
| 957 | /first true def | ||
| 836 | gsave | 958 | gsave |
| 837 | SpaceWidth mul 0 rmoveto | 959 | [ components { |
| 838 | dup | 960 | /elt exch def |
| 839 | GetPathBox | 961 | elt type /nametype eq { % font |
| 840 | [ HIGH currentpoint exch pop LOW HIGH LOW add 2 div ] gref get | 962 | elt dup FM |
| 841 | [ URY LLY sub LLY neg 0 URY LLY sub 2 div ] nref get | 963 | } { first { % first string |
| 842 | sub /btm exch def | 964 | /first false def |
| 843 | /top btm URY LLY sub add def | 965 | elt GetPathBox |
| 844 | top HIGH gt { /HIGH top def } if | 966 | %% Bounding box of overall glyphs. |
| 845 | btm LOW lt { /LOW btm def } if | 967 | /LEFT LLX def |
| 846 | currentpoint pop btm LLY sub moveto | 968 | /RIGHT URX def |
| 847 | S | 969 | /TOP URY def |
| 970 | /BOTTOM LLY def | ||
| 971 | currentfont /RelativeCompose known { | ||
| 972 | /relative currentfont /RelativeCompose get def | ||
| 973 | } { | ||
| 974 | %% Disable relative composition by setting sufficiently low | ||
| 975 | %% and high positions. | ||
| 976 | /relative [ -100000 100000 ] def | ||
| 977 | } ifelse | ||
| 978 | [ elt 0 0 ] | ||
| 979 | } { % other strings | ||
| 980 | elt GetPathBox | ||
| 981 | [ elt % str | ||
| 982 | LLX 0 lt { RIGHT } { 0 } ifelse % xoff | ||
| 983 | LLY relative 1 get ge { % compose on TOP | ||
| 984 | TOP LLY sub RelativeCompositionSkip add % yoff | ||
| 985 | /TOP TOP URY LLY sub add RelativeCompositionSkip add def | ||
| 986 | } { URY relative 0 get le { % compose under BOTTOM | ||
| 987 | BOTTOM URY sub RelativeCompositionSkip sub % yoff | ||
| 988 | /BOTTOM BOTTOM URY LLY sub sub | ||
| 989 | RelativeCompositionSkip sub def | ||
| 990 | } { | ||
| 991 | 0 % yoff | ||
| 992 | URY TOP gt { /TOP URY def } if | ||
| 993 | LLY BOTTOM lt { /BOTTOM LLY def } if | ||
| 994 | } ifelse } ifelse | ||
| 995 | ] | ||
| 996 | URX RIGHT gt { /RIGHT URX def } if | ||
| 997 | } ifelse } ifelse | ||
| 998 | } forall ] /components exch def | ||
| 848 | grestore | 999 | grestore |
| 849 | /CmpcharRelativeCompose false def | ||
| 850 | } bind def | ||
| 851 | 1000 | ||
| 852 | %% Relative composition | 1001 | %% Reflect special effects. |
| 853 | /RLC { % str |- -- | 1002 | SpecialEffect |
| 1003 | |||
| 1004 | %% Draw components while ignoring effects other than shadow and outline. | ||
| 1005 | components ShowComponents | ||
| 1006 | /Composing false def | ||
| 1007 | |||
| 1008 | } def | ||
| 1009 | |||
| 1010 | %% Show rule-base composition. | ||
| 1011 | /RBC { % [ font0? str0 rule1 font1? str1 rule2 ... strN ] |- -- | ||
| 1012 | /components exch def | ||
| 1013 | /Composing true def | ||
| 1014 | /first true def | ||
| 854 | gsave | 1015 | gsave |
| 855 | dup GetPathBox | 1016 | [ components { |
| 856 | LLX 0 lt { RIGHT currentpoint exch pop moveto } if | 1017 | /elt exch def |
| 857 | CmpcharRelativeCompose type /arraytype eq { | 1018 | elt type /nametype eq { % font |
| 858 | LLY CmpcharRelativeCompose 1 get ge { % compose on top | 1019 | elt dup FM |
| 859 | currentpoint pop HIGH LLY sub CmpcharRelativeSkip add moveto | 1020 | } { elt type /integertype eq { % rule |
| 860 | /HIGH HIGH URY LLY sub add CmpcharRelativeSkip add def | 1021 | %% This RULE decoding should be compatible with macro |
| 861 | } { URY CmpcharRelativeCompose 0 get le { % compose under bottom | 1022 | %% COMPOSITION_DECODE_RULE in emcas/src/composite.h. |
| 862 | currentpoint pop LOW URY sub CmpcharRelativeSkip sub moveto | 1023 | elt 12 idiv dup 3 mod /grefx exch def 3 idiv /grefy exch def |
| 863 | /LOW LOW URY LLY sub sub CmpcharRelativeSkip sub def | 1024 | elt 12 mod dup 3 mod /nrefx exch def 3 idiv /nrefy exch def |
| 864 | } { | 1025 | } { first { % first string |
| 865 | /y currentpoint exch pop def | 1026 | /first false def |
| 866 | y URY add dup HIGH gt { /HIGH exch def } { pop } ifelse | 1027 | elt GetPathBox |
| 867 | y LLY add dup LOW lt { /LOW exch def } { pop } ifelse | 1028 | %% Bounding box of overall glyphs. |
| 868 | } ifelse } ifelse } if | 1029 | /LEFT LLX def |
| 869 | S | 1030 | /RIGHT URX def |
| 1031 | /TOP URY def | ||
| 1032 | /BOTTOM LLY def | ||
| 1033 | /WIDTH RIGHT LEFT sub def | ||
| 1034 | [ elt 0 0 ] | ||
| 1035 | } { % other strings | ||
| 1036 | elt GetPathBox | ||
| 1037 | /width URX LLX sub def | ||
| 1038 | /height URY LLY sub def | ||
| 1039 | /left LEFT [ 0 WIDTH 2 div WIDTH ] grefx get add | ||
| 1040 | [ 0 width 2 div width ] nrefx get sub def | ||
| 1041 | /bottom [ TOP 0 BOTTOM TOP BOTTOM add 2 div ] grefy get | ||
| 1042 | [ height LLY neg 0 height 2 div ] nrefy get sub def | ||
| 1043 | %% Update bounding box | ||
| 1044 | left LEFT lt { /LEFT left def } if | ||
| 1045 | left width add RIGHT gt { /RIGHT left width add def } if | ||
| 1046 | /WIDTH RIGHT LEFT sub def | ||
| 1047 | bottom BOTTOM lt { /BOTTOM bottom def } if | ||
| 1048 | bottom height add TOP gt { /TOP bottom height add def } if | ||
| 1049 | [ elt left LLX sub bottom LLY sub ] | ||
| 1050 | } ifelse } ifelse } ifelse | ||
| 1051 | } forall ] /components exch def | ||
| 870 | grestore | 1052 | grestore |
| 871 | } bind def | 1053 | |
| 872 | %%%% End of composite character handler | 1054 | %% Reflect special effects. |
| 1055 | SpecialEffect | ||
| 1056 | |||
| 1057 | %% Draw components while ignoring effects other than shadow and outline. | ||
| 1058 | components ShowComponents | ||
| 1059 | |||
| 1060 | /Composing false def | ||
| 1061 | } def | ||
| 1062 | %%%% End of character composition handler | ||
| 873 | 1063 | ||
| 874 | " | 1064 | " |
| 875 | "PostScript code for printing composite characters.") | 1065 | "PostScript code for printing character compositition.") |
| 876 | |||
| 877 | (defun ps-mule-plot-rule-cmpchar (ch-rule-list total-width font-type) | ||
| 878 | (let ((leftmost 0.0) | ||
| 879 | (rightmost (float (char-width (car ch-rule-list)))) | ||
| 880 | (the-list (cons '(3 . 3) ch-rule-list)) | ||
| 881 | cmpchar-elements) | ||
| 882 | (while the-list | ||
| 883 | (let* ((this (car the-list)) | ||
| 884 | (gref (car this)) | ||
| 885 | (nref (cdr this)) | ||
| 886 | ;; X-axis info (0:left, 1:center, 2:right) | ||
| 887 | (gref-x (% gref 3)) | ||
| 888 | (nref-x (% nref 3)) | ||
| 889 | ;; Y-axis info (0:top, 1:base, 2:bottom, 3:center) | ||
| 890 | (gref-y (if (= gref 4) 3 (/ gref 3))) | ||
| 891 | (nref-y (if (= nref 4) 3 (/ nref 3))) | ||
| 892 | (char (car (cdr the-list))) | ||
| 893 | (width (float (char-width char))) | ||
| 894 | left) | ||
| 895 | (setq left (+ leftmost | ||
| 896 | (* (- rightmost leftmost) gref-x 0.5) | ||
| 897 | (- (* nref-x width 0.5))) | ||
| 898 | cmpchar-elements (cons (list char left gref-y nref-y) | ||
| 899 | cmpchar-elements) | ||
| 900 | leftmost (min left leftmost) | ||
| 901 | rightmost (max (+ left width) rightmost) | ||
| 902 | the-list (nthcdr 2 the-list)))) | ||
| 903 | (if (< leftmost 0) | ||
| 904 | (let ((the-list cmpchar-elements) | ||
| 905 | elt) | ||
| 906 | (while the-list | ||
| 907 | (setq elt (car the-list) | ||
| 908 | the-list (cdr the-list)) | ||
| 909 | (setcar (cdr elt) (- (nth 1 elt) leftmost))))) | ||
| 910 | (ps-mule-plot-cmpchar (nreverse cmpchar-elements) | ||
| 911 | total-width nil font-type))) | ||
| 912 | |||
| 913 | (defun ps-mule-plot-cmpchar (elements total-width relativep font-type) | ||
| 914 | (let* ((elt (car elements)) | ||
| 915 | (ch (if relativep elt (car elt)))) | ||
| 916 | (ps-output-string (ps-mule-prepare-cmpchar-font ch font-type)) | ||
| 917 | (ps-output (format " %d %d BC " | ||
| 918 | (if relativep 0 (nth 1 elt)) | ||
| 919 | total-width)) | ||
| 920 | (while (setq elements (cdr elements)) | ||
| 921 | (setq elt (car elements) | ||
| 922 | ch (if relativep elt (car elt))) | ||
| 923 | (ps-output-string (ps-mule-prepare-cmpchar-font ch font-type)) | ||
| 924 | (ps-output (if relativep | ||
| 925 | " RLC " | ||
| 926 | (format " %d %d %d RBC " | ||
| 927 | (nth 1 elt) (nth 2 elt) (nth 3 elt)))))) | ||
| 928 | (ps-output "EC\n")) | ||
| 929 | |||
| 930 | (defun ps-mule-prepare-cmpchar-font (char font-type) | ||
| 931 | (let* ((ps-mule-current-charset (char-charset char)) | ||
| 932 | (font-spec (ps-mule-get-font-spec ps-mule-current-charset font-type))) | ||
| 933 | (cond (font-spec | ||
| 934 | (ps-mule-string-encoding font-spec (char-to-string char))) | ||
| 935 | |||
| 936 | ((eq ps-mule-current-charset 'latin-iso8859-1) | ||
| 937 | (ps-mule-string-ascii (char-to-string char))) | ||
| 938 | |||
| 939 | (t | ||
| 940 | ;; No font for CHAR. | ||
| 941 | (ps-set-font ps-current-font) | ||
| 942 | " ")))) | ||
| 943 | 1066 | ||
| 944 | (defun ps-mule-string-ascii (str) | 1067 | (defun ps-mule-string-ascii (str) |
| 945 | (ps-set-font ps-current-font) | 1068 | (ps-set-font ps-current-font) |
| 946 | (string-as-unibyte (encode-coding-string str 'iso-latin-1))) | 1069 | (string-as-unibyte (encode-coding-string str 'iso-latin-1))) |
| 947 | 1070 | ||
| 948 | (defun ps-mule-string-encoding (font-spec str) | 1071 | ;; Encode STR for a font specified by FONT-SPEC and return the result. |
| 1072 | ;; If necessary, Postscript codes for the font and glyphs to print | ||
| 1073 | ;; STRING are generated. | ||
| 1074 | (defun ps-mule-string-encoding (font-spec str &optional no-setfont) | ||
| 949 | (let ((encoding (ps-mule-font-spec-encoding font-spec))) | 1075 | (let ((encoding (ps-mule-font-spec-encoding font-spec))) |
| 950 | (setq str | 1076 | (setq str |
| 951 | (string-as-unibyte | 1077 | (string-as-unibyte |
| @@ -958,8 +1084,9 @@ the sequence." | |||
| 958 | (t | 1084 | (t |
| 959 | str)))) | 1085 | str)))) |
| 960 | (if (ps-mule-font-spec-src font-spec) | 1086 | (if (ps-mule-font-spec-src font-spec) |
| 961 | (ps-mule-prepare-font font-spec str ps-mule-current-charset) | 1087 | (ps-mule-prepare-font font-spec str ps-mule-current-charset no-setfont) |
| 962 | (ps-set-font ps-current-font)) | 1088 | (or no-setfont |
| 1089 | (ps-set-font ps-current-font))) | ||
| 963 | str)) | 1090 | str)) |
| 964 | 1091 | ||
| 965 | ;; Bitmap font support | 1092 | ;; Bitmap font support |
| @@ -1026,7 +1153,7 @@ NewBitmapDict | |||
| 1026 | 1 index /FontIndex get exch FirstCode exch | 1153 | 1 index /FontIndex get exch FirstCode exch |
| 1027 | GlobalCharName GetBitmap /bmp exch def | 1154 | GlobalCharName GetBitmap /bmp exch def |
| 1028 | %% bmp == [ DWIDTH BBX-WIDTH BBX-HEIGHT BBX-XOFF BBX-YOFF BITMAP ] | 1155 | %% bmp == [ DWIDTH BBX-WIDTH BBX-HEIGHT BBX-XOFF BBX-YOFF BITMAP ] |
| 1029 | Cmpchar { %ifelse | 1156 | Composing { %ifelse |
| 1030 | /FontMatrix get [ exch { size div } forall ] /mtrx exch def | 1157 | /FontMatrix get [ exch { size div } forall ] /mtrx exch def |
| 1031 | bmp 3 get bmp 4 get mtrx transform | 1158 | bmp 3 get bmp 4 get mtrx transform |
| 1032 | /LLY exch def /LLX exch def | 1159 | /LLY exch def /LLX exch def |
| @@ -1141,7 +1268,7 @@ NewBitmapDict | |||
| 1141 | "Initialize global data for printing multi-byte characters." | 1268 | "Initialize global data for printing multi-byte characters." |
| 1142 | (setq ps-mule-font-cache nil | 1269 | (setq ps-mule-font-cache nil |
| 1143 | ps-mule-prologue-generated nil | 1270 | ps-mule-prologue-generated nil |
| 1144 | ps-mule-cmpchar-prologue-generated nil | 1271 | ps-mule-composition-prologue-generated nil |
| 1145 | ps-mule-bitmap-prologue-generated nil) | 1272 | ps-mule-bitmap-prologue-generated nil) |
| 1146 | (mapcar `(lambda (x) (setcar (nthcdr 2 x) nil)) | 1273 | (mapcar `(lambda (x) (setcar (nthcdr 2 x) nil)) |
| 1147 | ps-mule-external-libraries)) | 1274 | ps-mule-external-libraries)) |
| @@ -1186,6 +1313,13 @@ This checks if all multi-byte characters in the region are printable or not." | |||
| 1186 | 1313 | ||
| 1187 | (setq ps-mule-current-charset 'ascii) | 1314 | (setq ps-mule-current-charset 'ascii) |
| 1188 | 1315 | ||
| 1316 | (if (and (nth 2 (find-composition from to)) | ||
| 1317 | (not ps-mule-composition-prologue-generated)) | ||
| 1318 | (progn | ||
| 1319 | (ps-mule-prologue-generated) | ||
| 1320 | (ps-output-prologue ps-mule-composition-prologue) | ||
| 1321 | (setq ps-mule-composition-prologue-generated t))) | ||
| 1322 | |||
| 1189 | (if ps-mule-charset-list | 1323 | (if ps-mule-charset-list |
| 1190 | (let ((the-list ps-mule-charset-list) | 1324 | (let ((the-list ps-mule-charset-list) |
| 1191 | font-spec elt) | 1325 | font-spec elt) |
| @@ -1195,9 +1329,9 @@ This checks if all multi-byte characters in the region are printable or not." | |||
| 1195 | (setq elt (car the-list) | 1329 | (setq elt (car the-list) |
| 1196 | the-list (cdr the-list)) | 1330 | the-list (cdr the-list)) |
| 1197 | (cond ((and (eq elt 'composition) | 1331 | (cond ((and (eq elt 'composition) |
| 1198 | (not ps-mule-cmpchar-prologue-generated)) | 1332 | (not ps-mule-composition-prologue-generated)) |
| 1199 | (ps-output-prologue ps-mule-cmpchar-prologue) | 1333 | (ps-output-prologue ps-mule-composition-prologue) |
| 1200 | (setq ps-mule-cmpchar-prologue-generated t)) | 1334 | (setq ps-mule-composition-prologue-generated t)) |
| 1201 | ((setq font-spec (ps-mule-get-font-spec elt 'normal)) | 1335 | ((setq font-spec (ps-mule-get-font-spec elt 'normal)) |
| 1202 | (ps-mule-init-external-library font-spec)))))) | 1336 | (ps-mule-init-external-library font-spec)))))) |
| 1203 | 1337 | ||