-
Notifications
You must be signed in to change notification settings - Fork 0
/
min-rt.ml
2320 lines (2011 loc) · 67.3 KB
/
min-rt.ml
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
(****************************************************************)
(* *)
(* Ray Tracing Program for (Mini) Objective Caml *)
(* *)
(* Original Program by Ryoji Kawamichi *)
(* Arranged for Chez Scheme by Motohico Nanano *)
(* Arranged for Objective Caml by Y. Oiwa and E. Sumii *)
(* Added diffuse ray tracer by Y.Ssugawara *)
(* *)
(****************************************************************)
(*NOMINCAML open MiniMLRuntime;;*)
(*NOMINCAML open Globals;;*)
(*MINCAML*) let rec xor x y = if x then not y else y in
(******************************************************************************
ユーティリティー
*****************************************************************************)
(* 符号 *)
let rec sgn x =
if fiszero x then 0.0
else if fispos x then 1.0
else -1.0
in
(* 条件付き符号反転 *)
let rec fneg_cond cond x =
if cond then x else fneg x
in
(* (x+y) mod 5 *)
let rec add_mod5 x y =
let sum = x + y in
if sum >= 5 then sum - 5 else sum
in
(******************************************************************************
ベクトル操作のためのプリミティブ
*****************************************************************************)
(*
let rec vecprint v =
(o_param_abc m) inFormat.eprintf "(%f %f %f)" v.(0) v.(1) v.(2)
in
*)
(* 値代入 *)
let rec vecset v x y z =
v.(0) <- x;
v.(1) <- y;
v.(2) <- z
in
(* 同じ値で埋める *)
let rec vecfill v elem =
v.(0) <- elem;
v.(1) <- elem;
v.(2) <- elem
in
(* 零初期化 *)
let rec vecbzero v =
vecfill v 0.0
in
(* コピー *)
let rec veccpy dest src =
dest.(0) <- src.(0);
dest.(1) <- src.(1);
dest.(2) <- src.(2)
in
(* 距離の自乗 *)
let rec vecdist2 p q =
fsqr (p.(0) -. q.(0)) +. fsqr (p.(1) -. q.(1)) +. fsqr (p.(2) -. q.(2))
in
(* 正規化 ゼロ割りチェック無し *)
let rec vecunit v =
let il = 1.0 /. sqrt(fsqr v.(0) +. fsqr v.(1) +. fsqr v.(2)) in
v.(0) <- v.(0) *. il;
v.(1) <- v.(1) *. il;
v.(2) <- v.(2) *. il
in
(* 符号付正規化 ゼロ割チェック*)
let rec vecunit_sgn v inv =
let l = sqrt (fsqr v.(0) +. fsqr v.(1) +. fsqr v.(2)) in
let il = if fiszero l then 1.0 else if inv then -1.0 /. l else 1.0 /. l in
v.(0) <- v.(0) *. il;
v.(1) <- v.(1) *. il;
v.(2) <- v.(2) *. il
in
(* 内積 *)
let rec veciprod v w =
v.(0) *. w.(0) +. v.(1) *. w.(1) +. v.(2) *. w.(2)
in
(* 内積 引数形式が異なる版 *)
let rec veciprod2 v w0 w1 w2 =
v.(0) *. w0 +. v.(1) *. w1 +. v.(2) *. w2
in
(* 別なベクトルの定数倍を加算 *)
let rec vecaccum dest scale v =
dest.(0) <- dest.(0) +. scale *. v.(0);
dest.(1) <- dest.(1) +. scale *. v.(1);
dest.(2) <- dest.(2) +. scale *. v.(2)
in
(* ベクトルの和 *)
let rec vecadd dest v =
dest.(0) <- dest.(0) +. v.(0);
dest.(1) <- dest.(1) +. v.(1);
dest.(2) <- dest.(2) +. v.(2)
in
(* ベクトル要素同士の積 *)
let rec vecmul dest v =
dest.(0) <- dest.(0) *. v.(0);
dest.(1) <- dest.(1) *. v.(1);
dest.(2) <- dest.(2) *. v.(2)
in
(* ベクトルを定数倍 *)
let rec vecscale dest scale =
dest.(0) <- dest.(0) *. scale;
dest.(1) <- dest.(1) *. scale;
dest.(2) <- dest.(2) *. scale
in
(* 他の2ベクトルの要素同士の積を計算し加算 *)
let rec vecaccumv dest v w =
dest.(0) <- dest.(0) +. v.(0) *. w.(0);
dest.(1) <- dest.(1) +. v.(1) *. w.(1);
dest.(2) <- dest.(2) +. v.(2) *. w.(2)
in
(******************************************************************************
オブジェクトデータ構造へのアクセス関数
*****************************************************************************)
(* テクスチャ種 0:無し 1:市松模様 2:縞模様 3:同心円模様 4:斑点*)
let rec o_texturetype m =
let (m_tex, xm_shape, xm_surface, xm_isrot,
xm_abc, xm_xyz,
xm_invert, xm_surfparams, xm_color,
xm_rot123, xm_ctbl) = m
in
m_tex
in
(* 物体の形状 0:直方体 1:平面 2:二次曲面 3:円錐 *)
let rec o_form m =
let (xm_tex, m_shape, xm_surface, xm_isrot,
xm_abc, xm_xyz,
xm_invert, xm_surfparams, xm_color,
xm_rot123, xm_ctbl) = m
in
m_shape
in
(* 反射特性 0:拡散反射のみ 1:拡散+非完全鏡面反射 2:拡散+完全鏡面反射 *)
let rec o_reflectiontype m =
let (xm_tex, xm_shape, m_surface, xm_isrot,
xm_abc, xm_xyz,
xm_invert, xm_surfparams, xm_color,
xm_rot123, xm_ctbl) = m
in
m_surface
in
(* 曲面の外側が真かどうかのフラグ true:外側が真 false:内側が真 *)
let rec o_isinvert m =
let (xm_tex, xm_shape, xm_surface, xm_isrot,
xm_abc, xm_xyz,
m_invert, xm_surfparams, xm_color,
xm_rot123, xm_ctbl) = m in
m_invert
in
(* 回転の有無 true:回転あり false:回転無し 2次曲面と円錐のみ有効 *)
let rec o_isrot m =
let (xm_tex, xm_shape, xm_surface, m_isrot,
xm_abc, xm_xyz,
xm_invert, xm_surfparams, xm_color,
xm_rot123, xm_ctbl) = m in
m_isrot
in
(* 物体形状の aパラメータ *)
let rec o_param_a m =
let (xm_tex, xm_shape, xm_surface, xm_isrot,
m_abc, xm_xyz,
xm_invert, xm_surfparams, xm_color,
xm_rot123, xm_ctbl) = m
in
m_abc.(0)
in
(* 物体形状の bパラメータ *)
let rec o_param_b m =
let (xm_tex, xm_shape, xm_surface, xm_isrot,
m_abc, xm_xyz,
xm_invert, xm_surfparams, xm_color,
xm_rot123, xm_ctbl) = m
in
m_abc.(1)
in
(* 物体形状の cパラメータ *)
let rec o_param_c m =
let (xm_tex, xm_shape, xm_surface, xm_isrot,
m_abc, xm_xyz,
xm_invert, xm_surfparams, xm_color,
xm_rot123, xm_ctbl) = m
in
m_abc.(2)
in
(* 物体形状の abcパラメータ *)
let rec o_param_abc m =
let (xm_tex, xm_shape, xm_surface, xm_isrot,
m_abc, xm_xyz,
xm_invert, xm_surfparams, xm_color,
xm_rot123, xm_ctbl) = m
in
m_abc
in
(* 物体の中心x座標 *)
let rec o_param_x m =
let (xm_tex, xm_shape, xm_surface, xm_isrot,
xm_abc, m_xyz,
xm_invert, xm_surfparams, xm_color,
xm_rot123, xm_ctbl) = m
in
m_xyz.(0)
in
(* 物体の中心y座標 *)
let rec o_param_y m =
let (xm_tex, xm_shape, xm_surface, xm_isrot,
xm_abc, m_xyz,
xm_invert, xm_surfparams, xm_color,
xm_rot123, xm_ctbl) = m
in
m_xyz.(1)
in
(* 物体の中心z座標 *)
let rec o_param_z m =
let (xm_tex, xm_shape, xm_surface, xm_isrot,
xm_abc, m_xyz,
xm_invert, xm_surfparams, xm_color,
xm_rot123, xm_ctbl) = m
in
m_xyz.(2)
in
(* 物体の拡散反射率 0.0 -- 1.0 *)
let rec o_diffuse m =
let (xm_tex, xm_shape, xm_surface, xm_isrot,
xm_abc, xm_xyz,
xm_invert, m_surfparams, xm_color,
xm_rot123, xm_ctbl) = m
in
m_surfparams.(0)
in
(* 物体の不完全鏡面反射率 0.0 -- 1.0 *)
let rec o_hilight m =
let (xm_tex, xm_shape, xm_surface, xm_isrot,
xm_abc, xm_xyz,
xm_invert, m_surfparams, xm_color,
xm_rot123, xm_ctbl) = m
in
m_surfparams.(1)
in
(* 物体色の R成分 *)
let rec o_color_red m =
let (xm_tex, xm_shape, m_surface, xm_isrot,
xm_abc, xm_xyz,
xm_invert, xm_surfparams, m_color,
xm_rot123, xm_ctbl) = m
in
m_color.(0)
in
(* 物体色の G成分 *)
let rec o_color_green m =
let (xm_tex, xm_shape, m_surface, xm_isrot,
xm_abc, xm_xyz,
xm_invert, xm_surfparams, m_color,
xm_rot123, xm_ctbl) = m
in
m_color.(1)
in
(* 物体色の B成分 *)
let rec o_color_blue m =
let (xm_tex, xm_shape, m_surface, xm_isrot,
xm_abc, xm_xyz,
xm_invert, xm_surfparams, m_color,
xm_rot123, xm_ctbl) = m
in
m_color.(2)
in
(* 物体の曲面方程式の y*z項の係数 2次曲面と円錐で、回転がある場合のみ *)
let rec o_param_r1 m =
let (xm_tex, xm_shape, xm_surface, xm_isrot,
xm_abc, xm_xyz,
xm_invert, xm_surfparams, xm_color,
m_rot123, xm_ctbl) = m
in
m_rot123.(0)
in
(* 物体の曲面方程式の x*z項の係数 2次曲面と円錐で、回転がある場合のみ *)
let rec o_param_r2 m =
let (xm_tex, xm_shape, xm_surface, xm_isrot,
xm_abc, xm_xyz,
xm_invert, xm_surfparams, xm_color,
m_rot123, xm_ctbl) = m
in
m_rot123.(1)
in
(* 物体の曲面方程式の x*y項の係数 2次曲面と円錐で、回転がある場合のみ *)
let rec o_param_r3 m =
let (xm_tex, xm_shape, xm_surface, xm_isrot,
xm_abc, xm_xyz,
xm_invert, xm_surfparams, xm_color,
m_rot123, xm_ctbl) = m
in
m_rot123.(2)
in
(* 光線の発射点をあらかじめ計算した場合の定数テーブル *)
(*
0 -- 2 番目の要素: 物体の固有座標系に平行移動した光線始点
3番目の要素:
直方体→無効
平面→ abcベクトルとの内積
二次曲面、円錐→二次方程式の定数項
*)
let rec o_param_ctbl m =
let (xm_tex, xm_shape, xm_surface, xm_isrot,
xm_abc, xm_xyz,
xm_invert, xm_surfparams, xm_color,
xm_rot123, m_ctbl) = m
in
m_ctbl
in
(******************************************************************************
Pixelデータのメンバアクセス関数群
*****************************************************************************)
(* 直接光追跡で得られたピクセルのRGB値 *)
let rec p_rgb pixel =
let (m_rgb, xm_isect_ps, xm_sids, xm_cdif, xm_engy,
xm_r20p, xm_gid, xm_nvectors ) = pixel in
m_rgb
in
(* 飛ばした光が物体と衝突した点の配列 *)
let rec p_intersection_points pixel =
let (xm_rgb, m_isect_ps, xm_sids, xm_cdif, xm_engy,
xm_r20p, xm_gid, xm_nvectors ) = pixel in
m_isect_ps
in
(* 飛ばした光が衝突した物体面番号の配列 *)
(* 物体面番号は オブジェクト番号 * 4 + (solverの返り値) *)
let rec p_surface_ids pixel =
let (xm_rgb, xm_isect_ps, m_sids, xm_cdif, xm_engy,
xm_r20p, xm_gid, xm_nvectors ) = pixel in
m_sids
in
(* 間接受光を計算するか否かのフラグ *)
let rec p_calc_diffuse pixel =
let (xm_rgb, xm_isect_ps, xm_sids, m_cdif, xm_engy,
xm_r20p, xm_gid, xm_nvectors ) = pixel in
m_cdif
in
(* 衝突点の間接受光エネルギーがピクセル輝度に与える寄与の大きさ *)
let rec p_energy pixel =
let (xm_rgb, xm_isect_ps, xm_sids, xm_cdif, m_engy,
xm_r20p, xm_gid, xm_nvectors ) = pixel in
m_engy
in
(* 衝突点の間接受光エネルギーを光線本数を1/5に間引きして計算した値 *)
let rec p_received_ray_20percent pixel =
let (xm_rgb, xm_isect_ps, xm_sids, xm_cdif, xm_engy,
m_r20p, xm_gid, xm_nvectors ) = pixel in
m_r20p
in
(* このピクセルのグループ ID *)
(*
スクリーン座標 (x,y)の点のグループIDを (x+2*y) mod 5 と定める
結果、下図のような分け方になり、各点は上下左右4点と別なグループになる
0 1 2 3 4 0 1 2 3 4
2 3 4 0 1 2 3 4 0 1
4 0 1 2 3 4 0 1 2 3
1 2 3 4 0 1 2 3 4 0
*)
let rec p_group_id pixel =
let (xm_rgb, xm_isect_ps, xm_sids, xm_cdif, xm_engy,
xm_r20p, m_gid, xm_nvectors ) = pixel in
m_gid.(0)
in
(* グループIDをセットするアクセス関数 *)
let rec p_set_group_id pixel id =
let (xm_rgb, xm_isect_ps, xm_sids, xm_cdif, xm_engy,
xm_r20p, m_gid, xm_nvectors ) = pixel in
m_gid.(0) <- id
in
(* 各衝突点における法線ベクトル *)
let rec p_nvectors pixel =
let (xm_rgb, xm_isect_ps, xm_sids, xm_cdif, xm_engy,
xm_r20p, xm_gid, m_nvectors ) = pixel in
m_nvectors
in
(******************************************************************************
前処理済み方向ベクトルのメンバアクセス関数
*****************************************************************************)
(* ベクトル *)
let rec d_vec d =
let (m_vec, xm_const) = d in
m_vec
in
(* 各オブジェクトに対して作った solver 高速化用定数テーブル *)
let rec d_const d =
let (dm_vec, m_const) = d in
m_const
in
(******************************************************************************
平面鏡面体の反射情報
*****************************************************************************)
(* 面番号 オブジェクト番号*4 + (solverの返り値) *)
let rec r_surface_id r =
let (m_sid, xm_dvec, xm_br) = r in
m_sid
in
(* 光源光の反射方向ベクトル(光と逆向き) *)
let rec r_dvec r =
let (xm_sid, m_dvec, xm_br) = r in
m_dvec
in
(* 物体の反射率 *)
let rec r_bright r =
let (xm_sid, xm_dvec, m_br) = r in
m_br
in
(******************************************************************************
データ読み込みの関数群
*****************************************************************************)
(* ラジアン *)
let rec rad x =
x *. 0.017453293
in
(**** 環境データの読み込み ****)
let rec read_screen_settings _ =
(* スクリーン中心の座標 *)
screen.(0) <- read_float ();
screen.(1) <- read_float ();
screen.(2) <- read_float ();
(* 回転角 *)
let v1 = rad (read_float ()) in
let cos_v1 = cos v1 in
let sin_v1 = sin v1 in
let v2 = rad (read_float ()) in
let cos_v2 = cos v2 in
let sin_v2 = sin v2 in
(* スクリーン面の奥行き方向のベクトル 注視点からの距離200をかける *)
screenz_dir.(0) <- cos_v1 *. sin_v2 *. 200.0;
screenz_dir.(1) <- sin_v1 *. -200.0;
screenz_dir.(2) <- cos_v1 *. cos_v2 *. 200.0;
(* スクリーン面X方向のベクトル *)
screenx_dir.(0) <- cos_v2;
screenx_dir.(1) <- 0.0;
screenx_dir.(2) <- fneg sin_v2;
(* スクリーン面Y方向のベクトル *)
screeny_dir.(0) <- fneg sin_v1 *. sin_v2;
screeny_dir.(1) <- fneg cos_v1;
screeny_dir.(2) <- fneg sin_v1 *. cos_v2;
(* 視点位置ベクトル(絶対座標) *)
viewpoint.(0) <- screen.(0) -. screenz_dir.(0);
viewpoint.(1) <- screen.(1) -. screenz_dir.(1);
viewpoint.(2) <- screen.(2) -. screenz_dir.(2)
in
(* 光源情報の読み込み *)
let rec read_light _ =
let nl = read_int () in
(* 光線関係 *)
let l1 = rad (read_float ()) in
let sl1 = sin l1 in
light.(1) <- fneg sl1;
let l2 = rad (read_float ()) in
let cl1 = cos l1 in
let sl2 = sin l2 in
light.(0) <- cl1 *. sl2;
let cl2 = cos l2 in
light.(2) <- cl1 *. cl2;
beam.(0) <- read_float ()
in
(* 元の2次形式行列 A に両側から回転行列 R をかけた行列 R^t * A * R を作る *)
(* R は x,y,z軸に関する回転行列の積 R(z)R(y)R(x) *)
(* スクリーン座標のため、y軸回転のみ角度の符号が逆 *)
let rec rotate_quadratic_matrix abc rot =
(* 回転行列の積 R(z)R(y)R(x) を計算する *)
let cos_x = cos rot.(0) in
let sin_x = sin rot.(0) in
let cos_y = cos rot.(1) in
let sin_y = sin rot.(1) in
let cos_z = cos rot.(2) in
let sin_z = sin rot.(2) in
let m00 = cos_y *. cos_z in
let m01 = sin_x *. sin_y *. cos_z -. cos_x *. sin_z in
let m02 = cos_x *. sin_y *. cos_z +. sin_x *. sin_z in
let m10 = cos_y *. sin_z in
let m11 = sin_x *. sin_y *. sin_z +. cos_x *. cos_z in
let m12 = cos_x *. sin_y *. sin_z -. sin_x *. cos_z in
let m20 = fneg sin_y in
let m21 = sin_x *. cos_y in
let m22 = cos_x *. cos_y in
(* a, b, cの元の値をバックアップ *)
let ao = abc.(0) in
let bo = abc.(1) in
let co = abc.(2) in
(* R^t * A * R を計算 *)
(* X^2, Y^2, Z^2成分 *)
abc.(0) <- ao *. fsqr m00 +. bo *. fsqr m10 +. co *. fsqr m20;
abc.(1) <- ao *. fsqr m01 +. bo *. fsqr m11 +. co *. fsqr m21;
abc.(2) <- ao *. fsqr m02 +. bo *. fsqr m12 +. co *. fsqr m22;
(* 回転によって生じた XY, YZ, ZX成分 *)
rot.(0) <- 2.0 *. (ao *. m01 *. m02 +. bo *. m11 *. m12 +. co *. m21 *. m22);
rot.(1) <- 2.0 *. (ao *. m00 *. m02 +. bo *. m10 *. m12 +. co *. m20 *. m22);
rot.(2) <- 2.0 *. (ao *. m00 *. m01 +. bo *. m10 *. m11 +. co *. m20 *. m21)
in
(**** オブジェクト1つのデータの読み込み ****)
let rec read_nth_object n =
let texture = read_int () in
if texture <> -1 then
(
let form = read_int () in
let refltype = read_int () in
let isrot_p = read_int () in
let abc = create_array 3 0.0 in
abc.(0) <- read_float ();
abc.(1) <- read_float (); (* 5 *)
abc.(2) <- read_float ();
let xyz = create_array 3 0.0 in
xyz.(0) <- read_float ();
xyz.(1) <- read_float ();
xyz.(2) <- read_float ();
let m_invert = fisneg (read_float ()) in (* 10 *)
let reflparam = create_array 2 0.0 in
reflparam.(0) <- read_float (); (* diffuse *)
reflparam.(1) <- read_float (); (* hilight *)
let color = create_array 3 0.0 in
color.(0) <- read_float ();
color.(1) <- read_float ();
color.(2) <- read_float (); (* 15 *)
let rotation = create_array 3 0.0 in
if isrot_p <> 0 then
(
rotation.(0) <- rad (read_float ());
rotation.(1) <- rad (read_float ());
rotation.(2) <- rad (read_float ())
)
else ();
(* パラメータの正規化 *)
(* 注: 下記正規化 (form = 2) 参照 *)
let m_invert2 = if form = 2 then true else m_invert in
let ctbl = create_array 4 0.0 in
(* ここからあとは abc と rotation しか操作しない。*)
let obj =
(texture, form, refltype, isrot_p,
abc, xyz, (* x-z *)
m_invert2,
reflparam, (* reflection paramater *)
color, (* color *)
rotation, (* rotation *)
ctbl (* constant table *)
) in
objects.(n) <- obj;
if form = 3 then
(
(* 2次曲面: X,Y,Z サイズから2次形式行列の対角成分へ *)
let a = abc.(0) in
abc.(0) <- if fiszero a then 0.0 else sgn a /. fsqr a; (* X^2 成分 *)
let b = abc.(1) in
abc.(1) <- if fiszero b then 0.0 else sgn b /. fsqr b; (* Y^2 成分 *)
let c = abc.(2) in
abc.(2) <- if fiszero c then 0.0 else sgn c /. fsqr c (* Z^2 成分 *)
)
else if form = 2 then
(* 平面: 法線ベクトルを正規化, 極性を負に統一 *)
vecunit_sgn abc (not m_invert)
else ();
(* 2次形式行列に回転変換を施す *)
if isrot_p <> 0 then
rotate_quadratic_matrix abc rotation
else ();
true
)
else
false (* データの終了 *)
in
(**** 物体データ全体の読み込み ****)
let rec read_object n =
if n < 60 then
if read_nth_object n then
read_object (n + 1)
else
n_objects.(0) <- n
else () (* failwith "too many objects" *)
in
let rec read_all_object _ =
read_object 0
in
(**** AND, OR ネットワークの読み込み ****)
(* ネットワーク1つを読み込みベクトルにして返す *)
let rec read_net_item length =
let item = read_int () in
if item = -1 then create_array (length + 1) (-1)
else
let v = read_net_item (length + 1) in
(v.(length) <- item; v)
in
let rec read_or_network length =
let net = read_net_item 0 in
if net.(0) = -1 then
create_array (length + 1) net
else
let v = read_or_network (length + 1) in
(v.(length) <- net; v)
in
let rec read_and_network n =
let net = read_net_item 0 in
if net.(0) = -1 then ()
else (
and_net.(n) <- net;
read_and_network (n + 1)
)
in
let rec read_parameter _ =
(
read_screen_settings();
read_light();
read_all_object ();
read_and_network 0;
or_net.(0) <- read_or_network 0
)
in
(******************************************************************************
直線とオブジェクトの交点を求める関数群
*****************************************************************************)
(* solver :
オブジェクト (の index) と、ベクトル L, P を受けとり、
直線 Lt + P と、オブジェクトとの交点を求める。
交点がない場合は 0 を、交点がある場合はそれ以外を返す。
この返り値は nvector で交点の法線ベクトルを求める際に必要。
(直方体の場合)
交点の座標は t の値として solver_dist に格納される。
*)
(* 直方体の指定された面に衝突するかどうか判定する *)
(* i0 : 面に垂直な軸のindex X:0, Y:1, Z:2 i2,i3は他の2軸のindex *)
let rec solver_rect_surface m dirvec b0 b1 b2 i0 i1 i2 =
if fiszero dirvec.(i0) then false else
let abc = o_param_abc m in
let d = fneg_cond (xor (o_isinvert m) (fisneg dirvec.(i0))) abc.(i0) in
let d2 = (d -. b0) /. dirvec.(i0) in
if fless (fabs (d2 *. dirvec.(i1) +. b1)) abc.(i1) then
if fless (fabs (d2 *. dirvec.(i2) +. b2)) abc.(i2) then
(solver_dist.(0) <- d2; true)
else false
else false
in
(***** 直方体オブジェクトの場合 ****)
let rec solver_rect m dirvec b0 b1 b2 =
if solver_rect_surface m dirvec b0 b1 b2 0 1 2 then 1 (* YZ 平面 *)
else if solver_rect_surface m dirvec b1 b2 b0 1 2 0 then 2 (* ZX 平面 *)
else if solver_rect_surface m dirvec b2 b0 b1 2 0 1 then 3 (* XY 平面 *)
else 0
in
(* 平面オブジェクトの場合 *)
let rec solver_surface m dirvec b0 b1 b2 =
(* 点と平面の符号つき距離 *)
(* 平面は極性が負に統一されている *)
let abc = o_param_abc m in
let d = veciprod dirvec abc in
if fispos d then (
solver_dist.(0) <- fneg (veciprod2 abc b0 b1 b2) /. d;
1
) else 0
in
(* 3変数2次形式 v^t A v を計算 *)
(* 回転が無い場合は対角部分のみ計算すれば良い *)
let rec quadratic m v0 v1 v2 =
let diag_part =
fsqr v0 *. o_param_a m +. fsqr v1 *. o_param_b m +. fsqr v2 *. o_param_c m
in
if o_isrot m = 0 then
diag_part
else
diag_part
+. v1 *. v2 *. o_param_r1 m
+. v2 *. v0 *. o_param_r2 m
+. v0 *. v1 *. o_param_r3 m
in
(* 3変数双1次形式 v^t A w を計算 *)
(* 回転が無い場合は A の対角部分のみ計算すれば良い *)
let rec bilinear m v0 v1 v2 w0 w1 w2 =
let diag_part =
v0 *. w0 *. o_param_a m
+. v1 *. w1 *. o_param_b m
+. v2 *. w2 *. o_param_c m
in
if o_isrot m = 0 then
diag_part
else
diag_part +. fhalf
((v2 *. w1 +. v1 *. w2) *. o_param_r1 m
+. (v0 *. w2 +. v2 *. w0) *. o_param_r2 m
+. (v0 *. w1 +. v1 *. w0) *. o_param_r3 m)
in
(* 2次曲面または円錐の場合 *)
(* 2次形式で表現された曲面 x^t A x - (0 か 1) = 0 と 直線 base + dirvec*t の
交点を求める。曲線の方程式に x = base + dirvec*t を代入してtを求める。
つまり (base + dirvec*t)^t A (base + dirvec*t) - (0 か 1) = 0、
展開すると (dirvec^t A dirvec)*t^2 + 2*(dirvec^t A base)*t +
(base^t A base) - (0か1) = 0 、よってtに関する2次方程式を解けば良い。*)
let rec solver_second m dirvec b0 b1 b2 =
(* 解の公式 (-b' ± sqrt(b'^2 - a*c)) / a を使用(b' = b/2) *)
(* a = dirvec^t A dirvec *)
let aa = quadratic m dirvec.(0) dirvec.(1) dirvec.(2) in
if fiszero aa then
0 (* 正確にはこの場合も1次方程式の解があるが、無視しても通常は大丈夫 *)
else (
(* b' = b/2 = dirvec^t A base *)
let bb = bilinear m dirvec.(0) dirvec.(1) dirvec.(2) b0 b1 b2 in
(* c = base^t A base - (0か1) *)
let cc0 = quadratic m b0 b1 b2 in
let cc = if o_form m = 3 then cc0 -. 1.0 else cc0 in
(* 判別式 *)
let d = fsqr bb -. aa *. cc in
if fispos d then (
let sd = sqrt d in
let t1 = if o_isinvert m then sd else fneg sd in
(solver_dist.(0) <- (t1 -. bb) /. aa; 1)
)
else
0
)
in
(**** solver のメインルーチン ****)
let rec solver index dirvec org =
let m = objects.(index) in
(* 直線の始点を物体の基準位置に合わせて平行移動 *)
let b0 = org.(0) -. o_param_x m in
let b1 = org.(1) -. o_param_y m in
let b2 = org.(2) -. o_param_z m in
let m_shape = o_form m in
(* 物体の種類に応じた補助関数を呼ぶ *)
if m_shape = 1 then solver_rect m dirvec b0 b1 b2 (* 直方体 *)
else if m_shape = 2 then solver_surface m dirvec b0 b1 b2 (* 平面 *)
else solver_second m dirvec b0 b1 b2 (* 2次曲面/円錐 *)
in
(******************************************************************************
solverのテーブル使用高速版
*****************************************************************************)
(*
通常版solver と同様、直線 start + t * dirvec と物体の交点を t の値として返す
t の値は solver_distに格納
solver_fast は、直線の方向ベクトル dirvec について作ったテーブルを使用
内部的に solver_rect_fast, solver_surface_fast, solver_second_fastを呼ぶ
solver_fast2 は、dirvecと直線の始点 start それぞれに作ったテーブルを使用
直方体についてはstartのテーブルによる高速化はできないので、solver_fastと
同じく solver_rect_fastを内部的に呼ぶ。それ以外の物体については
solver_surface_fast2またはsolver_second_fast2を内部的に呼ぶ
変数dconstは方向ベクトル、sconstは始点に関するテーブル
*)
(***** solver_rectのdirvecテーブル使用高速版 ******)
let rec solver_rect_fast m v dconst b0 b1 b2 =
(* 2.7 *)
let d0 = (dconst.(0) -. b0) *. dconst.(1) in
if (* YZ平面との衝突判定 *)
if fless (fabs (d0 *. v.(1) +. b1)) (o_param_b m) then
if fless (fabs (d0 *. v.(2) +. b2)) (o_param_c m) then
not (fiszero dconst.(1))
else false
else false
then
(solver_dist.(0) <- d0; 1)
else let d1 = (dconst.(2) -. b1) *. dconst.(3) in
if (* ZX平面との衝突判定 *)
if fless (fabs (d1 *. v.(0) +. b0)) (o_param_a m) then
if fless (fabs (d1 *. v.(2) +. b2)) (o_param_c m) then
not (fiszero dconst.(3))
else false
else false
then
(solver_dist.(0) <- d1; 2)
else let d2 = (dconst.(4) -. b2) *. dconst.(5) in
if (* XY平面との衝突判定 *)
if fless (fabs (d2 *. v.(0) +. b0)) (o_param_a m) then
if fless (fabs (d2 *. v.(1) +. b1)) (o_param_b m) then
not (fiszero dconst.(5))
else false
else false
then
(solver_dist.(0) <- d2; 3)
else
0
in
(**** solver_surfaceのdirvecテーブル使用高速版 ******)
let rec solver_surface_fast m dconst b0 b1 b2 =
if fisneg dconst.(0) then (
solver_dist.(0) <-
dconst.(1) *. b0 +. dconst.(2) *. b1 +. dconst.(3) *. b2;
1
) else 0
in
(**** solver_second のdirvecテーブル使用高速版 ******)
let rec solver_second_fast m dconst b0 b1 b2 =
let aa = dconst.(0) in
if fiszero aa then
0
else
let neg_bb = dconst.(1) *. b0 +. dconst.(2) *. b1 +. dconst.(3) *. b2 in
let cc0 = quadratic m b0 b1 b2 in
let cc = if o_form m = 3 then cc0 -. 1.0 else cc0 in
let d = (fsqr neg_bb) -. aa *. cc in
if fispos d then (
if o_isinvert m then
solver_dist.(0) <- (neg_bb +. sqrt d) *. dconst.(4)
else
solver_dist.(0) <- (neg_bb -. sqrt d) *. dconst.(4);
1)
else 0
in
(**** solver のdirvecテーブル使用高速版 *******)
let rec solver_fast index dirvec org =
let m = objects.(index) in
let b0 = org.(0) -. o_param_x m in
let b1 = org.(1) -. o_param_y m in
let b2 = org.(2) -. o_param_z m in
let dconsts = d_const dirvec in
let dconst = dconsts.(index) in
let m_shape = o_form m in
if m_shape = 1 then
solver_rect_fast m (d_vec dirvec) dconst b0 b1 b2
else if m_shape = 2 then
solver_surface_fast m dconst b0 b1 b2
else
solver_second_fast m dconst b0 b1 b2
in
(* solver_surfaceのdirvec+startテーブル使用高速版 *)
let rec solver_surface_fast2 m dconst sconst b0 b1 b2 =
if fisneg dconst.(0) then (
solver_dist.(0) <- dconst.(0) *. sconst.(3);
1
) else 0
in
(* solver_secondのdirvec+startテーブル使用高速版 *)
let rec solver_second_fast2 m dconst sconst b0 b1 b2 =
let aa = dconst.(0) in
if fiszero aa then
0
else
let neg_bb = dconst.(1) *. b0 +. dconst.(2) *. b1 +. dconst.(3) *. b2 in
let cc = sconst.(3) in
let d = (fsqr neg_bb) -. aa *. cc in
if fispos d then (
if o_isinvert m then
solver_dist.(0) <- (neg_bb +. sqrt d) *. dconst.(4)
else
solver_dist.(0) <- (neg_bb -. sqrt d) *. dconst.(4);
1)
else 0
in
(* solverの、dirvec+startテーブル使用高速版 *)
let rec solver_fast2 index dirvec =
let m = objects.(index) in
let sconst = o_param_ctbl m in
let b0 = sconst.(0) in
let b1 = sconst.(1) in
let b2 = sconst.(2) in
let dconsts = d_const dirvec in
let dconst = dconsts.(index) in
let m_shape = o_form m in
if m_shape = 1 then
solver_rect_fast m (d_vec dirvec) dconst b0 b1 b2
else if m_shape = 2 then
solver_surface_fast2 m dconst sconst b0 b1 b2
else
solver_second_fast2 m dconst sconst b0 b1 b2
in
(******************************************************************************
方向ベクトルの定数テーブルを計算する関数群
*****************************************************************************)
(* 直方体オブジェクトに対する前処理 *)