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 351 : 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 351 : if (present(tabStr)) then
77 1 : Decoration%tab = tabStr
78 : else
79 350 : Decoration%tab = TAB
80 : end if
81 351 : if (present(symbol)) then
82 1 : Decoration%symbol = symbol
83 : else
84 350 : Decoration%symbol = STAR
85 : end if
86 351 : if (present(text)) Decoration%text = text
87 351 : if (present(List)) Decoration%List = List
88 351 : 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 3151 : 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 351 : 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 3151 : if (present(thicknessVert)) then
116 1616 : thicknessVertDefault = thicknessVert
117 : else
118 1535 : thicknessVertDefault = DECORATION_THICKNESS_VERT
119 : end if
120 3151 : if (present(newLine)) then
121 27078 : 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 6302 : 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 3153 : 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 3151 : 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 3153 : if (present(thicknessVert)) then
155 1617 : thicknessVertDefault = thicknessVert
156 : else
157 1536 : thicknessVertDefault = DECORATION_THICKNESS_VERT
158 : end if
159 3153 : call write(outputUnit,marginTop,0,thicknessVertDefault, drawLine(symbol,width) )
160 23937 : do i = 1,size(List)
161 23937 : call write(outputUnit,0,0,1, sandwich(List(i)%record,symbol,width,thicknessHorz) )
162 : end do
163 3153 : call write(outputUnit,0,marginBot,thicknessVertDefault, drawLine(symbol,width) )
164 6306 : 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 6309 : 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 3153 : 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 6309 : character(:), allocatable :: decorationSymbol
187 :
188 6309 : if (present(symbol)) then
189 3236 : if (len(symbol)<1) then
190 0 : decorationSymbol = " "
191 : else
192 3236 : decorationSymbol = symbol
193 : end if
194 : else
195 3073 : decorationSymbol = STAR
196 : end if
197 6309 : symbolLen = len(decorationSymbol)
198 :
199 6309 : if (present(width)) then
200 3235 : decorationWidth = width
201 : else
202 3074 : decorationWidth = DECORATION_WIDTH
203 : end if
204 :
205 6309 : symbolIndex = 1
206 6309 : allocate(character(decorationWidth) :: line)
207 838872 : do i=1,decorationWidth
208 832563 : line(i:i) = decorationSymbol(symbolIndex:symbolIndex)
209 832563 : symbolIndex = symbolIndex + 1
210 838872 : if (symbolIndex>symbolLen) symbolIndex = 1
211 : end do
212 :
213 6309 : 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 20789 : 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 6309 : 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 20789 : character(:), allocatable :: decorationText, decorationSymbol
237 : integer(IK) :: i,decorationTextLen, symbolLen, symbolIndex, leftLimit, rightLimit
238 : integer(IK) :: sandwichedTextStart,decorationTextStart,decorationTextLenCounter
239 :
240 20789 : if (present(symbol)) then
241 16169 : decorationSymbol = symbol
242 : else
243 4620 : decorationSymbol = STAR
244 : end if
245 :
246 20789 : if (present(width)) then
247 16168 : decorationWidth = width
248 : else
249 4621 : decorationWidth = DECORATION_WIDTH
250 : end if
251 :
252 20789 : if (present(thicknessHorz)) then
253 16167 : decorationThicknessHorz = thicknessHorz
254 : else
255 4622 : decorationThicknessHorz = DECORATION_THICKNESS_HORZ
256 : end if
257 :
258 20789 : if (present(text)) then
259 20788 : decorationText = trim(adjustl(text))
260 : else
261 1 : decorationText = ""
262 : end if
263 :
264 20789 : if (decorationWidth<1) then
265 0 : sandwichedText = ""
266 0 : return
267 : end if
268 :
269 20789 : allocate( character(decorationWidth) :: sandwichedText )
270 20789 : decorationTextLen = len(decorationText)
271 :
272 20789 : symbolLen = len(symbol)
273 20789 : symbolIndex = 1
274 20789 : leftLimit = decorationThicknessHorz + 1
275 20789 : rightLimit = decorationWidth - decorationThicknessHorz + 1
276 :
277 20789 : if (decorationTextLen<1) then
278 1354600 : do i = 1, decorationWidth
279 1354600 : if (i<leftLimit) then
280 40764 : sandwichedText(i:i) = decorationSymbol(symbolIndex:symbolIndex)
281 40764 : symbolIndex = symbolIndex + 1
282 40764 : if (symbolIndex>symbolLen) symbolIndex = 1
283 1303650 : elseif (i<rightLimit) then
284 1262880 : sandwichedText(i:i) = " "
285 1262880 : symbolIndex = symbolIndex + 1
286 1262880 : if (symbolIndex>symbolLen) symbolIndex = 1
287 : else
288 40764 : sandwichedText(i:i) = decorationSymbol(symbolIndex:symbolIndex)
289 40764 : symbolIndex = symbolIndex + 1
290 40764 : if (symbolIndex>symbolLen) symbolIndex = 1
291 : end if
292 : end do
293 10191 : return
294 : end if
295 :
296 10598 : sandwichedTextStart = max( leftLimit , ( decorationWidth - decorationTextLen ) / 2 + 1 )
297 10598 : decorationTextStart = max( 1 , leftLimit - ( decorationWidth - decorationTextLen ) / 2 )
298 10598 : decorationTextLenCounter = decorationTextStart
299 :
300 1409050 : do i=1,decorationWidth
301 1409050 : if (i<leftLimit) then
302 42381 : sandwichedText(i:i) = decorationSymbol(symbolIndex:symbolIndex)
303 42381 : symbolIndex = symbolIndex + 1
304 42381 : if (symbolIndex>symbolLen) symbolIndex = 1
305 1356080 : elseif (i<rightLimit) then
306 1313690 : if (i<sandwichedTextStart) then
307 478395 : sandwichedText(i:i) = " "
308 835299 : else if ( decorationTextLenCounter<=decorationTextLen ) then
309 350537 : sandwichedText(i:i) = decorationText(decorationTextLenCounter:decorationTextLenCounter)
310 350537 : decorationTextLenCounter = decorationTextLenCounter + 1
311 : else
312 484762 : sandwichedText(i:i) = " "
313 : end if
314 1313690 : symbolIndex = symbolIndex + 1
315 1313690 : if (symbolIndex>symbolLen) symbolIndex = 1
316 : else
317 42381 : sandwichedText(i:i) = decorationSymbol(symbolIndex:symbolIndex)
318 42381 : symbolIndex = symbolIndex + 1
319 42381 : 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 20789 : 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 294841 : 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 20789 : 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 294841 : if (present(outputUnit)) then
379 : #if defined MEXPRINT_ENABLED
380 : isStdout = output_unit == outputUnit
381 : #endif
382 294156 : logFileUnit = outputUnit
383 : else
384 : #if defined MEXPRINT_ENABLED
385 : isStdout = .true.
386 : #endif
387 685 : logFileUnit = output_unit
388 : end if
389 :
390 294841 : if (present(marginTop)) then
391 312473 : 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 312473 : write(logFileUnit,*)
400 : #endif
401 : end do
402 : end if
403 :
404 294841 : if (present(count)) then
405 274959 : thisManyTimes = count
406 : else
407 19882 : thisManyTimes = 1
408 : end if
409 :
410 294841 : if (present(string)) then
411 551484 : 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 551484 : write(logFileUnit,"(g0)") string
424 : #endif
425 : end do
426 19424 : elseif (.not. ( present(marginBot) .and. present(marginTop) ) ) then
427 37036 : 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 37036 : write(logFileUnit,*)
436 : #endif
437 : end do
438 : end if
439 :
440 294841 : if (present(marginBot)) then
441 310600 : 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 310600 : write(logFileUnit,*)
450 : #endif
451 : end do
452 : end if
453 :
454 589682 : 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 126523 : 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 294841 : 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 126523 : padLen = len(pad)
489 126523 : splitLen = len(split)
490 126523 : stringLen = len(string)
491 126523 : if (stringLen==0) then
492 76504 : allocate( ListOfLines(1) )
493 38252 : ListOfLines(1)%record = ""
494 38252 : return
495 88271 : elseif (splitLen>=stringLen) then
496 0 : allocate( ListOfLines(1) )
497 0 : ListOfLines(1)%record = string
498 0 : return
499 88271 : elseif (splitLen==0) then ! enforce wrapping at any character as necessary
500 11628 : lineCount = stringLen / width + 1
501 25517 : allocate( ListOfLines(lineCount) )
502 13889 : do indx = 1, lineCount-1
503 13889 : ListOfLines(indx)%record = string(width*(indx-1)+1:width*indx)
504 : end do
505 11628 : ListOfLines(lineCount)%record = string(width*(lineCount-1)+1:stringLen)
506 11628 : return
507 : end if
508 :
509 : ! get the initial pad size, and the locations of split ends.
510 :
511 76643 : allocate(IsEndOfSplitLoc(stringLen))
512 16975100 : IsEndOfSplitLoc = 0_IK
513 76643 : istart = 1_IK
514 76643 : iend = istart + splitLen - 1_IK
515 76643 : padLength = 0_IK
516 76643 : isPadZone = .true.
517 76643 : if (padLen==0_IK) isPadZone = .false.
518 16821800 : blockFindSplit: do
519 16898400 : if (iend==stringLen) then
520 76643 : IsEndOfSplitLoc(stringLen) = 1_IK
521 76643 : exit blockFindSplit
522 : end if
523 16821800 : if ( isPadZone .and. mod(iend,padLen)==0_IK .and. string(istart:iend)==pad ) then
524 241260 : padLength = iend
525 : else
526 16580500 : isPadZone = .false.
527 : end if
528 16821800 : if (string(istart:iend)==split) then
529 2637420 : IsEndOfSplitLoc(iend) = 1_IK
530 : else
531 14184400 : IsEndOfSplitLoc(iend) = 0_IK
532 : end if
533 16821800 : istart = istart + 1_IK
534 16821800 : iend = iend + 1_IK
535 : end do blockFindSplit
536 :
537 : ! create a vector of split-end indices
538 :
539 16975100 : numSplitEndLoc = sum(IsEndOfSplitLoc)
540 76643 : 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 76643 : if (allocated(EndOfSplitLoc)) deallocate(EndOfSplitLoc)
547 76643 : allocate(EndOfSplitLoc(numSplitEndLoc))
548 76643 : counter = 0_IK
549 16975100 : do indx = 1,stringLen
550 16975100 : if (IsEndOfSplitLoc(indx)==1_IK) then
551 2714060 : counter = counter + 1_IK
552 2714060 : EndOfSplitLoc(counter) = indx
553 : end if
554 : end do
555 : end if
556 5581410 : EndOfSplitLoc = EndOfSplitLoc(1:counter)
557 76643 : 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 76643 : if (allocated(EndOfLineLoc)) deallocate(EndOfLineLoc)
563 76643 : allocate( EndOfLineLoc(0:numSplitEndLoc+1) ) ! consider the maximum possible number of lines
564 2943990 : EndOfLineLoc = 0_IK
565 76643 : lineCount = 0_IK
566 76643 : padLengthDynamic = 0_IK ! first wrap does not need padding
567 76643 : indxOld = 1_IK
568 76643 : indx = 0_IK
569 76643 : oldLineLen = -huge(oldLineLen)
570 2656110 : blockFindLine: do
571 2732760 : indx = indx + 1_IK
572 2732760 : if (indx>numSplitEndLoc) exit blockFindLine
573 2656110 : newLineLen = padLengthDynamic+EndOfSplitLoc(indx)-EndOfLineLoc(lineCount)
574 2656110 : if (newLineLen<=width) then
575 2521590 : oldLineLen = newLineLen
576 2521590 : cycle blockFindLine
577 : else
578 : ! swap the commented block with the uncommented to switch from better to good wrapping style.
579 134521 : lineCount = lineCount + 1_IK
580 134521 : 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 133791 : if (width-oldLineLen>newLineLen-width) indx = indx + 1_IK ! removing the last token would make the line more beautiful
583 133791 : EndOfLineLoc(lineCount) = EndOfSplitLoc(indx-1)
584 : else
585 730 : EndOfLineLoc(lineCount) = EndOfSplitLoc(indx)
586 : end if
587 134521 : indxOld = indx
588 134521 : padLengthDynamic = padLength
589 : end if
590 : end do blockFindLine
591 :
592 : ! add the remaining end of the string as a separate line
593 :
594 76643 : if (EndOfLineLoc(lineCount)<stringLen .or. lineCount==0_IK) then
595 74382 : lineCount = lineCount + 1_IK
596 74382 : EndOfLineLoc(lineCount) = stringLen
597 : end if
598 3361800 : EndOfLineLoc = pack(EndOfLineLoc, mask=EndOfLineLoc/=0_IK)
599 :
600 : ! ensure the line count makes sense
601 :
602 76643 : 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 285546 : allocate( ListOfLines(lineCount) )
615 76643 : indx = 1_IK
616 76643 : ListOfLines(indx)%record = string(1:EndOfLineLoc(indx))
617 208903 : do indx = 2, lineCount
618 132260 : 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 208903 : ListOfLines(indx)%record = string(1:padLength) // string(EndOfLineLoc(indx-1)+1:EndOfLineLoc(indx))
629 : end do
630 :
631 126523 : 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 34042 : 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 126523 : 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 34042 : character(len=:) , allocatable :: dumstr
655 : integer(IK) :: stringLen, delimLen, delimLenMinusOne
656 : integer(IK) :: maxNumSplit, counterString, counterLine, counterRecord
657 : logical :: delimIsCStyle
658 :
659 34042 : if (.not.present(delimiter)) then
660 332 : allocate(ListOfLines(1))
661 166 : ListOfLines(1)%record = string
662 166 : return
663 : end if
664 :
665 33876 : stringLen = len(string)
666 33876 : delimLen = len(delimiter)
667 33876 : delimLenMinusOne = delimLen - 1
668 :
669 33876 : 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 33874 : delimIsCStyle = delimLen==2 .and. delimiter=="\n"
676 :
677 33874 : maxNumSplit = 1 + stringLen / delimLen
678 10019600 : allocate(ListOfLines(maxNumSplit))
679 33874 : allocate( character(len=stringLen) :: dumstr )
680 33874 : counterLine = 0
681 33874 : counterRecord = 0
682 33874 : counterString = 1
683 17308700 : loopParseString: do
684 17342500 : if (counterString+delimLenMinusOne>stringLen) then
685 30723 : counterLine = counterLine + 1
686 30723 : if (counterRecord==0) then
687 0 : ListOfLines(counterLine)%record = string(counterString:stringLen)
688 : else
689 30723 : ListOfLines(counterLine)%record = dumstr(1:counterRecord) // string(counterString:stringLen)
690 : end if
691 30723 : exit loopParseString
692 : end if
693 17311800 : if (string(counterString:counterString+delimLenMinusOne)==delimiter) then
694 101628 : counterLine = counterLine + 1
695 101628 : if (counterRecord==0) then
696 45289 : ListOfLines(counterLine)%record = ""
697 : else
698 56339 : ListOfLines(counterLine)%record = dumstr(1:counterRecord)
699 56339 : counterRecord = 0
700 : end if
701 101628 : counterString = counterString + delimLen
702 101628 : if (counterString>stringLen) then
703 3151 : counterLine = counterLine + 1
704 3151 : ListOfLines(counterLine)%record = ""
705 3151 : exit loopParseString
706 : end if
707 17210200 : elseif (delimIsCStyle .and. string(counterString:counterString)=="\") then
708 4199 : counterString = counterString + 1
709 4199 : counterRecord = counterRecord + 1
710 4199 : dumstr(counterRecord:counterRecord) = "\"
711 4199 : if (string(counterString:counterString)=="\") counterString = counterString + 1
712 : else
713 17206000 : counterRecord = counterRecord + 1
714 17206000 : dumstr(counterRecord:counterRecord) = string(counterString:counterString)
715 17206000 : counterString = counterString + 1
716 : end if
717 : end do loopParseString
718 :
719 10493800 : ListOfLines = ListOfLines(1:counterLine)
720 :
721 68084 : end function getListOfLines
722 :
723 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
724 :
725 : end submodule Routines_mod
|
