From 4d4743f394139e6eee45f611ecffdba06efc8d5c Mon Sep 17 00:00:00 2001 From: Alberto Otero de la Roza Date: Thu, 22 Aug 2024 12:20:29 +0200 Subject: [PATCH] implemented draw style labels --- VERSION | 2 +- src/gui/scenes.f90 | 24 +++++++++++--- src/gui/scenes@proc.f90 | 68 ++++++++++++++++++++++++---------------- src/gui/windows@tree.f90 | 1 + src/gui/windows@view.f90 | 18 +++++------ 5 files changed, 71 insertions(+), 42 deletions(-) diff --git a/VERSION b/VERSION index 4d248e7c..f25770e9 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -1.2.241 +1.2.242 diff --git a/src/gui/scenes.f90 b/src/gui/scenes.f90 index 6f1f38c6..a946ac38 100644 --- a/src/gui/scenes.f90 +++ b/src/gui/scenes.f90 @@ -114,6 +114,19 @@ module scenes end type draw_style_bond public :: draw_style_bond + !> Draw style for labels + type draw_style_label + logical :: isinit = .false. ! whether the style is intialized + integer(c_int) :: style ! 0=atom-symbol, 1=atom-name, 2=cel-atom, 3=cel-atom+lvec, 4=neq-atom, 5=spc, 6=Z, 7=mol, 8=wyckoff + real(c_float) :: scale ! scale for the labels + real(c_float) :: rgb(3) ! color of the labels + logical :: const_size ! whether labels scale with objects or are constant size + logical :: exclude_h ! whether to exclude hydrogen labels + contains + procedure :: reset => reset_label_style + end type draw_style_label + public :: draw_style_label + ! types of representations integer, parameter, public :: reptype_none = 0 integer, parameter, public :: reptype_atoms = 1 @@ -159,11 +172,7 @@ module scenes type(draw_style_atom) :: atom_style ! atom styles type(draw_style_molecule) :: mol_style ! molecule styles type(draw_style_bond) :: bond_style ! bond styles - integer(c_int) :: label_style ! 0=atom-symbol, 1=atom-name, 2=cel-atom, 3=cel-atom+lvec, 4=neq-atom, 5=spc, 6=Z, 7=mol, 8=wyckoff - real(c_float) :: label_scale ! scale for the labels - real(c_float) :: label_rgb(3) ! color of the labels - logical :: label_const_size ! whether labels scale with objects or are constant size - logical :: label_exclude_h ! whether to exclude hydrogen labels + type(draw_style_label) :: label_style ! bond styles ! unit cell logical :: uc_inner ! unit cell, display inner cylinders logical :: uc_coloraxes ! unit cell, color the axes (x=red,y=green,z=blue) @@ -345,6 +354,11 @@ module subroutine generate_neighstars_from_globals(d,isys) class(draw_style_bond), intent(inout), target :: d integer, intent(in) :: isys end subroutine generate_neighstars_from_globals + ! draw_style_label + module subroutine reset_label_style(d,isys) + class(draw_style_label), intent(inout), target :: d + integer, intent(in), value :: isys + end subroutine reset_label_style ! representation module subroutine representation_init(r,sc,isys,irep,itype,style,flavor) class(representation), intent(inout), target :: r diff --git a/src/gui/scenes@proc.f90 b/src/gui/scenes@proc.f90 index b0139288..ffebd06f 100644 --- a/src/gui/scenes@proc.f90 +++ b/src/gui/scenes@proc.f90 @@ -705,14 +705,12 @@ module subroutine scene_set_style_defaults(s,style) s%specular = 0.6_c_float s%shininess = 8_c_int do i = 1, s%nrep - s%rep(i)%label_rgb = 1._c_float s%rep(i)%uc_rgb = 1._c_float end do else !! simple !! s%bgcolor = (/1._c_float,1._c_float,1._c_float/) do i = 1, s%nrep - s%rep(i)%label_rgb = 0._c_float s%rep(i)%uc_rgb = 0._c_float end do s%atomborder = atomborder_def @@ -1253,7 +1251,7 @@ module subroutine generate_neighstars_from_globals(d,isys) class(draw_style_bond), intent(inout), target :: d integer, intent(in) :: isys - integer :: i, j, n, ispc, jspc + integer :: i, j real*8 :: r1cov, r1vdw, r2cov, r2vdw real*8, allocatable :: rij_t(:,:,:) @@ -1296,6 +1294,27 @@ module subroutine generate_neighstars_from_globals(d,isys) end subroutine generate_neighstars_from_globals + !> Reset label style with default values. Use the information in + !> system isys, or leave it empty if isys = 0. + module subroutine reset_label_style(d,isys) + use gui_main, only: nsys, sysc, sys_ready + class(draw_style_label), intent(inout), target :: d + integer, intent(in), value :: isys + + ! check the system is sane + if (isys < 1 .or. isys > nsys) return + if (sysc(isys)%status < sys_ready) return + + ! set the atom style to defaults + d%isinit = .true. + d%style = 0_c_int + d%scale = 0.5_c_float + d%rgb = 0._c_float + d%const_size = .false. + d%exclude_h = .true. + + end subroutine reset_label_style + !xx! representation !> Initialize a representation. If itype is present and not _none, @@ -1314,8 +1333,6 @@ module subroutine representation_init(r,sc,isys,irep,itype,style,flavor) integer, intent(in) :: style integer, intent(in) :: flavor - integer :: i, j - ! check the system is sane if (isys < 1 .or. isys > nsys) return if (sysc(isys)%status < sys_ready) return @@ -1341,10 +1358,6 @@ module subroutine representation_init(r,sc,isys,irep,itype,style,flavor) r%atom_radii_reset_type = 0 r%atom_radii_reset_scale = 0.7_c_float r%atom_color_reset_type = 0 - r%label_style = 0 - r%label_scale = 0.5_c_float - r%label_const_size = .false._c_bool - r%label_exclude_h = .true._c_bool r%uc_radius = 0.15_c_float r%uc_radiusinner = 0.15_c_float r%uc_innersteplen = 2d0 @@ -1356,10 +1369,8 @@ module subroutine representation_init(r,sc,isys,irep,itype,style,flavor) ! style-dependent settings if (style == style_phong) then - r%label_rgb = 1._c_float r%uc_rgb = 1._c_float else - r%label_rgb = 0._c_float r%uc_rgb = 0._c_float end if @@ -1414,7 +1425,7 @@ module subroutine representation_init(r,sc,isys,irep,itype,style,flavor) call r%atom_style%reset(r%id,0) call r%mol_style%reset(r%id) call r%bond_style%reset(r%id,r%flavor) - + call r%label_style%reset(r%id) end subroutine representation_init @@ -1442,7 +1453,7 @@ end subroutine representation_end !> Update the representation to respond to a change in the number !> of atoms or molecules in the associated system. module subroutine update_structure(r) - use gui_main, only: nsys, sys, sysc, lockbehavior, sys_ready + use gui_main, only: nsys, sys, sysc, sys_ready class(representation), intent(inout), target :: r logical :: doreset @@ -1468,6 +1479,9 @@ module subroutine update_structure(r) doreset = doreset .or. (r%mol_style%ntype /= sys(r%id)%c%nmol) if (doreset) call r%mol_style%reset(r%id) + doreset = .not.r%mol_style%isinit + if (doreset) call r%label_style%reset(r%id) + end subroutine update_structure !> Add the spheres, cylinder, etc. to the draw lists. Use nc number @@ -1797,7 +1811,7 @@ module subroutine add_draw_elements(r,nc,nsph,drawlist_sph,ncyl,drawlist_cyl,& ! labels if (r%labels_display .and. & - (.not.r%label_exclude_h.or.sys(r%id)%c%spc(sys(r%id)%c%atcel(i)%is)%z/=1)) then + (.not.r%label_style%exclude_h.or.sys(r%id)%c%spc(sys(r%id)%c%atcel(i)%is)%z/=1)) then nstring = nstring + 1 if (nstring > size(drawlist_string,1)) then allocate(auxstr(2*nstring)) @@ -1808,30 +1822,30 @@ module subroutine add_draw_elements(r,nc,nsph,drawlist_sph,ncyl,drawlist_cyl,& drawlist_string(nstring)%x = real(xc + uoriginc,c_float) drawlist_string(nstring)%xdelta = cmplx(xdelta1,kind=c_float_complex) drawlist_string(nstring)%r = real(rad1,c_float) - drawlist_string(nstring)%rgb = r%label_rgb - if (r%label_const_size) then - drawlist_string(nstring)%scale = r%label_scale + drawlist_string(nstring)%rgb = r%label_style%rgb + if (r%label_style%const_size) then + drawlist_string(nstring)%scale = r%label_style%scale else - drawlist_string(nstring)%scale = -r%label_scale + drawlist_string(nstring)%scale = -r%label_style%scale end if - if (r%label_style == 0) then ! 0 = atomic symbol + if (r%label_style%style == 0) then ! 0 = atomic symbol drawlist_string(nstring)%str = trim(nameguess(sys(r%id)%c%spc(sys(r%id)%c%atcel(i)%is)%z,.true.)) - elseif (r%label_style == 1) then ! 1 = atom name + elseif (r%label_style%style == 1) then ! 1 = atom name drawlist_string(nstring)%str = trim(sys(r%id)%c%spc(sys(r%id)%c%atcel(i)%is)%name) - elseif (r%label_style == 2) then ! 2 = cel-atom + elseif (r%label_style%style == 2) then ! 2 = cel-atom drawlist_string(nstring)%str = string(i) - elseif (r%label_style == 3) then ! 3 = cel-atom + lvec + elseif (r%label_style%style == 3) then ! 3 = cel-atom + lvec drawlist_string(nstring)%str = string(i) // newline // "(" // string(ix(1)) // "," //& string(ix(2)) // "," // string(ix(3)) // ")" - elseif (r%label_style == 4) then ! 4 = neq atom + elseif (r%label_style%style == 4) then ! 4 = neq atom drawlist_string(nstring)%str = string(sys(r%id)%c%atcel(i)%idx) - elseif (r%label_style == 5) then ! 5 = spc + elseif (r%label_style%style == 5) then ! 5 = spc drawlist_string(nstring)%str = string(sys(r%id)%c%atcel(i)%is) - elseif (r%label_style == 6) then ! 6 = Z + elseif (r%label_style%style == 6) then ! 6 = Z drawlist_string(nstring)%str = string(sys(r%id)%c%spc(sys(r%id)%c%atcel(i)%is)%z) - elseif (r%label_style == 7) then ! 7 = mol + elseif (r%label_style%style == 7) then ! 7 = mol drawlist_string(nstring)%str = string(imol) - elseif (r%label_style == 8) then ! 8 = wycoff + elseif (r%label_style%style == 8) then ! 8 = wycoff idx = sys(r%id)%c%atcel(i)%idx drawlist_string(nstring)%str = string(sys(r%id)%c%at(idx)%mult) //& string(sys(r%id)%c%at(idx)%wyc) diff --git a/src/gui/windows@tree.f90 b/src/gui/windows@tree.f90 index fbbb504a..56e48ba9 100644 --- a/src/gui/windows@tree.f90 +++ b/src/gui/windows@tree.f90 @@ -2541,6 +2541,7 @@ subroutine system_force_build_lists(i) do j = 1, nwin if (.not.win(j)%isinit) cycle if (win(j)%type == wintype_view .and..not.win(j)%ismain.and.associated(win(j)%sc)) then + ! force build lists and update representations do k = 1, win(j)%sc%nrep if (win(j)%sc%rep(k)%isinit .and. win(j)%sc%rep(k)%type==reptype_atoms.and.& win(j)%sc%rep(k)%bond_style%isinit.and.win(j)%sc%rep(k)%bond_style%isdef) then diff --git a/src/gui/windows@view.f90 b/src/gui/windows@view.f90 index 15706f71..6190ce38 100644 --- a/src/gui/windows@view.f90 +++ b/src/gui/windows@view.f90 @@ -2157,21 +2157,21 @@ module function draw_editrep_atoms(w,ttshown) result(changed) !! labels display !! ! label styles - call iw_text("Style Options",highlight=.true.) + call iw_text("Global Options",highlight=.true.) if (sys(isys)%c%ismolecule) then - lst = lsttrans(w%rep%label_style) + lst = lsttrans(w%rep%label_style%style) call iw_combo_simple("Text##labelcontentselect","Atomic symbol"//c_null_char//& "Atom name"// c_null_char//"Atom ID"// c_null_char//& "Species ID"// c_null_char// "Atomic number"// c_null_char// "Molecule ID"// c_null_char,& lst,changed=ch) - w%rep%label_style = lsttransi(lst) + w%rep%label_style%style = lsttransi(lst) else call iw_combo_simple("Text##labelcontentselect","Atomic symbol"//c_null_char//& "Atom name"//c_null_char//"Cell atom ID"//c_null_char//& "Cell atom ID + lattice vector"//c_null_char//"Symmetry-unique atom ID"//c_null_char//& "Species ID"//c_null_char//"Atomic number"//c_null_char//"Molecule ID"//c_null_char//& "Wyckoff position"//c_null_char,& - w%rep%label_style,changed=ch) + w%rep%label_style%style,changed=ch) end if call iw_tooltip("Text to display in the atom labels",ttshown) changed = changed .or. ch @@ -2180,22 +2180,22 @@ module function draw_editrep_atoms(w,ttshown) result(changed) str2 = "Scale##labelscale" // c_null_char str3 = "%.2f" // c_null_char call igPushItemWidth(iw_calcwidth(4,1)) - changed = changed .or. igDragFloat(c_loc(str2),w%rep%label_scale,0.01_c_float,0._c_float,10._c_float,c_loc(str3),& + changed = changed .or. igDragFloat(c_loc(str2),w%rep%label_style%scale,0.01_c_float,0._c_float,10._c_float,c_loc(str3),& ImGuiSliderFlags_AlwaysClamp) call igPopItemWidth() call iw_tooltip("Scale factor for the atom labels",ttshown) - changed = changed .or. iw_checkbox("Constant size##labelconstsize",w%rep%label_const_size,sameline=.true.) + changed = changed .or. iw_checkbox("Constant size##labelconstsize",w%rep%label_style%const_size,sameline=.true.) call iw_tooltip("Labels have constant size (on) or labels scale with the size of the associated atom (off)",ttshown) call igSameLine(0._c_float,-1._c_float) str2 = "Color##labelcolor" // c_null_char - changed = changed .or. igColorEdit3(c_loc(str2),w%rep%label_rgb,ImGuiColorEditFlags_NoInputs) + changed = changed .or. igColorEdit3(c_loc(str2),w%rep%label_style%rgb,ImGuiColorEditFlags_NoInputs) call iw_tooltip("Color of the atom labels",ttshown) - call iw_clamp_color3(w%rep%label_rgb) + call iw_clamp_color3(w%rep%label_style%rgb) ! exclude H - changed = changed .or. iw_checkbox("Exclude hydrogens##labelexcludeh",w%rep%label_exclude_h) + changed = changed .or. iw_checkbox("Exclude hydrogens##labelexcludeh",w%rep%label_style%exclude_h) call iw_tooltip("Do not show labels on hydrogen atoms",ttshown) call igEndTabItem()