srVoxel.Mod 22 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069
  1. MODULE srVoxel;
  2. IMPORT srBase, Math, srMath, srE, srHex,Out := KernelLog;
  3. TYPE SREAL=srBase.SREAL;
  4. TYPE PT=srBase.PT;
  5. TYPE Ray = srBase.Ray;
  6. TYPE Voxel = srBase.Voxel;
  7. TYPE ColoredVox* = OBJECT(Voxel);
  8. VAR
  9. r, g, b: SREAL;
  10. PROCEDURE SetColor* (red, green, blue : SREAL);
  11. BEGIN
  12. r := srBase.clamp(red );
  13. g := srBase.clamp(green );
  14. b := srBase.clamp(blue );
  15. END SetColor;
  16. PROCEDURE Shade (VAR ray: Ray);
  17. BEGIN
  18. ray.r := ray.r + r*ray.ra;
  19. ray.g := ray.g + g*ray.ga;
  20. ray.b := ray.b + b*ray.ba;
  21. ray.ra := 0;
  22. ray.ga := 0;
  23. ray.ba := 0;
  24. END Shade;
  25. END ColoredVox;
  26. TYPE GoorowVox* = OBJECT(Voxel);
  27. VAR
  28. r, g, b: SREAL;
  29. PROCEDURE Shade (VAR ray: Ray);
  30. BEGIN
  31. ray.r := ray.r + ray.lxyz.x*ray.ra;
  32. ray.g := ray.g + ray.lxyz.y*ray.ga;
  33. ray.b := ray.b + ray.lxyz.z*ray.ba;
  34. ray.ra := 0;
  35. ray.ga := 0;
  36. ray.ba := 0;
  37. ray.a :=0;
  38. END Shade;
  39. END GoorowVox;
  40. TYPE LitVox* = OBJECT(Voxel);
  41. VAR
  42. r, g, b, nx, ny, nz: SREAL;
  43. PROCEDURE SetColor* (red, green, blue : SREAL);
  44. BEGIN
  45. r := srBase.clamp(red);
  46. g := srBase.clamp(green);
  47. b := srBase.clamp(blue);
  48. END SetColor;
  49. PROCEDURE Shade (VAR ray: Ray);
  50. VAR
  51. x,y,z,dotrl: SREAL;
  52. BEGIN
  53. x := 1/2 - ray.lxyz.x; y := 1/2 - ray.lxyz.y; z := 1/2 - ray.lxyz.z;
  54. srBase.normalize(x,y,z);
  55. dotrl :=x*srBase.light.x + y*srBase.light.y + z*srBase.light.z;
  56. IF dotrl > 0 THEN
  57. ray.r := ray.r +(r*dotrl)*ray.ra ;
  58. ray.g := ray.g + (g*dotrl)*ray.ga;
  59. ray.b := ray.b + (b*dotrl)*ray.ba;
  60. END;
  61. ray.ra := 0;
  62. ray.ga := 0;
  63. ray.ba := 0;
  64. ray.a := 0;
  65. END Shade;
  66. END LitVox;
  67. TYPE ColoredMVox* = OBJECT(Voxel); (*NOT CORRECT YET *)
  68. VAR
  69. r, g, b, mf, a: SREAL;
  70. PROCEDURE SetColor*(red, green, blue, mfraction: SREAL);
  71. BEGIN
  72. mf := srBase.clamp(mfraction);
  73. a := mf;
  74. r := srBase.clamp(red)*a;
  75. g := srBase.clamp(green)*a;
  76. b := srBase.clamp(blue)*a;
  77. END SetColor;
  78. PROCEDURE Shade (VAR ray: Ray);
  79. VAR
  80. dr, dg, db: SREAL;
  81. BEGIN
  82. dr := r*ray.ra;
  83. dg := g*ray.ga;
  84. db := b*ray.ba;
  85. ray.r := ray.r + dr;
  86. ray.g := ray.g + dg;
  87. ray.b := ray.b + db;
  88. ray.ra := ray.ra - a*(dg+db);
  89. ray.ga := ray.ga - a*(dr+db);
  90. ray.ba := ray.ba - a*(dr+dg);
  91. ray.a := (ray.ra+ray.ga+ray.ba)/3;
  92. mirror(ray);
  93. END Shade;
  94. END ColoredMVox;
  95. TYPE DiffuseMVox* = OBJECT(Voxel);
  96. VAR
  97. r, g, b, mf, a: SREAL;
  98. PROCEDURE Shade (VAR ray: Ray);
  99. VAR
  100. nx, ny, nz: INTEGER;
  101. dot: SREAL;
  102. inside: BOOLEAN;
  103. BEGIN
  104. CASE ray.face OF
  105. 0: inside := TRUE
  106. |1: nx := -1
  107. |2: ny := -1
  108. |3: nz := -1
  109. |4: nx := 1
  110. |5: ny := 1
  111. |6: nz := 1
  112. ELSE
  113. END;
  114. IF inside THEN dot := 0 ELSE dot := ABS(nx*ray.dxyz.x + ny*ray.dxyz.y+ nz*ray.dxyz.z) END;
  115. ray.ra := dot*ray.ra- 0.3;
  116. ray.ga := dot*ray.ga- 0.3;
  117. ray.ba := dot*ray.ba- 0.3;
  118. ray.a := (ray.ra+ray.ga+ray.ba)/3;
  119. mirror(ray);
  120. END Shade;
  121. END DiffuseMVox;
  122. TYPE DiffuseSphMVox* = OBJECT(ColoredVox);
  123. VAR
  124. mf, a: SREAL;
  125. PROCEDURE Shade(VAR ray: Ray);
  126. VAR
  127. nx, ny, nz: SREAL;
  128. dot: SREAL;
  129. inside: BOOLEAN;
  130. BEGIN
  131. nx := 1/2 - ray.lxyz.x; ny := 1/2-ray.lxyz.y; nz := 1/2-ray.lxyz.z;
  132. srBase.normalize(nx,ny, nz);
  133. IF inside THEN dot := 0 ELSE dot := ABS(nx*ray.dxyz.x + ny*ray.dxyz.y+ nz*ray.dxyz.z) END;
  134. ray.a := dot*ray.a/2;
  135. ray.ra := dot*ray.ra/2;
  136. ray.ga := dot*ray.ga/2;
  137. ray.ba := dot*ray.ba/2;
  138. mirror(ray);
  139. END Shade;
  140. END DiffuseSphMVox;
  141. TYPE DiffuseSphVox* = OBJECT(ColoredVox);
  142. VAR
  143. mf, a: SREAL;
  144. PROCEDURE Shade(VAR ray: Ray);
  145. VAR
  146. dot: SREAL;
  147. p: srBase.PT;
  148. BEGIN
  149. p.x:= 1/2 - ray.lxyz.x; p.y:= 1/2 - ray.lxyz.y; p.z:= 1/2 - ray.lxyz.z;
  150. srBase.normalizePT(p);
  151. dot := ABS(p.x*ray.dxyz.x + p.y*ray.dxyz.y+ p.z*ray.dxyz.z);
  152. ray.r := ray.r + r * ray.ra*dot;
  153. ray.g := ray.g + g * ray.ga*dot;
  154. ray.b := ray.b + b * ray.ba*dot;
  155. ray.ra := 0;
  156. ray.ga := 0;
  157. ray.ba := 0;
  158. ray.a := 0;
  159. END Shade;
  160. END DiffuseSphVox;
  161. TYPE AlphaVox* = OBJECT(Voxel);
  162. VAR
  163. r, g, b, ra, ga, ba: SREAL;
  164. PROCEDURE SetColor* (red, green, blue, alpha : SREAL);
  165. BEGIN
  166. r := srBase.clamp(red * alpha);
  167. g := srBase.clamp(green * alpha);
  168. b := srBase.clamp(blue * alpha);
  169. END SetColor;
  170. PROCEDURE Shade (VAR ray: Ray);
  171. VAR
  172. dr, dg, db: SREAL;
  173. BEGIN
  174. dr := r*ray.ra;
  175. dg := g*ray.ga;
  176. db := b*ray.ba;
  177. ray.r := ray.r + dr;
  178. ray.g := ray.g + dg;
  179. ray.b := ray.b + db;
  180. ray.ra := ray.ra - (dg+db)/2;
  181. ray.ga := ray.ga - (dr+db)/2;
  182. ray.ba := ray.ba - (dr+dg)/2;
  183. ray.a := ray.a -(dr+dg+db)/3;
  184. ray.length := ray.length + ray.scale;
  185. END Shade;
  186. END AlphaVox;
  187. (*TYPE ColoredDetailVox*=OBJECT(ColoredVox);
  188. PROCEDURE Shade (VAR ray: Ray);
  189. VAR
  190. l, x, y, z: SREAL;
  191. ecount: INTEGER;
  192. BEGIN
  193. ray.r := ray.r + r * ray.a;
  194. ray.g := ray.g + g * ray.a;
  195. ray.b := ray.b + b * ray.a;
  196. ray.a := ray.a - a
  197. END Shade;
  198. END ColoredDetailVox; *)
  199. TYPE TransparaVox*=OBJECT(Voxel);
  200. VAR
  201. r, g, b, black: SREAL;
  202. PROCEDURE SetColor* (red, green, blue,bl : SREAL);
  203. BEGIN
  204. r := red;
  205. g := green;
  206. b := blue;
  207. black:=bl;
  208. passable := TRUE;
  209. END SetColor;
  210. PROCEDURE Shade (VAR ray: Ray);
  211. VAR
  212. depth: SREAL;
  213. exit:PT;
  214. dr,dg,db,dblack: SREAL;
  215. BEGIN
  216. exit:=srBase.Exit(ray);
  217. depth:=srBase.distsquared(ray.lxyz,exit);
  218. dr := r*depth;
  219. dg := g*depth;
  220. db := b*depth;
  221. dblack:=black*depth;
  222. ray.r := ray.r + dr;
  223. ray.g := ray.g + dg;
  224. ray.b := ray.b + db;
  225. ray.ra := ray.ra - dr-dblack;
  226. ray.ga := ray.ga - dg-dblack;
  227. ray.ba := ray.ba - db-dblack;
  228. srBase.clamp3(ray.ra,ray.ga,ray.ba);
  229. ray.a := (ray.ra+ray.ga+ray.ba)/3;
  230. END Shade;
  231. END TransparaVox;
  232. TYPE RainbowVox*=OBJECT(Voxel);
  233. VAR
  234. r, g, b, black: SREAL;
  235. PROCEDURE SetColor* (red, green, blue,bl : SREAL);
  236. BEGIN
  237. r := red;
  238. g := green;
  239. b := blue;
  240. black:=bl;
  241. passable := TRUE;
  242. END SetColor;
  243. PROCEDURE Shade (VAR ray: Ray);
  244. VAR
  245. depth: SREAL;
  246. exit:PT;
  247. dr,dg,db,dblack: SREAL;
  248. BEGIN
  249. exit:=srBase.Exit(ray);
  250. depth:=srBase.distsquared(ray.lxyz,exit);
  251. dr := ABS(r*depth*ray.dxyz.x);
  252. dg := ABS(g*depth*ray.dxyz.y);
  253. db := ABS(b*depth*ray.dxyz.z);
  254. dblack:=black*depth;
  255. ray.r := ray.r + dr;
  256. ray.g := ray.g + dg;
  257. ray.b := ray.b + db;
  258. ray.ra := ray.ra - dr-dblack;
  259. ray.ga := ray.ga - dg-dblack;
  260. ray.ba := ray.ba - db-dblack;
  261. srBase.clamp3(ray.ra,ray.ga,ray.ba);
  262. ray.a := (ray.ra+ray.ga+ray.ba)/3;
  263. END Shade;
  264. END RainbowVox;
  265. TYPE JelloVox*=OBJECT(AlphaVox);
  266. PROCEDURE Shade (VAR ray: Ray);
  267. VAR
  268. x,y,z: SREAL;
  269. depth: SREAL;
  270. dr, dg, db: SREAL;
  271. BEGIN
  272. (* x := ray.lxyz.x-ray.xlx;
  273. y := ray.lxyz.y-ray.xly;
  274. z := ray.lxyz.z-ray.xlz; *)
  275. depth := Math.sqrt(x*x+y*y+z*z);
  276. dr := r*ray.ra*depth;
  277. dg := g*ray.ga*depth;
  278. db := b*ray.ba*depth;
  279. ray.ra := ray.ra - dr;
  280. ray.ga := ray.ga - dg;
  281. ray.ba := ray.ba - db;
  282. ray.a := (ray.ra+ray.ga+ray.ba)/3;
  283. ray.length := ray.length + ray.scale;
  284. END Shade;
  285. END JelloVox;
  286. TYPE AirVox*=OBJECT(ColoredVox);
  287. PROCEDURE Shade (VAR ray: Ray);
  288. VAR
  289. x,y,z: SREAL;
  290. depth: SREAL;
  291. dr, dg, db: SREAL;
  292. BEGIN
  293. (* x := ray.lxyz.x-ray.xlx;
  294. y := ray.lxyz.y-ray.xly;
  295. z := ray.lxyz.z-ray.xlz; *)
  296. depth := Math.sqrt(x*x+y*y+z*z)*srBase.fog;
  297. dr := r*ray.ra*depth;
  298. dg := g*ray.ga*depth;
  299. db := b*ray.ba*depth;
  300. ray.ra := ray.ra - dr;
  301. ray.ga := ray.ga - dg;
  302. ray.ba := ray.ba - db;
  303. ray.a := (ray.ra+ray.ga+ray.ba)/3;
  304. ray.length := ray.length + ray.scale;
  305. END Shade;
  306. END AirVox;
  307. TYPE InkVox*=OBJECT(ColoredVox);
  308. PROCEDURE Shade (VAR ray: Ray);
  309. VAR
  310. ink: SREAL;
  311. BEGIN
  312. ink := 0.05*ray.a;
  313. ray.ra := ray.ra - ink;
  314. ray.ga := ray.ga - ink;
  315. ray.ba := ray.ba - ink;
  316. ray.a := (ray.ra+ray.ga+ray.ba)/3;
  317. ray.length := ray.length + ray.scale;
  318. END Shade;
  319. END InkVox;
  320. TYPE OutlineVox*=OBJECT(ColoredVox);
  321. VAR
  322. or, og, ob: SREAL;
  323. PROCEDURE SetOutline* (red, green, blue: SREAL);
  324. BEGIN
  325. or := red ;
  326. og := green ;
  327. ob := blue;
  328. END SetOutline;
  329. PROCEDURE Shade (VAR ray: Ray);
  330. VAR
  331. ecount: INTEGER;
  332. BEGIN
  333. IF (ray.lxyz.x< 0.01) OR (ray.lxyz.x > 0.99) THEN INC(ecount) END;
  334. IF (ray.lxyz.y <0.01) OR (ray.lxyz.y > 0.99) THEN INC(ecount) END;
  335. IF (ray.lxyz.z < 0.01) OR (ray.lxyz.z > 0.99) THEN INC(ecount) END;
  336. IF ecount > 1 THEN
  337. ray.r := ray.r + or * ray.ra;
  338. ray.g := ray.g + og * ray.ga;
  339. ray.b := ray.b + ob * ray.ba;
  340. ray.ra := 0;
  341. ray.ga := 0;
  342. ray.ba := 0;
  343. ray.a := 0;
  344. ELSE
  345. ray.r := ray.r + r * ray.ra;
  346. ray.g := ray.g + g * ray.ga;
  347. ray.b := ray.b + b * ray.ba;
  348. ray.ra := 0;
  349. ray.ga := 0;
  350. ray.ba := 0;
  351. ray.a := 0;
  352. END
  353. END Shade;
  354. END OutlineVox;
  355. TYPE GoutlineVox*=OBJECT(ColoredVox)
  356. VAR
  357. tx, ty, tz: SREAL; (* thickness of outline *)
  358. or, og, ob: SREAL; (* outline color *)
  359. PROCEDURE Shade (VAR ray: Ray);
  360. VAR
  361. ecount: INTEGER;
  362. l, le, xe, ye, ze: SREAL;
  363. BEGIN
  364. ecount := 0;
  365. IF (ray.lxyz.x < 1/100) THEN
  366. xe := 100*(1/100-ray.lxyz.x)
  367. ELSIF (ray.lxyz.x > 99/100) THEN
  368. xe := 00*(1-ray.lxyz.x)
  369. END;
  370. IF (ray.lxyz.y < 1/100) THEN
  371. ye := 100*(1/100-ray.lxyz.y)
  372. ELSIF (ray.lxyz.y > 99/100) THEN
  373. ye := 100*(1-ray.lxyz.y)
  374. END;
  375. IF (ray.lxyz.z < 1/100) THEN
  376. ze := 100*(1/100-ray.lxyz.z)
  377. ELSIF (ray.lxyz.z > 99/100) THEN
  378. ze := 100*(1-ray.lxyz.z)
  379. END;
  380. le := (xe+ye+ze)/3;
  381. l := (ray.lxyz.x+ray.lxyz.y+ray.lxyz.z)/3;
  382. ray.r := ray.r + r * ray.ra*l;
  383. ray.g := ray.g + g * ray.ga*l;
  384. ray.b := ray.b + b * ray.ba*l;
  385. ray.ra := 0;
  386. ray.ga := 0;
  387. ray.ba := 0;
  388. ray.a := 0;
  389. END Shade;
  390. END GoutlineVox;
  391. TYPE GouraudVox* = OBJECT(ColoredVox);
  392. VAR
  393. brightness: INTEGER;
  394. PROCEDURE & init*;
  395. BEGIN
  396. brightness := 16;
  397. END init;
  398. PROCEDURE tick;
  399. BEGIN
  400. IF srBase.rand.Uniform()>1/2 THEN
  401. brightness := (brightness + 1) MOD 20;
  402. ELSE
  403. brightness := (brightness - 1) MOD 20;
  404. END
  405. END tick;
  406. PROCEDURE Shade (VAR ray: Ray);
  407. VAR
  408. l: SREAL;
  409. BEGIN
  410. l := (ray.lxyz.x+ray.lxyz.y+ray.lxyz.z)/3;
  411. ray.r := ray.r + r * ray.ra*l;
  412. ray.g := ray.g + g * ray.ga*l;
  413. ray.b := ray.b + b * ray.ba*l;
  414. ray.a := (ray.ra+ray.ga+ray.ba)/3;
  415. END Shade;
  416. END GouraudVox;
  417. TYPE VGouraudVox* = OBJECT(GouraudVox);
  418. PROCEDURE Shade (VAR ray: Ray);
  419. VAR
  420. l: SREAL;
  421. BEGIN
  422. l := (ray.lxyz.x+ray.lxyz.y)/2;
  423. ray.r := ray.r + r * ray.ra*l;
  424. ray.g := ray.g + g * ray.ga*l;
  425. ray.b := ray.b + b * ray.ba*l;
  426. ray.a := (ray.ra+ray.ga+ray.ba)/3;
  427. END Shade;
  428. END VGouraudVox;
  429. TYPE HGouraudVox* = OBJECT(GouraudVox);
  430. PROCEDURE Shade (VAR ray: Ray);
  431. VAR
  432. l: SREAL;
  433. BEGIN
  434. l := (ray.lxyz.x+ray.lxyz.z)/2;
  435. ray.r := ray.r + r * ray.ra*l;
  436. ray.g := ray.g + g * ray.ga*l;
  437. ray.b := ray.b + b * ray.ba*l;
  438. ray.ra := 0;
  439. ray.ga := 0;
  440. ray.ba := 0;
  441. ray.a := 0;
  442. END Shade;
  443. END HGouraudVox;
  444. TYPE NouraudVox* = OBJECT(ColoredVox);
  445. PROCEDURE Shade (VAR ray: Ray);
  446. VAR
  447. l: SREAL;
  448. BEGIN
  449. l := 2*(ABS(1/2-ray.lxyz.x) + ABS(1/2-ray.lxyz.y) + ABS(1/2-ray.lxyz.z))/3;
  450. ray.r := ray.r + r * ray.ra*l;
  451. ray.g := ray.g + g * ray.ga*l;
  452. ray.b := ray.b + b * ray.ba*l;
  453. ray.ra := 0;
  454. ray.ga := 0;
  455. ray.ba := 0;
  456. ray.a := 0;
  457. END Shade;
  458. END NouraudVox;
  459. TYPE DiffuseVox* = OBJECT(ColoredVox);
  460. PROCEDURE Shade (VAR ray: Ray);
  461. VAR
  462. nx, ny, nz: INTEGER;
  463. dot: SREAL;
  464. inside: BOOLEAN;
  465. BEGIN
  466. CASE ray.face OF
  467. 0: inside := TRUE
  468. |1: nx := -1
  469. |2: ny := -1
  470. |3: nz := -1
  471. |4: nx := 1
  472. |5: ny := 1
  473. |6: nz := 1
  474. ELSE
  475. END;
  476. IF inside THEN dot := 1 ELSE dot := ABS(nx*ray.dxyz.x + ny*ray.dxyz.y+ nz*ray.dxyz.z) END;
  477. IF dot<1/2 THEN dot:=1/2 END;
  478. ray.r := ray.r + r * ray.ra*dot ;
  479. ray.g := ray.g + g * ray.ga*dot;
  480. ray.b := ray.b + b * ray.ba*dot;
  481. ray.ra := 0;
  482. ray.ga := 0;
  483. ray.ba := 0;
  484. ray.a := 0;
  485. END Shade;
  486. END DiffuseVox;
  487. TYPE DiffuseNouraudVox* = OBJECT(ColoredVox);
  488. PROCEDURE Shade (VAR ray: Ray);
  489. VAR
  490. nx, ny, nz: INTEGER;
  491. dot: SREAL;
  492. inside: BOOLEAN;
  493. l: SREAL;
  494. BEGIN
  495. l := 2*(ABS(1/2-ray.lxyz.x) + ABS(1/2-ray.lxyz.y) + ABS(1/2-ray.lxyz.z))/3;
  496. CASE ray.face OF
  497. 0: inside := TRUE
  498. |1: nx := -1
  499. |2: ny := -1
  500. |3: nz := -1
  501. |4: nx := 1
  502. |5: ny := 1
  503. |6: nz := 1
  504. ELSE
  505. END;
  506. IF inside THEN dot := l ELSE dot := l*(1/3+2*ABS(nx*ray.dxyz.x + ny*ray.dxyz.y+ nz*ray.dxyz.z)/2) END;
  507. ray.r := ray.r + r * ray.ra*dot;
  508. ray.g := ray.g + g * ray.ga*dot;
  509. ray.b := ray.b + b * ray.ba*dot;
  510. ray.ra := 0;
  511. ray.ga := 0;
  512. ray.ba := 0;
  513. ray.a := 0;
  514. END Shade;
  515. END DiffuseNouraudVox;
  516. TYPE GridVox* = OBJECT(Voxel);
  517. VAR
  518. r, g, b, a, gr, gg, gb, ga, Z: SREAL;
  519. PROCEDURE SetColor* (red, green, blue, alpha: SREAL);
  520. BEGIN
  521. r := red * alpha;
  522. g := green * alpha;
  523. b := blue * alpha;
  524. a := alpha;
  525. END SetColor;
  526. PROCEDURE SetGridColor* (red, green, blue, alpha: SREAL);
  527. BEGIN
  528. gr := red * alpha;
  529. gg := green * alpha;
  530. gb := blue * alpha;
  531. ga := alpha;
  532. END SetGridColor;
  533. PROCEDURE SetGrid*(z: SREAL);
  534. BEGIN
  535. Z := z;
  536. END SetGrid;
  537. PROCEDURE Shade (VAR ray: Ray);
  538. VAR
  539. lx, ly, x, y: SREAL;
  540. i, j: LONGINT;
  541. BEGIN
  542. CASE ray.face OF
  543. 1: lx := ray.lxyz.y; ly := ray.lxyz.z;
  544. |2: lx := ray.lxyz.x; ly := ray.lxyz.z;
  545. |3: lx := ray.lxyz.x; ly := ray.lxyz.y;
  546. |4: lx := ray.lxyz.y; ly := ray.lxyz.z;
  547. |5: lx := ray.lxyz.x; ly := ray.lxyz.z;
  548. |6: lx := ray.lxyz.x; ly := ray.lxyz.y;
  549. ELSE
  550. END;
  551. x := lx*Z; y := ly*Z;
  552. i := ENTIER(x); j := ENTIER(y);
  553. x := x - i; y := y - j;
  554. IF ((x<0.1) OR (y<0.1)) THEN
  555. ray.r := ray.r + gr;
  556. ray.g := ray.g + gg;
  557. ray.b := ray.b + gb;
  558. ray.ra := ray.ra - (gg+gb);
  559. ray.ga := ray.ga - (gr+gb);
  560. ray.ba := ray.ba - (gr+gg);
  561. ELSE
  562. ray.r := ray.r + r;
  563. ray.g := ray.g + g;
  564. ray.b := ray.b + b;
  565. ray.ra := ray.ra - (g+b);
  566. ray.ga := ray.ga - (r+b);
  567. ray.ba := ray.ba - (r+g);
  568. END;
  569. ray.a := (ray.ra+ray.ga+ray.ba)/3;
  570. END Shade;
  571. END GridVox;
  572. TYPE GridChirkleVox* = OBJECT(Voxel);
  573. VAR
  574. r, g, b, a, Z: SREAL;
  575. PROCEDURE SetColor* (red, green, blue, alpha: SREAL);
  576. BEGIN
  577. r := red * alpha;
  578. g := green * alpha;
  579. b := blue * alpha;
  580. a := alpha;
  581. register;
  582. END SetColor;
  583. PROCEDURE Shade (VAR ray: Ray);
  584. VAR
  585. dx, dy, dz, d2: SREAL;
  586. BEGIN
  587. dx := (1/2-ray.lxyz.x);
  588. dy := (1/2-ray.lxyz.y);
  589. dz := (1/2-ray.lxyz.z);
  590. d2 := dx*dx+dy+dy+dz+dz;
  591. IF d2>1 THEN
  592. ray.r := ray.r + r;
  593. ray.g := ray.g + g;
  594. ray.b := ray.b + b;
  595. ray.ra := ray.ra - (g+b);
  596. ray.ga := ray.ga - (r+b);
  597. ray.ba := ray.ba - (r+g);
  598. ray.a := (ray.ra+ray.ga+ray.ba)/3;
  599. END
  600. END Shade;
  601. END GridChirkleVox;
  602. TYPE CheckerVox* = OBJECT(Voxel);
  603. VAR
  604. r, g, b, a, Z: SREAL;
  605. PROCEDURE SetColor* (red, green, blue, alpha: SREAL);
  606. BEGIN
  607. r := red * alpha;
  608. g := green * alpha;
  609. b := blue * alpha;
  610. a := alpha;
  611. register;
  612. END SetColor;
  613. PROCEDURE Shade (VAR ray: Ray);
  614. VAR
  615. d, x,y,z, dr, dg, db: SREAL;
  616. ijk: srBase.IPT;
  617. BEGIN
  618. srE.E(ray.lxyz, ijk);
  619. x := ray.lxyz.x*2- ijk.i*2;
  620. y := ray.lxyz.y*2- ijk.j*2;
  621. z := ray.lxyz.z*2- ijk.k*2;
  622. d := ABS((1/2-x)*(1/2-x)*(1/2-z)*(Z));
  623. dr := (1- ray.lxyz.x*d)*ray.ra;
  624. dg := (1- ray.lxyz.y*d)*ray.ga;
  625. db := (1 - ray.lxyz.z*d)*ray.ba;
  626. ray.r := ray.r + dr;
  627. ray.g := ray.g + dg;
  628. ray.b := ray.b + db;
  629. ray.ra := ray.ra - (dg+db);
  630. ray.ga := ray.ga - (dr+db);
  631. ray.ba := ray.ba - (dr+dg);
  632. ray.a := (ray.ra+ray.ga+ray.ba)/3;
  633. END Shade;
  634. PROCEDURE tick*;
  635. BEGIN
  636. Z := 10+(srBase.frame MOD 13);
  637. END tick;
  638. END CheckerVox;
  639. TYPE HexaVox* = OBJECT(Voxel);
  640. VAR
  641. V: Voxel;
  642. hhx: SREAL;
  643. PROCEDURE&init*;
  644. BEGIN
  645. hhx := 6;
  646. END init;
  647. PROCEDURE setVox*(v: Voxel);
  648. BEGIN
  649. V := v;
  650. END setVox;
  651. PROCEDURE connectmessage*;
  652. BEGIN
  653. Out.String("HexaVox"); Out.Ln;
  654. END connectmessage;
  655. PROCEDURE talk*(c: CHAR; VAR connection: BOOLEAN);
  656. BEGIN
  657. CASE c OF
  658. '+': hhx := hhx + 0.05; Out.String("hhx +."); Out.Ln;
  659. | 'G': hhx := hhx - 0.05; Out.String("hhx - "); Out.Ln;
  660. ELSE
  661. Out.String(".");
  662. END;
  663. END talk;
  664. PROCEDURE Shade (VAR ray: Ray);
  665. VAR
  666. lx,ly: SREAL;
  667. Q, gray: SREAL;
  668. BEGIN
  669. CASE ray.face OF
  670. 1: lx := ray.lxyz.y; ly := ray.lxyz.z;
  671. |2: lx := ray.lxyz.x; ly := ray.lxyz.z;
  672. |3: lx := ray.lxyz.x; ly := ray.lxyz.y;
  673. |4: lx := ray.lxyz.y; ly := ray.lxyz.z;
  674. |5: lx := ray.lxyz.x; ly := ray.lxyz.z;
  675. |6: lx := ray.lxyz.x; ly := ray.lxyz.y;
  676. ELSE
  677. END;
  678. Q := srHex.hexize2(50*0.866*lx, 50*0.866*ly);
  679. IF Q < 1/10 THEN
  680. gray := (1-Q*10);
  681. ray.r := ray.r - gray*ray.ra;
  682. ray.g := ray.g - gray*ray.ga;
  683. ray.b := ray.b - gray*ray.ba;
  684. ray.ra := ray.ra-gray;
  685. ray.ga := ray.ga-gray;
  686. ray.ba := ray.ba-gray;
  687. ray.a := (ray.ra+ray.ga+ray.ba)/3;
  688. END;
  689. IF V # NIL THEN V.Shade(ray) END;
  690. END Shade;
  691. END HexaVox;
  692. TYPE SPHexaVox*=OBJECT(HexaVox);
  693. PROCEDURE ctop(x,y,z: SREAL; VAR th,ph: SREAL);
  694. BEGIN
  695. srBase.normalize(x,y,z);
  696. th := 6.28*srMath.sin(x);
  697. ph := 6.28*srMath.cos(y);
  698. END ctop;
  699. PROCEDURE Shade (VAR ray: Ray);
  700. VAR
  701. Q, gray: SREAL;
  702. th,ph: SREAL;
  703. BEGIN
  704. ctop(ray.lxyz.x,ray.lxyz.y,ray.lxyz.z,th,ph);
  705. Q := srHex.hexize2(3*0.866*th, 3*0.866*ph);
  706. IF Q < 1/10 THEN
  707. gray := (1-Q*10);
  708. ray.ra := ray.ra - gray;
  709. ray.ga := ray.ga - gray;
  710. ray.ba := ray.ba - gray;
  711. ray.a := (ray.ra+ray.ga+ray.ba)/3;
  712. END;
  713. IF V # NIL THEN V.Shade(ray) END;
  714. END Shade;
  715. END SPHexaVox;
  716. TYPE PolkaVox* = OBJECT(Voxel);
  717. VAR
  718. brightness: INTEGER;
  719. r, g, b, rr, gg, bb: SREAL;
  720. PROCEDURE & init*;
  721. BEGIN
  722. brightness := 16;
  723. END init;
  724. PROCEDURE SetColor* (red, green, blue, r2, g2, b2 : SREAL);
  725. BEGIN
  726. r := srBase.clamp(red );
  727. g := srBase.clamp(green );
  728. b := srBase.clamp(blue );
  729. rr := srBase.clamp(r2);
  730. gg := srBase.clamp(g2);
  731. bb := srBase.clamp(b2);
  732. END SetColor;
  733. PROCEDURE tick;
  734. BEGIN
  735. IF srBase.rand.Uniform()>1/2 THEN
  736. brightness := (brightness + 1) MOD 20;
  737. ELSE
  738. brightness := (brightness - 1) MOD 20;
  739. END
  740. END tick;
  741. PROCEDURE Shade (VAR ray: Ray);
  742. VAR
  743. l, x, y, z: SREAL;
  744. nx, ny, nz: INTEGER;
  745. dot: SREAL;
  746. inside: BOOLEAN;
  747. BEGIN
  748. CASE ray.face OF
  749. 0: inside := TRUE
  750. |1: nx := -1
  751. |2: ny := -1
  752. |3: nz := -1
  753. |4: nx := 1
  754. |5: ny := 1
  755. |6: nz := 1
  756. ELSE
  757. END;
  758. IF inside THEN dot := 1 ELSE dot := ABS(nx*ray.dxyz.x + ny*ray.dxyz.y+ nz*ray.dxyz.z) END; x := 2*ABS(1/2 - ray.lxyz.x);
  759. y := 2*ABS(1/2 - ray.lxyz.y);
  760. z := 2*ABS(1/2 - ray.lxyz.z);
  761. l := (x+y+z)/3;
  762. dot := dot*brightness;
  763. ray.r := ray.r + (r * ray.ra*l)*dot + (rr * ray.ra*(1-l))*dot ;
  764. ray.g := ray.g + g * ray.ga*l *dot+ (gg * ray.ga*(1-l))*dot;
  765. ray.b := ray.b + b * ray.ba*l*dot + (bb * ray.ba*(1-l)*dot);
  766. ray.ra := 0;
  767. ray.ga := 0;
  768. ray.ba := 0;
  769. ray.a := 0;
  770. END Shade;
  771. END PolkaVox;
  772. TYPE GeckoVox* = OBJECT(Voxel);
  773. VAR
  774. r, g, b, a: SREAL;
  775. ecount: INTEGER;
  776. PROCEDURE SetColor* (red, green, blue, alpha: SREAL);
  777. BEGIN
  778. r := red * alpha;
  779. g := green * alpha;
  780. b := blue * alpha;
  781. a := alpha
  782. END SetColor;
  783. PROCEDURE Shade (VAR ray: Ray);
  784. VAR
  785. d, dr, dg, db: SREAL;
  786. BEGIN
  787. d := ABS((1/2-ray.lxyz.x)*(1/2-ray.lxyz.y)*(1/2-ray.lxyz.z)*70);
  788. dr := r*ray.ra*d;
  789. dg := g*ray.ga*d;
  790. db := b*ray.ba*d;
  791. ray.r := ray.r + dr;
  792. ray.g := ray.g + dg;
  793. ray.b := ray.b + db;
  794. ray.ra := ray.ra - (dg+db);
  795. ray.ga := ray.ga - (dr+db);
  796. ray.ba := ray.ba - (dr+dg);
  797. ray.a := (ray.ra+ray.ga+ray.ba)/3;
  798. END Shade;
  799. END GeckoVox;
  800. (*TYPE SerpVox* = OBJECT(Voxel);
  801. VAR
  802. r1, g1, b1, r2, g2, b2: SREAL;
  803. PROCEDURE SetColor1* (r, g, b: SREAL);
  804. BEGIN
  805. r1 := r;
  806. g1 := g;
  807. b := b
  808. END SetColor1;
  809. PROCEDURE SetColor2* (r, g, b: SREAL);
  810. BEGIN
  811. r2 := r;
  812. g2 := g;
  813. b2 := b
  814. END SetColor2;
  815. PROCEDURE Shade (VAR ray: Ray);
  816. VAR
  817. i, j, k: LONGINT;
  818. sc, d: INTEGER;
  819. BEGIN
  820. ray.splitme := TRUE;
  821. sc := 0;
  822. d := 3;
  823. WHILE d > 0 DO
  824. IF (1 / 3 < ray.lx) & (ray.lx < 2 / 3) THEN INC(sc) END;
  825. IF (1 / 3 < ray.ly) & (ray.ly < 2 / 3) THEN INC(sc) END;
  826. IF (1 / 3 < ray.lz) & (ray.lz < 2 / 3) THEN INC(sc) END;
  827. IF sc < 2 THEN
  828. sc := 0;
  829. IF ray.lx >= 2 / 3 THEN
  830. ray.lx := ray.lx - 2 / 3
  831. ELSIF ray.lx >= 1 / 3 THEN
  832. ray.lx := ray.lx - 1 / 3
  833. END;
  834. ray.lx := ray.lx * 3;
  835. IF ray.ly >= 2 / 3 THEN
  836. ray.ly := ray.ly - 2 / 3
  837. ELSIF ray.ly >= 1 / 3 THEN
  838. ray.ly := ray.ly - 1 / 3
  839. END;
  840. ray.ly := ray.ly * 3;
  841. IF ray.lz >= 2 / 3 THEN
  842. ray.lz := ray.lz - 2 / 3
  843. ELSIF ray.lz >= 1 / 3 THEN
  844. ray.lz := ray.lz - 1 / 3
  845. END;
  846. ray.lz := ray.lz * 3
  847. END;
  848. DEC(d)
  849. END;
  850. IF sc > 1 THEN
  851. ray.r := ray.r + r1 * ray.ra * ray.lx;
  852. ray.g := ray.g + g1 * ray.ga * ray.ly;
  853. ray.b := ray.b + b1 * ray.ba * ray.lz;
  854. ray.ra := 0;
  855. ray.ga := 0;
  856. ray.ba := 0;
  857. ELSE
  858. ray.r := ray.r + r2 * ray.ra;
  859. ray.g := ray.g + g2 * ray.ga;
  860. ray.b := ray.b + b2 * ray.ba;
  861. END
  862. END Shade;
  863. END SerpVox;
  864. *)
  865. TYPE BiVox* = OBJECT(Voxel);
  866. VAR
  867. v1, v2: Voxel;
  868. PROCEDURE set*(x,y: Voxel);
  869. BEGIN
  870. v1 := x;
  871. v2 := y;
  872. END set;
  873. PROCEDURE probe*(x,y,z: SREAL):Voxel;
  874. VAR
  875. v: Voxel;
  876. BEGIN
  877. v := v1.probe(x,y,z);
  878. v := v2.probe(x,y,z);
  879. RETURN(SELF);
  880. END probe;
  881. PROCEDURE Shade (VAR ray: Ray);
  882. BEGIN
  883. v1.Shade(ray);
  884. v2.Shade(ray);
  885. END Shade;
  886. END BiVox;
  887. (*
  888. TYPE SphBiVox* = OBJECT(BiVox);
  889. VAR
  890. cx, cy, cz, R2: SREAL;
  891. PROCEDURE&init;
  892. BEGIN
  893. cx := 1/2; cy := 1/2; cz :=1/2;
  894. R2 := 0.3;
  895. END init;
  896. PROCEDURE tick*;
  897. BEGIN
  898. R2 := 1/3 + ((srBase.frame MOD 10)-4)/450;
  899. END tick;
  900. PROCEDURE Shade (VAR ray: Ray);
  901. VAR
  902. r2: SREAL;
  903. x,y,z,ax, ay, az, bx, by, bz : SREAL;
  904. i: INTEGER;
  905. BEGIN
  906. r2 := (cx-ray.lx)*(cx-ray.lx) + (cy-ray.ly)*(cy-ray.ly) + (cz-ray.lz)*(cz-ray.lz);
  907. IF r2 < R2 THEN (* ray is within sphere *)
  908. IF v2 # NIL THEN v2.Shade(ray) END;
  909. IF ray.a > 1/10 THEN
  910. ax := ray.lx; ay := ray.ly; az := ray.lz;
  911. bx := ray.lx + ray.dx; by := ray.ly+ ray.dy; bz := ray.lz+ ray.dz;
  912. x := (ax+bx)/2; y := (ay+by)/2; z := (az + bz)/2;
  913. FOR i := 0 TO 12 DO
  914. r2 := (cx-x)*(cx-x) + (cy-y)*(cy-y) + (cz-z)*(cz-z);
  915. IF r2 > R2 THEN
  916. bx := x; by := y; bz := z
  917. ELSE
  918. ax := x; ay := y; az := z
  919. END;
  920. x := (ax+bx)/2; y := (ay+by)/2; z := (az + bz)/2;
  921. END;
  922. IF ray.a > 1/10 THEN
  923. ray.lx := x; ray.ly := y; ray.lz := z;
  924. IF v1 # NIL THEN v1.Shade(ray) END
  925. END
  926. END
  927. ELSE
  928. IF v1 # NIL THEN v1.Shade(ray) END
  929. END;
  930. END Shade;
  931. END SphBiVox;
  932. *)
  933. TYPE FuzzyTVox*=OBJECT(AlphaVox);
  934. VAR
  935. fuzzdivisor, fuzzsubtract: SREAL;
  936. PROCEDURE & init*;
  937. BEGIN
  938. passable := TRUE;
  939. fuzzdivisor := 100;
  940. fuzzsubtract := 0.005
  941. END init;
  942. PROCEDURE setFuzz*(f: SREAL);
  943. BEGIN
  944. fuzzdivisor := f;
  945. fuzzsubtract := 1/(2*fuzzdivisor)
  946. END setFuzz;
  947. PROCEDURE Shade*(VAR ray: Ray);
  948. VAR
  949. dr, dg, db: SREAL;
  950. BEGIN
  951. ray.xyz.x := ray.xyz.x + srBase.rand.Uniform()/fuzzdivisor-fuzzsubtract;
  952. ray.xyz.y := ray.xyz.y + srBase.rand.Uniform()/fuzzdivisor-fuzzsubtract;
  953. ray.xyz.z:= ray.xyz.z + srBase.rand.Uniform()/fuzzdivisor-fuzzsubtract;
  954. dr := r*ray.ra;
  955. dg := g*ray.ga;
  956. db := b*ray.ba;
  957. ray.r := ray.r + dr;
  958. ray.g := ray.g + dg;
  959. ray.b := ray.b + db;
  960. ray.ra := ray.ra - (dg+db);
  961. ray.ga := ray.ga - (dr+db);
  962. ray.ba := ray.ba - (dr+dg);
  963. ray.a := (ray.ra+ray.ga+ray.ba)/3;
  964. END Shade;
  965. END FuzzyTVox;
  966. PROCEDURE mirror(VAR ray: Ray);
  967. BEGIN
  968. CASE ray.face OF
  969. 1: ray.dxyz.x:= -ray.dxyz.x;
  970. |2: ray.dxyz.y:= -ray.dxyz.y;
  971. |3: ray.dxyz.z:= -ray.dxyz.z;
  972. |4: ray.dxyz.x:= -ray.dxyz.x;
  973. |5: ray.dxyz.y:= -ray.dxyz.y;
  974. |6: ray.dxyz.z:= -ray.dxyz.z;
  975. ELSE
  976. END;
  977. ray.changed := TRUE;
  978. END mirror;
  979. END srVoxel.