1module m_charset 2! 3! One-byte only, sorry 4! 5private 6 7integer, parameter, private :: small_int = selected_int_kind(1) 8 9!-------------------------------------------------------------------------- 10type, public :: charset_t 11! private 12 integer(kind=small_int), dimension(0:255) :: mask 13end type charset_t 14 15 16public :: operator(.in.), operator(+) 17public :: assignment(=) 18public :: print_charset, reset_charset 19 20interface operator(.in.) 21 module procedure belongs 22end interface 23private :: belongs 24 25interface assignment(=) 26 module procedure set_string_to_charset, set_codes_to_charset 27end interface 28private :: set_string_to_charset, set_codes_to_charset 29 30interface operator(+) 31 module procedure add_string_to_charset, & 32 add_code_to_charset, add_codes_to_charset 33end interface 34private :: add_string_to_charset, add_code_to_charset, add_codes_to_charset 35 36!-------------------------------------------------------------------------- 37 38character(len=*), parameter, private :: & 39 lowercase = "abcdefghijklmnopqrstuvwxyz", & 40 uppercase = "ABCDEFGHIJKLMNOPQRSTUVWXYZ", & 41 digits = "0123456789" 42 43integer, parameter, public :: SPACE = 32 44integer, parameter, public :: NEWLINE = 10 45integer, parameter, public :: CARRIAGE_RETURN = 13 46integer, parameter, public :: TAB = 9 47 48type(charset_t), public :: initial_name_chars 49type(charset_t), public :: name_chars 50type(charset_t), public :: whitespace 51type(charset_t), public :: valid_chars 52type(charset_t), public :: uppercase_chars 53 54public :: setup_xml_charsets 55 56 57CONTAINS !========================================================== 58 59!-------------------------------------------------------------- 60function belongs(c,charset) result(res) 61character(len=1), intent(in) :: c 62type(charset_t), intent(in) :: charset 63logical :: res 64 65integer :: code 66 67code = ichar(c) 68res = (charset%mask(code) == 1) 69 70end function belongs 71 72!-------------------------------------------------------------- 73 74function add_string_to_charset(charset,str) result (sum) 75type(charset_t), intent(in) :: charset 76character(len=*), intent(in) :: str 77type(charset_t) :: sum 78 79integer :: length, code, i 80 81sum%mask = charset%mask 82 83length = len_trim(str) 84do i = 1, length 85 code = ichar(str(i:i)) 86 sum%mask(code) = 1 87enddo 88end function add_string_to_charset 89 90!-------------------------------------------------------------- 91 92function add_code_to_charset(charset,code) result(sum) 93type(charset_t), intent(in) :: charset 94integer, intent(in) :: code 95type(charset_t) :: sum 96 97if ((code > 255) .or. (code < 0)) return 98sum%mask = charset%mask 99sum%mask(code) = 1 100 101end function add_code_to_charset 102 103!-------------------------------------------------------------- 104function add_codes_to_charset(charset,codes) result(sum) 105type(charset_t), intent(in) :: charset 106integer, dimension(:), intent(in) :: codes 107type(charset_t) :: sum 108 109integer :: i 110 111sum%mask = charset%mask 112do i = 1, size(codes) 113 if ((codes(i) > 255) .or. (codes(i) < 0)) cycle 114 sum%mask(codes(i)) = 1 115enddo 116end function add_codes_to_charset 117 118!-------------------------------------------------------------- 119 120subroutine set_string_to_charset(charset,str) 121type(charset_t), intent(out) :: charset 122character(len=*), intent(in) :: str 123 124 125integer :: length, code, i 126 127charset%mask = 0 128 129length = len_trim(str) 130do i = 1, length 131 code = ichar(str(i:i)) 132 charset%mask(code) = 1 133enddo 134 135end subroutine set_string_to_charset 136 137!-------------------------------------------------------------- 138 139subroutine set_codes_to_charset(charset,codes) 140type(charset_t), intent(out) :: charset 141integer, dimension(:), intent(in) :: codes 142 143integer :: i 144 145charset%mask = 0 146 147do i = 1, size(codes) 148 charset%mask(codes(i)) = 1 149enddo 150 151end subroutine set_codes_to_charset 152 153 154!-------------------------------------------------------------- 155subroutine print_charset(charset) 156type(charset_t), intent(in) :: charset 157 158integer :: i 159 160do i = 0, 255 161 if (charset%mask(i) == 1) print *, "Code: ", i 162enddo 163end subroutine print_charset 164 165!-------------------------------------------------------------- 166 167subroutine reset_charset(charset) 168type(charset_t), intent(inout) :: charset 169 170integer :: i 171 172do i = 0, 255 173 charset%mask(i) = 0 174enddo 175end subroutine reset_charset 176 177!-------------------------------------------------------------- 178 179!-------------------------------------------------------- 180subroutine setup_xml_charsets() 181 182integer :: i 183 184uppercase_chars = uppercase 185initial_name_chars = (lowercase // uppercase // "_:" ) 186name_chars = initial_name_chars + ( digits // ".-") 187whitespace = (/ SPACE, NEWLINE, TAB, CARRIAGE_RETURN /) 188 189valid_chars = whitespace + (/ (i, i=33,255) /) 190 191end subroutine setup_xml_charsets 192!-------------------------------------------------------- 193 194end module m_charset 195 196 197 198 199 200 201 202 203 204