← Back to branch summary

~ubuntu-branches/ubuntu/saucy/cuyo/saucy

« back to all changes in this revision

Viewing changes to datasrc/pics/graphik.ml

  • Committer: Bazaar Package Importer
  • Author(s): Angel Abad
  • Date: 2010-07-19 09:54:44 UTC
  • mfrom: (4.1.3 sid)
  • Revision ID: james.westby@ubuntu.com-20100719095444-ecoegzo1vvvdwra9
Tags: 2.~-1.1.brl3-1ubuntu1
https://launchpad.net/bugs/607106
* Merge from debian unstable (LP: #607106). Remaining changes:
  - Don't register MimeType=application/x-executable in
    the .desktop file.
  - Remove UTF-8 in the .desktop file
  - 

Show diffs side-by-side

added added

removed removed

Lines of Context:
datasrc/pics/graphik.ml
1
 
(*
2
 
   Copyright 2006 by Mark Weyer
3
 
 
4
 
   This program is free software; you can redistribute it and/or modify
5
 
   it under the terms of the GNU General Public License as published by
6
 
   the Free Software Foundation; either version 2 of the License, or
7
 
   (at your option) any later version.
8
 
 
9
 
   This program is distributed in the hope that it will be useful,
10
 
   but WITHOUT ANY WARRANTY; without even the implied warranty of
11
 
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12
 
   GNU General Public License for more details.
13
 
 
14
 
   You should have received a copy of the GNU General Public License
15
 
   along with this program; if not, write to the Free Software
16
 
   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
17
 
*)
18
 
 
19
 
open Farbe
20
 
 
21
 
module Rgb = Vektor.Vektor(Natmod.Drei)
22
 
module Rgba = Vektor.Vektor(Natmod.Vier)
23
 
 
24
 
type punkt = float * float
25
 
 
26
 
type bildchen = int * int * (punkt -> farbe)
27
 
 
28
 
let monochrom farbe breite hoehe = breite, hoehe, function p -> farbe
29
 
 
30
 
let spiegel_x (breite,hoehe,farben) =
31
 
  let breite_f = float_of_int breite  in
32
 
  breite, hoehe,
33
 
  function x,y -> farben (breite_f-.x,y)
34
 
 
35
 
let kombiniere_bildchen breite hoehe einzelne =
36
 
  breite, hoehe,
37
 
  function (x,y) -> List.fold_left
38
 
    (function farbe -> function (x0,y0,(breite,hoehe,farben)) ->
39
 
      if (float_of_int x0)<=x && (x<=(float_of_int (x0+breite)))
40
 
          && (float_of_int y0)<=y && (y<=(float_of_int (y0+hoehe)))
41
 
        then farben (x-.(float_of_int x0), y-.(float_of_int y0))
42
 
        else farbe)
43
 
    durchsichtig
44
 
    einzelne
45
 
 
46
 
let ueberlagerung (b,h,funten) (b',h',foben) maske =
47
 
  match maske  with
48
 
  | None -> (b,h, fun p ->
49
 
    let o = foben p  in
50
 
    let d = nur_durchsichtig o  in
51
 
    if d=0.0  then o  else misch2 o (funten p) d)
52
 
  | Some (b'',h'',fmaske) -> (b,h, fun p ->
53
 
    let d = nur_durchsichtig (fmaske p)  in
54
 
    if d=0.0
55
 
    then foben p
56
 
    else if d=1.0
57
 
        then funten p
58
 
        else misch2 (foben p) (funten p) d)
59
 
 
60
 
 
61
 
 
62
 
 
63
 
type pixelbild = int * int * farbe array array
64
 
 
65
 
let berechne pixel (breite,hoehe,farben) =
66
 
  let breite,hoehe = breite*pixel,hoehe*pixel  in
67
 
  let aufloesung = 1.0/.(float_of_int pixel)  in
68
 
  breite,hoehe,Array.init hoehe (function y ->
69
 
    let yf = ((float_of_int (hoehe-y))-.0.5)*.aufloesung  in
70
 
    Array.init breite (function x ->
71
 
      farben (((float_of_int x)+.0.5)*.aufloesung, yf)))
72
 
 
73
 
let extrahiere_farben (breite,hoehe,pixel) =
74
 
  let n,k = Array.fold_left (Array.fold_left (fun (n,k) -> fun farbe ->
75
 
      if FarbMap.mem farbe k
76
 
      then n,k
77
 
      else n+1, FarbMap.add farbe n k))
78
 
    (0,FarbMap.empty)
79
 
    pixel  in
80
 
  let p = Array.make n schwarz  in    (* schwarz ist ein dummy *)
81
 
  FarbMap.iter
82
 
    (fun farbe -> fun i -> p.(i)<-farbe)
83
 
    k;
84
 
  p,k
85
 
 
86
 
let extrahiere_verteilung (breite,hoehe,pixel) =
87
 
  let n,v = Array.fold_left (Array.fold_left
88
 
    (fun (n,v) -> fun farbe -> if FarbMap.mem farbe v
89
 
      then n, FarbMap.add farbe ((FarbMap.find farbe v)+1) v
90
 
      else n+1, FarbMap.add farbe 1 v))
91
 
    (0,FarbMap.empty)  pixel  in
92
 
  let v' = Array.make n (schwarz,0)  in
93
 
  ignore (FarbMap.fold
94
 
    (fun farbe -> fun anzahl -> fun n ->
95
 
      v'.(n) <- (farbe,anzahl);
96
 
      n+1)
97
 
    v  0);
98
 
  v'
99
 
 
100
 
 
101
 
 
102
 
let xpm_zeichen = " #@*+-=~/.,:;_&%$!?|" ^
103
 
  "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" ^
104
 
  "'`^(){}[]<>"
105
 
 
106
 
let anz_xpm_zeichen = String.length xpm_zeichen
107
 
 
108
 
 
109
 
let gib_xpm_aus h palette farbsuche dateiname (breite,hoehe,pixel) =
110
 
  let anz_farb = Array.length palette  in
111
 
  let kodier_breite =
112
 
    let rec log n = if n>anz_xpm_zeichen
113
 
      then 1+(log (n/anz_xpm_zeichen))
114
 
      else 1  in
115
 
    log anz_farb  in
116
 
  let kodiere i =
117
 
    let rec kodiere_rest rest_laenge rest_i =
118
 
      if rest_laenge=0
119
 
        then ""
120
 
        else (kodiere_rest (rest_laenge-1) (rest_i/anz_xpm_zeichen))
121
 
          ^(String.sub xpm_zeichen (rest_i mod anz_xpm_zeichen) 1)  in
122
 
    kodiere_rest kodier_breite i  in
123
 
 
124
 
  let datei = open_out (dateiname^".xpm")  in
125
 
  let os = output_string datei  in
126
 
  let oi i = os (string_of_int i)  in
127
 
 
128
 
  let hex n =
129
 
    let hex_ziffer n = String.sub "0123456789ABCDEF" n 1  in
130
 
    (hex_ziffer (n/16))^(hex_ziffer (n mod 16))  in
131
 
  let hex f = os (hex (truncate (255.0*.f+.0.5)))  in
132
 
 
133
 
  os "/* XPM */\n";
134
 
  os "static char * noname[] = {\n";
135
 
  os "\""; oi breite; os " "; oi hoehe; os " ";
136
 
    oi anz_farb; os " "; oi kodier_breite; os "\"";
137
 
  ignore (Array.fold_left
138
 
    (function i -> function f ->
139
 
      os ",\n\""; os (kodiere i); os " c ";
140
 
      (if f=durchsichtig
141
 
        then os "None"
142
 
        else if f=hintergrund
143
 
          then os "Background"
144
 
          else
145
 
            let rgb = zu_rgb h h f  in
146
 
            os "#"; hex (Rgb.koord rgb 0);
147
 
            hex (Rgb.koord rgb 1); hex (Rgb.koord rgb 2));
148
 
      os "\"";
149
 
      i+1)
150
 
    0
151
 
    palette);
152
 
  for y = 0 to hoehe-1 do
153
 
    os ",\n\"";
154
 
    for x = 0 to breite-1 do
155
 
      os (kodiere (farbsuche pixel.(y).(x)))
156
 
    done;
157
 
    os "\"";
158
 
  done;
159
 
  os "};\n";
160
 
  close_out datei
161
 
 
162
 
 
163
 
let gib_xpm_aus_exakt h name bild =
164
 
  let palette,karte = extrahiere_farben bild  in
165
 
  gib_xpm_aus h palette (fun farbe -> FarbMap.find farbe karte) name bild
166
 
 
167
 
let gib_xpm_aus_runden h palette =
168
 
  let index = mach_index palette  in
169
 
  gib_xpm_aus h palette (naechste_farbe palette index)
170
 
 
171
 
let gib_xpm_aus h name bild = gib_xpm_aus_runden h
172
 
  (reduziere_farben2 (fst (extrahiere_farben bild)) anz_xpm_zeichen)
173
 
  name  bild
174
 
 
175
 
 
176
 
exception Falscher_TupleType
177
 
 
178
 
let lies_xpm dateiname =
179
 
  let lex = Lexing.from_channel (open_in (dateiname^".xpm"))  in
180
 
  let lies_zeile u = Xpmlex.xpm lex  in
181
 
  let zeile1 = Lexing.from_string (lies_zeile ())  in
182
 
  let zahl u = Xpmlex.erstezeile zeile1  in
183
 
  let breite = zahl ()  in
184
 
  let hoehe = zahl ()  in
185
 
  let anz_farben = zahl ()  in
186
 
  let charpp = zahl ()  in
187
 
  let farben = Array.to_list (Array.init anz_farben (function i ->
188
 
    let zeile = lies_zeile ()  in
189
 
    String.sub zeile 0 charpp,
190
 
    Xpmlex.farbzeilenrest (Lexing.from_string
191
 
      (String.sub zeile charpp ((String.length zeile)-charpp)))))  in
192
 
  breite,hoehe,Array.init hoehe (function y ->
193
 
    let zeile = lies_zeile ()  in
194
 
    Array.init breite (function x ->
195
 
      List.assoc (String.sub zeile (x*charpp) charpp) farben))
196
 
 
197
 
let lies_ppm dateiname =
198
 
  let (breite,hoehe,tiefe,maxval,daten),typ =
199
 
    Pam.read_pam (open_in (dateiname^".ppm"))  in
200
 
  let maxvalf = float_of_int maxval  in
201
 
  if tiefe!=3
202
 
    then raise Falscher_TupleType
203
 
    else
204
 
      breite,hoehe,
205
 
      Array.map
206
 
        (Array.map (function d ->
207
 
          von_rgb (Rgb.aus_array (Array.map
208
 
            (fun i -> (float_of_int i)/.maxvalf) d))))
209
 
        daten
210
 
 
211
 
let lies_pam dateiname =
212
 
  let (breite,hoehe,tiefe,maxval,daten),typ =
213
 
    Pam.read_pam (open_in (dateiname^".pam"))  in
214
 
  let maxvalf = float_of_int maxval  in
215
 
  if tiefe!=4
216
 
    then raise Falscher_TupleType
217
 
    else
218
 
      breite,hoehe,
219
 
      Array.map
220
 
        (Array.map (function d ->
221
 
          von_rgba (Rgba.aus_array (Array.map
222
 
            (fun i -> (float_of_int i)/.maxvalf) d))))
223
 
        daten
224
 
 
225