Mercurial > emacs
comparison lisp/ps-mule.el @ 26882:5b331ff3b477
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.
author | Kenichi Handa <handa@m17n.org> |
---|---|
date | Wed, 15 Dec 1999 00:34:01 +0000 |
parents | a6cf126fdf97 |
children | 1e00f7f6655c |
comparison
equal
deleted
inserted
replaced
26881:cd1cb9bf30e1 | 26882:5b331ff3b477 |
---|---|
161 (/ (length string) | 161 (/ (length string) |
162 (charset-bytes (char-charset (string-to-char string))))) | 162 (charset-bytes (char-charset (string-to-char string))))) |
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 |
170 "Alist of charsets with the corresponding font information. | 187 "Alist of charsets with the corresponding font information. |
171 Each element has the form: | 188 Each element has the form: |
494 (or (not font-src) | 511 (or (not font-src) |
495 (nth 2 slot) | 512 (nth 2 slot) |
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 |
503 ;; Cached glyph information of fonts, alist of: | 520 ;; Cached glyph information of fonts, alist of: |
504 ;; (FONT-NAME ((FONT-TYPE-NUMBER . SCALED-FONT-NAME) ...) | 521 ;; (FONT-NAME ((FONT-TYPE-NUMBER . SCALED-FONT-NAME) ...) |
643 findfont dup /Encoding get /ISOLatin1Encoding exch def | 660 findfont dup /Encoding get /ISOLatin1Encoding exch def |
644 exch scalefont AdjustRelativeCompose reencodeFontISO | 661 exch scalefont AdjustRelativeCompose reencodeFontISO |
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. |
655 /SB { % count column |- -- | 679 /SB { % count column |- -- |
656 SpaceWidth mul /w exch def | 680 SpaceWidth mul /w exch def |
663 grestore | 687 grestore |
664 w 0 rmoveto | 688 w 0 rmoveto |
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 |
675 " | 699 " |
676 "PostScript code for printing multi-byte characters.") | 700 "PostScript code for printing multi-byte characters.") |
680 (defun ps-mule-prologue-generated () | 704 (defun ps-mule-prologue-generated () |
681 (unless ps-mule-prologue-generated | 705 (unless ps-mule-prologue-generated |
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 |
693 Returns the value: | 724 Returns the value: |
694 | 725 |
695 (ENDPOS . RUN-WIDTH) | 726 (ENDPOS . RUN-WIDTH) |
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))) |
708 (if (> run-width ps-width-remaining) | 744 (if (> run-width ps-width-remaining) |
709 (cons (min to | 745 (cons (min to |
749 ((eq ps-mule-current-charset 'latin-iso8859-1) | 785 ((eq ps-mule-current-charset 'latin-iso8859-1) |
750 ;; Latin-1 can be printed by a normal ASCII font. | 786 ;; Latin-1 can be printed by a normal ASCII font. |
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 |
764 ;; appropriate width. | 796 ;; appropriate width. |
765 (ps-output (format "%d %d SB\n" | 797 (ps-output (format "%d %d SB\n" |
767 (if (eq ps-mule-current-charset 'composition) | 799 (if (eq ps-mule-current-charset 'composition) |
768 (char-width (char-after from)) | 800 (char-width (char-after from)) |
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 |- -- |
784 gsave | 900 gsave |
785 currentfont /FontType get 3 eq { %ifelse | 901 currentfont /FontType get 3 eq { %ifelse |
791 y sub /LLY exch def x sub /LLX exch def | 907 y sub /LLY exch def x sub /LLX exch def |
792 } ifelse | 908 } ifelse |
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 |
926 true | |
927 Effect 16 and 0 ne {SpaceBackground doBox} { xx yy XX YY doRect} ifelse | |
928 } if | |
929 Effect 16 and 0 ne { false 0 doBox } if % box | |
930 } def | |
931 | |
932 %% Show STR with effects (shadow, outline). | |
933 /ShowWithEffect { % str |- -- | |
934 Effect 8 and 0 ne { dup doShadow } if | |
935 Effect 32 and 0 ne { true doOutline } { show } ifelse | |
936 } def | |
937 | |
938 %% Draw COMPONETS which have the form [ font0? [str0 xoff0 yoff0] ... ]. | |
939 /ShowComponents { % compoents |- - | |
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 | |
958 gsave | |
959 [ components { | |
960 /elt exch def | |
961 elt type /nametype eq { % font | |
962 elt dup FM | |
963 } { first { % first string | |
964 /first false def | |
965 elt GetPathBox | |
966 %% Bounding box of overall glyphs. | |
967 /LEFT LLX def | |
968 /RIGHT URX def | |
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 | |
810 grestore | 999 grestore |
811 /Effect Effectsave 8 32 add and def % enable only shadow and outline | 1000 |
812 false BG | 1001 %% Reflect special effects. |
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 | |
813 gsave | 1015 gsave |
814 SpaceWidth mul 0 rmoveto dup GetPathBox S | 1016 [ components { |
815 /RIGHT currentpoint pop def | 1017 /elt exch def |
1018 elt type /nametype eq { % font | |
1019 elt dup FM | |
1020 } { elt type /integertype eq { % rule | |
1021 %% This RULE decoding should be compatible with macro | |
1022 %% COMPOSITION_DECODE_RULE in emcas/src/composite.h. | |
1023 elt 12 idiv dup 3 mod /grefx exch def 3 idiv /grefy exch def | |
1024 elt 12 mod dup 3 mod /nrefx exch def 3 idiv /nrefy exch def | |
1025 } { first { % first string | |
1026 /first false def | |
1027 elt GetPathBox | |
1028 %% Bounding box of overall glyphs. | |
1029 /LEFT LLX def | |
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 | |
816 grestore | 1052 grestore |
817 /y currentpoint exch pop def | 1053 |
818 /HIGH URY y add def /LOW LLY y add def | 1054 %% Reflect special effects. |
819 } bind def | 1055 SpecialEffect |
820 | 1056 |
821 %% End of composite char. | 1057 %% Draw components while ignoring effects other than shadow and outline. |
822 /EC { % -- |- -- | 1058 components ShowComponents |
823 /bg bgsave def /bgcolor bgcolorsave def | 1059 |
824 /Effect Effectsave def | 1060 /Composing false def |
825 /Cmpchar false def | 1061 } def |
826 CmpcharRelativeCompose false eq { | 1062 %%%% End of character composition handler |
827 CmpcharWidth SpaceWidth mul 0 rmoveto | |
828 } { | |
829 RIGHT currentpoint exch pop moveto | |
830 } ifelse | |
831 } bind def | |
832 | |
833 %% Rule base composition | |
834 /RBC { % str xoff gref nref |- -- | |
835 /nref exch def /gref exch def | |
836 gsave | |
837 SpaceWidth mul 0 rmoveto | |
838 dup | |
839 GetPathBox | |
840 [ HIGH currentpoint exch pop LOW HIGH LOW add 2 div ] gref get | |
841 [ URY LLY sub LLY neg 0 URY LLY sub 2 div ] nref get | |
842 sub /btm exch def | |
843 /top btm URY LLY sub add def | |
844 top HIGH gt { /HIGH top def } if | |
845 btm LOW lt { /LOW btm def } if | |
846 currentpoint pop btm LLY sub moveto | |
847 S | |
848 grestore | |
849 /CmpcharRelativeCompose false def | |
850 } bind def | |
851 | |
852 %% Relative composition | |
853 /RLC { % str |- -- | |
854 gsave | |
855 dup GetPathBox | |
856 LLX 0 lt { RIGHT currentpoint exch pop moveto } if | |
857 CmpcharRelativeCompose type /arraytype eq { | |
858 LLY CmpcharRelativeCompose 1 get ge { % compose on top | |
859 currentpoint pop HIGH LLY sub CmpcharRelativeSkip add moveto | |
860 /HIGH HIGH URY LLY sub add CmpcharRelativeSkip add def | |
861 } { URY CmpcharRelativeCompose 0 get le { % compose under bottom | |
862 currentpoint pop LOW URY sub CmpcharRelativeSkip sub moveto | |
863 /LOW LOW URY LLY sub sub CmpcharRelativeSkip sub def | |
864 } { | |
865 /y currentpoint exch pop def | |
866 y URY add dup HIGH gt { /HIGH exch def } { pop } ifelse | |
867 y LLY add dup LOW lt { /LOW exch def } { pop } ifelse | |
868 } ifelse } ifelse } if | |
869 S | |
870 grestore | |
871 } bind def | |
872 %%%% End of composite character 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 |
952 (cond ((coding-system-p encoding) | 1078 (cond ((coding-system-p encoding) |
953 (encode-coding-string str encoding)) | 1079 (encode-coding-string str encoding)) |
956 (encoding | 1082 (encoding |
957 (error "Invalid coding system or function: %s" encoding)) | 1083 (error "Invalid coding system or function: %s" encoding)) |
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 |
966 | 1093 |
967 (defvar ps-mule-bitmap-prologue-generated nil) | 1094 (defvar ps-mule-bitmap-prologue-generated nil) |
1024 1 index /FontSize get /size exch def | 1151 1 index /FontSize get /size exch def |
1025 1 index /FontSpaceWidthRatio get /ratio exch def | 1152 1 index /FontSpaceWidthRatio get /ratio exch def |
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 |
1033 bmp 1 get bmp 3 get add bmp 2 get bmp 4 get add mtrx transform | 1160 bmp 1 get bmp 3 get add bmp 2 get bmp 4 get add mtrx transform |
1034 /URY exch def /URX exch def | 1161 /URY exch def /URX exch def |
1139 ;;;###autoload | 1266 ;;;###autoload |
1140 (defun ps-mule-initialize () | 1267 (defun ps-mule-initialize () |
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)) |
1148 | 1275 |
1149 ;;;###autoload | 1276 ;;;###autoload |
1184 (t | 1311 (t |
1185 (error "Printing cancelled"))))))) | 1312 (error "Printing cancelled"))))))) |
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) |
1192 (ps-mule-prologue-generated) | 1326 (ps-mule-prologue-generated) |
1193 ;; If external functions are necessary, generate prologues for them. | 1327 ;; If external functions are necessary, generate prologues for them. |
1194 (while the-list | 1328 (while the-list |
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 |
1204 ;; If ASCII font is also specified in ps-mule-font-info-database, | 1338 ;; If ASCII font is also specified in ps-mule-font-info-database, |
1205 ;; use it istead of what specified in ps-font-info-database. | 1339 ;; use it istead of what specified in ps-font-info-database. |