2
Copyright 2007 by Mark Weyer
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.
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.
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
23
(*===========================================================================*)
25
let gric = 32 (* Not everything respects gric changes *)
27
let ml_graphik = ["pam";"natmod";"vektor";"farbe";"xpmlex";"graphik"]
28
let ml_vektorgraphik = ml_graphik @ ["polynome"; "vektorgraphik"]
32
let colour colour none some = match colour with
34
| Some (r,g,b) -> some^" "^
35
(string_of_int r)^"/"^(string_of_int g)^"/"^(string_of_int b)^" "
38
let rec num_anim digits a b = if a>b
41
let s = string_of_int a in
42
let missing = digits-(String.length s) in
43
((String.make (max 0 missing) '0')^s)::(num_anim digits (a+1) b)
45
let fill_anim left stages right = List.map
46
(fun stage -> left^stage^right)
51
let group file files = [[file],files,groupaction]
53
let xgz file = [[file^".xpm.gz"], [file^".xpm"],
54
["gzip -c -f -n "^file^".xpm > "^file^".xpm.gz"]]
56
let xzgroup file files = List.concat [
57
group file (fill_anim "" files ".xpm.gz");
58
List.concat (List.map xgz files);
61
let xpm_of_rgba ?(quant_colours=None) ?(quant_method="maximal") file = [
63
[file^".pam"; "machxpm.opt"],
64
["./machxpm.opt -rgba "^
65
(match quant_colours with
67
| Some n -> "-colours "^(string_of_int n))^
71
let pam_of_ppmpgm file = [
73
[file^".ppm"; file^".umriss.pgm"],
74
["pamarith -multiply "^file^".ppm "^file^".umriss.pgm "^
75
"| pamstack - "^file^".umriss.pgm > "^file^".pam"]]
77
let pgm_of_ppm file = [
80
["ppmtopgm "^file^".ppm | pamfunc -multiplier 255 > "^file^".pgm"]]
82
let xpm_of_ppm2 quant_colours quant_method file =
84
pgm_of_ppm (file^".umriss");
86
xpm_of_rgba ~quant_colours:quant_colours ~quant_method:quant_method file;
89
let pov_umriss file = [
92
["echo \"#declare Nur_Umriss=1;\" | "^
93
"cat - "^file^".pov > "^file^".umriss.pov"]]
95
let ppm_of_pov width height aa extra file includes =
96
let w,h = width*gric, height*gric in
97
let ws,hs = string_of_int w, string_of_int h in
99
(* The antialiasing argument aa is:
100
None for no antialiasing
101
Some true for antialising which respects pixel boundaries
102
Some false for antialising which does not respect pixel boundaries *)
104
[file^".pov"]@includes,
105
["povray +FP -D -w"^ws^" -h"^hs^
108
| Some true -> " +A +AM1 -J"
109
| Some false -> " +A +AM2 +R2 -J")^
112
"test -e "^file^".ppm && test `wc -c < "^file^".ppm` -eq "^
113
(* Test whether povray did well.
114
(Exit code 0 from povray does not really mean much.) *)
115
(string_of_int (w*h*3+(String.length ws)+(String.length hs)+9));
118
let xpm_of_pov_trans width height ?(aa=Some false) ?(extra="")
119
?(quant_colours=None) ?(quant_method="maximal") file includes =
120
let includes = "cuyopov.inc"::includes in
122
ppm_of_pov width height aa extra file includes;
124
ppm_of_pov width height aa extra (file^".umriss") includes;
125
xpm_of_ppm2 quant_colours quant_method file;
128
let xpm_of_ppm trans_colour quant_colours quant_method file = [
130
[file^".ppm"; "machxpm.opt"],
131
["./machxpm.opt -ppm "^
132
(colour trans_colour "" "-transcolour")^
133
(match quant_colours with
135
| Some n -> "-colours "^(string_of_int n))^
139
let xpm_of_pov width height ?(aa=Some false) ?(extra="") ?(trans_colour=None)
140
?(quant_colours=None) ?(quant_method="maximal") file includes =
142
ppm_of_pov width height aa extra file includes;
143
xpm_of_ppm trans_colour quant_colours quant_method file;
146
let stuff_of_prog files prog options = [
149
["./"^prog^" "^options]]
151
let ml_prog file includes =
152
let endings ending = List.map (fun include_ -> include_^ending) includes in
154
[file^".opt"; file^".cmx"; file^".cmi"; file^".o"],
155
(file^".ml")::(endings ".cmi")@(endings ".cmx"),
156
["ocamlopt.opt -o "^file^".opt"^
157
(List.fold_left (fun l -> fun r -> l^" "^r^".cmx") "" includes)^
160
let stuff_of_ml targets prog ?(options="") includes = List.concat [
161
stuff_of_prog targets (prog^".opt") options;
162
ml_prog prog includes;
165
let group_of_ml name targets includes = List.concat [
166
xzgroup name targets;
167
stuff_of_ml (fill_anim "" targets ".xpm") name
168
~options:(string_of_int gric) includes;
171
let ml_module file includes =
172
let endings ending = List.map (fun include_ -> include_^ending) includes in
175
(file^".mli")::(endings ".cmi"),
176
["ocamlopt.opt "^file^".mli"];
177
[file^".cmx"; file^".o"],
178
(file^".ml")::(file^".cmi")::(endings ".cmi")@(endings ".cmx"),
179
["ocamlopt.opt -c "^file^".ml"];
182
let recolour source drain colour' = [
184
[source^".xpm"; "machxpm.opt"],
185
["./machxpm.opt -xpm -recolour "^(colour colour' "trans " "")^
186
" "^source^" "^drain]]
188
let pov_fill2 source drain povvar value stage = [
189
[drain^stage^".pov"],
191
["echo \"#declare "^povvar^"="^value^";\" "^
192
"| cat - "^source^".pov > "^drain^stage^".pov"]]
194
let pov_fill file povvar stage = pov_fill2 file file povvar stage stage
196
let xpm_of_pov_fill_trans width height ?(aa=Some false) ?(extra="")
197
?(quant_colours=None) ?(quant_method="maximal") file includes
198
povvar stages = List.concat (List.map
199
(fun stage -> List.concat [
200
xpm_of_pov_trans width height ~aa:aa ~extra:extra
201
~quant_colours:quant_colours ~quant_method:quant_method
202
(file^stage) includes;
203
pov_fill file povvar stage])
206
(*===========================================================================*)
208
let rules = List.concat [
211
["aehnlich"; "aux"; "breakout"; "bunt"; "dungeon"; "fische"; "kacheln";
212
"kolben"; "puzzle"; "reversi"; "reversi_brl";
213
"rohrpost"; "rollenspiel"; "slime"; "tennis"; "zahn"; "ziehlen"];
216
xzgroup "aehnlich" ["maeSorten"; "maeSchema"];
217
xpm_of_pov_trans 4 4 "maeSchema" ["aehnlich.inc"];
218
xpm_of_pov_trans 7 14 ~quant_colours:(Some 400)
219
"maeSorten" ["aehnlich.inc"];
222
xzgroup "aux" ["font-big"; "highlight"; "feenstaub"];
223
xpm_of_rgba "font-big";
225
["font-orig.png";"genSchrift"],
226
["./genSchrift -font font-orig.png font-big.pam"]];
229
["g++ -g genSchrift.cc -L../lib -lSDL -lSDL_image -lm"^
230
" -I../include -I/usr/include/SDL -O2 -o genSchrift"]];
231
xpm_of_pov 3 3 ~trans_colour:(Some (30,30,70)) "highlight" [];
232
stuff_of_ml ["feenstaub.xpm"] "feenstaub" ml_graphik;
235
xzgroup "breakout" ["mbrBall2"; "mbrBall4"; "mbrSchlaeger"; "mbrStein"];
236
xpm_of_pov_trans 4 4 "mbrBall2" ["breakout.inc"];
237
xpm_of_pov_trans 8 8 "mbrBall4" ["breakout.inc"];
238
xpm_of_pov_trans 4 3 "mbrSchlaeger" ["breakout.inc"];
239
xpm_of_pov_trans 4 1 "mbrStein" ["breakout.inc"];
240
pov_fill "mbrBall" "Anzahl" "2";
241
pov_fill "mbrBall" "Anzahl" "4";
245
(let schmelz = num_anim 1 1 4 in
247
xzgroup "bunt" (["mbUnbunt";"mbBunt"]@
248
(fill_anim "mbSchmelz" schmelz ""));
249
xpm_of_pov_trans 17 1 ~quant_colours:(Some 512) "mbUnbunt" ["bunt.inc"];
250
xpm_of_pov_trans 17 8 ~quant_colours:(Some 512) "mbBunt" ["bunt.inc"];
251
xpm_of_pov_fill_trans 16 32 ~quant_colours:(Some 512)
252
"mbSchmelz" ["bunt.inc"] "Schritt" schmelz;
258
Damit niemand denkt, das Ausschalten von antialiasing (~aa:None)
259
sei aus Angst vor der Rechenzeit geschehen: Es ist v�llig normal,
260
da� sich die Graphiken �berlappen, so da� antialiasing gegen
261
irgendeine feste Farbe immer falsch ist.
264
["Plastik"; "Gold"] in
266
["Ziegel"; "Holz"; "Eisen"; "Stein"; "Fels"] in
267
let farben = farben22@farben31 in
268
let boden = num_anim 2 0 15 in
269
let render = num_anim 2 0 11 in
270
let render4 = num_anim 2 0 3 in
271
let render3 = num_anim 2 4 8 in
272
let render2 = num_anim 2 9 11 in
274
["dungeon_boden.inc"; "dungeon.inc"; "mdGold.inc"; "cuyo.ppm"] in
275
(* Eigentlich werden mdGold.inc und cuyo.ppm nur f�r den
276
Gold-Zweig gebraucht, aber wir machen es uns mal einfach. *)
278
group "dungeon" (fill_anim "dungeon" ("Boden"::farben) "");
279
xzgroup "dungeonBoden" (fill_anim "mdBoden" boden "");
280
List.concat (List.map
282
xpm_of_pov 3 1 ~aa:(Some true) ("md"^farbe) includes)
284
List.concat (List.map
286
xpm_of_pov_trans 2 2 ~aa:(Some true) ("md"^farbe) includes)
288
xpm_of_pov_fill_trans 4 2 ~extra:"-UV" "mdBoden" includes
289
"BodenVersion" boden;
290
List.concat (List.map
291
(fun farbe -> List.concat [
292
xzgroup ("dungeon"^farbe) (fill_anim ("md"^farbe) (""::render) "");
293
xpm_of_pov_fill_trans 4 4 ~aa:None ("md"^farbe) includes
295
xpm_of_pov_fill_trans 4 3 ~aa:None ~extra:"-UV" ("md"^farbe) includes
297
xpm_of_pov_fill_trans 4 2 ~aa:None ("md"^farbe) includes
304
["./mdGold.opt > mdGold.inc"]];
307
["xpmtoppm cuyo.xpm > cuyo.ppm"]];
309
(* Um sich die Pr�gung auf den Goldm�nzen anzusehen: *)
310
xpm_of_pov 10 5 "mdGoldM" includes;
311
pov_fill2 "mdGold" "mdGold" "Version" "-1" "M";
315
group_of_ml "fische" ["mffisch1"; "mffisch2"; "mffisch3"; "mffisch4";
316
"mfmuschel"; "mfqualle"]
320
group_of_ml "kacheln" ["mkaSechseckRahmen"; "mkaSechseckKacheln";
321
"mkaViereckRahmen"; "mkaViereckKacheln"; "mkaViereckFall";
322
"mkaFuenfeckRahmen"; "mkaFuenfeckKacheln"; "mkaFuenfeckFall";
323
"mkaRhombusRahmen"; "mkaRhombusKacheln"]
327
xzgroup "kolben" ["mkKolben"; "mkKolbenBlitzBlau";
328
"mkKolbenBlitzGruen"; "mkKolbenBlitzRot"];
329
recolour "mkKolben.src" "mkKolben" None;
330
recolour "mkKolben.src" "mkKolbenBlitzBlau" (Some (0,0,255));
331
recolour "mkKolben.src" "mkKolbenBlitzGruen" (Some (0,255,0));
332
recolour "mkKolben.src" "mkKolbenBlitzRot" (Some (255,0,0));
335
group_of_ml "puzzle" ["mpAlle"] ml_vektorgraphik;
338
xzgroup "reversi" ["mrAlle"; "mrTrenn"];
339
xpm_of_pov_trans 5 4 "mrAlle" ["reversi.inc"];
340
xpm_of_pov_trans ~aa:(Some true) 4 3
341
"mrTrenn" ["reversi.inc"; "fall_dreh.inc"];
344
xzgroup "reversi_brl" ["lreAlle"];
345
xpm_of_pov 3 6 ~trans_colour:(Some (255,255,255)) "lreAlle" [];
348
xzgroup "rohrpost" ["lpStart"; "lpWhite"; "lpYellow"; "lpPink"; "lpCyan"];
349
xpm_of_pov 4 20 ~trans_colour:(Some (0,0,0)) "lpStart" ["rohrpost.inc"];
350
xpm_of_pov 8 9 ~trans_colour:(Some (0,0,0)) "lpAlle" ["rohrpost.inc"];
351
recolour "lpAlle" "lpWhite" (Some (255,255,255));
352
recolour "lpAlle" "lpYellow" (Some (255,255,0));
353
recolour "lpAlle" "lpPink" (Some (255,0,255));
354
recolour "lpAlle" "lpCyan" (Some (0,255,255));
357
group_of_ml "rollenspiel" ["mrpAlle"] ml_vektorgraphik;
361
(let slime_anim = num_anim 1 0 5 in
362
let slime_pics = "msGreen"::"msRed"::(fill_anim "msRed" slime_anim "") in
364
xzgroup "slime" slime_pics;
365
List.concat (List.map
366
(fun file -> xpm_of_pov_trans 5 1 file [])
368
pov_fill2 "slime2" "msGreen" "Case" "1" "";
369
pov_fill2 "slime2" "msRed" "Case" "2" "";
370
List.concat (List.map
371
(fun stage -> pov_fill "msRed" "Time" stage)
377
(let times = num_anim 1 0 8 in
378
let colours = ["Yellow"; "Grey"; "Blue"; "Green"] in
379
let roofs = fill_anim "mtRoof" (num_anim 1 1 4) "" in
380
let moves = ["Left"; "Right"; "Bounce"; "In"; "Out"] in
381
let balls = List.concat (List.map (fill_anim "mt" colours) moves) in
382
let progtargets = roofs @ balls in
383
let ppmstuff = ["Wall"; "Roof"] in
384
let ppmpgmstuff = ["Ball"; "Source"] in
385
let extra = ["Source"; "Wall"; "Racket"] in
387
xzgroup "tennis" (progtargets @ (fill_anim "mt" extra ""));
388
ml_prog "tennis2" [];
391
["mt"^file^".ppm"; "mt"^file^"Alpha.pgm"],
393
["xpmtoppm --alphaout=mt"^file^"Alpha.pgm mt"^file^".xpm > mt"^file^".ppm"])
394
("Racket_"::ppmpgmstuff);
399
["xpmtoppm mt"^file^".xpm > mt"^file^".ppm"])
401
xpm_of_ppm None None "maximal" "mtRacket";
403
(fill_anim "" progtargets ".xpm"),
404
["mtBall.pgm"; "mtRoof.ppm"; "mtBlack32.ppm"; "mtBlack64.ppm"; "tennis2.opt"] @
405
(fill_anim "mt" ppmpgmstuff ".ppm") @
406
(fill_anim "mt" ppmpgmstuff "Alpha.pgm"),
410
["ppmtopgm mtBall.ppm > mtBall.pgm"];
411
["mtBlack32.ppm"], [],
412
["ppmmake rgbi:0/0/0 32 32 > mtBlack32.ppm"];
413
["mtBlack64.ppm"], [],
414
["ppmmake rgbi:0/0/0 64 64 > mtBlack64.ppm"];
416
["mtRacket_.ppm"; "mtRacket_Alpha.pgm"; "mtWall.ppm"],
417
["pnmcat -topbottom mtWall.ppm mtWall.ppm mtWall.ppm | pamcomp -alpha=mtRacket_Alpha.pgm mtRacket_.ppm - > mtRacket.ppm"];
424
xzgroup "zahn" ["mzZahn"; "mzZahnGras"; "mzZahnDreh"];
425
xpm_of_pov_trans 3 9 "mzZahn" ["zahn.inc"];
426
xpm_of_pov_trans 3 9 "mzZahnGras" ["zahn.inc"];
427
xpm_of_pov_trans 4 8 "mzZahnDreh" ["zahn.inc"];
428
pov_fill2 "mzZahn" "mzZahn" "Gras" "1" "Gras";
431
xzgroup "ziehlen" ["mziAlle"];
432
xpm_of_pov_trans 5 2 "mziAlle" [];
436
ml_module "natmod" [];
437
ml_module "vektor" ["natmod"];
438
ml_module "farbe" ["natmod"; "vektor"];
439
ml_module "xpmlex" ["farbe"];
440
ml_module "graphik" ["pam"; "farbe"; "xpmlex"];
441
ml_module "polynome" [];
442
ml_module "vektorgraphik" ["farbe"; "graphik"; "polynome"];
443
ml_module "valarg" [];
446
["ocamllex xpmlex.mll"]];
447
ml_prog "machxpm" ("valarg"::ml_graphik);
451
(*===========================================================================*)