aboutsummaryrefslogtreecommitdiffhomepage
path: root/images/gimp/scripts/proofgeneral.scm
blob: 369b6ca59d0e601335b9b9245be8e7c6dc3d838a (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
;;
;; Gimp script fu to make buttons from a source .xcf file.
;;
;; David Aspinall <da@dcs.ed.ac.uk>
;;
;; $Id$
;;


;; TODO: make greyed out, pressed, unpressed versions.
;; e.g. : Add bevel for "up" position:
;; (script-fu-add-bevel 0 image
;;     (car (gimp-image-active-drawable image)) "10" 0 0)

(define (script-fu-proofgeneral-make-button buttonname)
  (let* ((filename (string-append buttonname ".xcf"))
	 (image    (car (gimp-file-load 1 filename filename)))
	 (xpmname  (string-append buttonname ".xpm"))
	 (poor-xpm (string-append buttonname ".8bit.xpm"))
	 (xbmname  (string-append buttonname ".xbm")))
    (gimp-image-flatten image)
    ;; Full xpm
    (gimp-file-save 1 image (car (gimp-image-active-drawable image))
		    xpmname xpmname)
    ;; Impoverised xpm
    (gimp-convert-indexed image 1 0 8 1 1 "blah")
    (gimp-file-save 1 image (car (gimp-image-active-drawable image))
		    poor-xpm poor-xpm)
    ;; Mono image
    (gimp-convert-rgb image)
    (gimp-image-flatten image)
    (gimp-convert-indexed image 1 1 3 2 1 "blah")
    (file-xbm-save 1 image (car (gimp-image-active-drawable image))
		    xbmname xbmname
		    "Proof General button"
		    FALSE 0 0 "")
    ;; Finish
    (gimp-image-delete image)
    ))

(script-fu-register "script-fu-proofgeneral-make-button" 
		    "<Toolbox>/Xtns/Script-Fu/Proof General/Make Button"
		    "Save buttons in various formats"
		    "da@dcs.ed.ac.uk" "da@dcs.ed.ac.uk"
		    "1998/10/04"
		    ""
		    SF-VALUE "Button/file name" "\"goal\"")

(define (script-fu-proofgeneral-make-all-buttons)
  (mapcar script-fu-proofgeneral-make-button
	  '("goal" "next" "qed" "restart" "retract" "undo" "use" "state" "context" "info" "command" "find" "help" "interrupt" "goto" "abort")))

(script-fu-register "script-fu-proofgeneral-make-all-buttons" 
		    "<Toolbox>/Xtns/Script-Fu/Proof General/Make All Buttons"
		    "Save Proof General buttons in the various formats"
		    "da@dcs.ed.ac.uk" "da@dcs.ed.ac.uk"
		    "1998/10/04"
		    "")

(define (script-fu-proofgeneral-save-pic imgname)
  (let* ((filename (string-append imgname ".xcf"))
	 (image    (car (gimp-file-load 1 filename filename)))
	 (jpgname  (string-append imgname ".jpg"))
	 (gifname  (string-append imgname ".gif"))
	 (poorgifname  (string-append imgname ".8bit.gif")))
    ;; Flatten and save as jpg
    ;;(gimp-image-flatten image)
    ;; Flattening forces a white background.  Let's use merge.
    (if (> (car (gimp-image-get-layers image)) 1)
	(gimp-image-merge-visible-layers image 0))
    (file-jpeg-save 1 image (car (gimp-image-active-drawable image))
		    jpgname jpgname
		    0.75 0 1)
    ;; gif with full palette
    (gimp-convert-indexed image TRUE 255)
    (file-gif-save 1 image (car (gimp-image-active-drawable image))
		    gifname gifname
		    FALSE FALSE 0 0)
    ;; gif with impoverished palette for display in XEmacs
    (gimp-convert-rgb image)
    (gimp-convert-indexed image 1 15)
    (file-gif-save 1 image (car (gimp-image-active-drawable image))
		    poorgifname poorgifname
		    FALSE FALSE 0 0)
    ;; Finish
    (gimp-image-delete image)
    ))

(script-fu-register "script-fu-proofgeneral-save-jpg" 
		    "<Toolbox>/Xtns/Script-Fu/Proof General/Save Jpeg"
		    "Save image as jpeg"
		    "da@dcs.ed.ac.uk" "da@dcs.ed.ac.uk"
		    "1998/10/04"
		    ""
		    SF-VALUE "Basename" "\"test\"")


(define (script-fu-proofgeneral-save-all-pix)
  (mapcar script-fu-proofgeneral-save-pic
	  '("ProofGeneral" "pg-text")))

(script-fu-register "script-fu-proofgeneral-save-all-jpegs" 
		    "<Toolbox>/Xtns/Script-Fu/Proof General/Save all Jpegs"
		    "Save Proof General images as jpegs"
		    "da@dcs.ed.ac.uk" "da@dcs.ed.ac.uk"
		    "1998/10/04"
		    "")