2
Copyright 2006 by Mark Weyer
3
modified 20.7.2009 by Bernhard R. Link <brlink@debian.org>
4
to not have 2 gib_xpm_aus,
5
and to add "pics/" before picture names...
7
This program is free software; you can redistribute it and/or modify
8
it under the terms of the GNU General Public License as published by
9
the Free Software Foundation; either version 2 of the License, or
10
(at your option) any later version.
12
This program is distributed in the hope that it will be useful,
13
but WITHOUT ANY WARRANTY; without even the implied warranty of
14
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15
GNU General Public License for more details.
17
You should have received a copy of the GNU General Public License
18
along with this program; if not, write to the Free Software
19
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
24
module Rgb = Vektor.Vektor(Natmod.Drei)
25
module Rgba = Vektor.Vektor(Natmod.Vier)
27
type punkt = float * float
29
type bildchen = int * int * (punkt -> farbe)
31
let monochrom farbe breite hoehe = breite, hoehe, function p -> farbe
33
let spiegel_x (breite,hoehe,farben) =
34
let breite_f = float_of_int breite in
36
function x,y -> farben (breite_f-.x,y)
38
let kombiniere_bildchen breite hoehe einzelne =
40
function (x,y) -> List.fold_left
41
(function farbe -> function (x0,y0,(breite,hoehe,farben)) ->
42
if (float_of_int x0)<=x && (x<=(float_of_int (x0+breite)))
43
&& (float_of_int y0)<=y && (y<=(float_of_int (y0+hoehe)))
44
then farben (x-.(float_of_int x0), y-.(float_of_int y0))
49
let ueberlagerung (b,h,funten) (b',h',foben) maske =
51
| None -> (b,h, fun p ->
53
let d = nur_durchsichtig o in
54
if d=0.0 then o else misch2 o (funten p) d)
55
| Some (b'',h'',fmaske) -> (b,h, fun p ->
56
let d = nur_durchsichtig (fmaske p) in
61
else misch2 (foben p) (funten p) d)
66
type pixelbild = int * int * farbe array array
68
let berechne pixel (breite,hoehe,farben) =
69
let breite,hoehe = breite*pixel,hoehe*pixel in
70
let aufloesung = 1.0/.(float_of_int pixel) in
71
breite,hoehe,Array.init hoehe (function y ->
72
let yf = ((float_of_int (hoehe-y))-.0.5)*.aufloesung in
73
Array.init breite (function x ->
74
farben (((float_of_int x)+.0.5)*.aufloesung, yf)))
76
let extrahiere_farben (breite,hoehe,pixel) =
77
let n,k = Array.fold_left (Array.fold_left (fun (n,k) -> fun farbe ->
78
if FarbMap.mem farbe k
80
else n+1, FarbMap.add farbe n k))
83
let p = Array.make n schwarz in (* schwarz ist ein dummy *)
85
(fun farbe -> fun i -> p.(i)<-farbe)
89
let extrahiere_verteilung (breite,hoehe,pixel) =
90
let n,v = Array.fold_left (Array.fold_left
91
(fun (n,v) -> fun farbe -> if FarbMap.mem farbe v
92
then n, FarbMap.add farbe ((FarbMap.find farbe v)+1) v
93
else n+1, FarbMap.add farbe 1 v))
94
(0,FarbMap.empty) pixel in
95
let v' = Array.make n (schwarz,0) in
97
(fun farbe -> fun anzahl -> fun n ->
98
v'.(n) <- (farbe,anzahl);
105
let xpm_zeichen = " #@*+-=~/.,:;_&%$!?|" ^
106
"0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" ^
109
let anz_xpm_zeichen = String.length xpm_zeichen
112
let gib_xpm_aus_a h palette farbsuche dateiname (breite,hoehe,pixel) =
113
let anz_farb = Array.length palette in
115
let rec log n = if n>anz_xpm_zeichen
116
then 1+(log (n/anz_xpm_zeichen))
120
let rec kodiere_rest rest_laenge rest_i =
123
else (kodiere_rest (rest_laenge-1) (rest_i/anz_xpm_zeichen))
124
^(String.sub xpm_zeichen (rest_i mod anz_xpm_zeichen) 1) in
125
kodiere_rest kodier_breite i in
127
let datei = open_out ("pics/"^dateiname^".xpm") in
128
let os = output_string datei in
129
let oi i = os (string_of_int i) in
132
let hex_ziffer n = String.sub "0123456789ABCDEF" n 1 in
133
(hex_ziffer (n/16))^(hex_ziffer (n mod 16)) in
134
let hex f = os (hex (truncate (255.0*.f+.0.5))) in
137
os "static char * noname[] = {\n";
138
os "\""; oi breite; os " "; oi hoehe; os " ";
139
oi anz_farb; os " "; oi kodier_breite; os "\"";
140
ignore (Array.fold_left
141
(function i -> function f ->
142
os ",\n\""; os (kodiere i); os " c ";
145
else if f=hintergrund
148
let rgb = zu_rgb h h f in
149
os "#"; hex (Rgb.koord rgb 0);
150
hex (Rgb.koord rgb 1); hex (Rgb.koord rgb 2));
155
for y = 0 to hoehe-1 do
157
for x = 0 to breite-1 do
158
os (kodiere (farbsuche pixel.(y).(x)))
166
let gib_xpm_aus_exakt h name bild =
167
let palette,karte = extrahiere_farben bild in
168
gib_xpm_aus_a h palette (fun farbe -> FarbMap.find farbe karte) name bild
170
let gib_xpm_aus_runden h palette =
171
let index = mach_index palette in
172
gib_xpm_aus_a h palette (naechste_farbe palette index)
174
let gib_xpm_aus h name bild = gib_xpm_aus_runden h
175
(reduziere_farben2 [| |] (fst (extrahiere_farben bild)) anz_xpm_zeichen)
179
exception Falscher_TupleType
181
let lies_xpm dateiname =
182
let lex = Lexing.from_channel (open_in (dateiname^".xpm")) in
183
let lies_zeile u = Xpmlex.xpm lex in
184
let zeile1 = Lexing.from_string (lies_zeile ()) in
185
let zahl u = Xpmlex.erstezeile zeile1 in
186
let breite = zahl () in
187
let hoehe = zahl () in
188
let anz_farben = zahl () in
189
let charpp = zahl () in
190
let farben = Array.to_list (Array.init anz_farben (function i ->
191
let zeile = lies_zeile () in
192
String.sub zeile 0 charpp,
193
Xpmlex.farbzeilenrest (Lexing.from_string
194
(String.sub zeile charpp ((String.length zeile)-charpp))))) in
195
breite,hoehe,Array.init hoehe (function y ->
196
let zeile = lies_zeile () in
197
Array.init breite (function x ->
198
List.assoc (String.sub zeile (x*charpp) charpp) farben))
200
let lies_ppm dateiname =
201
let (breite,hoehe,tiefe,maxval,daten),typ =
202
Pam.read_pam (open_in (dateiname^".ppm")) in
203
let maxvalf = float_of_int maxval in
205
then raise Falscher_TupleType
209
(Array.map (function d ->
210
von_rgb (Rgb.aus_array (Array.map
211
(fun i -> (float_of_int i)/.maxvalf) d))))
214
let lies_pam dateiname =
215
let (breite,hoehe,tiefe,maxval,daten),typ =
216
Pam.read_pam (open_in (dateiname^".pam")) in
217
let maxvalf = float_of_int maxval in
219
then raise Falscher_TupleType
223
(Array.map (function d ->
224
von_rgba (Rgba.aus_array (Array.map
225
(fun i -> (float_of_int i)/.maxvalf) d))))
added
removed
data/graphik.ml
