(define (write-interpress filename thunk)
"makes a one-page interpress master; thunk should draw a picture to *default-context*, in point units"
(let ((m (open-interpress-output filename)) (save-c *default-context*))
(write-interpress-page
m
(lambda (c)
(set! *default-context* c)
(scale 127/360000)
(thunk)
)
)
(set! *default-context* save-c)
(close-interpress-output m)
)
)

(define (read-ais-as-res filename white-pixel black-pixel)
"Reads an AIS file, making an res-description"
(let
  ((pixel-array (pixel-array-from-ais filename))
)
`((color-image ,pixel-array) (color-operator ,(make-gray-linear-color-operator white-pixel black-pixel '())))
)
)

(define (read-interpress-page filename page-number)
"makes a thunk that draws a picture to *default-context*, in point units"
(define m (open-interpress-input filename))
(define (thunk)
"a page from an interpress master"
(do-save-all (lambda ()
(scale 360000/127)
(interpret-interpress-page m page-number *default-context*)
))
)
thunk
)

(define (add-filename-extension filename ext)
"strips directory, replaces or provides filename extension"
(define end (string-length filename))
(define (find-dot k)
(if (= k 0)
end
(case (string-ref filename (- k 1))
((#\.) (- k 1))
((#\/ #\> #\]) end)
(else (find-dot (- k 1)))
)
)
)
(define (find-base-start k)
(if (= k 0)
0
(case (string-ref filename (- k 1))
((#\/ #\> #\]) k)
(else (find-base-start (- k 1)))
)
)
)
(string-append (substring filename (find-base-start end) (find-dot end)) "." ext)
)

(define res-bpi 300)
(define (interpress->mumble filename portrait? page-bitmap-action pages)
"converts an interpress master to bitmaps"
(let
  ((master-in (open-interpress-input filename))
(s-size (if portrait? (* 11 res-bpi) (* #e8.5 res-bpi)))
(f-size (if portrait? (* #e8.5 res-bpi) (* 11 res-bpi)))
)
(define page-buffer (make-pixelmap s-size f-size))
(define (fill-buffer page-number)
(define c (make-bitmap-context page-buffer))
(when (not portrait?)
(translate (* 11 res-bpi #e.5) (* #e8.5 res-bpi #e.5) c)
(rotate -90 c)
(translate (* #e8.5 res-bpi -#e.5) (* 11 res-bpi -#e.5) c)
)
(scale (/ res-bpi #e0.0254) c)
(set-gray 0 c)
(mask-box 0 0 1 1 c)
(set-gray 1 c)
(interpret-interpress-page master-in page-number c)
)
(define (do-interpress-compressed-page-range first-page last-page)
(if (> first-page last-page)
#t
(begin
(if (or (null? pages) (memv first-page (car pages))) (begin
(display "[")
(fill-buffer first-page)
(display first-page)
(page-bitmap-action page-buffer first-page)
(display "] ")
))
(do-interpress-compressed-page-range (+ first-page 1) last-page)
)
)
)
(do-interpress-compressed-page-range 1 (interpress-input-page-count master-in))
(newline)
(close-interpress-input master-in)
)
)

(define (interpress->compressed filename . pages)
"converts an interpress master to one that consists of compressed bitmaps"
(let
  ((outputname (add-filename-extension filename "cip"))
)
(define master-out (open-interpress-output outputname))
(define (write-buffer page-buffer page-number)
(write-interpress-page master-out (lambda (out-c)
(scale (/ #e0.0254 res-bpi) out-c)
(translate (* #e8.5 res-bpi #e.5) (* 11 res-bpi #e.5) out-c)
(rotate 90 out-c)
(translate (* 11 res-bpi -#e.5) (* #e8.5 res-bpi -#e.5) out-c)
(mask-pixel-array (xerox-compress-pixel-array (pixelmap->pixel-array page-buffer #t)) out-c)
))
)
(interpress->mumble filename #f write-buffer pages)
(close-interpress-output master-out)
outputname
)
)

(define (interpress->res filename compress? . pages)
"converts pages of an interpress master to RES format bitmap files"
(define output-names '())
(define (write-buffer page-buffer page-number)
(define outputname (add-filename-extension filename (format #f "~a.res" page-number)))
(define pa (pixelmap->pixel-array page-buffer #t))
(write-restricted-res
(open-output-file outputname)
(if compress? (xerox-compress-pixel-array pa) pa)
res-bpi
compress?
(format #f "from page ~a of ~a" page-number filename)
)
(set! output-names (cons outputname output-names))
)
(interpress->mumble filename #t write-buffer pages)
(reverse output-names)
)


  :  
InterpressUtil.scheme
Copyright Ó 1988, 1991 by Xerox Corporation.  All rights reserved.
Michael Plass, April 27, 1991 11:20 pm PDT

(define (debug-compress interpress-master-name output-port res-bpi)
(define master-in (open-interpress-input interpress-master-name))
(define page-buffer (make-pixelmap (* #e8.5 res-bpi) (* 11 res-bpi)))
(define (fill-buffer page-number)
(define c (make-bitmap-context page-buffer))
(translate (* 11 res-bpi #e.5) (* #e8.5 res-bpi #e.5) c)
(rotate -90 c)
(translate (* #e8.5 res-bpi -#e.5) (* 11 res-bpi -#e.5) c)
(scale (/ res-bpi #e0.0254) c)
(set-gray 0 c)
(mask-box 0 0 1 1 c)
(set-gray 1 c)
(interpret-interpress-page master-in page-number c)
)
(fill-buffer 1)
(display "Compressed form of " output-port)
(display interpress-master-name output-port)
(display ":" output-port)
(newline output-port)
(debug-xerox-compress-pixel-array (pixelmap->pixel-array page-buffer #t) output-port)
)

(define (interpress-page-frame c)
"for debugging coordinate systems; assumes interpress initial coordinate system; puts frame around 8.5 x 11 inch page"
(let
  ((w (* 8.5 0.0254))
(h (* 11 0.0254))
)
(set-stroke-width 0.05 c)
(set-stroke-end 'square)
(mask-vector 0 0 w 0 c)
(mask-vector 0 0 0 h c)
(mask-vector w 0 w h c)
(mask-vector 0 h w h c)
(set-stroke-width 0.02 c)
(mask-vector 0 0 0 1e-6 c)
)
)

 Êš  •NewlineDelimiter
–(cedarcode) style™ šœ™Jšœ
Ðetœ7™BJ™*J™ —šœ)˜)Jšœf˜fšœG˜Gšœ˜Jšœ˜šœ˜Jšœ˜Jšœ˜Jšœ˜Jšœ˜—Jšœ˜—Jšœ˜Jšœ˜Jšœ˜—Jšœ˜J˜ —šœ:˜:Jšœ.˜.defaultšœ˜šœ0˜0Kšœ˜—Kš	œ.ÏtÏfžœžœžœ˜mKšœ˜—J˜J˜ —šœ3˜3JšœI˜IJšœ+˜+˜J˜"˜Jšœ˜Jšœ;˜;J˜—J˜—J˜J˜—K˜ šœ-˜-Kšœ;˜;Kšœ%˜%šœ˜šœ˜Kšœ˜šœ#˜#Kšœ˜Kšœ˜Kšœ˜K˜—Kšœ˜—Kšœ˜—šœ˜šœ˜K˜šœ#˜#Kšœ˜Kšœ ˜ K˜—Kšœ˜—Kšœ˜—KšœQ˜QKšœ˜K˜ —K˜˜HK˜*šœ˜šœ/˜/Kšœ8˜8Kšœ8˜8Kšœ˜—KšœŸœ˜2˜!Kšœ,˜,šœ˜Kšœ8˜8K˜Kšœ:˜:K˜—Kšœ˜K˜K˜K˜Kšœ3˜3K˜—šœB˜Bšœ˜K˜˜šœ;˜;K˜Kšœ˜Kšœ˜Kšœ+˜+K˜K˜—Kšœ@˜@K˜—K˜—Kšœ˜—KšœO˜OK˜	Kšœ"˜"Kšœ˜—J˜J˜ —˜1K˜Jšœ˜šœ7˜7Kšœ˜—Kšœ7˜7šœ.˜.šœ1˜1Kšœ"˜"Kšœ<˜<Kšœ˜Kšœ>˜>Kšœ\˜\Kšœ˜—K˜—Kšœ3˜3Kšœ$˜$Kšœ
˜
Kšœ˜—J˜J˜ —šœ4˜4K˜CK˜šœ.˜.KšœV˜VKšœ2˜2šœ˜Kšœ˜Kšœ1˜1K˜Kšœ	˜	Kšœ5˜5K˜—Kšœ2˜2K˜—Kšœ3˜3K˜J˜J˜ —˜ J˜ —™CKšœA™AKšœŸœ#™E™!Kšœ,™,Kšœ8™8K™Kšœ:™:Kšœ™K™K™K™Kšœ3™3K™—K™K™+K™,K™K™KšœU™UK™K™ —™!Kšœv™všœ™šœ™Kšœ™Kšœ™—K™K™K™K™K™K™K™K™Kšœ™—K™K™ —J˜ — …—    ì  À  