2
Copyright 2006 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
26
let orange = von_rgb (rgbrgb 1.0 0.7 0.0)
28
let pi = 4.0*.(atan 1.0)
30
type kante = float * float * float -> float -> polygon
31
(* floats: ragen nach oben und unten.
32
float-Argumente: ragen links und rechts *)
34
let gerade_kante = 0.0,0.0,
35
function l -> function r -> [Strecke ((l,0.0),(1.0-.r,0.0))]
37
let nupsi1_kante,nupsi2_kante =
38
let rad1,rad2 = 0.02, 0.1 in
39
let h = (rad1+.rad2)*.(sqrt 0.5) in
40
(h+.rad1+.rad2, 0.0, function l -> function r -> [
41
Strecke ((l,0.0),(0.5-.h,0.0));
42
Bogen ((0.5-.h,rad1),rad1,true,pi*.1.5,pi*.0.25);
43
Bogen ((0.5,h+.rad1),rad2,false,pi*.1.25,pi*.1.75);
44
Bogen ((0.5+.h,rad1),rad1,true,pi*.0.75,pi*.1.5);
45
Strecke ((0.5+.h,0.0),(1.0-.r,0.0));]),
46
(0.0, h+.rad1+.rad2, function l -> function r -> [
47
Strecke ((l,0.0),(0.5-.h,0.0));
48
Bogen ((0.5-.h,-.rad1),rad1,false,pi*.0.5,pi*.1.75);
49
Bogen ((0.5,-.h-.rad1),rad2,true,pi*.0.75,pi*.0.25);
50
Bogen ((0.5+.h,-.rad1),rad1,false,pi*.1.25,pi*.0.5);
51
Strecke ((0.5+.h,0.0),(1.0-.r,0.0));])
53
let nupsi3_kante = (* Der symmetrische Nupsi *)
54
let rad1,rad2,d = 0.02, 0.07, 0.05 in
55
let h1,h2,h3 = rad1+.2.0*.rad2, 2.0*.rad2, rad1+.d in
56
h3+.rad2, h3+.rad2, function l -> function r -> [
57
Strecke ((l,0.0),(0.5-.h1,0.0));
58
Bogen ((0.5-.h1,rad1),rad1,true,pi*.1.5,0.0);
59
Strecke ((0.5-.h2,rad1),(0.5-.h2,h3));
60
Bogen ((0.5-.rad2,h3),rad2,false,pi,0.0);
61
Strecke ((0.5,h3),(0.5,-.h3));
62
Bogen ((0.5+.rad2,-.h3),rad2,true,pi,0.0);
63
Strecke ((0.5+.h2,-.h3),(0.5+.h2,-.rad1));
64
Bogen ((0.5+.h1,-.rad1),rad1,false,pi,pi*.0.5);
65
Strecke ((0.5+.h1,0.0),(1.0-.r,0.0));
68
let nupsi4_kante,nupsi5_kante =
69
let d1,d2 = 0.2, 0.15 in
70
(d2, 0.0, function l -> function r -> [
71
Strecke ((l,0.0),(0.5-.d1,0.0));
72
Spline ((0.5-.d1,0.0),(0.5,0.0),(0.5-.d1,d2),(0.5,d2));
73
Spline ((0.5,d2),(0.5+.d1,d2),(0.5,0.0),(0.5+.d1,0.0));
74
Strecke ((0.5+.d1,0.0),(1.0-.r,0.0));]),
75
(0.0, d2, function l -> function r -> [
76
Strecke ((l,0.0),(0.5-.d1,0.0));
77
Spline ((0.5-.d1,0.0),(0.5,0.0),(0.5-.d1,-.d2),(0.5,-.d2));
78
Spline ((0.5,-.d2),(0.5+.d1,-.d2),(0.5,0.0),(0.5+.d1,0.0));
79
Strecke ((0.5+.d1,0.0),(1.0-.r,0.0));])
81
let waagerecht = [gerade_kante; nupsi1_kante; nupsi5_kante;
82
nupsi3_kante; nupsi2_kante; nupsi4_kante]
84
let senkrecht = List.map
85
(function o,u,p -> o,u,
86
function l -> function r -> drehe_polygon 90.0 (p l r))
89
let bilder = (List.length waagerecht)*(List.length senkrecht)
91
let puzzle waagerecht senkrecht =
92
let ow,uw,pw = waagerecht in
93
let ls,rs,ps = senkrecht in
94
let oben,unten,links,rechts =
95
abstand+.ow, abstand+.uw, abstand+.ls, abstand+.rs in
97
List.map (function x,y,l,r -> verschiebe_polygon x y (pw l r)),
98
List.map (function x,u,o -> verschiebe_polygon x 0.0 (ps u o)) in
99
let wstriche,sstriche =
100
List.map (function x1,x2,y -> Strecke ((x1,y),(x2,y))),
101
List.map (function x,y1,y2 -> Strecke ((x,y1),(x,y2))) in
102
let vorwaerts = konvertiere_polygon (List.concat (
103
(wkanten [2.0,unten,links,rechts; 4.0,unten,-.rechts,0.0]) @
104
(skanten [2.0-.rechts,0.0,0.0; 3.0-.rechts,unten,oben]) @
105
[wstriche [0.0,links,unten; 5.0,5.0-.rechts,1.0-.oben];
107
links,unten,0.0; 4.0-.rechts,0.0,unten;
108
1.0+.links,1.0,1.0-.oben; 5.0-.rechts,1.0-.oben,1.0]])) in
109
let rueckwaerts = rueckwaerts (konvertiere_polygon (List.concat (
110
(wkanten [0.0,1.0-.oben,0.0,-.links; 2.0,1.0-.oben,links,rechts]) @
111
(skanten [2.0+.links,unten,oben; 3.0+.links,0.0,0.0])))) in
112
let aussen = [vorwaerts;rueckwaerts] in
113
let ersatz = [konvertiere_polygon (
115
links,2.0-.rechts,0.0; 3.0+.links,4.0-.rechts,0.0;
116
2.0-.rechts,1.0+.links,1.0; 5.0-.rechts,3.0+.links,1.0]) @
117
(sstriche [0.0,1.0-.oben,unten; 5.0,unten,1.0-.oben]))] in
118
let innen = [konvertiere_polygon (List.concat (
119
(wkanten [0.0,0.0,links,0.0; 1.0,0.0,0.0,rechts; 3.0,0.0,links,rechts;
120
1.0,1.0,links,rechts; 3.0,1.0,links,0.0; 4.0,1.0,0.0,rechts]) @
121
(skanten [0.0,unten,oben; 1.0,0.0,oben; 4.0,unten,0.0; 5.0,unten,oben])
125
[flaeche orange (aussen@ersatz); Strich (schwarz,aussen@innen)])
127
(monochrom durchsichtig 5 1)
129
let puzzles = kombiniere_bildchen 5 bilder (fst (List.fold_left
130
(function bilder,y -> function waagerecht -> List.fold_left
131
(function bilder,y -> function senkrecht ->
132
(0,y,puzzle waagerecht senkrecht)::bilder, y+1)
133
(bilder,y) senkrecht)
140
let gric = int_of_string Sys.argv.(1) in
142
gib_xpm_aus (rgb_grau 1.0) "mpAlle" (berechne gric puzzles)
added
removed
data/puzzle.ml
