Commit d1cc0f8d authored by gerd's avatar gerd

Removed CVS Log.

make-headline.scm is the same as the 1.0 version, so remove it.


git-svn-id: https://godirepo.camlcity.org/svn/app-presentation/trunk@12 50e5f3cf-a9f2-0310-83d8-d11ec64cb5ab
parent 180e0413
(* $Id: main.ml,v 1.5 2003/02/24 01:24:47 gerd Exp $
(* $Id$
* ----------------------------------------------------------------------
*
*)
......@@ -105,26 +105,3 @@ let main() =
;;
main();;
(* ======================================================================
* History:
*
* $Log: main.ml,v $
* Revision 1.5 2003/02/24 01:24:47 gerd
* New: to_latex
*
* Revision 1.4 2002/02/14 16:46:33 gerd
* Updates
*
* Revision 1.3 2002/02/08 14:47:27 gerd
* Change: The XML tree is now encoded as UTF-8 strings.
* Improvement: Pages that are not included in the hierarchy
* are skipped (no longer Not_found)
*
* Revision 1.2 2001/04/26 20:47:47 gerd
* New elements: c, picture, nameref, numref
*
* Revision 1.1 2001/01/13 23:10:31 gerd
* Initial revision.
*
*)
; Start this script with:
; gimp -b '(begin (load "make-headline.scm") (make-headline "berschrift" "headline.gif"))' '(gimp-quit 0)'
;**********************************************************************
;From: gimp-headers.scm
;**********************************************************************
; The GIMP -- an image manipulation program
; Copyright (C) 1995 Spencer Kimball and Peter Mattis
;
; www.gimp.org web headers
; Copyright (c) 1997 Adrian Likins
; aklikins@eos.ncsu.edu
;
; based on a idea by jtl (Jens Lautenbacher)
; and improved by jtl
;
; This program is free software; you can redistribute it and/or modify
; it under the terms of the GNU General Public License as published by
; the Free Software Foundation; either version 2 of the License, or
; (at your option) any later version.
;
; This program 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 General Public License for more details.
;
; You should have received a copy of the GNU General Public License
; along with this program; if not, write to the Free Software
; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
;
; **NOTE** This fonts use some very common fonts, that are typically
; bitmap fonts on most installations. If you want better quality versions
; you need to grab the urw font package form www.gimp.org/fonts.html
; and install as indicated. This will replace the some current bitmap fonts
; with higher quality vector fonts. This is how the actual www.gimp.org
; logos were created.
;
; ************************************************************************
; Changed on Feb 4, 1999 by Piet van Oostrum <piet@cs.uu.nl>
; For use with GIMP 1.1.
; All calls to gimp-text-* have been converted to use the *-fontname form.
; The corresponding parameters have been replaced by an SF-FONT parameter.
; ************************************************************************
(define (cadddr list)
(car (cdddr list)))
(define (cddddr list)
(cdr (cdddr list)))
(define (text-fontname image drawable x y text border antialias size size-type
font)
(letrec
((split-fontname
(lambda (k0 k)
(if (< k (string-length font))
(let ((c (substring font k (+ k 1))))
(if (equal? c "-")
(let ((piece (substring font k0 k)))
(cons piece (split-fontname (+ k 1) (+ k 1))))
(split-fontname k0 (+ k 1))))
(list (substring font k0 k)))))
)
(let* ((fontlist (cdr (split-fontname 0 0)))
(foundry (car fontlist))
(family (cadr fontlist))
(weight (caddr fontlist))
(slant (cadddr fontlist))
(fontlist4 (cddddr fontlist))
(set-width (car fontlist4))
(style (cadr fontlist4))
(pixel-size (caddr fontlist4))
(point-size (cadddr fontlist4))
(fontlist8 (cddddr fontlist4))
(res-x (car fontlist8))
(res-y (cadr fontlist8))
(spacing (caddr fontlist8))
(avg-width (cadddr fontlist8))
(fontlist12 (cddddr fontlist8))
(registry (car fontlist12))
(encoding (cadr fontlist12))
)
; (print image)
; (print drawable)
; (print text)
; (print border)
; (print antialias)
; (print size)
; (print size-type)
; (print foundry)
; (print family)
; (print weight)
; (print slant)
; (print set-width)
; (print spacing)
(gimp-text image drawable x y text border antialias size size-type
foundry family weight slant set-width spacing))
))
(define (my-script-fu-headers-gimp-org text font font-size text-color high-color side-color shadow-color bg-color crop rm-bg index num-colors)
(let* ((img (car (gimp-image-new 256 256 RGB)))
(text-layer (car (text-fontname img -1 0 0
text 30 TRUE font-size PIXELS
font)))
(width (car (gimp-drawable-width text-layer)))
(height (car (gimp-drawable-height text-layer)))
(bg-layer (car (gimp-layer-new img width height RGB_IMAGE "Background" 100 NORMAL)))
(old-fg (car (gimp-palette-get-foreground)))
(old-bg (car (gimp-palette-get-background))))
(gimp-image-disable-undo img)
(gimp-image-resize img width height 0 0)
(gimp-image-add-layer img bg-layer 1)
(gimp-layer-set-preserve-trans text-layer TRUE)
(gimp-palette-set-background text-color)
(gimp-edit-fill img text-layer)
(gimp-palette-set-background bg-color)
(gimp-edit-fill img bg-layer)
(let* ((highlight-layer (car (gimp-layer-copy text-layer TRUE)))
(side-layer (car (gimp-layer-copy text-layer TRUE)))
(shadow-layer (car (gimp-layer-copy text-layer TRUE))))
(gimp-image-add-layer img highlight-layer 1)
(gimp-layer-set-preserve-trans highlight-layer TRUE)
(gimp-image-add-layer img side-layer 1)
(gimp-layer-set-preserve-trans side-layer TRUE)
(gimp-image-add-layer img shadow-layer 1)
(gimp-layer-set-preserve-trans shadow-layer TRUE)
(gimp-palette-set-background high-color)
(gimp-edit-fill img highlight-layer)
(gimp-layer-translate highlight-layer -1 -1)
(gimp-palette-set-background side-color)
(gimp-edit-fill img side-layer)
(gimp-layer-translate side-layer 1 1)
(gimp-palette-set-background shadow-color)
(gimp-edit-fill img shadow-layer)
(gimp-layer-translate shadow-layer 5 5)
(gimp-layer-set-preserve-trans shadow-layer FALSE)
(plug-in-gauss-rle 1 img shadow-layer 5 TRUE TRUE)
(gimp-layer-set-opacity shadow-layer 60)
(gimp-image-lower-layer img shadow-layer)
(gimp-image-lower-layer img shadow-layer))
(set! text-layer (car (gimp-image-flatten img)))
(gimp-layer-add-alpha text-layer)
(if (= rm-bg TRUE)
(begin
(gimp-by-color-select text-layer bg-color
1 REPLACE TRUE FALSE 0 FALSE)
(gimp-edit-clear text-layer)
(gimp-selection-clear img)))
(if (= crop TRUE)
(plug-in-autocrop 1 img text-layer))
(if (= index TRUE)
(gimp-convert-indexed img TRUE num-colors))
(gimp-palette-set-foreground old-fg)
(gimp-palette-set-background old-bg)
(gimp-image-enable-undo img)
; We do not need the image to be displayed:
; ORIG: (gimp-display-new img)
; But we need the image to save it on disk:
img
))
;**********************************************************************
(define (color-triple hexnumber)
(let*
((red-hex (substring hexnumber 0 2))
(green-hex (substring hexnumber 2 4))
(blue-hex (substring hexnumber 4 6))
(red-val (string->number red-hex 16))
(green-val (string->number green-hex 16))
(blue-val (string->number blue-hex 16)))
(list red-val green-val blue-val)))
(define (make-headline text filename font font-size text-color high-color
side-color shadow-color bg-color)
(let*
((header
(my-script-fu-headers-gimp-org
text
font ;"-*-geometric 706-black-r-normal-*-*-*-*-*-p-*-iso8859-1"
font-size
(color-triple text-color) ; '(82 108 159) = 526c9f
(color-triple high-color) ; '(192 220 251) = c0dcfb
(color-triple side-color) ; '(46 74 92) = 2e4a5c
(color-triple shadow-color) ; '(0 0 0) = 000000
(color-triple bg-color) ; '(255 255 255) = ffffff
TRUE
FALSE
TRUE
15)))
(file-gif-save
1
header
header
filename
filename
FALSE
FALSE
1
0)
)
)
(* $Id: to_html.ml,v 1.9 2003/07/30 21:24:00 gerd Exp $
(* $Id$
* ----------------------------------------------------------------------
*
*)
......@@ -1207,38 +1207,3 @@ let tag_map =
()
;;
(* ======================================================================
* History:
*
* $Log: to_html.ml,v $
* Revision 1.9 2003/07/30 21:24:00 gerd
* Fix: Do not use HTML-escaped strings for GIFs
*
* Revision 1.8 2003/03/30 20:25:40 gerd
* @PREVLINK@, @NEXTLINK@
*
* Revision 1.7 2003/03/23 21:11:06 gerd
* Anti-SPAM: Escaping characters @ and :
*
* Revision 1.6 2003/02/24 01:24:47 gerd
* New: to_latex
*
* Revision 1.5 2002/02/14 16:46:33 gerd
* Updates
*
* Revision 1.4 2002/02/08 14:47:27 gerd
* Change: The XML tree is now encoded as UTF-8 strings.
* Improvement: Pages that are not included in the hierarchy
* are skipped (no longer Not_found)
*
* Revision 1.3 2001/07/14 16:27:07 gerd
* Fix: <c> tag is now HTML-escaped in the right way.
*
* Revision 1.2 2001/04/26 20:47:47 gerd
* New elements: c, picture, nameref, numref
*
* Revision 1.1 2001/01/13 23:10:31 gerd
* Initial revision.
*
*)
(* $Id: to_latex.ml,v 1.2 2003/03/21 20:34:35 gerd Exp $
(* $Id$
* ----------------------------------------------------------------------
*
*)
......@@ -1019,15 +1019,3 @@ let tag_map =
()
;;
(* ======================================================================
* History:
*
* $Log: to_latex.ml,v $
* Revision 1.2 2003/03/21 20:34:35 gerd
* T1 encoding
*
* Revision 1.1 2003/02/24 01:24:36 gerd
* Initial revision
*
*)
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment