Line data Source code
1 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3 : !!!!
4 : !!!! MIT License
5 : !!!!
6 : !!!! ParaMonte: plain powerful parallel Monte Carlo library.
7 : !!!!
8 : !!!! Copyright (C) 2012-present, The Computational Data Science Lab
9 : !!!!
10 : !!!! This file is part of the ParaMonte library.
11 : !!!!
12 : !!!! Permission is hereby granted, free of charge, to any person obtaining a
13 : !!!! copy of this software and associated documentation files (the "Software"),
14 : !!!! to deal in the Software without restriction, including without limitation
15 : !!!! the rights to use, copy, modify, merge, publish, distribute, sublicense,
16 : !!!! and/or sell copies of the Software, and to permit persons to whom the
17 : !!!! Software is furnished to do so, subject to the following conditions:
18 : !!!!
19 : !!!! The above copyright notice and this permission notice shall be
20 : !!!! included in all copies or substantial portions of the Software.
21 : !!!!
22 : !!!! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
23 : !!!! EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
24 : !!!! MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
25 : !!!! IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM,
26 : !!!! DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR
27 : !!!! OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE
28 : !!!! OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
29 : !!!!
30 : !!!! ACKNOWLEDGMENT
31 : !!!!
32 : !!!! ParaMonte is an honor-ware and its currency is acknowledgment and citations.
33 : !!!! As per the ParaMonte library license agreement terms, if you use any parts of
34 : !!!! this library for any purposes, kindly acknowledge the use of ParaMonte in your
35 : !!!! work (education/research/industry/development/...) by citing the ParaMonte
36 : !!!! library as described on this page:
37 : !!!!
38 : !!!! https://github.com/cdslaborg/paramonte/blob/main/ACKNOWLEDGMENT.md
39 : !!!!
40 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
41 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
42 :
43 : #if defined MEXPRINT_ENABLED
44 : #include "fintrf.h"
45 : #endif
46 :
47 : !> \brief This submodule contains module procedures for outputting text.
48 : !> \author Amir Shahmoradi
49 :
50 : submodule (Decoration_mod) Routines_mod
51 :
52 : implicit none
53 :
54 : contains
55 :
56 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
57 :
58 : !> \brief
59 : !> The constructor of the [Decoration_type](@ref decoration_type class.
60 : !> @param[in] tabStr : The string representing the tab character (**optional**, default = `TAB`).
61 : !> @param[in] symbol : The symbol with which the text is decorated (**optional**).
62 : !> @param[in] text : The text to be decorated (**optional**).
63 : !> @param[in] List : A list of lines to be decorated (**optional**).
64 : !>
65 : !> \return
66 : !> Decoration : An object of class [Decoration_type](@ref decoration_type).
67 1053 : module function constructDecoration(tabStr,symbol,text,List) result(Decoration)
68 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
69 : !DEC$ ATTRIBUTES DLLEXPORT :: constructDecoration
70 : #endif
71 : use JaggedArray_mod, only: CharVec_type
72 : implicit none
73 : character(*), intent(in), optional :: tabStr, symbol, text
74 : type(CharVec_type), intent(in), optional :: List
75 : type(Decoration_type) :: Decoration
76 1053 : if (present(tabStr)) then
77 3 : Decoration%tab = tabStr
78 : else
79 1050 : Decoration%tab = TAB
80 : end if
81 1053 : if (present(symbol)) then
82 3 : Decoration%symbol = symbol
83 : else
84 1050 : Decoration%symbol = STAR
85 : end if
86 1053 : if (present(text)) Decoration%text = text
87 1053 : if (present(List)) Decoration%List = List
88 1053 : end function constructDecoration
89 :
90 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
91 :
92 : !> \brief
93 : !> Given a text and the requested characteristics, this function wraps the text to within the maximum width specified.
94 : !> @param[in] text : The input text.
95 : !> @param[in] symbol : The decoration symbol added to beginning and ending of the wrapped line (**optional**).
96 : !> @param[in] width : The wrapping with (**optional**).
97 : !> @param[in] thicknessHorz : The horizontal thickness of the symbol that sandwiches the text (**optional**).
98 : !> @param[in] thicknessVert : The vertical thickness of the symbol that sandwiches the text from top and bottom (**optional**).
99 : !> @param[in] marginTop : The number of empty lines between the top symbol line and the text start (**optional**).
100 : !> @param[in] marginBot : The number of empty lines between the bottom symbol line and the text start (**optional**).
101 : !> @param[in] outputUnit : The file unit to which the wrapper text must be written (**optional**).
102 : !> @param[in] newLine : The string that represent the new line in the input text (**optional**).
103 3543 : module subroutine writeDecoratedText(text,symbol,width,thicknessHorz,thicknessVert,marginTop,marginBot,outputUnit,newLine)
104 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
105 : !DEC$ ATTRIBUTES DLLEXPORT :: writeDecoratedText
106 : #endif
107 : use, intrinsic :: iso_fortran_env, only: output_unit
108 1053 : use Constants_mod, only: IK
109 : implicit none
110 : character(*), intent(in) :: text
111 : character(*), intent(in), optional :: symbol,newLine
112 : integer(IK) , intent(in), optional :: width,thicknessHorz,thicknessVert,marginTop,marginBot
113 : integer(IK) , intent(in), optional :: outputUnit
114 : integer(IK) :: thicknessVertDefault
115 3543 : if (present(thicknessVert)) then
116 1798 : thicknessVertDefault = thicknessVert
117 : else
118 1745 : thicknessVertDefault = DECORATION_THICKNESS_VERT
119 : end if
120 3543 : if (present(newLine)) then
121 30334 : call writeDecoratedList( getListOfLines(text,newLine), symbol, width, thicknessHorz, thicknessVert, marginTop, marginBot, outputUnit )
122 : else
123 0 : call write(outputUnit,marginTop,0,thicknessVertDefault, drawLine(symbol,width) )
124 0 : call write(outputUnit,0,0,1, sandwich(text,symbol,width,thicknessHorz) )
125 0 : call write(outputUnit,0,marginBot,thicknessVertDefault, drawLine(symbol,width) )
126 : end if
127 7086 : end subroutine writeDecoratedText
128 :
129 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
130 :
131 : !> \brief
132 : !> Given a list of lines and the requested characteristics, this function wraps the text to within the maximum width specified.
133 : !> @param[in] List : The input list of lines to decorate and write.
134 : !> @param[in] symbol : The decoration symbol added to beginning and ending of the wrapped line (**optional**).
135 : !> @param[in] width : The wrapping with (**optional**).
136 : !> @param[in] thicknessHorz : The horizontal thickness of the symbol that sandwiches the text (**optional**).
137 : !> @param[in] thicknessVert : The vertical thickness of the symbol that sandwiches the text from top and bottom (**optional**).
138 : !> @param[in] marginTop : The number of empty lines between the top symbol line and the text start (**optional**).
139 : !> @param[in] marginBot : The number of empty lines between the bottom symbol line and the text start (**optional**).
140 : !> @param[in] outputUnit : The file unit to which the wrapper text must be written (**optional**).
141 3549 : module subroutine writeDecoratedList(List,symbol,width,thicknessHorz,thicknessVert,marginTop,marginBot,outputUnit)
142 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
143 : !DEC$ ATTRIBUTES DLLEXPORT :: writeDecoratedList
144 : #endif
145 : use, intrinsic :: iso_fortran_env, only: output_unit
146 3543 : use Constants_mod, only: IK
147 : implicit none
148 : type(CharVec_type), allocatable , intent(in) :: List(:)
149 : character(*) , intent(in), optional :: symbol
150 : integer(IK) , intent(in), optional :: width,thicknessHorz,thicknessVert,marginTop,marginBot
151 : integer(IK) , intent(in), optional :: outputUnit
152 : integer(IK) :: i
153 : integer(IK) :: thicknessVertDefault
154 3549 : if (present(thicknessVert)) then
155 1801 : thicknessVertDefault = thicknessVert
156 : else
157 1748 : thicknessVertDefault = DECORATION_THICKNESS_VERT
158 : end if
159 3549 : call write(outputUnit,marginTop,0,thicknessVertDefault, drawLine(symbol,width) )
160 26821 : do i = 1,size(List)
161 26821 : call write(outputUnit,0,0,1, sandwich(List(i)%record,symbol,width,thicknessHorz) )
162 : end do
163 3549 : call write(outputUnit,0,marginBot,thicknessVertDefault, drawLine(symbol,width) )
164 7098 : end subroutine writeDecoratedList
165 :
166 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
167 :
168 : !> \brief
169 : !> Return a string which is a pattern repetition for the requested width.
170 : !> @param[in] symbol : The decoration symbol added to beginning and ending of the wrapped line (**optional**, default = `STAR`).
171 : !> @param[in] width : The width of the line (**optional**, default = `DECORATION_WIDTH`).
172 : !>
173 : !> \return
174 : !> `line` : A string of the requested pattern.
175 7107 : pure module function drawLine(symbol,width) result(line)
176 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
177 : !DEC$ ATTRIBUTES DLLEXPORT :: drawLine
178 : #endif
179 3549 : use Constants_mod, only: IK
180 : implicit none
181 : character(*), intent(in), optional :: symbol
182 : integer(IK), intent(in) , optional :: width
183 :
184 : character(:), allocatable :: line
185 : integer(IK) :: decorationWidth, symbolLen, symbolIndex, i
186 7107 : character(:), allocatable :: decorationSymbol
187 :
188 7107 : if (present(symbol)) then
189 3608 : if (len(symbol)<1) then
190 0 : decorationSymbol = " "
191 : else
192 3608 : decorationSymbol = symbol
193 : end if
194 : else
195 3499 : decorationSymbol = STAR
196 : end if
197 7107 : symbolLen = len(decorationSymbol)
198 :
199 7107 : if (present(width)) then
200 3605 : decorationWidth = width
201 : else
202 3502 : decorationWidth = DECORATION_WIDTH
203 : end if
204 :
205 7107 : symbolIndex = 1
206 7107 : allocate(character(decorationWidth) :: line)
207 944556 : do i=1,decorationWidth
208 937449 : line(i:i) = decorationSymbol(symbolIndex:symbolIndex)
209 937449 : symbolIndex = symbolIndex + 1
210 944556 : if (symbolIndex>symbolLen) symbolIndex = 1
211 : end do
212 :
213 7107 : end function drawLine
214 :
215 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
216 :
217 : !> \brief
218 : !> Sandwich the input string with the input symbol for the requested thickness on both ends of the string.
219 : !> @param[in] text : The text to be sandwiched (**optional**).
220 : !> @param[in] symbol : The decoration symbol added to beginning and ending of the wrapped line (**optional**).
221 : !> @param[in] width : The width of the line (**optional**).
222 : !> @param[in] thicknessHorz : The width of the decoration to be added at the beginning and end of the string (**optional**).
223 : !>
224 : !> \return
225 : !> `sandwichedText` : A string of the requested pattern.
226 23287 : pure module function sandwich(text,symbol,width,thicknessHorz) result(sandwichedText)
227 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
228 : !DEC$ ATTRIBUTES DLLEXPORT :: sandwich
229 : #endif
230 7107 : use Constants_mod, only: IK
231 : implicit none
232 : character(*), intent(in), optional :: text, symbol
233 : integer(IK), intent(in) , optional :: width,thicknessHorz
234 : character(:), allocatable :: sandwichedText
235 : integer(IK) :: decorationWidth, decorationThicknessHorz
236 23287 : character(:), allocatable :: decorationText, decorationSymbol
237 : integer(IK) :: i,decorationTextLen, symbolLen, symbolIndex, leftLimit, rightLimit
238 : integer(IK) :: sandwichedTextStart,decorationTextStart,decorationTextLenCounter
239 :
240 23287 : if (present(symbol)) then
241 18007 : decorationSymbol = symbol
242 : else
243 5280 : decorationSymbol = STAR
244 : end if
245 :
246 23287 : if (present(width)) then
247 18004 : decorationWidth = width
248 : else
249 5283 : decorationWidth = DECORATION_WIDTH
250 : end if
251 :
252 23287 : if (present(thicknessHorz)) then
253 18001 : decorationThicknessHorz = thicknessHorz
254 : else
255 5286 : decorationThicknessHorz = DECORATION_THICKNESS_HORZ
256 : end if
257 :
258 23287 : if (present(text)) then
259 23284 : decorationText = trim(adjustl(text))
260 : else
261 3 : decorationText = ""
262 : end if
263 :
264 23287 : if (decorationWidth<1) then
265 0 : sandwichedText = ""
266 0 : return
267 : end if
268 :
269 23287 : allocate( character(decorationWidth) :: sandwichedText )
270 23287 : decorationTextLen = len(decorationText)
271 :
272 23287 : symbolLen = len(symbol)
273 23287 : symbolIndex = 1
274 23287 : leftLimit = decorationThicknessHorz + 1
275 23287 : rightLimit = decorationWidth - decorationThicknessHorz + 1
276 :
277 23287 : if (decorationTextLen<1) then
278 1518190 : do i = 1, decorationWidth
279 1518190 : if (i<leftLimit) then
280 45732 : sandwichedText(i:i) = decorationSymbol(symbolIndex:symbolIndex)
281 45732 : symbolIndex = symbolIndex + 1
282 45732 : if (symbolIndex>symbolLen) symbolIndex = 1
283 1461020 : elseif (i<rightLimit) then
284 1415290 : sandwichedText(i:i) = " "
285 1415290 : symbolIndex = symbolIndex + 1
286 1415290 : if (symbolIndex>symbolLen) symbolIndex = 1
287 : else
288 45732 : sandwichedText(i:i) = decorationSymbol(symbolIndex:symbolIndex)
289 45732 : symbolIndex = symbolIndex + 1
290 45732 : if (symbolIndex>symbolLen) symbolIndex = 1
291 : end if
292 : end do
293 11433 : return
294 : end if
295 :
296 11854 : sandwichedTextStart = max( leftLimit , ( decorationWidth - decorationTextLen ) / 2 + 1 )
297 11854 : decorationTextStart = max( 1 , leftLimit - ( decorationWidth - decorationTextLen ) / 2 )
298 11854 : decorationTextLenCounter = decorationTextStart
299 :
300 1575140 : do i=1,decorationWidth
301 1575140 : if (i<leftLimit) then
302 47383 : sandwichedText(i:i) = decorationSymbol(symbolIndex:symbolIndex)
303 47383 : symbolIndex = symbolIndex + 1
304 47383 : if (symbolIndex>symbolLen) symbolIndex = 1
305 1515900 : elseif (i<rightLimit) then
306 1468520 : if (i<sandwichedTextStart) then
307 534313 : sandwichedText(i:i) = " "
308 934209 : else if ( decorationTextLenCounter<=decorationTextLen ) then
309 392803 : sandwichedText(i:i) = decorationText(decorationTextLenCounter:decorationTextLenCounter)
310 392803 : decorationTextLenCounter = decorationTextLenCounter + 1
311 : else
312 541406 : sandwichedText(i:i) = " "
313 : end if
314 1468520 : symbolIndex = symbolIndex + 1
315 1468520 : if (symbolIndex>symbolLen) symbolIndex = 1
316 : else
317 47383 : sandwichedText(i:i) = decorationSymbol(symbolIndex:symbolIndex)
318 47383 : symbolIndex = symbolIndex + 1
319 47383 : if (symbolIndex>symbolLen) symbolIndex = 1
320 : end if
321 : end do
322 :
323 : !! initialize empty container
324 : !do i=1,decorationWidth
325 : ! sandwichedText(i:i) = " "
326 : !end do
327 :
328 : !! add margin
329 : !do i=1,decorationThicknessHorz
330 : ! sandwichedText(i:i) = decorationSymbol
331 : ! sandwichedText(decorationWidth-i+1:decorationWidth-i+1) = decorationSymbol
332 : !end do
333 :
334 : !! add decorationText in between
335 : !sandwichedTextStart = max( decorationThicknessHorz , (decorationWidth-decorationTextLen)/2 )
336 : !sandwichedTextEnd = min( decorationWidth , sandwichedTextStart + decorationTextLen - 1 )
337 : !decorationTextStart = 1
338 : !decorationTextEnd = sandwichedTextEnd - sandwichedTextStart + 1
339 : !sandwichedText(sandwichedTextStart:sandwichedTextEnd) = decorationText(decorationTextStart:decorationTextEnd)
340 :
341 23287 : end function sandwich
342 :
343 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
344 :
345 : !> \brief
346 : !> Write the decorated text to the output.
347 : !> @param[in] outputUnit : The output file unit (**optional**).
348 : !> @param[in] marginTop : The number of empty lines before writing the string (**optional**).
349 : !> @param[in] marginBot : The number of empty lines after writing the string (**optional**).
350 : !> @param[in] count : The number of times to write the string to the output (**optional**, default = 1).
351 : !> @param[in] width : The width of the line (**optional**).
352 : !> @param[in] string : The string to output (**optional**, default = "").
353 332724 : module subroutine write ( outputUnit &
354 : , marginTop &
355 : , marginBot &
356 : , count &
357 : , string &
358 : #if defined MEXPRINT_ENABLED
359 : , advance &
360 : #endif
361 : )
362 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
363 : !DEC$ ATTRIBUTES DLLEXPORT :: write
364 : #endif
365 : use, intrinsic :: iso_fortran_env, only: output_unit
366 23287 : use Constants_mod, only: IK, NLC
367 : implicit none
368 : integer(IK) , intent(in), optional :: outputUnit
369 : integer(IK) , intent(in), optional :: marginTop, marginBot, count
370 : character(*), intent(in), optional :: string
371 : integer(IK) :: i, logFileUnit, thisManyTimes
372 : #if defined MEXPRINT_ENABLED
373 : logical , intent(in), optional :: advance
374 : logical :: isStdout, advanceEnabled
375 : advanceEnabled = .true.; if (present(advance)) advanceEnabled = advance
376 : #endif
377 :
378 332724 : if (present(outputUnit)) then
379 : #if defined MEXPRINT_ENABLED
380 : isStdout = output_unit == outputUnit
381 : #endif
382 332039 : logFileUnit = outputUnit
383 : else
384 : #if defined MEXPRINT_ENABLED
385 : isStdout = .true.
386 : #endif
387 685 : logFileUnit = output_unit
388 : end if
389 :
390 332724 : if (present(marginTop)) then
391 353513 : do i = 1, marginTop
392 : #if defined MEXPRINT_ENABLED
393 : if (isStdout) then
394 : call mexPrintf(NLC)
395 : else
396 : write(logFileUnit,*)
397 : end if
398 : #else
399 353513 : write(logFileUnit,*)
400 : #endif
401 : end do
402 : end if
403 :
404 332724 : if (present(count)) then
405 310460 : thisManyTimes = count
406 : else
407 22264 : thisManyTimes = 1
408 : end if
409 :
410 332724 : if (present(string)) then
411 622566 : do i = 1, thisManyTimes
412 : #if defined MEXPRINT_ENABLED
413 : if (isStdout) then
414 : if (advanceEnabled) then
415 : call mexPrintf(string//NLC)
416 : else
417 : call mexPrintf(string)
418 : end if
419 : else
420 : write(logFileUnit,"(g0)") string
421 : end if
422 : #else
423 622566 : write(logFileUnit,"(g0)") string
424 : #endif
425 : end do
426 21806 : elseif (.not. ( present(marginBot) .and. present(marginTop) ) ) then
427 41728 : do i = 1, thisManyTimes
428 : #if defined MEXPRINT_ENABLED
429 : if (isStdout) then
430 : call mexPrintf(NLC)
431 : else
432 : write(logFileUnit,*)
433 : end if
434 : #else
435 41728 : write(logFileUnit,*)
436 : #endif
437 : end do
438 : end if
439 :
440 332724 : if (present(marginBot)) then
441 350885 : do i = 1, marginBot
442 : #if defined MEXPRINT_ENABLED
443 : if (isStdout) then
444 : call mexPrintf(NLC)
445 : else
446 : write(logFileUnit,*)
447 : end if
448 : #else
449 350885 : write(logFileUnit,*)
450 : #endif
451 : end do
452 : end if
453 :
454 665448 : end subroutine write
455 :
456 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
457 :
458 : !> \brief
459 : !> Wrap the input text to fit it within the requested line width.
460 : !> @param[in] string : The string to wrap.
461 : !> @param[in] width : The wrapping width.
462 : !> @param[in] split : The string at which the text can be broken and put on the next line, if needed (**optional**, default = "").
463 : !> @param[in] pad : The string to prepend each line (**optional**).
464 : !>
465 : !> \return
466 : !> ListOfLines : The list of lines that are wrapped to fit within the requested input width.
467 142329 : module function wrapText(string,width,split,pad) result(ListOfLines)
468 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
469 : !DEC$ ATTRIBUTES DLLEXPORT :: wrapText
470 : #endif
471 :
472 : use, intrinsic :: iso_fortran_env, only: output_unit
473 332724 : use Constants_mod, only: IK
474 :
475 : implicit none
476 :
477 : character(*), parameter :: PROCEDURE_NAME = "@wrapText()"
478 :
479 : character(*), intent(in) :: string
480 : integer(IK) , intent(in) :: width
481 : character(*), intent(in), optional :: split, pad
482 : type(CharVec_type), allocatable :: ListOfLines(:)
483 : integer(IK) :: stringLen, splitLen, padLen, padLength, padLengthDynamic, newLineLen, oldLineLen
484 : integer(IK) :: istart, iend, numSplitEndLoc, counter, lineCount, indx, indxOld
485 : integer(IK), allocatable :: IsEndOfSplitLoc(:), EndOfSplitLoc(:), EndOfLineLoc(:)
486 : logical :: isPadZone
487 :
488 142329 : padLen = len(pad)
489 142329 : splitLen = len(split)
490 142329 : stringLen = len(string)
491 142329 : if (stringLen==0) then
492 85808 : allocate( ListOfLines(1) )
493 42904 : ListOfLines(1)%record = ""
494 42904 : return
495 99425 : elseif (splitLen>=stringLen) then
496 0 : allocate( ListOfLines(1) )
497 0 : ListOfLines(1)%record = string
498 0 : return
499 99425 : elseif (splitLen==0) then ! enforce wrapping at any character as necessary
500 12924 : lineCount = stringLen / width + 1
501 28720 : allocate( ListOfLines(lineCount) )
502 15796 : do indx = 1, lineCount-1
503 15796 : ListOfLines(indx)%record = string(width*(indx-1)+1:width*indx)
504 : end do
505 12924 : ListOfLines(lineCount)%record = string(width*(lineCount-1)+1:stringLen)
506 12924 : return
507 : end if
508 :
509 : ! get the initial pad size, and the locations of split ends.
510 :
511 86501 : allocate(IsEndOfSplitLoc(stringLen))
512 19212100 : IsEndOfSplitLoc = 0_IK
513 86501 : istart = 1_IK
514 86501 : iend = istart + splitLen - 1_IK
515 86501 : padLength = 0_IK
516 86501 : isPadZone = .true.
517 86501 : if (padLen==0_IK) isPadZone = .false.
518 19039100 : blockFindSplit: do
519 19125600 : if (iend==stringLen) then
520 86501 : IsEndOfSplitLoc(stringLen) = 1_IK
521 86501 : exit blockFindSplit
522 : end if
523 19039100 : if ( isPadZone .and. mod(iend,padLen)==0_IK .and. string(istart:iend)==pad ) then
524 268668 : padLength = iend
525 : else
526 18770400 : isPadZone = .false.
527 : end if
528 19039100 : if (string(istart:iend)==split) then
529 2977370 : IsEndOfSplitLoc(iend) = 1_IK
530 : else
531 16061700 : IsEndOfSplitLoc(iend) = 0_IK
532 : end if
533 19039100 : istart = istart + 1_IK
534 19039100 : iend = iend + 1_IK
535 : end do blockFindSplit
536 :
537 : ! create a vector of split-end indices
538 :
539 19212100 : numSplitEndLoc = sum(IsEndOfSplitLoc)
540 86501 : if (numSplitEndLoc==0_IK) then
541 0 : allocate( ListOfLines(1) )
542 0 : ListOfLines(1)%record = string
543 0 : return
544 : else
545 : ! xxx: here goes another GFortran 7.3 bug: EndOfSplitLoc is assumed already allocated, despite the first appearance here.
546 86501 : if (allocated(EndOfSplitLoc)) deallocate(EndOfSplitLoc)
547 86501 : allocate(EndOfSplitLoc(numSplitEndLoc))
548 86501 : counter = 0_IK
549 19212100 : do indx = 1,stringLen
550 19212100 : if (IsEndOfSplitLoc(indx)==1_IK) then
551 3063870 : counter = counter + 1_IK
552 3063870 : EndOfSplitLoc(counter) = indx
553 : end if
554 : end do
555 : end if
556 6300740 : EndOfSplitLoc = EndOfSplitLoc(1:counter)
557 86501 : deallocate(IsEndOfSplitLoc)
558 :
559 : ! compute the number wrappings to be done
560 :
561 : ! xxx: here goes another GFortran 7.3 bug: EndOfLineLoc is assumed already allocated, despite the first appearance here.
562 86501 : if (allocated(EndOfLineLoc)) deallocate(EndOfLineLoc)
563 86501 : allocate( EndOfLineLoc(0:numSplitEndLoc+1) ) ! consider the maximum possible number of lines
564 3323370 : EndOfLineLoc = 0_IK
565 86501 : lineCount = 0_IK
566 86501 : padLengthDynamic = 0_IK ! first wrap does not need padding
567 86501 : indxOld = 1_IK
568 86501 : indx = 0_IK
569 86501 : oldLineLen = -huge(oldLineLen)
570 2998870 : blockFindLine: do
571 3085370 : indx = indx + 1_IK
572 3085370 : if (indx>numSplitEndLoc) exit blockFindLine
573 2998870 : newLineLen = padLengthDynamic+EndOfSplitLoc(indx)-EndOfLineLoc(lineCount)
574 2998870 : if (newLineLen<=width) then
575 2846500 : oldLineLen = newLineLen
576 2846500 : cycle blockFindLine
577 : else
578 : ! swap the commented block with the uncommented to switch from better to good wrapping style.
579 152376 : lineCount = lineCount + 1_IK
580 152376 : if (indx-1_IK>indxOld) then ! ensure there is at least one split before the wrapping point
581 : ! comment the following line to keep the max line length, strictly less than width (if possible).
582 151590 : if (width-oldLineLen>newLineLen-width) indx = indx + 1_IK ! removing the last token would make the line more beautiful
583 151590 : EndOfLineLoc(lineCount) = EndOfSplitLoc(indx-1)
584 : else
585 786 : EndOfLineLoc(lineCount) = EndOfSplitLoc(indx)
586 : end if
587 152376 : indxOld = indx
588 152376 : padLengthDynamic = padLength
589 : end if
590 : end do blockFindLine
591 :
592 : ! add the remaining end of the string as a separate line
593 :
594 86501 : if (EndOfLineLoc(lineCount)<stringLen .or. lineCount==0_IK) then
595 84012 : lineCount = lineCount + 1_IK
596 84012 : EndOfLineLoc(lineCount) = stringLen
597 : end if
598 3796150 : EndOfLineLoc = pack(EndOfLineLoc, mask=EndOfLineLoc/=0_IK)
599 :
600 : ! ensure the line count makes sense
601 :
602 86501 : if ( lineCount /= size(EndOfLineLoc) ) then
603 : ! LCOV_EXCL_START
604 : write(output_unit,"(*(g0,:,' '))") MODULE_NAME // PROCEDURE_NAME // &
605 : ": Internal error occurred. lineCount /= size(EndOfLineLoc):", &
606 : lineCount, "/=", size(EndOfLineLoc), EndOfLineLoc
607 : write(output_unit,"(*(g0,:,' '))") EndOfSplitLoc
608 : error stop
609 : ! LCOV_EXCL_STOP
610 : end if
611 :
612 : ! construct the wrappings
613 :
614 322889 : allocate( ListOfLines(lineCount) )
615 86501 : indx = 1_IK
616 86501 : ListOfLines(indx)%record = string(1:EndOfLineLoc(indx))
617 236388 : do indx = 2, lineCount
618 149887 : if ( padLength==0 .and. EndOfLineLoc(indx-1)+1>EndOfLineLoc(indx) ) then
619 : ! LCOV_EXCL_START
620 : write(output_unit,"(*(g0,:,' '))") MODULE_NAME // PROCEDURE_NAME // &
621 : ": Fatal error occurred. " // &
622 : "padLength==0 .and. EndOfLineLoc(indx-1)+1>EndOfLineLoc(indx) " // &
623 : "for string: "
624 : write(output_unit,"(A)") string
625 : error stop
626 : ! LCOV_EXCL_STOP
627 : end if
628 236388 : ListOfLines(indx)%record = string(1:padLength) // string(EndOfLineLoc(indx-1)+1:EndOfLineLoc(indx))
629 : end do
630 :
631 142329 : end function wrapText
632 :
633 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
634 :
635 : !> \brief
636 : !> Convert a string to a list of lines.
637 : !> @param[in] string : The string.
638 : !> @param[in] delimiter : The substring at which the string will be split to form multiple lines (**optional**, default = "").
639 : !>
640 : !> \return
641 : !> ListOfLines : The list of lines generated from the input string.
642 : !>
643 : !> \remark
644 : !> The escape sequence "\n" can be passed as the input value of `delimiter` to separate the lines.
645 39093 : module function getListOfLines(string,delimiter) result(ListOfLines)
646 : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
647 : !DEC$ ATTRIBUTES DLLEXPORT :: getListOfLines
648 : #endif
649 142329 : use Constants_mod, only: IK
650 : implicit none
651 : character(len=*) , intent(in) :: string
652 : character(len=*) , intent(in), optional :: delimiter
653 : type(CharVec_type), allocatable :: ListOfLines(:)
654 39093 : character(len=:) , allocatable :: dumstr
655 : integer(IK) :: stringLen, delimLen, delimLenMinusOne
656 : integer(IK) :: maxNumSplit, counterString, counterLine, counterRecord
657 : logical :: delimIsCStyle
658 :
659 39093 : if (.not.present(delimiter)) then
660 1120 : allocate(ListOfLines(1))
661 560 : ListOfLines(1)%record = string
662 560 : return
663 : end if
664 :
665 38533 : stringLen = len(string)
666 38533 : delimLen = len(delimiter)
667 38533 : delimLenMinusOne = delimLen - 1
668 :
669 38533 : if (delimLen==0 .or. stringLen==0 .or. stringLen<delimLen) then
670 4 : allocate(ListOfLines(1))
671 2 : ListOfLines(1)%record = string
672 2 : return
673 : end if
674 :
675 38531 : delimIsCStyle = delimLen==2 .and. delimiter=="\n"
676 :
677 38531 : maxNumSplit = 1 + stringLen / delimLen
678 11385800 : allocate(ListOfLines(maxNumSplit))
679 38531 : allocate( character(len=stringLen) :: dumstr )
680 38531 : counterLine = 0
681 38531 : counterRecord = 0
682 38531 : counterString = 1
683 19529700 : loopParseString: do
684 19568200 : if (counterString+delimLenMinusOne>stringLen) then
685 34988 : counterLine = counterLine + 1
686 34988 : if (counterRecord==0) then
687 0 : ListOfLines(counterLine)%record = string(counterString:stringLen)
688 : else
689 34988 : ListOfLines(counterLine)%record = dumstr(1:counterRecord) // string(counterString:stringLen)
690 : end if
691 34988 : exit loopParseString
692 : end if
693 19533300 : if (string(counterString:counterString+delimLenMinusOne)==delimiter) then
694 113557 : counterLine = counterLine + 1
695 113557 : if (counterRecord==0) then
696 50789 : ListOfLines(counterLine)%record = ""
697 : else
698 62768 : ListOfLines(counterLine)%record = dumstr(1:counterRecord)
699 62768 : counterRecord = 0
700 : end if
701 113557 : counterString = counterString + delimLen
702 113557 : if (counterString>stringLen) then
703 3543 : counterLine = counterLine + 1
704 3543 : ListOfLines(counterLine)%record = ""
705 3543 : exit loopParseString
706 : end if
707 19419700 : elseif (delimIsCStyle .and. string(counterString:counterString)=="\") then
708 4667 : counterString = counterString + 1
709 4667 : counterRecord = counterRecord + 1
710 4667 : dumstr(counterRecord:counterRecord) = "\"
711 4667 : if (string(counterString:counterString)=="\") counterString = counterString + 1
712 : else
713 19415000 : counterRecord = counterRecord + 1
714 19415000 : dumstr(counterRecord:counterRecord) = string(counterString:counterString)
715 19415000 : counterString = counterString + 1
716 : end if
717 : end do loopParseString
718 :
719 11919100 : ListOfLines = ListOfLines(1:counterLine)
720 :
721 78186 : end function getListOfLines
722 :
723 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
724 :
725 : end submodule Routines_mod
|
