<commit_before>;;; -*- Mode: Lisp; Package: CLIM-POSTSCRIPT -*-

;;;  (c) copyright 2001 by
;;;           <NAME> (<EMAIL>)
;;;           <NAME> (<EMAIL>)
;;;  (c) copyright 2002 by
;;;           <NAME> (<EMAIL>)
;;;           <NAME> (<EMAIL>)

;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Library General Public
;;; License as published by the Free Software Foundation; either
;;; version 2 of the License, or (at your option) any later version.
;;;
;;; This library is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;; Library General Public License for more details.
;;;
;;; You should have received a copy of the GNU Library General Public
;;; License along with this library; if not, write to the
;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;;; Boston, MA  02111-1307  USA.

;;; TODO:
;;;
;;; - do smth with POSTSCRIPT-GRAFT.

;;; Also missing IMO:
;;;
;;; - WITH-OUTPUT-TO-POSTSCRIPT-STREAM should offer a :PAPER-SIZE option.
;;; - NEW-PAGE should also offer to specify the page name.
;;; - device fonts are missing
;;; - font metrics are missing
;;;
;;;--GB

(in-package :clim-postscript)

(defmacro with-output-to-postscript-stream ((stream-var file-stream
                                             &rest options)
                                            &body body)
  (let ((cont (gensym)))
    `(flet ((,cont (,stream-var)
              ,@body))
       (declare (dynamic-extent #',cont))
       (invoke-with-output-to-postscript-stream #',cont
                                                ,file-stream ,@options))))

(defun invoke-with-output-to-postscript-stream (continuation
                                                file-stream &key device-type
                                                multi-page scale-to-fit
                                                (orientation :portrait)
                                                header-comments)
  (let* ((port (find-port :server-path `(:ps :stream ,file-stream)))
         (stream (make-postscript-stream file-stream port device-type
                                         multi-page scale-to-fit
                                         orientation header-comments))
         translate-x translate-y)
    (unwind-protect
         (progn
           (with-output-recording-options (stream :record t :draw nil)
             (with-graphics-state (stream)
               ;; we need at least one level of saving -- APD, 2002-02-11
               (funcall continuation stream)))
           (with-slots (file-stream title for orientation paper) stream
             (format file-stream "%!PS-Adobe-3.0~@[ EPSF-3.0~*~]~%"
                     (eq device-type :eps))
             (format file-stream "%%Creator: McCLIM~%")
             (format file-stream "%%Title: ~A~%" title)
             (format file-stream "%%For: ~A~%" for)
             (format file-stream "%%LanguageLevel: 2~%")
             (case paper
               ((:eps)
                (let ((record (stream-output-history stream)))
                  (multiple-value-bind (lx ly ux uy) (bounding-rectangle* record)
                    (setf translate-x (- (ceiling lx))
                          translate-y (ceiling uy))
                    (format file-stream "%%BoundingBox: ~A ~A ~A ~A~%" 
                            0 0
                            (+ translate-x (floor lx))
                            (- translate-y (floor ly))))))
               (t
                (multiple-value-bind (width height)
                    (paper-size paper)
                  (format file-stream "%%BoundingBox: 0 0 ~A ~A~%" width height)
                  (format file-stream "%%DocumentMedia: ~A ~A ~A 0 () ()~%"
                          paper width height))
                (format file-stream "%%Orientation: ~A~%"
                        (ecase orientation
                          (:portrait "Portrait")
                          (:landscape "Landscape")))
                (format file-stream "%%Pages: (atend)~%")))
             (format file-stream "%%DocumentNeededResources: (atend)~%")
             (format file-stream "%%EndComments~%~%")
             (write-postscript-dictionary file-stream)
             (dolist (text-style (device-fonts (sheet-medium stream)))
               (write-font-to-postscript-stream (sheet-medium stream) text-style))
             (start-page stream)
             (format file-stream "~@[~A ~]~@[~A translate~%~]" translate-x translate-y)
             (let ((record (stream-output-history stream)))
               (with-output-recording-options (stream :draw t :record nil)<commit_msg>Fix for EPS output from postscript backend.  (From David Lewis)<commit_after>;;; -*- Mode: Lisp; Package: CLIM-POSTSCRIPT -*-

;;;  (c) copyright 2001 by
;;;           <NAME> (<EMAIL>)
;;;           <NAME> (<EMAIL>)
;;;  (c) copyright 2002 by
;;;           <NAME> (<EMAIL>)
;;;           <NAME> (<EMAIL>)

;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Library General Public
;;; License as published by the Free Software Foundation; either
;;; version 2 of the License, or (at your option) any later version.
;;;
;;; This library is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;; Library General Public License for more details.
;;;
;;; You should have received a copy of the GNU Library General Public
;;; License along with this library; if not, write to the
;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;;; Boston, MA  02111-1307  USA.

;;; TODO:
;;;
;;; - do smth with POSTSCRIPT-GRAFT.

;;; Also missing IMO:
;;;
;;; - WITH-OUTPUT-TO-POSTSCRIPT-STREAM should offer a :PAPER-SIZE option.
;;; - NEW-PAGE should also offer to specify the page name.
;;; - device fonts are missing
;;; - font metrics are missing
;;;
;;;--GB

(in-package :clim-postscript)

(defmacro with-output-to-postscript-stream ((stream-var file-stream
                                             &rest options)
                                            &body body)
  (let ((cont (gensym)))
    `(flet ((,cont (,stream-var)
              ,@body))
       (declare (dynamic-extent #',cont))
       (invoke-with-output-to-postscript-stream #',cont
                                                ,file-stream ,@options))))

(defun invoke-with-output-to-postscript-stream (continuation
                                                file-stream &key device-type
                                                multi-page scale-to-fit
                                                (orientation :portrait)
                                                header-comments)
  (let* ((port (find-port :server-path `(:ps :stream ,file-stream)))
         (stream (make-postscript-stream file-stream port device-type
                                         multi-page scale-to-fit
                                         orientation header-comments))
         translate-x translate-y)
    (unwind-protect
         (progn
           (with-output-recording-options (stream :record t :draw nil)
             (with-graphics-state (stream)
               ;; we need at least one level of saving -- APD, 2002-02-11
               (funcall continuation stream)))
           (with-slots (file-stream title for orientation paper) stream
             (format file-stream "%!PS-Adobe-3.0~@[ EPSF-3.0~*~]~%"
                     (eq device-type :eps))
             (format file-stream "%%Creator: McCLIM~%")
             (format file-stream "%%Title: ~A~%" title)
             (format file-stream "%%For: ~A~%" for)
             (format file-stream "%%LanguageLevel: 2~%")
             (case paper
               ((:eps)
                (let ((record (stream-output-history stream)))
                  (multiple-value-bind (lx ly ux uy) (bounding-rectangle* record)
                    (setf translate-x (- (floor lx))
                          translate-y (ceiling uy))
                    (format file-stream "%%BoundingBox: ~A ~A ~A ~A~%" 
                            0 0
                            (+ translate-x (ceiling ux))
                            (- translate-y (floor ly))))))
               (t
                (multiple-value-bind (width height)
                    (paper-size paper)
                  (format file-stream "%%BoundingBox: 0 0 ~A ~A~%" width height)
                  (format file-stream "%%DocumentMedia: ~A ~A ~A 0 () ()~%"
                          paper width height))
                (format file-stream "%%Orientation: ~A~%"
                        (ecase orientation
                          (:portrait "Portrait")
                          (:landscape "Landscape")))
                (format file-stream "%%Pages: (atend)~%")))
             (format file-stream "%%DocumentNeededResources: (atend)~%")
             (format file-stream "%%EndComments~%~%")
             (write-postscript-dictionary file-stream)
             (dolist (text-style (device-fonts (sheet-medium stream)))
               (write-font-to-postscript-stream (sheet-medium stream) text-style))
             (start-page stream)
             (format file-stream "~@[~A ~]~@[~A translate~%~]" translate-x translate-y)
             (let ((record (stream-output-history stream)))
               (with-output-recording-options (stream :draw t :record nil)
{'fraction_non_alphanumeric': 0.12897526501766785, 'fraction_numerical': 0.008522136769902306, 'mean_word_length': 1.6582872928176795, 'pattern_counts': {'":': 0, '<': 19, '<?xml version=': 0, '>': 19, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 36, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '3491778', 'n_tokens_mistral': 2652, 'n_tokens_neox': 2490, 'n_words': 786}