1(* 2 Copyright 2006,2011 by Mark Weyer 3 Maintenance modifications 2007,2010 by the cuyo developers 4 5 This program is free software; you can redistribute it and/or modify 6 it under the terms of the GNU General Public License as published by 7 the Free Software Foundation; either version 2 of the License, or 8 (at your option) any later version. 9 10 This program is distributed in the hope that it will be useful, 11 but WITHOUT ANY WARRANTY; without even the implied warranty of 12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 GNU General Public License for more details. 14 15 You should have received a copy of the GNU General Public License 16 along with this program; if not, write to the Free Software 17 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 18*) 19 20open Farbe 21open Graphik 22open Vektorgraphik 23open Helfer 24 25open Male_mit_aa 26 27let gib_xpm_aus aufloesung name bild = 28 gib_xpm_aus (rgb_grau 1.0) name (berechne aufloesung bild) 29 30let farbraum_hai = [ 31 von_rgb (rgbrgb 0.25 0.5 0.95); 32 von_rgb (rgbrgb 0.5 0.75 1.0); 33 ] 34 35let farbraum_krake = [ 36 von_rgb (rgbrgb 0.79 0.06 0.79); 37 von_rgb (rgbrgb 0.95 0.37 0.96); 38 ] 39 40let farbraum3 = 41 let o = von_rgb (rgbrgb 0.9 0.6 0.15) in 42 let w = von_rgb (rgbrgb 1.0 0.95 0.85) in 43 [ 44 von_rgb (rgbrgb 0.6 1.0 0.7); 45 w; 46 o; 47 von_rgb (rgbrgb 0.85 0.2 0.05); 48 o; 49 w; 50 ] 51 52let farbraum4 = [ 53 von_rgb (rgbrgb 0.5 0.95 0.25); 54 von_rgb (rgbrgb 0.75 1.0 0.5); 55 ] 56 57let farbraum_goldfisch = [ 58 von_rgb (rgbrgb 0.95 0.4 0.15); 59 von_rgb (rgbrgb 1.0 0.7 0.4); 60 ] 61 62let farbraum6 = 63 let w = von_rgb (rgbrgb 1.0 0.95 0.9) in 64 let s = von_rgb (rgbrgb 0.3 0.3 0.35) in 65 [s; w; s; w; s; w;] 66 67let zug f (h::t) = snd (List.fold_left 68 (function p,bisher -> function p' -> p',(f p p')::bisher) 69 (h,[]) t) 70let polygonzug = zug (function p -> function p' -> Strecke (p,p')) 71let spline (x1,y1,dx1,dy1) (x2,y2,dx2,dy2) = 72 Spline ((x1,y1),(x1+.dx1,y1+.dy1),(x2-.dx2,y2-.dy2),(x2,y2)) 73let splines = zug spline 74let strich p = Strich (schwarz, p) 75let umrande f ps = [flaeche f ps; strich ps] 76 77let richtung (x,y) laenge winkel = 78 let winkel = winkel*.pi/.180.0 in 79 x, y, laenge*.(cos winkel), laenge*.(sin winkel) 80let in_richtung p l w = 81 let x,y,dx,dy = richtung p l w in 82 x+.dx, y+.dy 83let punkt_auf_polygon p t = 84 match punkt_auf_polygon_relativ p t with 85 p',Some w -> p',w 86 87 88 89let korrektur bild = erzeuge_vektorbild (verschiebe_dinge 0.5 0.5 bild) 90 91let male bild hintergrund = male (korrektur bild) (1.0/.32.0) hintergrund 92 93 94 95type zustand = 96 | Warten 97 | Zucken 98 | Fressen 99 100let auge_rad = 0.07 101 102let auge = konvertiere_polygon [Kreis ((0.0,0.0),auge_rad)] 103let auge farbe zustand = if zustand=Zucken 104 then umrande farbe [auge] 105 else 106 let pupille = konvertiere_polygon 107 [Kreis ((0.5*.auge_rad,0.0),auge_rad*.0.5)] in 108 [ 109 Flaechen ([|schwarz;weiss|], [auge,1,None; pupille,0,Some 1]); 110 strich [auge]; 111 ] 112let auge (x,y) w farbe zustand = 113 verschiebe_dinge x y (drehe_dinge w (auge farbe zustand)) 114 115let loeschdaten groesse = 116 (if groesse > 0.6 then 0.4 else 0.3), 117 (if groesse > 0.6 then -0.4 else -0.3), 118 0.5 -. (groesse*.3.0 -. floor(groesse*.3.0)) 119 120 121 122let hai farbe groesse kiemenzahl zustand = 123 124 let laenge = (groesse**(1.0/.3.0))*.0.4 in 125 let dicke = (groesse**(2.0/.3.0))*.0.3 in 126 let extralaenge = match zustand with 127 | Warten -> 0.0 128 | Zucken -> -.laenge/.8.0 129 | Fressen -> laenge/.8.0 in 130 131 let mundwinkel = richtung (laenge/.2.0, -.dicke/.7.0) (laenge/.5.0) 240.0 in 132 let mund,nase,kinn = if zustand=Fressen 133 then (laenge*.3.0/.4.0, -.dicke/.7.0), (laenge, dicke), (laenge, -.dicke) 134 else (laenge, 0.0), (laenge, dicke/.3.0), (laenge, -.dicke/.3.0) in 135 let mund1,mund2 = if zustand=Fressen 136 then richtung mund (dicke/.2.0) 90.0, richtung mund (dicke/.2.0) 90.0 137 else richtung mund (dicke/.7.0) 0.0, richtung mund (dicke/.7.0) 180.0 in 138 let nasekinn_extrawinkel = if zustand=Fressen then 60.0 else 0.0 in 139 let nase1 = richtung nase (dicke/.7.0) (120.0+.nasekinn_extrawinkel) in 140 let nase2 = richtung nase (dicke/.2.0) (120.0+.nasekinn_extrawinkel) in 141 let nase3 = richtung nase (laenge/.2.0) (-30.0+.nasekinn_extrawinkel) in 142 let kinn1 = richtung kinn (dicke/.2.0) (60.0-.nasekinn_extrawinkel) in 143 let kinn2 = richtung kinn (dicke/.7.0) (60.0-.nasekinn_extrawinkel) in 144 let heck = -.laenge*.0.9-.extralaenge, 0.0 in 145 let heck1 = richtung heck dicke 240.0 in 146 let heck2 = richtung heck dicke 300.0 in 147 let heck3 = richtung heck laenge (-15.0) in 148 let rumpf_oben = konvertiere_polygon [ 149 spline nase2 heck1; 150 ] in 151 let rumpf_nur_unten = konvertiere_polygon [spline heck2 kinn1] in 152 let rumpf_unten = konvertiere_polygon [ 153 spline heck2 kinn1; 154 spline kinn2 mund2; 155 spline mund1 nase1; 156 ] in 157 158 let auge_basis,auge_basis_w = punkt_auf_polygon rumpf_oben 0.3 in 159 let auge_p = in_richtung auge_basis (auge_rad*.0.5) (auge_basis_w+.90.0) in 160 let oben_basis,oben_basis_w = 161 punkt_auf_polygon rumpf_oben (if zustand=Zucken then 0.63 else 0.6) in 162 let obenoben = in_richtung oben_basis (dicke*.0.6) (oben_basis_w-.90.0) in 163 let obenoben1 = richtung obenoben (dicke/.3.0) (oben_basis_w+.90.0) in 164 let obenoben2 = richtung obenoben (dicke/.3.0) (oben_basis_w-.15.0) in 165 let obenvorne = 166 in_richtung oben_basis (laenge*.0.4) (oben_basis_w+.160.0) in 167 let obenvorne1 = richtung obenvorne (dicke/.3.0) (oben_basis_w-.90.0) in 168 let obenhinten = 169 in_richtung oben_basis (laenge*.0.4) (oben_basis_w+.30.0) in 170 let obenhinten1 = richtung obenhinten (dicke/.3.0) (oben_basis_w+.45.0) in 171 let unten_basis,unten_basis_w = punkt_auf_polygon rumpf_nur_unten 0.55 in 172 let untenunten = in_richtung unten_basis 173 (if zustand=Zucken then dicke/.5.0 else dicke/.3.0) 174 (unten_basis_w-.90.0) in 175 let untenunten1 = richtung untenunten (laenge/.4.0) (unten_basis_w) in 176 let untenunten2 = 177 richtung untenunten (laenge/.4.0) (unten_basis_w-.105.0) in 178 let untenvorne = 179 in_richtung unten_basis (dicke*.0.6) (unten_basis_w+.30.0) in 180 let untenvorne1 = 181 richtung untenvorne (dicke/.10.0) (unten_basis_w+.135.0) in 182 let untenhinten = 183 in_richtung unten_basis (dicke/.3.0) (unten_basis_w+.50.0) in 184 let untenhinten1 = 185 richtung untenhinten (dicke/.10.0) (unten_basis_w-.135.0) in 186 let schwanzoben = -.laenge*.1.1-.extralaenge, dicke in 187 let schwanzoben1 = richtung schwanzoben dicke (-75.0) in 188 let schwanzoben2 = richtung schwanzoben (laenge+.extralaenge) 165.0 in 189 let schwanzunten = -.laenge*.1.1-.extralaenge, -.dicke in 190 let schwanzunten1 = richtung schwanzunten dicke (-105.0) in 191 let schwanzunten2 = richtung schwanzunten (laenge+.extralaenge) 15.0 in 192 193 let rec kiemen n = if n=kiemenzahl 194 then [] 195 else (Bogen 196 ((dicke/.2.0-.(float_of_int n)*.(1.0/.12.0+.extralaenge/.4.0), 0.0), 197 dicke/.2.0, true, pi*.5.0/.6.0, pi*.7.0/.6.0)) 198 :: (kiemen (n+1)) in 199 let kiemen = [strich [konvertiere_polygon (kiemen 0)]] in 200 let kiemen = [strich [konvertiere_polygon (list_for 0 (kiemenzahl-1) (fun i -> 201 Bogen ((dicke/.2.0-.(float_of_int i)*.(1.0/.12.0+.extralaenge/.4.0), 0.0), 202 dicke/.2.0, true, pi*.5.0/.6.0, pi*.7.0/.6.0)))]] in 203 204 205 let schwanz = konvertiere_polygon [ 206 spline schwanzoben1 schwanzunten1; 207 spline schwanzunten2 schwanzoben2; 208 ] in 209 let oben = konvertiere_polygon 210 (splines [obenoben1; obenhinten1; obenvorne1; obenoben2]) in 211 let farbwechsel = konvertiere_polygon [spline heck3 nase3] in 212 let mund = konvertiere_polygon [spline mund2 mundwinkel] in 213 let unten = konvertiere_polygon 214 (splines [untenunten1; untenvorne1; untenhinten1; untenunten2]) in 215 let loescho,loeschu,loeschl = loeschdaten groesse in 216 let loeschen = konvertiere_polygon (polygonzug [ 217 0.0,0.0; nase; laenge,loescho; loeschl,loescho; 218 loeschl,loeschu; laenge,loeschu; kinn; 0.0,0.0 219 ]) in 220 221 let schwanz = umrande (farbe 1) [schwanz] in 222 let oben = umrande (farbe 1) [oben] in 223 let rumpf = [ 224 Flaechen ([|farbe 1; farbe 2|], 225 [rumpf_oben, 0, None; rumpf_unten, 1, None; farbwechsel, 0, Some 1]); 226 strich ([rumpf_oben; rumpf_unten] 227 @ (if zustand=Fressen then [] else [mund])); 228 (* beim Fressen ist der Mund Teil der unteren Mundlinie *) 229 ] in 230 let auge = auge auge_p (auge_basis_w-.180.0) (farbe 1) zustand in 231 let unten = umrande (farbe 1) [unten] in 232 let loeschen = if zustand=Fressen 233 then [flaeche hintergrund [loeschen]] 234 else [] in 235 236 loeschen @ schwanz @ oben @ rumpf @ kiemen @ auge @ unten 237 238 239 240let krake farbe groesse augenzahl zustand = 241 let laenge = (groesse ** 0.3) in 242 let dicke = groesse ** (1.0/.2.0) in 243 let tentakel_dicke = dicke*.0.02 in 244 let tentakel_rand_dicke = tentakel_dicke+.1.0/.32.0 in 245 let kopf_rad = dicke*.0.2 in 246 let kopf_x = -.kopf_rad-.(if zustand=Fressen then laenge*.0.2 else 0.0) in 247 let blesse_richtung = 130.0 in 248 let blesse_breite = 50.0 in 249 let augen = List.concat (List.map 250 (function (r,w) -> 251 auge (in_richtung (kopf_x,0.0) (r*.kopf_rad) w) 0.0 (farbe 1) zustand) 252 (List.nth [ 253 []; 254 [0.4,0.0]; 255 [0.6,45.0; 0.7,-110.0;]; 256 [0.65,-30.0; 0.7,50.0; 0.8,-130.0;] 257 ] augenzahl)) in 258 let tentakel ry rlaenge w1 w2 w3 w3' = if zustand=Fressen 259 then konvertiere_polygon [Strecke 260 ((kopf_x, kopf_rad*.ry), (kopf_x+.laenge*.rlaenge, dicke*.0.5*.ry))] 261 else 262 let laenge = laenge*.0.5*.rlaenge in 263 let p t = 264 kopf_x/.2.0+.laenge*.t, 265 (kopf_rad*.(1.0-.t)+.dicke*.0.3*.t)*.ry in 266 konvertiere_polygon (splines [ 267 richtung (p 0.0) (kopf_rad*.1.0) w1; 268 richtung (p 0.3) (kopf_rad*.1.0) w2; 269 richtung (p (if zustand=Zucken then 0.85 else 1.0)) 270 (kopf_rad*.1.0) 271 (if zustand=Zucken then w3' else w3)]) in 272 let kopf = konvertiere_polygon 273 [Kreis ((kopf_x,0.0),kopf_rad-.tentakel_dicke)] in 274 let blesse1,blesse2 = 275 (kopf_x-.kopf_rad*.0.65,kopf_rad*.0.15), 276 (kopf_x+.kopf_rad*.0.05,kopf_rad*.0.75) in 277 let blesse1,blesse2 = 278 richtung blesse1 (kopf_rad/.3.0) 90.0, 279 richtung blesse2 (kopf_rad/.3.0) 0.0 in 280 let blesse = konvertiere_polygon (splines [blesse1;blesse2;blesse1]) in 281 let kopf_vorne = [Flaechen ([|farbe 1; farbe 2|], 282 [kopf, 0, None; blesse, 0, Some 1])] in 283 let dickstrich p = [ 284 Dicker_Strich (schwarz, tentakel_rand_dicke, p); 285 Dicker_Strich (farbe 1, tentakel_dicke, p)] in 286 let rand_hinten = [ 287 tentakel (-0.5) 0.85 20.0 (-5.0) (-30.0) 0.0; 288 tentakel 0.5 0.9 10.0 (-15.0) 15.0 (-15.0)] in 289 let rand_hinten = dickstrich rand_hinten in 290 let rand_vorne = [kopf; 291 tentakel (-0.8) 1.0 60.0 0.0 45.0 15.0; 292 tentakel 0.0 1.0 (-15.0) 30.0 0.0 30.0; 293 tentakel 0.8 1.0 10.0 5.0 (-15.0) (-30.0);] in 294 let rand_vorne = dickstrich rand_vorne in 295 let loescho,loeschu,loeschl = loeschdaten groesse in 296 let loeschen = konvertiere_polygon (polygonzug [ 297 loeschl,loeschu; 298 kopf_x+.laenge+.dicke*.0.1, loeschu; 299 kopf_x+.laenge, dicke*. -0.4; 300 kopf_x, kopf_rad*. -0.8; 301 kopf_x, kopf_rad*.0.8; 302 kopf_x+.laenge, dicke*.0.4; 303 kopf_x+.laenge+.dicke*.0.1, loescho; 304 loeschl, loescho; 305 loeschl, loeschu]) in 306 let loeschen = if zustand=Fressen 307 then [flaeche hintergrund [loeschen]] 308 else [] in 309 loeschen @ rand_hinten @ rand_vorne @ kopf_vorne @ augen 310 311 312 313let zierfisch farbe groesse kiemenzahl zustand = 314 let laenge = groesse**(1.0/.2.0)*.0.8 in 315 let mund_laenge = 0.1 in 316 let zucklaenge = if zustand=Zucken then laenge/.15.0 else 0.0 in 317 let kiemenrad = laenge/.4.0 in 318 let kiemend = laenge/.11.0 in 319 320 let streifen_parameter = [ 321 0.2, 80.0, 105.0, 95.0; 322 -0.3, 95.0, 80.0, 85.0; 323 0.15, 70.0, 75.0, 65.0; 324 0.1, 105.0, 95.0, 80.0; 325 0.3, 75.0, 80.0, 95.0; 326 ] in 327 let anz_streifen = List.length streifen_parameter + 1 in 328 let streifen_x i = 329 let i' = float_of_int(i)/.float_of_int(anz_streifen) -.0.5 in 330 laenge *. i' -. 331 if i'<0.0 then 2.0*.zucklaenge*.i' else 0.0 in 332 let streifen i = 333 let h,wu,wm,wo = List.nth streifen_parameter (i-1) in 334 let x = streifen_x i in 335 let lm = laenge/.3.0 in 336 konvertiere_polygon (splines [ 337 richtung (x,-.laenge/.2.0) (lm*.(1.0+.h)) wu; 338 richtung (x,laenge/.2.0*.h) lm wm; 339 richtung (x,laenge/.2.0) (lm*.(1.0-.h)) wo; 340 ]) in 341 let streifen_rahmen i = konvertiere_polygon ( 342 Strecke ((streifen_x i,laenge/.2.0),(streifen_x (i-1),laenge/.2.0)) :: 343 Strecke ((streifen_x (i-1),-.laenge/.2.0),(streifen_x i,-.laenge/.2.0)) :: 344 if i=1 345 then [Strecke ((streifen_x 0, laenge/.2.0),(streifen_x 0, -.laenge/.2.0))] 346 else if i=anz_streifen 347 then [Strecke ((laenge/.2.0, -.laenge/.2.0),(laenge/.2.0, laenge/.2.0))] 348 else []) in 349 let streifen = Flaechen ( 350 Array.init anz_streifen (fun i -> farbe (i+1)), 351 list_for 1 anz_streifen (fun i -> streifen_rahmen i, i-1, None) @ 352 list_for 1 (anz_streifen-1) (fun i -> streifen i, i-1, Some i)) in 353 354 let mund = (laenge/.2.0, 0.0) in 355 let mund' = (laenge/.2.0-.mund_laenge, 0.0) in 356 let stirn = (laenge*.0.2, laenge/.4.0) in 357 let kinn = (laenge*.0.2, -.laenge/.4.0) in 358 let oben = (-0.15*.laenge, laenge/.2.0) in 359 let unten = (-0.15*.laenge, -.laenge/.2.0) in 360 let kreuz = (zucklaenge/.2.0-.laenge*.0.2, laenge/.8.0) in 361 let po = (zucklaenge/.2.0-.laenge*.0.2, -.laenge/.8.0) in 362 let obenh = (zucklaenge-.laenge/.2.0, laenge/.4.0) in 363 let untenh = (zucklaenge-.laenge/.2.0, -.laenge/.4.0) in 364 365 let mundo,mundu,mundw,stirnw = if zustand=Fressen 366 then 367 in_richtung mund (laenge/.2.0) 90.0, 368 in_richtung mund (laenge/.2.0) 270.0, 369 225.0, 370 180.0 371 else mund,mund,145.0,135.0 in 372 let munduw,mundul = if zustand=Zucken 373 then 80.0, laenge/.3.0 374 else 540.0-.mundw, laenge/.6.0 in 375 376 let umriss_aussen = List.concat [ 377 splines [ 378 richtung mundo (laenge/.6.0) mundw; 379 richtung stirn (laenge/.6.0) stirnw; 380 richtung oben (laenge/.6.0) 125.0; 381 ]; 382 splines [ 383 richtung oben (laenge/.7.0) 260.0; 384 richtung kreuz (laenge/.13.0) 225.0; 385 richtung obenh (laenge/.9.0) 120.0; 386 ]; 387 [Spline (obenh, 388 in_richtung obenh (laenge/.6.0) 280.0, 389 in_richtung untenh (laenge/.6.0) 80.0, 390 untenh); 391 ]; 392 splines [ 393 richtung untenh (laenge/.9.0) 60.0; 394 richtung po (laenge/.13.0) 315.0; 395 richtung unten (laenge/.7.0) 260.0; 396 ]; 397 splines [ 398 richtung unten (laenge/.6.0) 55.0; 399 richtung kinn (laenge/.6.0) (540.0-.stirnw); 400 richtung mundu (laenge/.6.0) munduw; 401 ]] in 402 403 let mund,umriss = if zustand=Fressen 404 then [], Spline (mundu,mund',mund',mundo) :: umriss_aussen 405 else [Strecke (mund,mund')], umriss_aussen in 406 let mund,umriss = konvertiere_polygon mund, konvertiere_polygon umriss in 407 408 let streifen_weg = flaeche durchsichtig [umriss; 409 konvertiere_polygon (polygonzug [ 410 laenge/.2.0, laenge/.2.0; 411 -.laenge/.2.0,laenge/.2.0; 412 -.laenge/.2.0,-.laenge/.2.0; 413 laenge/.2.0, -.laenge/.2.0; 414 laenge/.2.0, laenge/.2.0; 415 ])] in 416 417 let loescho,loeschu,loeschl = loeschdaten groesse in 418 let loescho = max loescho (0.55*.laenge) in 419 let loeschu = min loeschu (-0.55*.laenge) in 420 let loeschl = min loeschl (-0.55*.laenge) in 421 let loeschen = if zustand=Fressen 422 then [flaeche hintergrund [konvertiere_polygon (umriss_aussen @ 423 polygonzug [ 424 mundu; 425 laenge*.0.55, loeschu; 426 loeschl, loeschu; 427 loeschl, loescho; 428 laenge*.0.55, loescho; 429 mundo; 430 ])]] 431 else [] in 432 433 let kiemen = konvertiere_polygon (list_for 1 kiemenzahl (fun i -> 434 Bogen ((kiemenrad-.kiemend*.float_of_int(i-2),0.0), 435 kiemenrad, true, 7.0*.pi/.8.0, 9.0*.pi/.8.0))) in 436 437 let zierrat = [mund; kiemen; umriss] in 438 let zierrat = [strich zierrat] in 439 440 let auge = auge 441 (in_richtung stirn (laenge/.12.0) 270.0) 442 0.0 (farbe 5) zustand in 443 444 streifen :: streifen_weg :: loeschen @ zierrat @ auge 445 446 447 448let seepferdchen farbe groesse flossenanzahl zustand = 449 let hoehe = groesse ** (1.0/.2.0) *. 0.9 in 450 let breite = hoehe/.2.0 in 451 let schwanz_segmente = (if zustand=Zucken then 7 else 5)*flossenanzahl in 452 let schwanz_y = -0.3*.hoehe in 453 let schwanz_x = 0.25*.breite in 454 let hueft_x1 = 0.0 in 455 let hueft_x2 = -0.25*.breite in 456 let nacken_y = 0.3*.hoehe in 457 let flossenbreite = breite/.3.0 in 458 let hals_w = 80.0 in 459 let bauch_dicke = breite/.4.0 in 460 let bauch_w = 20.0 in 461 let mund_w = -20.0 in 462 463 let schwanz_segmentef = float_of_int schwanz_segmente in 464 let schwanz_dw = pi/.3.0 in 465 let schwanz_r1 = schwanz_x -. hueft_x1 in 466 let schwanz_r2 = schwanz_x -. hueft_x2 in 467 let schwanz_rf2 = (schwanz_r1/.schwanz_r2) ** (schwanz_dw/.2.0/.pi) in 468 let schwanz_rf1 = 469 ((schwanz_r2/.schwanz_r1) ** (1.0/.schwanz_segmentef)) *. schwanz_rf2 in 470 let schwanz_w1 = atan2 (log schwanz_rf1) schwanz_dw in 471 let schwanz_w2 = atan2 (log schwanz_rf2) schwanz_dw in 472 let schwanz r f w = konvertiere_polygon (splines 473 (list_for 0 schwanz_segmente (fun i -> 474 let if_ = float_of_int i in 475 let r = r*.(f**if_) in 476 let w' = pi+.schwanz_dw*.if_ in 477 richtung (schwanz_x+.r*.cos w', schwanz_y+.r*.sin w') 478 (r*.schwanz_dw/.3.0) 479 ((w'+.pi/.2.0-.w)*.180.0/.pi)))) in 480 let schwanz = [ 481 rueckwaerts (schwanz schwanz_r1 schwanz_rf1 schwanz_w1); 482 schwanz schwanz_r2 schwanz_rf2 schwanz_w2; 483 ] in 484 485 let koerper_h = nacken_y-.schwanz_y in 486 let ruecken_y = (nacken_y+.schwanz_y)/.2.0 in 487 let ruecken_r = (schwanz_y-.ruecken_y) /. sin schwanz_w2 in 488 let ruecken_x = hueft_x2 +. ruecken_r *. cos schwanz_w2 in 489 let ruecken = konvertiere_polygon 490 [Bogen ((ruecken_x,ruecken_y), ruecken_r, false, 491 pi-.schwanz_w2, pi+.schwanz_w2)] in 492 let flossen = konvertiere_polygon (splines 493 (list_for 0 (3*flossenanzahl) (fun i -> 494 let w = schwanz_w2 *. 495 (1.0 -. float_of_int i /. float_of_int flossenanzahl /. 1.5) in 496 let r = ruecken_r +. 497 if i mod 3 = 1 || i mod 3 = 2 then flossenbreite else 0.0 in 498 richtung (ruecken_x-.r*.cos w,ruecken_y-.r*.sin w) 499 (koerper_h/.(float_of_int flossenanzahl)/.2.0) 500 (180.0/.pi*.(w -. pi/.2.0))))) in 501 502 let bauchsl = koerper_h/.6.0 in 503 let nacken1 = hueft_x1,nacken_y in 504 let bauch = splines [ 505 richtung (hueft_x1,schwanz_y) bauchsl (180.0/.pi*.(pi/.2.0-.schwanz_w1)); 506 richtung (hueft_x1+.bauch_dicke, (2.0*.schwanz_y+.nacken_y)/.3.0) 507 bauchsl (90.0-.bauch_w); 508 richtung (hueft_x1+.bauch_dicke, (schwanz_y+.2.0*.nacken_y)/.3.0) 509 bauchsl (90.0+.bauch_w); 510 richtung nacken1 bauchsl hals_w; 511 ] in 512 513 let kopf = (hueft_x1+.hueft_x2)/.2.0, nacken_y+.hoehe/.6.0 in 514 let nacken2 = hueft_x2,nacken_y in 515 let mund = in_richtung 516 ((hueft_x1+.hueft_x2)/.2.0,nacken_y+.hoehe/.9.0) 517 (breite*.0.6) mund_w in 518 let mundo = in_richtung mund 0.02 (mund_w+.90.0) in 519 let mundu = in_richtung mund 0.02 (mund_w-.90.0) in 520 let kopf = [ 521 Spline (nacken1, in_richtung nacken1 (breite/.4.0) 340.0, 522 in_richtung mundu (breite/.4.0) (mund_w+.183.0), mundu); 523 Strecke (mundu,mundo); 524 Spline (mundo, in_richtung mundo (breite/.3.0) (mund_w+.177.0), 525 in_richtung kopf (breite/.3.0) 10.0, kopf); 526 Spline (kopf, 527 in_richtung kopf (hoehe/.11.0) 260.0, 528 in_richtung nacken2 (hoehe/.11.0) (90.0+.180.0/.pi*.schwanz_w2), 529 nacken2); 530 ] in 531 532 let restrand = konvertiere_polygon (bauch @ kopf) :: schwanz in 533 534 let auge = auge 535 ((hueft_x1+.hueft_x1)/.2.0, nacken_y+.hoehe/.10.0) 536 0.0 (farbe 1) zustand in 537 538 let loescho,loeschu,loeschl = loeschdaten groesse in 539 let fressor = (0.7,loescho) in 540 let fressur = (0.7,loeschu) in 541 let loeschen = if zustand=Fressen 542 then [konvertiere_polygon ( 543 Spline (mund, in_richtung mund 0.2 mund_w, 544 in_richtung fressor 0.2 180.0, fressor) :: 545 Spline (fressur, in_richtung fressur 0.2 180.0, 546 in_richtung mund 0.2 mund_w, mund) :: 547 polygonzug [fressor; loeschl,loescho; loeschl,loeschu; fressur])] 548 else [] in 549 550 let linien = konvertiere_polygon (bauch @ kopf) :: ruecken :: flossen :: schwanz in 551 552 [ 553 flaeche hintergrund loeschen; 554 Flaechen ([| farbe 1; farbe 2|], 555 (flossen, 0, None) :: 556 (ruecken, 0, Some 1) :: 557 List.map (fun p -> p,1,None) restrand); 558 strich linien; 559 ] @ auge 560 561 562 563let fuelle_parameter fisch verschieben groesse anzahl zustand farbe = 564 let bild = fisch farbe (groesse/.3.0) anzahl zustand in 565 if verschieben 566 then verschiebe_dinge (groesse-.(floor groesse)) 0.0 bild 567 else bild 568 569let fischkomplett fisch farbe = 570 let statisch y n = [ 571 0,y,1,fisch (float_of_int n) n Warten; 572 1,y,1,fisch (float_of_int n) n Zucken] in 573 let beweglich y n = [ 574 0,y,2,fisch ((float_of_int n)+.1.0/.3.0) n Fressen; 575 0,y-1,2,fisch ((float_of_int n)+.2.0/.3.0) (n+1) Fressen] in 576 let haelfte = kombiniere_bildchen 2 7 (List.map 577 (function x,y,w,b -> x,y, male (b farbe) (monochrom durchsichtig w 1)) 578 ((statisch 6 1) @ (beweglich 5 1) 579 @ (statisch 3 2) @ (beweglich 2 2) @ (statisch 0 3))) in 580 kombiniere_bildchen 4 7 [0,0,haelfte; 2,0,spiegel_x haelfte] 581 582 583 584let muschel augen oeffnung = 585 let farbe = List.nth [ 586 schwarz; 587 von_rgb (rgbrgb 0.9 1.0 0.5); 588 von_rgb (rgbrgb 0.8 0.7 0.4); 589 von_rgb (rgbrgb 0.3 0.3 0.3); 590 ] in 591 let streifen = 5 in 592 let costreifen = 3 in 593 let rad = 0.4 in 594 let dicke = 0.15 in 595 let klappenwinkel = pi/.6.0 in 596 let dreh (x,y,z) t = x, y*.(cos t)+.z*.(sin t) in 597 let punkt u t = 598 let t' = 1.0-.t in 599 let u' = 2.0*.u-.1.0 in 600 let w = u'*.pi*.0.5 in 601 t*.rad*.(sin w) +. t'*.rad*.(sin klappenwinkel)*.u', 602 t*.t'*.(1.0-.u'*.u')*.dicke*.4.0, 603 -.t*.rad*.((cos klappenwinkel)+.(cos w)) in 604 let punkt i j = punkt 605 ((float_of_int i)/.(float_of_int streifen)) 606 ((float_of_int j)/.(float_of_int costreifen)) in 607 let punkt w i j = dreh (punkt i j) w in 608 let punkt oben i j = if oben 609 then punkt (0.1-.oeffnung) i j 610 else let x,y = punkt (-0.1) i j in x,-.y in 611 let minmax oben i = 612 let rec versuche j (minj,miny) (maxj,maxy) = if j>costreifen 613 then minj,maxj 614 else 615 let x,y = punkt oben i j in 616 versuche (j+1) 617 (if y<=miny then j,y else minj,miny) 618 (if y>=maxy then j,y else maxj,maxy) in 619 let x,y = punkt oben i 0 in 620 versuche 1 (0,y) (0,y) in 621 let maxoben = Array.init (streifen+1) (function i -> snd (minmax true i)) in 622 let minunten = 623 Array.init (streifen+1) (function i -> fst (minmax false i)) in 624 let liste f n = 625 let rec erstelle i = if i>=n 626 then [] 627 else (f i)::(erstelle (i+1)) in 628 erstelle 0 in 629 let zug f n = konvertiere_polygon 630 (liste (function i -> Strecke (f i,f (i+1))) n) in 631 let haelfte oben extrema = 632 let senkrecht1 = Array.init (streifen+1) 633 (function i -> zug (function j -> punkt oben i j) extrema.(i)) in 634 let senkrecht2 = Array.init (streifen+1) 635 (function i -> zug (function j -> punkt oben i (j+extrema.(i))) 636 (costreifen-extrema.(i))) in 637 let waagerecht1 = Array.init streifen 638 (function i -> konvertiere_polygon 639 [Strecke (punkt oben i 0, punkt oben (i+1) 0)]) in 640 let waagerecht2 = Array.init streifen 641 (function i -> konvertiere_polygon [Strecke 642 (punkt oben i extrema.(i), punkt oben (i+1) extrema.(i+1))]) in 643 let waagerecht3 = Array.init streifen 644 (function i -> konvertiere_polygon 645 [Strecke (punkt oben i costreifen, punkt oben (i+1) costreifen)]) in 646 [Flaechen 647 (Array.init streifen 648 (function i -> misch2 (farbe 3) (farbe (1+(i mod 2))) oeffnung), 649 (liste (function i -> waagerecht1.(i), i, None) streifen) @ 650 (liste (function i -> rueckwaerts (waagerecht2.(i)), i, None) streifen) @ 651 (liste (function i -> senkrecht1.(i+1), i, Some (i+1)) (streifen-1)) @ 652 [senkrecht1.(streifen), streifen-1, None; 653 rueckwaerts senkrecht1.(0), 0, None]); 654 Flaechen 655 (Array.init streifen (function i -> farbe (1+(i mod 2))), 656 (liste (function i -> waagerecht2.(i), i, None) streifen) @ 657 (liste (function i -> rueckwaerts (waagerecht3.(i)), i, None) streifen) @ 658 (liste (function i -> senkrecht2.(i+1), i, Some (i+1)) (streifen-1)) @ 659 [senkrecht2.(streifen), streifen-1, None; 660 rueckwaerts senkrecht2.(0), 0, None]); 661 strich 662 ((Array.to_list waagerecht1) @ 663 (Array.to_list waagerecht2) @ 664 (Array.to_list waagerecht3) @ 665 [senkrecht1.(0);senkrecht2.(0); 666 senkrecht1.(streifen);senkrecht2.(streifen)]) 667 ] in 668 let augen = match augen with 669 | None -> [] 670 | Some rechts -> 671 (auge (0.13,0.0) (if rechts then 0.0 else 180.0) weiss Warten) @ 672 (auge (-0.13,0.0) (if rechts then 0.0 else 180.0) weiss Warten) in 673 verschiebe_dinge 0.0 (-0.2) 674 ((haelfte false minunten)@(haelfte true maxoben)@augen) 675 676 677let muschelkomplett u = 678 let schliessbilder = 5 in 679 let minoeffnung = 0.1 in 680 let rec schliessen i = if i>=schliessbilder 681 then [] 682 else (i,None,minoeffnung +. (1.0-.minoeffnung)*. 683 (float_of_int i)/.(float_of_int (schliessbilder-1))) 684 ::(schliessen (i+1)) in 685 let bilder = 686 (schliessbilder,Some true,minoeffnung) :: 687 (schliessbilder+1,Some false,minoeffnung) :: 688 (schliessen 0) in 689 let hintergrund = monochrom durchsichtig 1 1 in 690 kombiniere_bildchen (schliessbilder+2) 1 691 (List.map 692 (function i,a,o -> i,0, 693 male (muschel a o) hintergrund) 694 bilder) 695 696 697 698type qzustand = Auf | Zu | Mitte 699 700let qualle zustand unten = 701 let farbe = List.nth [ 702 schwarz; 703 von_rgb (rgbrgb 1.0 0.3 0.3); 704 von_rgb (rgbrgb 0.9 0.8 0.5); 705 von_rgb (rgbrgb 0.8 0.9 1.0); 706 ] in 707 let faden_dicke = 0.02 in 708 let faden_spline_staerke = 0.2 in 709 let glocke_spline_staerke = 0.6 in 710 let faden_rand_dicke = faden_dicke +. 1.0/.32.0 in 711 let faden staerke p1 p2 w = 712 let p3 = in_richtung p2 0.07 w in 713 let sp1,sp2,sp3 = 714 richtung p1 staerke 270.0, 715 richtung p2 staerke w, 716 richtung p3 staerke w in 717 let anfang,ende = 718 konvertiere_polygon [spline sp1 sp2], 719 konvertiere_polygon [spline sp2 sp3] in 720 [Dicker_Strich (schwarz, faden_rand_dicke, [anfang;ende]); 721 Dicker_Strich (farbe 2, faden_dicke, [anfang]); 722 Dicker_Strich (farbe 1, faden_dicke, [ende])] in 723 let faeden x y1 y2 w = 724 let faden t = faden 725 (faden_spline_staerke *. (y1-.y2)) 726 (0.175*.t,y1) 727 (x*.t,y2+.0.05*.t*.t) 728 (270.0+.w*.t) in 729 (faden (-1.0))@(faden (-1.0/.3.0))@(faden (1.0/.3.0))@(faden 1.0) in 730 let glocke x y1 y2 w = 731 let staerke = glocke_spline_staerke *. (y1-.y2) in 732 let p1,p2,p3 = (-.x,y2), (x,y2), (0.0,y1) in 733 let sp1,sp1',sp2,sp2',sp3 = 734 richtung p1 staerke (-.w), 735 richtung p1 staerke (270.0-.w), 736 richtung p2 staerke w, 737 richtung p2 staerke (90.0+.w), 738 richtung p3 staerke 180.0 in 739 konvertiere_polygon [ 740 spline sp1 sp2; 741 spline sp2' sp3; 742 spline sp3 sp1'] in 743 let glocke,faeden = match zustand with 744 | Auf -> glocke 0.45 0.3 0.0 45.0, 745 faeden 0.35 0.1 (-0.2) 45.0 746 | Zu -> glocke 0.30 0.4 (-0.15) (-15.0), 747 faeden 0.25 0.15 (-0.35) 15.0 748 | Mitte -> glocke 0.35 0.3 (-0.1) 15.0, 749 faeden 0.3 0.1 (-0.25) 30.0 in 750 if unten 751 then (umrande (farbe 3) [glocke]) @ faeden 752 else umrande (misch2 durchsichtig (farbe 3) 0.5) [glocke] 753 754let qualle_komplett u = 755 let hintergrund = monochrom durchsichtig 1 1 in 756 kombiniere_bildchen 3 1 757 (List.map 758 (fun (x,z) -> 759 let q u = male (qualle z u) hintergrund in 760 x,0,ueberlagerung (q true) (q false) None) 761 [0,Mitte; 1,Auf; 2,Zu]) 762 763 764 765 766let fischraus gric name farbraum fisch = 767 gib_xpm_aus gric name 768 (fischkomplett (fuelle_parameter fisch true) 769 (fun i -> List.nth farbraum (i-1))) 770 771let muschelraus gric name = gib_xpm_aus gric name (muschelkomplett ()) 772 773let qualleraus gric name = gib_xpm_aus gric name (qualle_komplett ()) 774 775;; 776 777 778let gric,command,outname = Gen_common.parse_args () in 779 780match command with 781| "mfmuschel" -> muschelraus gric outname 782| "mfqualle" -> qualleraus gric outname 783| _ -> let farbraum,form = match command with 784 | "mffisch1" -> farbraum_hai, hai 785 | "mffisch2" -> farbraum_krake, krake 786 | "mffisch3" -> farbraum6, zierfisch 787 | "mffisch4" -> farbraum4, seepferdchen 788 | "mffisch5" -> farbraum3, zierfisch 789 | "mffisch6" -> farbraum_goldfisch, hai in 790 fischraus gric outname farbraum form 791 792