R语言rayrender包，hair发丝材料

R语言rayrender包，hair发丝材料

# Thu Jul 01 01:49:26 2021 -

# 字符编码：UTF-8
# R 版本：R x64 4.1 for window 10
# cgh163email@163.com
# 个人笔记不负责任，拎了个梨🍐🌷
#.rs.restartR()
require(rayrender)
rm(list = ls());gc()

?   hair    #   发材料

#Create a hairball

#Generate rendom points on a sphere
lengthval = 0.5
theta = acos(2*runif(10000)-1.0);
phi = 2*pi*(runif(10000))
bezier_list = list()

#Grow the hairs
for(i in 1:length(phi)) {
  pointval = c(sin(theta[i]) * sin(phi[i]),
               cos(theta[i]),
               sin(theta[i]) * cos(phi[i]))
  bezier_list[[i]] = bezier_curve(width=0.01, width_end=0.008,
                                  p1 = pointval,
                                  p2 = (1+(lengthval*0.33))*pointval,
                                  p3 = (1+(lengthval*0.66))*pointval,
                                  p4 = (1+(lengthval)) * pointval,
                                  material=hair(pigment = 0.3, red_pigment = 1.3,
                                                beta_m = 0.3, beta_n= 0.3),
                                  type="flat")
}
hairball = dplyr::bind_rows(bezier_list)

generate_ground(depth=-2,material=diffuse(color="grey20")) %>%
  add_object(sphere()) %>%
  add_object(hairball) %>%
  add_object(sphere(y=20,z=20,radius=5,material=light(color="white",intensity = 100))) %>%
  render_scene(samples=64, lookfrom=c(0,3,10),clamp_value = 10,
               fov=20)


#直接指定颜色并增加头发粗糙度
for(i in 1:length(phi)) {
  pointval = c(sin(theta[i]) * sin(phi[i]),
               cos(theta[i]),
               sin(theta[i]) * cos(phi[i]))
  bezier_list[[i]] = bezier_curve(width=0.01, width_end=0.008,
                                  p1 = pointval,
                                  p2 = (1+(lengthval*0.33))*pointval,
                                  p3 = (1+(lengthval*0.66))*pointval,
                                  p4 = (1+(lengthval)) * pointval,
                                  material=hair(color="purple",
                                                beta_m = 0.5, beta_n= 0.5),
                                  type="flat")
}
hairball = dplyr::bind_rows(bezier_list)
generate_ground(depth=-2,material=diffuse(color="grey20")) %>%
  add_object(sphere()) %>%
  add_object(hairball) %>%
  add_object(sphere(y=20,z=20,radius=5,material=light(color="white",intensity = 100))) %>%
  render_scene(samples=64, lookfrom=c(0,3,10),clamp_value = 10,
               fov=20)
kittyR::meowR(sound = 4)#猫叫
dev.copy(png, "2.png");dev.off()

image.png
image.png