1:- module(onepointfour_basics_stringy_overwrite, 2 [ 3 stringy_overwrite/5 % stringy_overwrite(BgText,FgText,FgPos,Result,ResultType) 4 ,stringy_overwrite/7 % stringy_overwrite(+BgText,+FgText,+FgPos,+CutLeft,+CutRight,?Result,+ResultType) 5 ,stringy_overwrite_using_chars/7 % stringy_overwrite_using_chars(+BgText,+FgText,+FgPos,+CutLeft,+CutRight,?Result,+ResultType) 6 ,stringy_overwrite_using_runs/7 % stringy_overwrite_using_runs(+BgText,+FgText,+FgPos,+CutLeft,+CutRight,?Result,+ResultType) 7 ]). 8 9:- use_module(library('onepointfour_basics/checks.pl')). 10:- use_module(library('onepointfour_basics/space_stringy.pl')). 11:- use_module(library('onepointfour_basics/stringy_concat.pl')). 12:- use_module(library('onepointfour_basics/stringy_length.pl')). 13:- use_module(library('onepointfour_basics/stringy_morph.pl')). 14 15/* MIT License Follows (https://opensource.org/licenses/MIT) 16 17 Copyright 2021 David Tonhofer <ronerycoder@gluino.name> 18 19 Permission is hereby granted, free of charge, to any person obtaining 20 a copy of this software and associated documentation files 21 (the "Software"), to deal in the Software without restriction, 22 including without limitation the rights to use, copy, modify, merge, 23 publish, distribute, sublicense, and/or sell copies of the Software, 24 and to permit persons to whom the Software is furnished to do so, 25 subject to the following conditions: 26 27 The above copyright notice and this permission notice shall be 28 included in all copies or substantial portions of the Software. 29 30 THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 31 EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 32 MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. 33 IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY 34 CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, 35 TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE 36 SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 37*/ 38 39/* pldoc ==================================================================== */

Overwrite a a background text BgText with foreground text FgText

Homepage for this code

https://github.com/dtonhofer/prolog_code/blob/main/unpacked/onepointfour_basics/README_stringy_overwrite.md

History

2020-07-XX: First version
2021-01-19: Review
2021-01-29: Changes in naming, review overwrite_intro_assertions/7
2021-05-27: Review
2021-06-06: Another review to use the (now completed) "checks"
2021-06-12: All test cases pass
2021-06-13: Code rearranged

78stringy_overwrite(BgText,FgText,FgPos,CutLeft,CutRight,Result,ResultType) :- 79 stringy_overwrite_using_runs(BgText,FgText,FgPos,CutLeft,CutRight,Result,ResultType). 80 81% Entry verification called by both overwrite_using_chars/7 and 82% overwrite_using_runs/7. 83 84stringy_overwrite_entry(BgText,FgText,FgPos,CutLeft,CutRight,Result,ResultType) :- 85 check_that(BgText , hard(stringy)), 86 check_that(FgText , hard(stringy)), 87 check_that(FgPos , hard(integer)), 88 check_that(CutLeft , hard(boolean)), 89 check_that(CutRight , hard(boolean)), 90 check_that(Result , break(var),hard(stringy)), % throw if ResultType instantiated but bad type 91 check_that(ResultType , break(var),hard(stringy_typeid)), % throw if ResultType instantiated but not 'atom' or 'string' 92 complete_result_type(BgText,FgText,Result,ResultType), % succeeds with ResultType instantiated, or throws on missing info, or fails 93 assertion(nonvar(ResultType)).

100stringy_overwrite_using_chars(BgText,FgText,FgPos,CutLeft,CutRight,Result,ResultType) :- 101 stringy_overwrite_entry(BgText,FgText,FgPos,CutLeft,CutRight,Result,ResultType), 102 stringy_charylist_morph(BgText,BgChars,_,chars), 103 stringy_charylist_morph(FgText,FgChars,_,chars), 104 stringy_length(BgText,BgLen), 105 stringy_length(FgText,FgLen), 106 PrelimStartPos is min(FgPos,0), 107 PrelimEndPos is max(BgLen,FgPos+FgLen), 108 ((CutLeft == true) 109 -> 110 StartPos = 0 111 ; 112 StartPos = PrelimStartPos), 113 ((CutRight == true) 114 -> 115 EndPos = BgLen 116 ; 117 EndPos = PrelimEndPos), 118 FgEnd is FgPos+FgLen, 119 collect(StartPos,EndPos,FgPos,FgEnd,FgChars,BgChars,BgLen,Tip,FinalFin), 120 FinalFin=[], % close open list 121 stringy_charylist_morph(Result,Tip,ResultType,_), 122 !. 123 124collect(Pos,EndPos,_,_,_,_,_,Fin,Fin) :- 125 Pos == EndPos, 126 !. 127 128collect(Pos,EndPos,FgPos,FgEnd,FgChars,BgChars,BgLen,Fin,FinalFin) :- 129 Pos < EndPos, 130 !, 131 ( 132 (FgPos=<Pos, Pos<FgEnd) 133 -> 134 (Index is Pos-FgPos,nth0(Index,FgChars,Char)) % use "foreground" character if possible 135 ; 136 (0=<Pos, Pos<BgLen) 137 -> 138 nth0(Pos,BgChars,Char) % otherwise use "background" character 139 ; 140 Char=' ' % otherwise use space as filler 141 ), 142 Fin=[Char|NewFin], 143 PosPP is Pos+1, 144 collect(PosPP,EndPos,FgPos,FgEnd,FgChars,BgChars,BgLen,NewFin,FinalFin).

151stringy_overwrite_using_runs(BgText,FgText,FgPos,CutLeft,CutRight,Result,ResultType) :- 152 stringy_overwrite_entry(BgText,FgText,FgPos,CutLeft,CutRight,Result,ResultType), 153 stringy_length(BgText,BgLen), 154 stringy_length(FgText,FgLen), 155 FgEnd is FgPos+FgLen, 156 fg_completely_or_partially_on_positions_below_position0(FgText,FgPos,FgEnd,CutLeft,R1,ResultType), 157 filler_between_end_of_fg_and_position0(FgEnd,CutLeft,R1,R2,ResultType), 158 bg_visible_between_position0_and_start_of_fg(FgPos,BgLen,BgText,R2,R3,ResultType), 159 fg_covering_bg(FgText,FgPos,FgEnd,BgLen,R3,R4,ResultType), 160 bg_visible_between_end_of_fg_and_end_of_bg(BgText,FgEnd,BgLen,R4,R5,ResultType), 161 filler_between_end_of_bg_and_start_of_fg(FgPos,BgLen,CutRight,R5,R6,ResultType), 162 fg_completely_or_partially_on_the_right(FgText,FgPos,FgLen,FgEnd,BgLen,CutRight,R6,Result,ResultType). 163 164fg_completely_or_partially_on_positions_below_position0(FgText,FgPos,FgEnd,CutLeft,Rnew,ResultType) :- 165 (CutLeft == true ; 0 =< FgPos) 166 -> 167 stringy_concat([],Rnew,ResultType) % do nothing except returning the empty string/atom 168 ; 169 (Len is min(0,FgEnd)-FgPos, 170 sub_atom(FgText,0,Len,_,Run), % gives a string 171 stringy_concat([Run],Rnew,ResultType)). % gives sth corresponding to"ResultType" 172 173filler_between_end_of_fg_and_position0(FgEnd,CutLeft,Rprev,Rnew,ResultType) :- 174 (CutLeft == true ; 0 =< FgEnd) 175 -> 176 (Rnew=Rprev) % do nothing 177 ; 178 (Len is -FgEnd, 179 space_stringy(Len,Run,ResultType,hard), 180 stringy_concat([Rprev,Run],Rnew,ResultType)). % gives sth corresponding to "ResultType" 181 182bg_visible_between_position0_and_start_of_fg(FgPos,BgLen,Bg,Rprev,Rnew,ResultType) :- 183 (FgPos =< 0 ; BgLen == 0) 184 -> 185 (Rnew=Rprev) % do nothing 186 ; 187 (Len is min(BgLen,FgPos), 188 sub_atom(Bg,0,Len,_,Run), % gives a string 189 stringy_concat([Rprev,Run],Rnew,ResultType)). % gives sth corresponding to "ResultType" 190 191fg_covering_bg(FgText,FgPos,FgEnd,BgLen,Rprev,Rnew,ResultType) :- 192 (FgEnd =< 0 ; BgLen =< FgPos) 193 -> 194 (Rnew=Rprev) % do nothing 195 ; 196 (StartPos is max(0,FgPos), 197 StartPosInFg is -min(0,FgPos), 198 EndPos is min(BgLen,FgEnd), 199 Len is EndPos-StartPos, 200 sub_atom(FgText,StartPosInFg,Len,_,Run), % gives an atom 201 stringy_concat([Rprev,Run],Rnew,ResultType)). % gives sth corresponding to "ResultType" 202 203bg_visible_between_end_of_fg_and_end_of_bg(BgText,FgEnd,BgLen,Rprev,Rnew,ResultType) :- 204 (BgLen =< FgEnd) 205 -> 206 (Rnew=Rprev) % do nothing 207 ; 208 (Len is min(BgLen,BgLen-FgEnd), 209 StartPos is max(0,FgEnd), 210 sub_atom(BgText,StartPos,Len,_,Run), % gives an atom 211 stringy_concat([Rprev,Run],Rnew,ResultType)). % gives sth corresponding to "ResultType" 212 213filler_between_end_of_bg_and_start_of_fg(FgPos,BgLen,CutRight,Rprev,Rnew,ResultType) :- 214 (FgPos =< BgLen ; CutRight == true) 215 -> 216 (Rnew=Rprev) % do nothing 217 ; 218 (Len is FgPos-BgLen, 219 space_stringy(Len,Run,ResultType,hard), 220 stringy_concat([Rprev,Run],Rnew,ResultType)). % gives sth corresponding to "ResultType" 221 222fg_completely_or_partially_on_the_right(FgText,FgPos,FgLen,FgEnd,BgLen,CutRight,Rprev,Rnew,ResultType) :- 223 (FgEnd =< BgLen ; CutRight == true) 224 -> 225 (Rnew=Rprev) % do nothing 226 ; 227 (StartPos is max(BgLen,FgPos), 228 Len is FgEnd-StartPos, 229 StartPosInFg is FgLen-Len, 230 sub_atom(FgText,StartPosInFg,Len,_,Run), % gives an atom 231 stringy_concat([Rprev,Run],Rnew,ResultType)). % gives sth corresponding to "ResultType" 232 233% In case the ResultType (here called PassedResultType) has been left uninstantiated 234% by the caller, clamp it to 'atom' or 'string' if both 'FgText' and 'BgText' are 235% atoms, respectively strings. Possibly throw, possibly fail. 236% Note that we demand to have a positive conclusion as to what type to deliver or 237% we complain, unlike in stringy_concat for example, where lack of a positive 238% conclusion leads to non-determinacy, with two solutions delivered. 239 240complete_result_type(BgText,FgText,Result,PassedResultType) :- 241 has_type(BgText,BgTextType), 242 has_type(FgText,FgTextType), 243 has_type(Result,ResultType), 244 has_type(PassedResultType,PassedResultTypeType), 245 assertion(member(BgTextType,[atom,string])), % has already been check_that-ed 246 assertion(member(FgTextType,[atom,string])), % has already been check_that-ed 247 assertion(member(ResultType,[var,string,atom])), % has already been check_that-ed 248 assertion(member(PassedResultTypeType,[var,atom])), % has already been check_that-ed (also, if atom, it is one of 'atom', 'string') 249 complete_result_type_2(BgTextType,FgTextType,ResultType,PassedResultTypeType,PassedResultType), % this throws, or fails or succeeds, with PassedResultType instantiated 250 !, % complete_result_type_2 generates choicepoint we don't want! 251 check_that(PassedResultType , hard(stringy_typeid)). % PassedResultType must be instantiated now! 252 253% FgTextType PassedResultTypeType 254% BgTextType | ResultType | 255% | | | | PassedResultType (maybe var on call, as indicated by the preceding arg) 256% | | | | | 257complete_result_type_2(atom , string , var , var , _ ) :- error_msg(Msg),check_that(_,hard(nonvar),_{msg:Msg}). % unconditionally throw 258complete_result_type_2(string , atom , var , var , _ ) :- error_msg(Msg),check_that(_,hard(nonvar),_{msg:Msg}). % unconditionally throw 259complete_result_type_2(atom , atom , var , var , atom ). % Guess: We want PassedResultType (unbound on call) to be the atom 'atom' because the input texts are both atom 260complete_result_type_2(string , string , var , var , string ). % Guess: We want PassedResultType (unbound on call) to be the atom 'string' because the input texts are both string 261complete_result_type_2( _ , _ , string , var , string ). % Set: We definitely want PassedResultType (unbound on call) to be the atom 'string' because the provided Result is a string 262complete_result_type_2( _ , _ , atom , var , atom ). % Set: We definitely want PassedResultType (unbound on call) to be the atom 'atom' because the provided Result is an atom 263complete_result_type_2( _ , _ , var , atom , _ ). % OK: the result type is specified (atom on 4th arg) but the Result is var, so anything is ok 264complete_result_type_2( _ , _ , string , atom , atom ) :- fail. % FAIL: the result is specified and 'string' but the ResultType is provided and is 'atom' 265complete_result_type_2( _ , _ , atom , atom , string ) :- fail. % FAIL: the result is specified and 'atom' but the ResultType is provided and is 'string' 266complete_result_type_2( _ , _ , string , atom , string ). % OK: the result is specified and 'string' and the ResultType is provided and is 'string' 267complete_result_type_2( _ , _ , atom , atom , atom ). % OK: the result is specified and 'atom' and the ResultType is provided and is 'atom' 268 269has_type(X,var) :- var(X),!. 270has_type(X,atom) :- atom(X),!. 271has_type(X,string) :- string(X),!. 272 273error_msg("If the input texts are of differing type (here, atom and string) and the Result is unbound, then ResultType must be bound")