OpenVMS Source-Code Demos
unicode_array_to_cp1252
function string unicode_array_to_cp1252(long uni(), long mode_bits) ! ! unicode_array_to_latin1(long uni(), long mode_bits) ! !================================================================================================= ! title : unicode_array_to_cp1252_107.fun ! purpose: character data must be loaded into uni() before this function is called ! mode_bits% bit-0: 0 (relaxed - copy controls as-is) ! 1 (strict - swap controls with a space; then compress) ! bit-1: 0 (relaxed - copy unmapped data as-is ! 1 (strict - swap unmapped data with a space; then compress) ! bit-4: 0 (debug off) ! 1 (debug on ) ! notes : 1) perhaps this function shour be renamed unicode_array_to_latin1() ! 2) no multi-byte characters are passed through this routine so if the destination ! database table defaults to utf-8 then you must use "character set latin1" in the ! "load data" command during the import into MySQL/MariaDB ! history: ! ver who when what ! --- --- -------- ------------------------------------------------------------------------------- ! 107 NSR 20200107 1. derived from UNICODE_TO_ISO_107.FUN !================================================================================================= option type=explicit ! ! declare string z ! declare long last,i,j,k,boggy ! !----------------------------------------------------------------------- ! main !----------------------------------------------------------------------- last = uni(0) ! for i = 1 to last ! select uni(i) ! case 0 to 31, 127 ! if (mode_bits and 1%) = 0% then ! z = z + chr$(uni(i)) ! relaxed - copy controls as-is else ! z = z + " " ! strict (no controls allowed) end if ! iterate ! case 32 to 126 ! z = z + chr$(uni(i)) ! iterate ! case 129, 141, 143 ! table holes z = z + " " ! iterate ! case 144, 157 ! table holes z = z + " " ! iterate ! case 128 to 255 ! block catch-all (holes have been excluded) z = z + chr$(uni(i)) ! iterate ! ! ! line-8 of the table ! case x'20ac' ! euro z = z + chr$(128) ! case x'201a' ! z = z + chr$(130) ! case x'0192' ! z = z + chr$(131) ! case x'201e' ! z = z + chr$(132) ! case x'2026' ! z = z + chr$(133) ! case x'2020' ! z = z + chr$(134) ! case x'2021' ! z = z + chr$(135) ! case x'02c6' ! z = z + chr$(136) ! case x'2030' ! z = z + chr$(137) ! case x'0160' ! z = z + chr$(138) ! case x'2039' ! z = z + chr$(139) ! case x'0152' ! z = z + chr$(140) ! case x'017d' ! z = z + chr$(142) ! ! ! line-9 of the table ! case x'2018' ! z = z + chr$(145) ! case x'2019' ! z = z + chr$(146) ! case x'201c' ! z = z + chr$(147) ! case x'201d' ! z = z + chr$(148) ! case x'2022' ! z = z + chr$(149) ! case x'2013' ! z = z + chr$(150) ! case x'2014' ! z = z + chr$(151) ! case x'02dc' ! z = z + chr$(152) ! case x'2122' ! z = z + chr$(153) ! case x'0161' ! z = z + chr$(154) ! case x'203a' ! z = z + chr$(155) ! case x'0153' ! z = z + chr$(156) ! case x'017e' ! z = z + chr$(158) ! case x'0178' ! z = z + chr$(159) ! ! ! boggies that have crept into RMS ! case x'2033' ! a.k.a. 8243 (double prime) z = z + chr$(148) ! case x'2036' ! a.k.a. 8246 (reversed double prime) z = z + chr$(147) ! ! ! catch all ! case else ! if (mode_bits and 2%) = 0% then ! select uni(i) ! case x'2000' to x'2FFF' ! z = z + chr$( int(uni(i)/256%) ) ! z = z + chr$( uni(i) and x'ff' ) ! end select ! else ! z = z + " " ! strict end if ! if (mode_bits and 4%) = 4% then ! boggy = 1 ! print "-d-unicode_array_to_cp1252:";i;" ";uni(i) ! sleep 1 ! end if ! end select ! next i ! ! z = edit$(z,128+16+8) ! trailing, multiple, leading print "-i-unicode_array_to_cp1252:"; z if boggy = 1 ! unicode_array_to_cp1252 = z ! pass back to caller end function ! adios !
Back to OpenVMS
Back to OpenVMS Demo Index
Back to Home
Neil Rieck
Kitchener - Waterloo - Cambridge, Ontario, Canada.