From 5680e383b9e6ca458fef2dd831cbbb03604f245b Mon Sep 17 00:00:00 2001 From: brodieG Date: Sat, 12 Jun 2021 13:51:03 -0400 Subject: [PATCH 01/20] add 'carry', 'terminate' to R-side, re-org validation --- R/has.R | 15 +-- R/internal.R | 103 ++++++++++++++++++- R/misc.R | 1 + R/nchar.R | 34 +------ R/normalize.R | 13 +-- R/strip.R | 27 +---- R/strsplit.R | 62 +++++------- R/strtrim.R | 156 +++++++++++++---------------- R/strwrap.R | 266 ++++++++++++++++++++------------------------------ R/substr2.R | 102 +++++++++---------- R/tohtml.R | 18 +--- R/unhandled.R | 10 +- 12 files changed, 368 insertions(+), 439 deletions(-) diff --git a/R/has.R b/R/has.R index 053f5bd7..10ac5521 100644 --- a/R/has.R +++ b/R/has.R @@ -38,22 +38,13 @@ #' has_sgr("hello\nworld") has_ctl <- function(x, ctl='all', warn=getOption('fansi.warn'), which) { - if(!is.logical(warn)) warn <- as.logical(warn) if(!missing(which)) { message("Parameter `which` has been deprecated; use `ctl` instead.") ctl <- which } - if(length(warn) != 1L || is.na(warn)) - stop("Argument `warn` must be TRUE or FALSE.") - if(!is.character(ctl)) stop("Argument `ctl` must be character.") - - if(length(ctl)) { - if(anyNA(ctl.int <- match(ctl, VALID.CTL))) - stop( - "Argument `ctl` may contain only values in `", - deparse(VALID.CTL), "`" - ) - .Call(FANSI_has_csi, enc2utf8(as.character(x)), ctl.int, warn) + args <- validate(x=x, ctl=ctl, warn=warn) + if(length(ctl.int)) { + with(args, .Call(FANSI_has_csi, x, ctl.int, warn)) } else rep(FALSE, length(x)) } #' @export diff --git a/R/internal.R b/R/internal.R index de340766..fa79423e 100644 --- a/R/internal.R +++ b/R/internal.R @@ -52,7 +52,108 @@ reset_limits <- function(x) .Call(FANSI_reset_limits) check_enc <- function(x, i) .Call(FANSI_check_enc, x, as.integer(i)[1]) -## make sure what compression working +## make sure `ctl` compression working ctl_as_int <- function(x) .Call(FANSI_ctl_as_int, as.integer(x)) +## Common argument validation and conversion. Missing args okay. + +validate <- function(...) { + call <- sys.cal(-1) + stop2 <- function(x) stop(simpleError(x, call)) + args <- list(...) + if( + !all(names(args)) %in% + c( + 'x', 'warn', 'term.cap', 'ctl', 'normalize', 'carry', 'terminate', + 'tab.stops', 'tabs.as.spaces', 'strip.spaces' + ) + ) + stop("Internal Error: some arguments to validate unknown") + + if('x' %in% names(args)) { + if(!is.character(x)) x <- as.character(x) + x <- enc2utf8(x) + if(any(Encoding(x) == "bytes")) + stop2("BYTE encoded strings are not supported.") + args[['x']] <- x + } + if('warn' %in% names(args)) { + if(!is.logical(warn)) warn <- as.logical(warn) + if(length(warn) != 1L || is.na(warn)) + stop2("Argument `warn` must be TRUE or FALSE.") + args[['warn']] <- warn + } + if('normalize' %in% names(args)) { + if(!isTRUE(normalize %in% c(FALSE, TRUE))) + stop2("Argument `normalize` must be TRUE or FALSE.") + args[['normalize']] <- as.logical(normalize) + } + if('term.cap' %in% names(args)) { + if(!is.character(term.cap)) + stop2("Argument `term.cap` must be character.") + if(anyNA(term.cap.int <- match(term.cap, VALID.TERM.CAP))) + stop2( + "Argument `term.cap` may only contain values in ", + deparse(VALID.TERM.CAP) + ) + args[['term.cap.int']] <- term.cap.int + } + if('ctl' %in% names(args)) { + if(!is.character(ctl)) + stop2("Argument `ctl` must be character.") + ctl.int <- integer() + if(length(ctl)) { + # duplicate values in `ctl` are okay, so save a call to `unique` here + if(anyNA(ctl.int <- match(ctl, VALID.CTL))) + stop2( + "Argument `ctl` may contain only values in `", + deparse(VALID.CTL), "`" + ) + } + args[['ctl.int']] <- ctl.int + } + if('carry' %in% names(args)) { + if(length(carry) != 1L) + stop2("Argument `carry` must be scalar.") + if(!is.logical(carry) && !is.character(carry)) + stop2("Argument `carry` must be logical or character.") + if(is.na(carry)) carry <- as.character(carry) + else { + if(is.logical(carry)) if(carry) carry <- "" else carry = NA_character_ + } + args[['carry']] <- carry + } + if('terminate' %in% names(args)) { + if(!isTRUE(terminate %in% c(TRUE, FALSE))) + stop2("Argument `terminate` must be TRUE or FALSE") + terminate <- as.logical(terminate) + } + if('tab.stops' %in% names(args)) { + if( + !is.numeric(tab.stops) || !length(tab.stops) || any(tab.stops < 1) || + anyNA(tab.stops) + ) + stop2( + "Argument `tab.stops` must be numeric, strictly positive, and ", + "representable as an integer." + ) + ags[['tab.stops']] <- as.integer(tab.stops) + } + if('tabs.as.spaces' %in% names(args)) { + if(!is.logical(tabs.as.spaces)) tabs.as.spaces <- as.logical(tabs.as.spaces) + if(length(tabs.as.spaces) != 1L || is.na(tabs.as.spaces)) + stop("Argument `tabs.as.spaces` must be TRUE or FALSE.") + args[['tabs.as.spaces']] <- tabs.as.spaces + } + if('strip.spaces' %in% names(args)) { + if(!is.logical(strip.spaces)) strip.spaces <- as.logical(strip.spaces) + if(length(strip.spaces) != 1L || is.na(strip.spaces)) + stop("Argument `strip.spaces` must be TRUE or FALSE.") + args[['strip.spaces']] <- strip.spaces + } + + # we might not have validated all, so we should be careful + args +} + diff --git a/R/misc.R b/R/misc.R index 1d96a642..3b6427e4 100644 --- a/R/misc.R +++ b/R/misc.R @@ -58,6 +58,7 @@ tabs_as_spaces <- function( x, tab.stops=getOption('fansi.tab.stops'), warn=getOption('fansi.warn'), ctl='all' ) { + if(!is.character(x)) x <- as.character(x) if(!is.logical(warn)) warn <- as.logical(warn) if(length(warn) != 1L || is.na(warn)) diff --git a/R/nchar.R b/R/nchar.R index 742d8a09..07deb121 100644 --- a/R/nchar.R +++ b/R/nchar.R @@ -63,10 +63,7 @@ nchar_ctl <- function( x, type='chars', allowNA=FALSE, keepNA=NA, ctl='all', warn=getOption('fansi.warn'), strip ) { - if(!is.character(x)) x <- as.character(x) - if(!is.logical(warn)) warn <- as.logical(warn) - if(length(warn) != 1L || is.na(warn)) - stop("Argument `warn` must be TRUE or FALSE.") + args <- validate(x=x, ctl=ctl, warn=warn) if(!is.logical(allowNA)) allowNA <- as.logical(allowNA) if(length(allowNA) != 1L) @@ -80,12 +77,6 @@ nchar_ctl <- function( message("Parameter `strip` has been deprecated; use `ctl` instead.") ctl <- strip } - if(!is.character(ctl)) - stop("Argument `ctl` must be character.") - if(!all(ctl %in% VALID.CTL)) - stop( - "Argument `ctl` may contain only values in `", deparse(VALID.CTL), "`" - ) if(!is.character(type) || length(type) != 1 || is.na(type)) stop("Argument `type` must be scalar character and not NA.") valid.types <- c('chars', 'width', 'bytes') @@ -94,7 +85,7 @@ nchar_ctl <- function( "Argument `type` must partial match one of 'chars', 'width', or 'bytes'." ) type <- valid.types[type.int] - stripped <- strip_ctl(x, ctl=ctl, warn=warn) + with(args, stripped <- strip_ctl(x, ctl=ctl, warn=warn)) R.ver.gte.3.2.2 <- R.ver.gte.3.2.2 # "import" symbol from namespace if(R.ver.gte.3.2.2) nchar(stripped, type=type, allowNA=allowNA, keepNA=keepNA) @@ -114,32 +105,17 @@ nchar_sgr <- function( #' @rdname nchar_ctl nzchar_ctl <- function(x, keepNA=NA, ctl='all', warn=getOption('fansi.warn')) { - if(!is.character(x)) x <- as.character(x) - - if(length(warn) != 1L || is.na(warn)) - stop("Argument `warn` must be TRUE or FALSE.") - + args <- validate(x=x, ctl=ctl, warn=warn) if(!is.logical(keepNA)) keepNA <- as.logical(keepNA) if(length(keepNA) != 1L) stop("Argument `keepNA` must be a scalar logical.") - if(!is.character(ctl)) - stop("Argument `ctl` must be character.") - ctl.int <- integer() - if(length(ctl)) { - # duplicate values in `ctl` are okay, so save a call to `unique` here - if(anyNA(ctl.int <- match(ctl, VALID.CTL))) - stop( - "Argument `ctl` may contain only values in `", - deparse(VALID.CTL), "`" - ) - } term.cap.int <- seq_along(VALID.TERM.CAP) - .Call(FANSI_nzchar_esc, enc2utf8(x), keepNA, warn, term.cap.int, ctl.int) + with(args, .Call(FANSI_nzchar_esc, x, keepNA, warn, term.cap.int, ctl.int)) } #' @export #' @rdname nchar_ctl nzchar_sgr <- function(x, keepNA=NA, warn=getOption('fansi.warn')) - nzchar_ctl(x=x, keepNA=keepNA, warn=warn, ctl='sgr') + nzchar_ctl(x=x, keepNA=keepNA, warn=warn, ctl='sgr') diff --git a/R/normalize.R b/R/normalize.R index b750131b..7cdc8c72 100644 --- a/R/normalize.R +++ b/R/normalize.R @@ -73,17 +73,8 @@ normalize_sgr <- function( x, warn=getOption('fansi.warn'), term.cap=getOption('fansi.term.cap') ) { - if(!is.logical(warn)) warn <- as.logical(warn) - if(!is.character(x)) stop("Argument `x` should be a character vector.") - if(!is.character(term.cap)) - stop("Argument `term.cap` must be character.") - if(anyNA(term.cap.int <- match(term.cap, VALID.TERM.CAP))) - stop( - "Argument `term.cap` may only contain values in ", - deparse(VALID.TERM.CAP) - ) - - .Call(FANSI_normalize_sgr, enc2utf8(x), warn, term.cap.int) + args <- validate(x=x, warn=warn, term.cap=term.cap) + with(args, .Call(FANSI_normalize_sgr, enc2utf8(x), warn, term.cap.int)) } # To reduce overhead of applying this in `strwrap_ctl` diff --git a/R/strip.R b/R/strip.R index e88f1996..115ab791 100644 --- a/R/strip.R +++ b/R/strip.R @@ -66,38 +66,19 @@ strip_ctl <- function(x, ctl='all', warn=getOption('fansi.warn'), strip) { message("Parameter `strip` has been deprecated; use `ctl` instead.") ctl <- strip } - if(!is.character(x)) x <- as.character(x) + args <- validate(x=x, ctl=ctl, warn=warn) - if(!is.logical(warn)) warn <- as.logical(warn) - if(length(warn) != 1L || is.na(warn)) - stop("Argument `warn` must be TRUE or FALSE.") - - if(!is.character(ctl)) - stop("Argument `ctl` must be character.") if(length(ctl)) { - # duplicate values in `ctl` are okay, so save a call to `unique` here - if(anyNA(ctl.int <- match(ctl, VALID.CTL))) - stop( - "Argument `ctl` may contain only values in `", - deparse(VALID.CTL), "`" - ) - .Call(FANSI_strip_csi, enc2utf8(x), ctl.int, warn) + with(args, .Call(FANSI_strip_csi, enc2utf8(x), ctl.int, warn)) } else x } #' @export #' @rdname strip_ctl strip_sgr <- function(x, warn=getOption('fansi.warn')) { - if(!is.character(x)) x <- as.character(x) - if(!is.logical(warn)) warn <- as.logical(warn) - if(length(warn) != 1L || is.na(warn)) - stop("Argument `warn` must be TRUE or FALSE.") - + args <- validate(x=x, warn=warn) ctl.int <- match("sgr", VALID.CTL) - if(anyNA(ctl.int)) - stop("Internal Error: invalid ctl type; contact maintainer.") # nocov - - .Call(FANSI_strip_csi, enc2utf8(x), ctl.int, warn) + with(args, .Call(FANSI_strip_csi, x, ctl.int, warn)) } ## Process String by Removing Unwanted Characters diff --git a/R/strsplit.R b/R/strsplit.R index 124e7de4..04e4c2b7 100644 --- a/R/strsplit.R +++ b/R/strsplit.R @@ -54,21 +54,20 @@ strsplit_ctl <- function( x, split, fixed=FALSE, perl=FALSE, useBytes=FALSE, warn=getOption('fansi.warn'), term.cap=getOption('fansi.term.cap'), - ctl='all', normalize=getOption('fansi.normalize', FALSE) + ctl='all', normalize=getOption('fansi.normalize', FALSE), + carry=getOption('fansi.carry', FALSE), + terminate=getOption('fansi.terminate', TRUE) ) { - x <- as.character(x) - if(any(Encoding(x) == "bytes")) - stop("BYTE encoded strings are not supported.") + args <- validate( + x=x, warn=warn, term.cap=term.cap, ctl=ctl, normalize=normalize, + carry=carry, terminate=terminate, + ) if(is.null(split)) split <- "" split <- enc2utf8(as.character(split)) if(!length(split)) split <- "" if(anyNA(split)) stop("Argument `split` may not contain NAs.") - if(!is.logical(warn)) warn <- as.logical(warn) - if(length(warn) != 1L || is.na(warn)) - stop("Argument `warn` must be TRUE or FALSE.") - if(!is.logical(fixed)) fixed <- as.logical(fixed) if(length(fixed) != 1L || is.na(fixed)) stop("Argument `fixed` must be TRUE or FALSE.") @@ -81,28 +80,6 @@ strsplit_ctl <- function( if(length(useBytes) != 1L || is.na(useBytes)) stop("Argument `useBytes` must be TRUE or FALSE.") - if(!isTRUE(normalize %in% c(FALSE, TRUE))) - stop("Argument `normalize` must be TRUE or FALSE.") - normalize <- as.logical(normalize) - - if(!is.character(term.cap)) - stop("Argument `term.cap` must be character.") - if(anyNA(term.cap.int <- match(term.cap, VALID.TERM.CAP))) - stop( - "Argument `term.cap` may only contain values in ", - deparse(VALID.TERM.CAP) - ) - if(!is.character(ctl)) - stop("Argument `ctl` must be character.") - ctl.int <- integer() - if(length(ctl)) { - # duplicate values in `ctl` are okay, so save a call to `unique` here - if(anyNA(ctl.int <- match(ctl, VALID.CTL))) - stop( - "Argument `ctl` may contain only values in `", - deparse(VALID.CTL), "`" - ) - } # Need to handle recycling, complicated by the ability of strsplit to accept # multiple different split arguments @@ -148,14 +125,16 @@ strsplit_ctl <- function( starts <- starts[!sub.invalid] ends <- ends[!sub.invalid] } - res[[i]] <- substr_ctl_internal( - x=x[[i]], - start=starts, stop=ends, type.int=0L, - round.start=TRUE, round.stop=FALSE, - tabs.as.spaces=FALSE, tab.stops=8L, warn=warn, - term.cap.int=term.cap.int, x.len=length(starts), - ctl.int=ctl.int, normalize=normalize - ) + with(args, + res[[i]] <- substr_ctl_internal( + x=x[[i]], + start=starts, stop=ends, type.int=0L, + round.start=TRUE, round.stop=FALSE, + tabs.as.spaces=FALSE, tab.stops=8L, warn=warn, + term.cap.int=term.cap.int, x.len=length(starts), + ctl.int=ctl.int, normalize=normalize, + carry=carry, terminate=terminate + ) ) } else { res[[i]] <- x[[i]] } @@ -173,11 +152,14 @@ strsplit_ctl <- function( strsplit_sgr <- function( x, split, fixed=FALSE, perl=FALSE, useBytes=FALSE, warn=getOption('fansi.warn'), term.cap=getOption('fansi.term.cap'), - normalize=getOption('fansi.normalize', FALSE) + normalize=getOption('fansi.normalize', FALSE), + carry=getOption('fansi.carry', FALSE), + terminate=getOption('fansi.terminate', TRUE) ) strsplit_ctl( x=x, split=split, fixed=fixed, perl=perl, useBytes=useBytes, - warn=warn, term.cap=term.cap, ctl='sgr', normalize=normalize + warn=warn, term.cap=term.cap, ctl='sgr', normalize=normalize, + carry=carry, terminate=terminate ) # # old interface to split happening directly in C code diff --git a/R/strtrim.R b/R/strtrim.R index be81d6be..73d60030 100644 --- a/R/strtrim.R +++ b/R/strtrim.R @@ -36,52 +36,43 @@ strtrim_ctl <- function( x, width, warn=getOption('fansi.warn'), ctl='all', - normalize=getOption('fansi.normalize', FALSE) + normalize=getOption('fansi.normalize', FALSE), + carry=getOption('fansi.carry', FALSE), + terminate=getOption('fansi.terminate', TRUE) ) { - if(!is.character(x)) x <- as.character(x) - + args <- validate( + x=x, warn=warn, ctl=ctl, normalize=normalize, carry=carry, + terminate=terminate + ) + width <- as.integer(width) if(!is.numeric(width) || length(width) != 1L || is.na(width) || width < 0) - stop("Argument `width` must be a positive scalar numeric.") - - if(!is.logical(warn)) warn <- as.logical(warn) - if(length(warn) != 1L || is.na(warn)) - stop("Argument `warn` must be TRUE or FALSE.") - - if(!isTRUE(normalize %in% c(FALSE, TRUE))) - stop("Argument `normalize` must be TRUE or FALSE.") - normalize <- as.logical(normalize) - - if(!is.character(ctl)) - stop("Argument `ctl` must be character.") - ctl.int <- integer() - if(length(ctl)) { - # duplicate values in `ctl` are okay, so save a call to `unique` here - if(anyNA(ctl.int <- match(ctl, VALID.CTL))) - stop( - "Argument `ctl` may contain only values in `", - deparse(VALID.CTL), "`" - ) - } + stop( + "Argument `width` must be a positive scalar numeric representable ", + "as an integer." + ) # can assume all term cap available for these purposes term.cap.int <- seq_along(VALID.TERM.CAP) - width <- as.integer(width) # a bit inefficient to rely on strwrap, but oh well - res <- .Call( - FANSI_strwrap_csi, - enc2utf8(x), width, - 0L, 0L, # indent, exdent - "", "", # prefix, initial - TRUE, "", # wrap always - FALSE, # strip spaces - FALSE, 8L, - warn, term.cap.int, - TRUE, # first only - ctl.int, - normalize - ) + with( + args, + res <- .Call( + FANSI_strwrap_csi, + enc2utf8(x), width, + 0L, 0L, # indent, exdent + "", "", # prefix, initial + TRUE, "", # wrap always + FALSE, # strip spaces + FALSE, 8L, + warn, term.cap.int, + TRUE, # first only + ctl.int, + normalize, + carry, + terminate + ) ) if(normalize) normalize_sgr(res) else res } #' @export @@ -91,39 +82,22 @@ strtrim2_ctl <- function( x, width, warn=getOption('fansi.warn'), tabs.as.spaces=getOption('fansi.tabs.as.spaces'), tab.stops=getOption('fansi.tab.stops'), - ctl='all', normalize=getOption('fansi.normalize', FALSE) + ctl='all', normalize=getOption('fansi.normalize', FALSE), + carry=getOption('fansi.carry', FALSE), + terminate=getOption('fansi.terminate', TRUE) ) { - if(!is.character(x)) x <- as.character(x) - + args <- validate( + x=x, warn=warn, ctl=ctl, + tabs.as.spaces=tabs.as.spaces, tab.stops=tab.stops + normalize=normalize, carry=carry, + terminate=terminate + ) + width <- as.integer(width) if(!is.numeric(width) || length(width) != 1L || is.na(width) || width < 0) - stop("Argument `width` must be a positive scalar numeric.") - - if(!is.logical(warn)) warn <- as.logical(warn) - if(length(warn) != 1L || is.na(warn)) - stop("Argument `warn` must be TRUE or FALSE.") - - if(!isTRUE(normalize %in% c(FALSE, TRUE))) - stop("Argument `normalize` must be TRUE or FALSE.") - normalize <- as.logical(normalize) - - if(!is.logical(tabs.as.spaces)) tabs.as.spaces <- as.logical(tabs.as.spaces) - if(length(tabs.as.spaces) != 1L || is.na(tabs.as.spaces)) - stop("Argument `tabs.as.spaces` must be TRUE or FALSE.") - - if(!is.numeric(tab.stops) || !length(tab.stops) || any(tab.stops < 1)) - stop("Argument `tab.stops` must be numeric and strictly positive") - - if(!is.character(ctl)) - stop("Argument `ctl` must be character.") - ctl.int <- integer() - if(length(ctl)) { - # duplicate values in `ctl` are okay, so save a call to `unique` here - if(anyNA(ctl.int <- match(ctl, VALID.CTL))) - stop( - "Argument `ctl` may contain only values in `", - deparse(VALID.CTL), "`" - ) - } + stop( + "Argument `width` must be a positive scalar numeric representable ", + "as an integer." + ) # can assume all term cap available for these purposes term.cap.int <- seq_along(VALID.TERM.CAP) @@ -132,19 +106,21 @@ strtrim2_ctl <- function( # a bit inefficient to rely on strwrap, but oh well - res <- .Call( - FANSI_strwrap_csi, - enc2utf8(x), width, - 0L, 0L, # indent, exdent - "", "", # prefix, initial - TRUE, "", # wrap always - FALSE, # strip spaces - tabs.as.spaces, tab.stops, - warn, term.cap.int, - TRUE, # first only - ctl.int, - normalize - ) + with( + args, + res <- .Call( + FANSI_strwrap_csi, + enc2utf8(x), width, + 0L, 0L, # indent, exdent + "", "", # prefix, initial + TRUE, "", # wrap always + FALSE, # strip spaces + tabs.as.spaces, tab.stops, + warn, term.cap.int, + TRUE, # first only + ctl.int, + normalize, carry, terminate + ) ) if(normalize) normalize_sgr(res) else res } #' @export @@ -152,9 +128,14 @@ strtrim2_ctl <- function( strtrim_sgr <- function( x, width, warn=getOption('fansi.warn'), - normalize=getOption('fansi.normalize', FALSE) + normalize=getOption('fansi.normalize', FALSE), + carry=getOption('fansi.carry', FALSE), + terminate=getOption('fansi.terminate', TRUE) ) - strtrim_ctl(x=x, width=width, warn=warn, ctl='sgr', normalize=normalize) + strtrim_ctl( + x=x, width=width, warn=warn, ctl='sgr', normalize=normalize, + carry=carry, terminate=terminate + ) #' @export #' @rdname strtrim_ctl @@ -162,9 +143,12 @@ strtrim_sgr <- function( strtrim2_sgr <- function(x, width, warn=getOption('fansi.warn'), tabs.as.spaces=getOption('fansi.tabs.as.spaces'), tab.stops=getOption('fansi.tab.stops'), - normalize=getOption('fansi.normalize', FALSE) + normalize=getOption('fansi.normalize', FALSE), + carry=getOption('fansi.carry', FALSE), + terminate=getOption('fansi.terminate', TRUE) ) strtrim2_ctl( x=x, width=width, warn=warn, tabs.as.spaces=tabs.as.spaces, - tab.stops=tab.stops, ctl='sgr', normalize=normalize + tab.stops=tab.stops, ctl='sgr', normalize=normalize, + carry=carry, terminate=terminate ) diff --git a/R/strwrap.R b/R/strwrap.R index 87eff63a..b834b22d 100644 --- a/R/strwrap.R +++ b/R/strwrap.R @@ -100,76 +100,34 @@ strwrap_ctl <- function( x, width = 0.9 * getOption("width"), indent = 0, exdent = 0, prefix = "", simplify = TRUE, initial = prefix, warn=getOption('fansi.warn'), term.cap=getOption('fansi.term.cap'), - ctl='all', normalize=getOption('fansi.normalize', FALSE) + ctl='all', normalize=getOption('fansi.normalize', FALSE), + carry=getOption('fansi.carry', FALSE), + terminate=getOption('fansi.terminate', TRUE) ) { - if(!is.character(x)) x <- as.character(x) - - if(!is.numeric(width) || length(width) != 1L || is.na(width)) - stop("Argument `width` must be a scalar numeric.") - - if(!is.numeric(indent) || length(indent) != 1L || is.na(indent) || indent < 0) - stop("Argument `indent` must be a positive scalar numeric.") - - if(!is.numeric(exdent) || length(exdent) != 1L || is.na(exdent) || exdent < 0) - stop("Argument `exdent` must be a positive scalar numeric.") - - if(!is.character(prefix)) prefix <- as.character(prefix) - if(length(prefix) != 1L) - stop("Argument `prefix` must be a scalar character.") - - if(!is.character(initial)) initial <- as.character(initial) - if(length(initial) != 1L) - stop("Argument `initial` must be a scalar character.") - - if(!is.logical(warn)) warn <- as.logical(warn) - if(length(warn) != 1L || is.na(warn)) - stop("Argument `warn` must be TRUE or FALSE.") - - if(!isTRUE(normalize %in% c(FALSE, TRUE))) - stop("Argument `normalize` must be TRUE or FALSE.") - normalize <- as.logical(normalize) - - if(!is.character(term.cap)) - stop("Argument `term.cap` must be character.") - - if(anyNA(term.cap.int <- match(term.cap, VALID.TERM.CAP))) - stop( - "Argument `term.cap` may only contain values in ", - deparse(VALID.TERM.CAP) - ) - if(!is.character(ctl)) - stop("Argument `ctl` must be character.") - ctl.int <- integer() - if(length(ctl)) { - # duplicate values in `ctl` are okay, so save a call to `unique` here - if(anyNA(ctl.int <- match(ctl, VALID.CTL))) - stop( - "Argument `ctl` may contain only values in `", - deparse(VALID.CTL), "`" - ) - } - - width <- max(c(as.integer(width) - 1L, 1L)) - indent <- as.integer(indent) - exdent <- as.integer(exdent) - - res <- .Call( - FANSI_strwrap_csi, - enc2utf8(x), width, indent, exdent, - enc2utf8(prefix), enc2utf8(initial), - FALSE, "", - TRUE, - FALSE, 8L, - warn, term.cap.int, - FALSE, # first_only - ctl.int, normalize + args <- validate( + x=x, warn=warn, term.cap=term.cap, ctl=ctl, normalize=normalize, + carry=carry, terminate=terminate ) - if(simplify) { - if(normalize) normalize_sgr(unlist(res), warn, term.cap) - else unlist(res) - } else { - if(normalize) normalize_sgr_list(res, warn, term.cap.int) else res - } + args.basic <- validate_wrap_basic(width, indent, exdent, prefix, initial) + with( + c(args.basic, args), { + res <- .Call( + FANSI_strwrap_csi, + x, width, indent, exdent, + enc2utf8(prefix), enc2utf8(initial), + FALSE, "", + TRUE, + FALSE, 8L, + warn, term.cap.int, + FALSE, # first_only + ctl.int, normalize + ) + if(simplify) { + if(normalize) normalize_sgr(unlist(res), warn, term.cap) + else unlist(res) + } else { + if(normalize) normalize_sgr_list(res, warn, term.cap.int) else res + } } ) } #' @export #' @rdname strwrap_ctl @@ -182,105 +140,60 @@ strwrap2_ctl <- function( tabs.as.spaces=getOption('fansi.tabs.as.spaces'), tab.stops=getOption('fansi.tab.stops'), warn=getOption('fansi.warn'), term.cap=getOption('fansi.term.cap'), - ctl='all', normalize=getOption('fansi.normalize', FALSE) + ctl='all', normalize=getOption('fansi.normalize', FALSE), + carry=getOption('fansi.carry', FALSE), + terminate=getOption('fansi.terminate', TRUE) ) { - # {{{ validation - - if(!is.character(x)) x <- as.character(x) - - if(!is.numeric(width) || length(width) != 1L || is.na(width)) - stop("Argument `width` must be a scalar numeric.") - - if(!is.numeric(indent) || length(indent) != 1L || is.na(indent) || indent < 0) - stop("Argument `indent` must be a positive scalar numeric.") - - if(!is.numeric(exdent) || length(exdent) != 1L || is.na(exdent) || exdent < 0) - stop("Argument `exdent` must be a positive scalar numeric.") - - if(!is.character(prefix)) prefix <- as.character(prefix) - if(length(prefix) != 1L) - stop("Argument `prefix` must be a scalar character.") - - if(!is.character(initial)) initial <- as.character(initial) - if(length(initial) != 1L) - stop("Argument `initial` must be a scalar character.") - - if(!is.logical(warn)) warn <- as.logical(warn) - if(length(warn) != 1L || is.na(warn)) - stop("Argument `warn` must be TRUE or FALSE.") - - if(!isTRUE(normalize %in% c(FALSE, TRUE))) - stop("Argument `normalize` must be TRUE or FALSE.") - normalize <- as.logical(normalize) - - if(!is.character(term.cap)) - stop("Argument `term.cap` must be character.") - if(anyNA(term.cap.int <- match(term.cap, VALID.TERM.CAP))) - stop( - "Argument `term.cap` may only contain values in ", - deparse(VALID.TERM.CAP) - ) - + args.basic <- + validate_wrap_basic(width, indent, exdent, prefix, initial, pad.end) + args <- validate( + x=x, warn=warn, term.cap=term.cap, ctl=ctl, normalize=normalize, + carry=carry, terminate=terminate, tab.stops=tab.stops, + tabs.as.spaces=tabs.as.spaces, strip.spaces=strip.spaces + ) if(!is.character(pad.end) || length(pad.end) != 1 || nchar(pad.end) > 1) stop("Argument `pad.end` must be a one character or empty string.") - if(!is.logical(wrap.always)) wrap.always <- as.logical(wrap.always) if(length(wrap.always) != 1L || is.na(wrap.always)) stop("Argument `wrap.always` must be TRUE or FALSE.") - if(!is.logical(tabs.as.spaces)) tabs.as.spaces <- as.logical(tabs.as.spaces) - if(length(tabs.as.spaces) != 1L || is.na(tabs.as.spaces)) - stop("Argument `tabs.as.spaces` must be TRUE or FALSE.") - if(!is.numeric(tab.stops) || !length(tab.stops) || any(tab.stops < 1)) - stop("Argument `tab.stops` must be numeric and strictly positive") - - if(!is.logical(strip.spaces)) strip.spaces <- as.logical(strip.spaces) - if(length(strip.spaces) != 1L || is.na(strip.spaces)) - stop("Argument `strip.spaces` must be TRUE or FALSE.") - if(wrap.always && width < 2L) stop("Width must be at least 2 in `wrap.always` mode.") + if(!is.character(prefix)) prefix <- as.character(prefix) + if(length(prefix) != 1L) + stop("Argument `prefix` must be a scalar character.") + if(!is.character(initial)) initial <- as.character(initial) + if(length(initial) != 1L) + stop("Argument `initial` must be a scalar character.") + prefix <- enc2utf8(prefix) + if(Encoding(prefix) == "bytes") + stop("Argument `prefix` cannot be \"bytes\" encoded.") + initial <- enc2utf8(initial) + if(Encoding(initial) == "bytes") + stop("Argument `initial` cannot be \"bytes\" encoded.") - if(tabs.as.spaces && strip.spaces) - stop("`tabs.as.spaces` and `strip.spaces` should not both be TRUE.") - - if(!is.character(ctl)) - stop("Argument `ctl` must be character.") - ctl.int <- integer() - - if(length(ctl)) { - # duplicate values in `ctl` are okay, so save a call to `unique` here - if(anyNA(ctl.int <- match(ctl, VALID.CTL))) - stop( - "Argument `ctl` may contain only values in `", - deparse(VALID.CTL), "`" - ) - } - # }}} end validation - - width <- max(c(as.integer(width) - 1L, 1L)) - indent <- as.integer(indent) - exdent <- as.integer(exdent) tab.stops <- as.integer(tab.stops) - res <- .Call( - FANSI_strwrap_csi, - enc2utf8(x), width, - indent, exdent, - enc2utf8(prefix), enc2utf8(initial), - wrap.always, pad.end, - strip.spaces, - tabs.as.spaces, tab.stops, - warn, term.cap.int, - FALSE, # first_only - ctl.int, normalize - ) - if(simplify) { - if(normalize) normalize_sgr(unlist(res), warn, term.cap) - else unlist(res) - } else { - if(normalize) normalize_sgr_list(res, warn, term.cap.int) else res - } + with( + c(args.basic, args), { + res <- .Call( + FANSI_strwrap_csi, + x, width, + indent, exdent, + enc2utf8(prefix), enc2utf8(initial), + wrap.always, pad.end, + strip.spaces, + tabs.as.spaces, tab.stops, + warn, term.cap.int, + FALSE, # first_only + ctl.int, normalize + ) + if(simplify) { + if(normalize) normalize_sgr(unlist(res), warn, term.cap) + else unlist(res) + } else { + if(normalize) normalize_sgr_list(res, warn, term.cap.int) else res + } } ) } #' @export #' @rdname strwrap_ctl @@ -289,12 +202,15 @@ strwrap_sgr <- function( x, width = 0.9 * getOption("width"), indent = 0, exdent = 0, prefix = "", simplify = TRUE, initial = prefix, warn=getOption('fansi.warn'), term.cap=getOption('fansi.term.cap'), - normalize=getOption('fansi.normalize', FALSE) + normalize=getOption('fansi.normalize', FALSE), + carry=getOption('fansi.carry', FALSE), + terminate=getOption('fansi.terminate', TRUE) ) strwrap_ctl( x=x, width=width, indent=indent, exdent=exdent, prefix=prefix, simplify=simplify, initial=initial, - warn=warn, term.cap=term.cap, ctl='sgr', normalize=normalize + warn=warn, term.cap=term.cap, ctl='sgr', normalize=normalize, + carry=carry, terminate=terminate ) #' @export #' @rdname strwrap_ctl @@ -307,7 +223,9 @@ strwrap2_sgr <- function( tabs.as.spaces=getOption('fansi.tabs.as.spaces'), tab.stops=getOption('fansi.tab.stops'), warn=getOption('fansi.warn'), term.cap=getOption('fansi.term.cap'), - normalize=getOption('fansi.normalize', FALSE) + normalize=getOption('fansi.normalize', FALSE), + carry=getOption('fansi.carry', FALSE), + terminate=getOption('fansi.terminate', TRUE) ) strwrap2_ctl( x=x, width=width, indent=indent, @@ -316,6 +234,36 @@ strwrap2_sgr <- function( strip.spaces=strip.spaces, tabs.as.spaces=tabs.as.spaces, tab.stops=tab.stops, - warn=warn, term.cap=term.cap, ctl='sgr', normalize=normalize + warn=warn, term.cap=term.cap, ctl='sgr', normalize=normalize, + carry=carry, terminate=terminate ) +validate_wrap_basic <- function( + width, indent, exdent, prefix, initial, pad.end +) { + call <- sys.cal(-1) + stop2 <- function(x) stop(simpleError(x, call)) + is_scl_int_pos <- function(x, name, strict=FALSE) { + x <- as.integer(x) + if( + !is.numeric(x) || length(x) != 1L || is.na(x) || + if(strict) x <= 0 else x < 0 + ) + stop2( + sprintf( + "Argument `%s` %s.", name, + "must be a positive scalar numeric representable as integer." + ) ) + x + } + width <- is_scl_int_pos(x, 'width', strict=TRUE) + exdent <- is_scl_int_pos(x, 'exdent', strict=FALSE) + indent <- is_scl_int_pos(x, 'indent', strict=FALSE) + width <- max(c(as.integer(width) - 1L, 1L)) + + list( + width=width, indent=indent, exdent=extent, prefix=prefix, initial=initial + ) +} + + diff --git a/R/substr2.R b/R/substr2.R index aad3acf6..c62846f9 100644 --- a/R/substr2.R +++ b/R/substr2.R @@ -137,7 +137,9 @@ substr_ctl <- function( x, start, stop, warn=getOption('fansi.warn'), term.cap=getOption('fansi.term.cap'), - ctl='all', normalize=getOption('fansi.normalize', FALSE) + ctl='all', normalize=getOption('fansi.normalize', FALSE), + carry=getOption('fansi.carry', FALSE), + terminate=getOption('fansi.terminate', TRUE) ) substr2_ctl( x=x, start=start, stop=stop, warn=warn, term.cap=term.cap, ctl=ctl, @@ -153,45 +155,15 @@ substr2_ctl <- function( tab.stops=getOption('fansi.tab.stops'), warn=getOption('fansi.warn'), term.cap=getOption('fansi.term.cap'), - ctl='all', normalize=getOption('fansi.normalize', FALSE) + ctl='all', normalize=getOption('fansi.normalize', FALSE), + carry=getOption('fansi.carry', FALSE), + terminate=getOption('fansi.terminate', TRUE) ) { - if(!is.character(x)) x <- as.character(x) - x <- enc2utf8(x) - if(any(Encoding(x) == "bytes")) - stop("BYTE encoded strings are not supported.") - - if(!is.logical(tabs.as.spaces)) tabs.as.spaces <- as.logical(tabs.as.spaces) - if(length(tabs.as.spaces) != 1L || is.na(tabs.as.spaces)) - stop("Argument `tabs.as.spaces` must be TRUE or FALSE.") - if(!is.numeric(tab.stops) || !length(tab.stops) || any(tab.stops < 1)) - stop("Argument `tab.stops` must be numeric and strictly positive") - - if(!is.logical(warn)) warn <- as.logical(warn) - if(length(warn) != 1L || is.na(warn)) - stop("Argument `warn` must be TRUE or FALSE.") - if(!isTRUE(normalize %in% c(FALSE, TRUE))) - stop("Argument `normalize` must be TRUE or FALSE.") - normalize <- as.logical(normalize) - - if(!is.character(term.cap)) - stop("Argument `term.cap` must be character.") - if(anyNA(term.cap.int <- match(term.cap, VALID.TERM.CAP))) - stop( - "Argument `term.cap` may only contain values in ", - deparse(VALID.TERM.CAP) - ) - if(!is.character(ctl)) - stop("Argument `ctl` must be character.") - ctl.int <- integer() - if(length(ctl)) { - # duplicate values in `ctl` are okay, so save a call to `unique` here - if(anyNA(ctl.int <- match(ctl, VALID.CTL))) - stop( - "Argument `ctl` may contain only values in `", - deparse(VALID.CTL), "`" - ) - } - + args <- validate( + x=x, warn=warn, term.cap=term.cap, ctl=ctl, normalize=normalize, + carry=carry, terminate=terminate, tab.stops=tab.stops, + tabs.as.spaces=tabs.as.spaces + ) valid.round <- c('start', 'stop', 'both', 'neither') if( !is.character(round) || length(round) != 1 || @@ -220,15 +192,18 @@ substr2_ctl <- function( res <- x no.na <- !(is.na(x) | is.na(start & stop)) - res[no.na] <- substr_ctl_internal( - x[no.na], start=start[no.na], stop=stop[no.na], - type.int=type.m, - tabs.as.spaces=tabs.as.spaces, tab.stops=tab.stops, warn=warn, - term.cap.int=term.cap.int, - round.start=round == 'start' || round == 'both', - round.stop=round == 'stop' || round == 'both', - x.len=length(x), - ctl.int=ctl.int, normalize=normalize + with( + args, + res[no.na] <- substr_ctl_internal( + x[no.na], start=start[no.na], stop=stop[no.na], + type.int=type.m, + tabs.as.spaces=tabs.as.spaces, tab.stops=tab.stops, warn=warn, + term.cap.int=term.cap.int, + round.start=round == 'start' || round == 'both', + round.stop=round == 'stop' || round == 'both', + x.len=length(x), + ctl.int=ctl.int, normalize=normalize + ) ) res[!no.na] <- NA_character_ res @@ -240,11 +215,13 @@ substr_sgr <- function( x, start, stop, warn=getOption('fansi.warn'), term.cap=getOption('fansi.term.cap'), - normalize=getOption('fansi.normalize', FALSE) + normalize=getOption('fansi.normalize', FALSE), + carry=getOption('fansi.carry', FALSE), + terminate=getOption('fansi.terminate', TRUE) ) substr2_ctl( x=x, start=start, stop=stop, warn=warn, term.cap=term.cap, ctl='sgr', - normalize=normalize + normalize=normalize, carry=carry, terminate=terminate ) #' @rdname substr_ctl @@ -256,13 +233,16 @@ substr2_sgr <- function( tab.stops=getOption('fansi.tab.stops'), warn=getOption('fansi.warn'), term.cap=getOption('fansi.term.cap'), - normalize=getOption('fansi.normalize', FALSE) + normalize=getOption('fansi.normalize', FALSE), + carry=getOption('fansi.carry', FALSE), + terminate=getOption('fansi.terminate', TRUE) ) substr2_ctl( x=x, start=start, stop=stop, type=type, round=round, tabs.as.spaces=tabs.as.spaces, tab.stops=tab.stops, warn=warn, term.cap=term.cap, ctl='sgr', - normalize=normalize + normalize=normalize, + carry=carry, terminate=terminate ) ## @x must already have been converted to UTF8 @@ -271,7 +251,7 @@ substr2_sgr <- function( substr_ctl_internal <- function( x, start, stop, type.int, round, tabs.as.spaces, tab.stops, warn, term.cap.int, round.start, round.stop, - x.len, ctl.int, normalize + x.len, ctl.int, normalize, carry, terminate ) { # For each unique string, compute the state at each start and stop position # and re-map the positions to "ansi" space @@ -282,6 +262,11 @@ substr_ctl_internal <- function( res <- character(x.len) s.s.valid <- stop >= start & stop + # If we want to carry, we'll do this manually as too much work to try to do it + # in C given the current structure using ordered indices into each string. + + stop("Implement carry.") + x.scalar <- length(x) == 1 x.u <- if(x.scalar) x else unique_chr(x) @@ -290,6 +275,9 @@ substr_ctl_internal <- function( # original order and whether they are starting or ending positions (affects # how multi-byte characters are trimmed/kept). + # We do this for each unique string in `x` as the indices must be incrementing + # for each of them. + for(u in x.u) { elems <- which(x == u & s.s.valid) elems.len <- length(elems) @@ -312,7 +300,7 @@ substr_ctl_internal <- function( e.lag, # whether to include a partially covered multi-byte character e.ends, # whether it's a start or end position warn, term.cap.int, - ctl.int, normalize + ctl.int, normalize, carry ) # Recover the matching values for e.sort @@ -354,7 +342,8 @@ substr_ctl_internal <- function( state_at_pos <- function( x, starts, ends, warn=getOption('fansi.warn'), - normalize=getOption('fansi.normalize', FALSE) + normalize=getOption('fansi.normalize', FALSE), + carry=getOption('fansi.carry', FALSE) ) { is.start <- c(rep(TRUE, length(starts)), rep(FALSE, length(ends))) .Call( @@ -366,6 +355,7 @@ state_at_pos <- function( warn, seq_along(VALID.TERM.CAP), 1L, # ctl="all" - normalize + normalize, + carry ) } diff --git a/R/tohtml.R b/R/tohtml.R index 716a28a4..942d70a6 100644 --- a/R/tohtml.R +++ b/R/tohtml.R @@ -143,20 +143,10 @@ sgr_to_html <- function( x, warn=getOption('fansi.warn'), term.cap=getOption('fansi.term.cap'), - classes=FALSE + classes=FALSE, + carry=getOption('fansi.carry', FALSE) ) { - if(!is.character(x)) x <- as.character(x) - if(!is.logical(warn)) warn <- as.logical(warn) - if(length(warn) != 1L || is.na(warn)) - stop("Argument `warn` must be TRUE or FALSE.") - - if(!is.character(term.cap)) - stop("Argument `term.cap` must be character.") - if(anyNA(term.cap.int <- match(term.cap, VALID.TERM.CAP))) - stop( - "Argument `term.cap` may only contain values in ", - deparse(VALID.TERM.CAP) - ) + args <- validate(x=x, warn=warn, term.cap=term.cap, carry=carry) classes <- if(isTRUE(classes)) { FANSI.CLASSES @@ -167,7 +157,7 @@ sgr_to_html <- function( } else stop("Argument `classes` must be TRUE, FALSE, or a character vector.") - .Call(FANSI_esc_to_html, enc2utf8(x), warn, term.cap.int, classes) + with(args, .Call(FANSI_esc_to_html, x, warn, term.cap.int, classes, carry)) } #' Generate CSS Mapping Classes to Colors #' diff --git a/R/unhandled.R b/R/unhandled.R index 9fd48afb..f858634b 100644 --- a/R/unhandled.R +++ b/R/unhandled.R @@ -74,14 +74,8 @@ #' unhandled_ctl(string) unhandled_ctl <- function(x, term.cap=getOption('fansi.term.cap')) { - if(!is.character(term.cap)) - stop("Argument `term.cap` must be character.") - if(anyNA(term.cap.int <- match(term.cap, VALID.TERM.CAP))) - stop( - "Argument `term.cap` may only contain values in ", - deparse(VALID.TERM.CAP) - ) - res <- .Call(FANSI_unhandled_esc, enc2utf8(x), term.cap.int) + args <- validate(x=x, term.cap=term.cap) + with(args, res <- .Call(FANSI_unhandled_esc, x, term.cap.int)) names(res) <- c("index", "start", "stop", "error", "translated", "esc") errors <- c( 'unknown', 'special', 'exceed-term-cap', 'non-SGR', 'malformed-CSI', From 71cc04b575ec126c2ff6d256ae261b8df208de86 Mon Sep 17 00:00:00 2001 From: brodieG Date: Sat, 12 Jun 2021 13:51:23 -0400 Subject: [PATCH 02/20] docs --- DEVNOTES.md | 45 +++++++++++++++++++++++++++++++++++++++++++-- R/carry.R | 31 +++++++++++++++++++++++++++++++ R/fansi-package.R | 35 +++++++++++++++++++++++++++++++++++ R/misc.R | 1 + 4 files changed, 110 insertions(+), 2 deletions(-) create mode 100644 R/carry.R diff --git a/DEVNOTES.md b/DEVNOTES.md index 9aca18db..6eb024ee 100644 --- a/DEVNOTES.md +++ b/DEVNOTES.md @@ -4,6 +4,15 @@ These are internal developer notes. ## Todo +* Are we checking byte encoding on e.g. pre/pad, etc.? +* Rationalize type checking on entry into C code given that state init already + checks many of them. +* Move the interrupt to be `_read_next` based with an unsigned counter? With + maybe the SGR reads contributing more to the counter? What about writes? Is + there a more universal way to check for interrupts? Main issue is that it's + possible (though perhaps unlikely) that there will be some very slow + individual loop iterations as we saw with `tabs_as_spaces`. +* Write a section on performance in the fansi section. * Look into hiding global functions / structures, and split off fansi.h into the internal and external functions. Maybe also split off the write functions from general utilities. @@ -20,7 +29,6 @@ These are internal developer notes. * This needs to be properly documented. Will also simplify implementation of normalize. -* Write docs about behavior of bleeding. * Bunch of docs don't have @return tags, oddly. * Make sure we check we're not using `intmax_t` or `uintmax_t` in a tight loop anywhere. @@ -32,6 +40,8 @@ These are internal developer notes. ## Done +* Write docs about behavior of bleeding. + * Can we manage the stack better with the growing buffer so we don't keep all the prior half sized ones around until we exit so they are eligible for gc? @@ -181,7 +191,7 @@ Do we warn about closing tags that don't close an active style? Maybe we do that, and then point to docs about bleed. But it does mean we should include the bleed argument. -## Bleed +## Bleed / Carry Add a `bleed` param that is a single string (or TRUE) that causes the program to bleed from string to string, with the initial state specified @@ -204,6 +214,37 @@ Is this the desired outcome: Yes, if "isolate" is true, but if not we should emit the ending style. +What was the issue with recycling carry? That you have to pick whether to wrap +your own carry, or whether take the external one? Indeed, what's the right +answer there? Ah, that's the ambiguity, carry and inherit are really distinct +but potentially mutually exclusive (where inherit means take a previously known +state). Inherit matters also beyond normalized mode as e.g. when we take +substrings we start the string with all the known states. + +Inherit doesn't really make sense for `strwrap`? I guess it does to begin, and +then carry does the rest (although `strwrap` always auto-carries per element, so +that's a different type of carry). + +So: + +* Inherit, a recycled vector of starting styles. +* Carry, TRUE or FALSE, or a single style string to start with. + * Mutually exclusive with inherit. +* Isolate, "start", "end", "both", "none/neither". + * Orthogonal to all the others. + * Both Carry and Inherit will be emitted? Or is inherit just so we know + what to close with isolate in normalized mode? + +Leaning more and more on it being user responsibility to handle interactions +with external strings by pre-pasting either the style-at-end of other strings, +or the required closing tags. + +Does `isolate` then just become `terminate`? What if we change our mind in the +future about wanting to terminate the beginning? + +So we're left with just `carry` and terminate, and instructions on how to do +things manually. + ## Overflow Set R_LEN_T_MAX to INT_MAX - N, and check that on expansion we get the correct diff --git a/R/carry.R b/R/carry.R new file mode 100644 index 00000000..a4a02138 --- /dev/null +++ b/R/carry.R @@ -0,0 +1,31 @@ +## Copyright (C) 2021 Brodie Gaslam +## +## This file is part of "fansi - ANSI Control Sequence Aware String Functions" +## +## This program is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 2 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## Go to for a copy of the license. + +sgr_at_end <- function( + x, warn=getOption('fansi.warn'), + term.cap=getOption('fansi.term.cap'), + normalize=getOption('fansi.normalize', FALSE), + carry=getOption('fansi.carry', FALSE) +) { + args <- validate( + x=x, warn=warn, term.cap=term.cap, normalize=normalize, carry=carry, + ctl='sgr' + ) + with( + args, + .Call(FANSI_sgr_at_end, x, warn, term.cap.int, ctl.int, normalize, carry) + ) +} diff --git a/R/fansi-package.R b/R/fansi-package.R index 34a7164b..4371ea60 100644 --- a/R/fansi-package.R +++ b/R/fansi-package.R @@ -116,6 +116,41 @@ #' the effect is the same as replacement (e.g. if you have a color active and #' pick another one). #' +#' @section SGR Interactions +#' +#' The cumulative nature of SGR means that SGR in strings that are spliced will +#' interact with each other, and that a substring does not contain all the +#' formatting information that will affect its display. Since context affects +#' how SGR should be interpreted and output, `fansi` provides mechanisms by +#' which to communicate the context. +#' +#' One form of interaction is how a character vector provided to `fansi` +#' functions interact with itself. By default, `fansi` assumes that each +#' element in an input character vector is independent, but if the input +#' represents a single document with each element a line in it, this is an +#' incorrect interpretation. In that situation SGR from a prior line should +#' bleed into a subsequent line. Setting `carry = TRUE` enables the "single +#' document" interpretation. +#' +#' Another form of interaction is when `fansi` processed substrings are spliced +#' with or into other substrings. By default `fansi` automatically terminates +#' strings it processes if they contain active SGR. This prevents the SGR +#' therein from affecting display of external strings, which is useful e.g. when +#' arranging text in columns. We can allow the SGR to bleed into appended +#' strings by setting `terminate = FALSE`. `carry` is unaffected by `terminate` +#' as `fansi` records the ending SGR state prior to termination internally. +#' +#' Finally, `fansi` strings will be affected by any active SGR in strings they +#' are appended to. There are no parameters to control what happens +#' automatically, but `fansi` provides several functions that can help the user +#' get their desired outcome. `sgr_at_end` computes the active SGR at the end +#' of a string, this can then be prepended onto the _input_ of `fansi` functions +#' so that they are aware of what the active style at the beginning of the +#' string. Alternatively, one could use `close_sgr(sgr_at_end(...))` and +#' pre-pend that to the _output_ of `fansi` functions so they are unaffected by +#' preceding SGR (one could also just prepend "ESC[0m", see `?normalize_sgr` for +#' why that may not make sense). +#' #' @section Encodings / UTF-8: #' #' `fansi` will convert any non-ASCII strings to UTF-8 before processing them, diff --git a/R/misc.R b/R/misc.R index 3b6427e4..e665441d 100644 --- a/R/misc.R +++ b/R/misc.R @@ -183,6 +183,7 @@ fansi_lines <- function(txt, step=1) { #' be sufficient. @return `x`, but with the `what` characters replaced by #' their HTML entity codes, and Encoding set to UTF-8 if non-ASCII input are #' present in `x`. +#' @return x possibly re-encoded to UTF8, with `what` characters escaped. #' @examples #' html_esc("day > night") #' html_esc("hello world") From d37fcfb43817e26e484bcdd01f564e890bdfc72a Mon Sep 17 00:00:00 2001 From: brodieG Date: Sun, 13 Jun 2021 08:07:11 -0400 Subject: [PATCH 03/20] add carry/terminate to C side; untested --- src/carry.c | 105 ++++++++++++++++++++++++++++++++++++++++++++++++ src/fansi.h | 36 +++++++++++++---- src/init.c | 13 +++--- src/normalize.c | 57 +++++++++++++++++--------- src/state.c | 69 +++++++++++++++---------------- src/tohtml.c | 20 +++++++-- src/utils.c | 16 ++++++++ src/wrap.c | 53 ++++++++++++++---------- 8 files changed, 275 insertions(+), 94 deletions(-) create mode 100644 src/carry.c diff --git a/src/carry.c b/src/carry.c new file mode 100644 index 00000000..da383b66 --- /dev/null +++ b/src/carry.c @@ -0,0 +1,105 @@ +/* + * Copyright (C) 2021 Brodie Gaslam + * + * This file is part of "fansi - ANSI Control Sequence Aware String Functions" + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation, either version 2 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * Go to for a copy of the license. + */ + +#include "fansi.h" + +static struct FANSI_state state_at_end( + struct FANSI_state state, R_xlen_t i +) { + while(state.string[state.pos_byte]) { + state = FANSI_read_next(state, i); + } + state = FANSI_reset_pos(state); + return state; +} + +SEXP FANSI_sgr_at_end_ext( + SEXP x, SEXP warn, SEXP term_cap, SEXP ctl, SEXP norm, SEXP carry +) { + FANSI_val_args(x, norm, carry); + + int normalize = asInteger(norm); + + // Read-in any pre-existing state to carry + int do_carry = STRING_ELT(carry, 0) != NA_STRING; + SEXP carry_string; + if(do_carry) carry_string = PROTECT(carry); + else carry_string = PROTECT(mkString("")); + + SEXP R_true = PROTECT(ScalarLogical(1)); + SEXP R_zero = PROTECT(ScalarInteger(0)); + + struct FANSI_state state_prev = FANSI_state_init_full( + carry_string, warn, term_cap, R_true, R_true, + R_zero, // character width mode + ctl, (R_xlen_t) 0 + ); + state_prev = state_at_end(state_prev, 0); + + R_xlen_t len = XLENGTH(x); + struct FANSI_buff buff; + FANSI_INIT_BUFF(&buff); + + SEXP res = PROTECT(allocVector(STRSXP, len)); + + for(R_xlen_t i = 0; i < len; ++i) { + FANSI_interrupt(i); + + struct FANSI_state state = FANSI_state_init_full( + x, warn, term_cap, R_true, R_true, R_zero, ctl, i + ); + if(do_carry) state.sgr = state_prev.sgr; + + state = state_at_end(state, i); + char * state_chr = FANSI_sgr_as_chr(&buff, state.sgr, normalize, i); + + SEXP reschr = PROTECT( + FANSI_mkChar(state_chr, state_chr + strlen(state_chr), CE_NATIVE, i) + ); + SET_STRING_ELT(res, i, reschr); + UNPROTECT(1); + state_prev = state; + } + FANSI_release_buff(&buff, 1); + UNPROTECT(3); + return res; +} + +struct FANSI_sgr FANSI_carry_init( + SEXP carry, SEXP warn, SEXP term_cap, SEXP ctl +) { + int do_carry = STRING_ELT(carry, 1) != NA_STRING; + SEXP carry_string; + if(do_carry) carry_string = PROTECT(carry); + else carry_string = PROTECT(mkString("")); + + SEXP R_true = PROTECT(ScalarLogical(1)); + SEXP R_zero = PROTECT(ScalarInteger(0)); + + // Read-in any pre-existing state to carry + struct FANSI_state state_carry = FANSI_state_init_full( + carry_string, warn, term_cap, R_true, R_true, + R_zero, // normal char, we don't care about width + ctl, (R_xlen_t) 0 + ); + state_carry = state_at_end(state_carry, (R_xlen_t) 0); + UNPROTECT(3); + return state_carry.sgr; +} + + diff --git a/src/fansi.h b/src/fansi.h index 43ae3b36..7d5a4268 100644 --- a/src/fansi.h +++ b/src/fansi.h @@ -354,24 +354,29 @@ Go to for a copy of the license. SEXP FANSI_has(SEXP x, SEXP ctl, SEXP warn); SEXP FANSI_strip(SEXP x, SEXP ctl, SEXP warn); SEXP FANSI_state_at_pos_ext( - SEXP text, SEXP pos, SEXP type, SEXP lag, SEXP ends, - SEXP warn, SEXP term_cap, SEXP ctl, SEXP norm + SEXP x, SEXP pos, SEXP type, SEXP lag, SEXP ends, + SEXP warn, SEXP term_cap, SEXP ctl, SEXP norm, SEXP carry ); SEXP FANSI_strwrap_ext( SEXP x, SEXP width, - SEXP indent, SEXP exdent, SEXP prefix, SEXP initial, + SEXP indent, SEXP exdent, + SEXP prefix, SEXP initial, SEXP wrap_always, SEXP pad_end, SEXP strip_spaces, SEXP tabs_as_spaces, SEXP tab_stops, SEXP warn, SEXP term_cap, - SEXP first_only, SEXP ctl, SEXP norm + SEXP first_only, + SEXP ctl, SEXP norm, SEXP carry, + SEXP terminate ); SEXP FANSI_process_ext(SEXP input); SEXP FANSI_tabs_as_spaces_ext( SEXP vec, SEXP tab_stops, SEXP warn, SEXP term_cap, SEXP ctl ); SEXP FANSI_color_to_html_ext(SEXP x); - SEXP FANSI_esc_to_html(SEXP x, SEXP warn, SEXP term_cap, SEXP class_pre); + SEXP FANSI_esc_to_html( + SEXP x, SEXP warn, SEXP term_cap, SEXP color_classes, SEXP carry + ); SEXP FANSI_unhandled_esc(SEXP x, SEXP term_cap); SEXP FANSI_nchar( @@ -395,8 +400,12 @@ Go to for a copy of the license. SEXP FANSI_get_int_max(); SEXP FANSI_esc_html(SEXP x, SEXP what); - SEXP FANSI_normalize_sgr_ext(SEXP x, SEXP warn, SEXP term_cap); - SEXP FANSI_normalize_sgr_list_ext(SEXP x, SEXP warn, SEXP term_cap); + SEXP FANSI_normalize_sgr_ext( + SEXP x, SEXP warn, SEXP term_cap, SEXP carry + ); + SEXP FANSI_normalize_sgr_list_ext( + SEXP x, SEXP warn, SEXP term_cap, SEXP carry + ); SEXP FANSI_size_buff_ext(SEXP x); SEXP FANSI_size_buff_prot_test(); @@ -404,7 +413,10 @@ Go to for a copy of the license. SEXP FANSI_check_enc_ext(SEXP x, SEXP i); SEXP FANSI_ctl_as_int_ext(SEXP ctl); - SEXP FANSI_sgr_close_ext(SEXP x, SEXP term_cap); + SEXP FANSI_sgr_close_ext(SEXP x, SEXP warn, SEXP term_cap, SEXP norm); + SEXP FANSI_sgr_at_end_ext( + SEXP x, SEXP warn, SEXP term_cap, SEXP ctl, SEXP norm, SEXP carry + ); // - Internal funs ----------------------------------------------------------- @@ -494,6 +506,14 @@ Go to for a copy of the license. int FANSI_check_append(int cur, int extra, const char * msg, R_xlen_t i); void FANSI_check_append_err(const char * msg, R_xlen_t i); + void FANSI_val_args(SEXP x, SEXP norm, SEXP carry); + char * FANSI_sgr_as_chr( + struct FANSI_buff *buff, struct FANSI_sgr sgr, int normalize, R_xlen_t i + ); + struct FANSI_sgr FANSI_carry_init( + SEXP carry, SEXP warn, SEXP term_cap, SEXP ctl + ); + // - Compatibility ----------------------------------------------------------- // R_nchar does not exist prior to 3.2.2, so we sub in this dummy diff --git a/src/init.c b/src/init.c index ef9111fa..7cdb905c 100644 --- a/src/init.c +++ b/src/init.c @@ -23,14 +23,14 @@ static const R_CallMethodDef callMethods[] = { {"has_csi", (DL_FUNC) &FANSI_has, 3}, {"strip_csi", (DL_FUNC) &FANSI_strip, 3}, - {"strwrap_csi", (DL_FUNC) &FANSI_strwrap_ext, 16}, - {"state_at_pos_ext", (DL_FUNC) &FANSI_state_at_pos_ext, 9}, + {"strwrap_csi", (DL_FUNC) &FANSI_strwrap_ext, 18}, + {"state_at_pos_ext", (DL_FUNC) &FANSI_state_at_pos_ext, 11}, {"process", (DL_FUNC) &FANSI_process_ext, 1}, {"check_assumptions", (DL_FUNC) &FANSI_check_assumptions, 0}, {"digits_in_int", (DL_FUNC) &FANSI_digits_in_int_ext, 1}, {"tabs_as_spaces", (DL_FUNC) &FANSI_tabs_as_spaces_ext, 5}, {"color_to_html", (DL_FUNC) &FANSI_color_to_html_ext, 1}, - {"esc_to_html", (DL_FUNC) &FANSI_esc_to_html, 4}, + {"esc_to_html", (DL_FUNC) &FANSI_esc_to_html, 5}, {"unhandled_esc", (DL_FUNC) &FANSI_unhandled_esc, 2}, {"unique_chr", (DL_FUNC) &FANSI_unique_chr, 1}, {"nzchar_esc", (DL_FUNC) &FANSI_nzchar, 5}, @@ -45,11 +45,12 @@ R_CallMethodDef callMethods[] = { {"ctl_as_int", (DL_FUNC) &FANSI_ctl_as_int_ext, 1}, {"esc_html", (DL_FUNC) &FANSI_esc_html, 2}, {"reset_limits", (DL_FUNC) &FANSI_reset_limits, 0}, - {"normalize_sgr", (DL_FUNC) &FANSI_normalize_sgr_ext, 3}, - {"normalize_sgr_list", (DL_FUNC) &FANSI_normalize_sgr_list_ext, 3}, - {"close_sgr", (DL_FUNC) &FANSI_sgr_close_ext, 2}, + {"normalize_sgr", (DL_FUNC) &FANSI_normalize_sgr_ext, 4}, + {"normalize_sgr_list", (DL_FUNC) &FANSI_normalize_sgr_list_ext, 4}, + {"close_sgr", (DL_FUNC) &FANSI_sgr_close_ext, 4}, {"size_buff", (DL_FUNC) &FANSI_size_buff_ext, 1}, {"size_buff_prot_test", (DL_FUNC) &FANSI_size_buff_prot_test, 0}, + {"sgr_at_end", (DL_FUNC) &FANSI_sgr_at_end_ext, 6}, {NULL, NULL, 0} }; diff --git a/src/normalize.c b/src/normalize.c index 270b4413..5ada94ff 100644 --- a/src/normalize.c +++ b/src/normalize.c @@ -29,10 +29,11 @@ */ static int normalize( - char * buff, struct FANSI_state state, R_xlen_t i + char * buff, struct FANSI_state *state, R_xlen_t i ) { + struct FANSI_state state_int = *state; const char * string, * string_prev, * string_last; - string_prev = string_last = string = state.string + state.pos_byte; + string_prev = string_last = string = state_int.string + state_int.pos_byte; int len = 0; // output int any_to_exp = 0; char * buff_track = buff; @@ -45,31 +46,32 @@ static int normalize( while(1) { string = strchr(string_prev, 0x1b); if(!string) string = string_prev + strlen(string_prev); - state.pos_byte = (string - state.string); + state_int.pos_byte = (string - state_int.string); // We encountered an ESC if(*string && *string == 0x1b) { - state = FANSI_read_next(state, i); + state_int = FANSI_read_next(state_int, i); // Not all ESC sequences are SGR, and only non-normalized need re-writing - if(state.is_sgr && state.non_normalized) { + if(state_int.is_sgr && state_int.non_normalized) { any_to_exp = 1; // stuff prior to SGR len += FANSI_W_MCOPY(&buff_track, string_last, string - string_last); // Any prior open styles not overriden by new one need to be closed struct FANSI_sgr to_close = - FANSI_sgr_setdiff(state.sgr_prev, state.sgr); + FANSI_sgr_setdiff(state_int.sgr_prev, state_int.sgr); len += FANSI_W_sgr_close(&buff_track, to_close, len, 1, i); // Any newly open styles will need to be opened - struct FANSI_sgr to_open = FANSI_sgr_setdiff(state.sgr, state.sgr_prev); + struct FANSI_sgr to_open = + FANSI_sgr_setdiff(state_int.sgr, state_int.sgr_prev); len += FANSI_W_sgr(&buff_track, to_open, len, 1, i); // Keep track of the last point we copied - string_last = state.string + state.pos_byte; + string_last = state_int.string + state_int.pos_byte; } - string = state.string + state.pos_byte; + string = state_int.string + state_int.pos_byte; } else if (*string == 0) { if(any_to_exp) { @@ -84,11 +86,13 @@ static int normalize( } if(buff && (buff_track - buff != len)) error("Internal Error: buffer sync mismatch in normalize SGR."); // nocov + *state = state_int; return len; } static SEXP normalize_sgr_int( - SEXP x, SEXP warn, SEXP term_cap, struct FANSI_buff *buff, R_xlen_t index0 + SEXP x, SEXP warn, SEXP term_cap, SEXP carry, + struct FANSI_buff *buff, R_xlen_t index0 ) { if(TYPEOF(x) != STRSXP) error("Internal Error: `x` must be a character vector"); // nocov @@ -99,43 +103,58 @@ static SEXP normalize_sgr_int( PROTECT_INDEX ipx; PROTECT_WITH_INDEX(res, &ipx); + SEXP ctl = PROTECT(ScalarInteger(1)); // "all" + int do_carry = STRING_ELT(carry, 1) != NA_STRING; + struct FANSI_sgr sgr_carry = FANSI_carry_init(carry, warn, term_cap, ctl); + UNPROTECT(1); + + struct FANSI_state state_prev = + FANSI_state_init(x, warn, term_cap, (R_xlen_t)0); + state_prev.sgr = sgr_carry; + for(R_xlen_t i = 0; i < x_len; ++i) { FANSI_interrupt(i + index0); SEXP chrsxp = STRING_ELT(x, i); if(chrsxp == NA_STRING) continue; // Measure - struct FANSI_state state = FANSI_state_init(x, warn, term_cap, i); - int len = normalize(NULL, state, i); + struct FANSI_state state_start, state; + state = FANSI_state_init(x, warn, term_cap, i); + if(do_carry) state.sgr = state_prev.sgr; + state_start = state; + + int len = normalize(NULL, &state, i); if(len < 0) continue; // Write if(res == x) REPROTECT(res = duplicate(x), ipx); FANSI_size_buff(buff, len); + state = state_start; state.warn = 0; // avoid double warnings - normalize(buff->buff, state, i); + normalize(buff->buff, &state, i); cetype_t chr_type = getCharCE(chrsxp); SEXP reschr = PROTECT(FANSI_mkChar(buff->buff, buff->buff + len, chr_type, i)); SET_STRING_ELT(res, i, reschr); UNPROTECT(1); + state_prev = state; } - UNPROTECT(1); + UNPROTECT(2); return res; } -SEXP FANSI_normalize_sgr_ext(SEXP x, SEXP warn, SEXP term_cap) { +SEXP FANSI_normalize_sgr_ext(SEXP x, SEXP warn, SEXP term_cap, SEXP carry) { if(TYPEOF(x) != STRSXP) error("Internal Error: `x` must be a character vector"); // nocov struct FANSI_buff buff = {.buff=NULL, .len=0}; - return normalize_sgr_int(x, warn, term_cap, &buff, 0); + return normalize_sgr_int(x, warn, term_cap, carry, &buff, 0); } // List version to use with result of `strwrap_ctl(..., unlist=FALSE)` // Just a lower overhead version. -SEXP FANSI_normalize_sgr_list_ext(SEXP x, SEXP warn, SEXP term_cap) { +SEXP FANSI_normalize_sgr_list_ext(SEXP x, SEXP warn, SEXP term_cap, SEXP carry) { if(TYPEOF(x) != VECSXP) error("Internal Error: `x` must be a list vector"); // nocov @@ -150,7 +169,9 @@ SEXP FANSI_normalize_sgr_list_ext(SEXP x, SEXP warn, SEXP term_cap) { for(R_xlen_t i = 0; i < llen; ++i) { SEXP elt0 = VECTOR_ELT(x, i); if(i0 > FANSI_lim.lim_R_xlen_t.max - XLENGTH(elt0)) i0 = 0; - SEXP elt1 = PROTECT(normalize_sgr_int(elt0, warn, term_cap, &buff, i0)); + SEXP elt1 = PROTECT( + normalize_sgr_int(elt0, warn, term_cap, carry, &buff, i0) + ); // If unequal, normalization occurred if(elt0 != elt1) { if(res == x) REPROTECT(res = duplicate(x), ipx); diff --git a/src/state.c b/src/state.c index 31480eb9..ae8cefaf 100644 --- a/src/state.c +++ b/src/state.c @@ -35,7 +35,7 @@ struct FANSI_state FANSI_state_init_full( if(TYPEOF(strsxp) != STRSXP) { error( "Internal error: state_init with bad type for strsxp (%s)", - type2char(TYPEOF(warn)) + type2char(TYPEOF(strsxp)) ); } if(i < 0 || i > XLENGTH(strsxp)) @@ -47,6 +47,8 @@ struct FANSI_state FANSI_state_init_full( FANSI_check_chrsxp(chrsxp, i); const char * string = CHAR(chrsxp); + // Validation not complete here, many of these should be scalar, rely on R + // level checks. if(TYPEOF(warn) != LGLSXP) error( "Internal error: state_init with bad type for warn (%s)", @@ -107,23 +109,28 @@ struct FANSI_state FANSI_state_init_full( .ctl = FANSI_ctl_as_int(ctl) }; } +// When we don't care about R_nchar width, but do care about CSI / SGR (which +// means, we only really care about SGR since all CSI does is affect width calc). + struct FANSI_state FANSI_state_init( SEXP strsxp, SEXP warn, SEXP term_cap, R_xlen_t i ) { SEXP R_false = PROTECT(ScalarLogical(0)); SEXP R_true = PROTECT(ScalarLogical(1)); SEXP R_zero = PROTECT(ScalarInteger(0)); + SEXP R_one = PROTECT(ScalarInteger(1)); struct FANSI_state res = FANSI_state_init_full( strsxp, warn, term_cap, R_true, // allowNA for invalid multibyte - R_false, + R_false, // keepNA R_zero, // Don't use width by default - R_zero, // Don't treat any escapes as special by default + R_one, // Treat all escapes as special by default (wrong prior to v1.0) i ); UNPROTECT(3); return res; } + struct FANSI_state FANSI_reset_width(struct FANSI_state state) { state.pos_width = 0; state.pos_width_target = 0; @@ -347,7 +354,7 @@ int FANSI_color_size(int color, int * color_extra) { * Generate the ANSI tag corresponding to the state and write it out as a NULL * terminated string. */ -static char * sgr_as_chr( +char * FANSI_sgr_as_chr( struct FANSI_buff *buff, struct FANSI_sgr sgr, int normalize, R_xlen_t i ) { // First pass computes total size of tag @@ -437,21 +444,16 @@ int FANSI_sgr_active(struct FANSI_sgr sgr) { * * Pretty inefficient to do it this way... * - * Any warnings this could emit should have been emitted earlier during reading - * of string the active state came from. - * * @param x should be a vector of active states at end of strings. */ -SEXP FANSI_sgr_close_ext(SEXP x, SEXP term_cap) { +SEXP FANSI_sgr_close_ext(SEXP x, SEXP warn, SEXP term_cap, SEXP norm) { if(TYPEOF(x) != STRSXP) error("Argument `x` should be a character vector."); // nocov - if(TYPEOF(term_cap) != INTSXP) - error("Argument `term.cap` should be an integer vector."); // nocov - - // Compress `ctl` into a single integer using bit flags + if(TYPEOF(norm) != INTSXP || XLENGTH(norm) != 1) + error("Argument `normalize` should be an integer vector."); // nocov R_xlen_t len = xlength(x); - SEXP res = x; + SEXP res = PROTECT(allocVector(STRSXP, len)); PROTECT_INDEX ipx; // reserve spot if we need to alloc later @@ -462,7 +464,6 @@ SEXP FANSI_sgr_close_ext(SEXP x, SEXP term_cap) { int normalize = 1; SEXP R_true = PROTECT(ScalarLogical(1)); - SEXP R_false = PROTECT(ScalarLogical(0)); SEXP R_one = PROTECT(ScalarInteger(1)); SEXP R_zero = PROTECT(ScalarInteger(0)); @@ -472,7 +473,7 @@ SEXP FANSI_sgr_close_ext(SEXP x, SEXP term_cap) { if(x_chr == NA_STRING || !LENGTH(x_chr)) continue; struct FANSI_state state = FANSI_state_init_full( - x, R_false, term_cap, R_true, R_true, R_zero, R_one, i + x, warn, term_cap, R_true, R_true, R_zero, R_one, i ); while(*(state.string + state.pos_byte)) { state = FANSI_read_next(state, i); @@ -493,7 +494,7 @@ SEXP FANSI_sgr_close_ext(SEXP x, SEXP term_cap) { } } FANSI_release_buff(&buff, 1); - UNPROTECT(5); + UNPROTECT(4); return res; } @@ -504,20 +505,19 @@ SEXP FANSI_sgr_close_ext(SEXP x, SEXP term_cap) { */ SEXP FANSI_state_at_pos_ext( - SEXP text, SEXP pos, SEXP type, + SEXP x, SEXP pos, SEXP type, SEXP lag, SEXP ends, SEXP warn, SEXP term_cap, SEXP ctl, - SEXP norm + SEXP norm, SEXP carry ) { /*******************************************\ * IMPORTANT: INPUT MUST ALREADY BE IN UTF8! * \*******************************************/ - // no errors should make it here, it should be handled R side - if(TYPEOF(text) != STRSXP && XLENGTH(text) != 1) - error("Argument `text` must be character(1L)."); // nocov - if(STRING_ELT(text, 0) == NA_STRING) - error("Argument `text` may not be NA."); // nocov + // errors shoudl be handled R side, but just in case + FANSI_val_args(x, norm, carry); + if(XLENGTH(x) != 1 || STRING_ELT(x, 0) == NA_STRING) + error("Argument `x` must be scalar character and not be NA."); // nocov if(TYPEOF(pos) != INTSXP) error("Argument `pos` must be integer."); // nocov if(TYPEOF(lag) != LGLSXP) @@ -526,18 +526,15 @@ SEXP FANSI_state_at_pos_ext( error("Argument `lag` must be the same length as `pos`."); // nocov if(XLENGTH(pos) != XLENGTH(ends)) error("Argument `ends` must be the same length as `pos`."); // nocov - if(TYPEOF(warn) != LGLSXP) - error("Argument `warn` must be integer."); // nocov - if(TYPEOF(term_cap) != INTSXP) - error("Argument `term.cap` must be integer."); // nocov - if(TYPEOF(ctl) != INTSXP) - error("Argument `ctl` must be integer."); // nocov - if(TYPEOF(norm) != LGLSXP) - error("Argument `norm` must be logical."); // nocov + SEXP R_true = PROTECT(ScalarLogical(1)); R_xlen_t len = XLENGTH(pos); int normalize = asInteger(norm); + // Read-in any pre-existing state to carry; we don't need to worry about + // explicitly handling carrying across positions as that + struct FANSI_sgr sgr_carry = FANSI_carry_init(carry, warn, term_cap, ctl); + const int res_cols = 4; // if change this, need to change rownames init if(len > R_XLEN_T_MAX / res_cols) { // nocov start @@ -582,12 +579,10 @@ SEXP FANSI_state_at_pos_ext( const char * empty = ""; SEXP res_chr, res_chr_prev = PROTECT(FANSI_mkChar(empty, empty, CE_NATIVE, (R_xlen_t) 0)); - // PROTECT should not be needed here, but rchk complaining - SEXP R_true = PROTECT(ScalarLogical(1)); struct FANSI_state state = FANSI_state_init_full( - text, warn, term_cap, R_true, R_true, type, ctl, (R_xlen_t) 0 + x, warn, term_cap, R_true, R_true, type, ctl, (R_xlen_t) 0 ); - UNPROTECT(1); + state.sgr = sgr_carry; struct FANSI_state state_prev = state; state_pair.cur = state; @@ -636,7 +631,7 @@ SEXP FANSI_state_at_pos_ext( if(FANSI_sgr_comp(state.sgr, state_prev.sgr)) { // this computes length twice..., we know state_char can be at most // INT_MAX excluding NULL (and certainly will be much less). - char * state_chr = sgr_as_chr(&buff, state.sgr, normalize, i); + char * state_chr = FANSI_sgr_as_chr(&buff, state.sgr, normalize, i); res_chr = PROTECT( FANSI_mkChar( state_chr, state_chr + strlen(state_chr), CE_NATIVE, i @@ -657,6 +652,6 @@ SEXP FANSI_state_at_pos_ext( SET_VECTOR_ELT(res_list, 0, res_str); SET_VECTOR_ELT(res_list, 1, res_mx); - UNPROTECT(7); + UNPROTECT(9); return(res_list); } diff --git a/src/tohtml.c b/src/tohtml.c index dc6e4999..dd484385 100644 --- a/src/tohtml.c +++ b/src/tohtml.c @@ -355,7 +355,9 @@ static int W_sgr_as_html( /* * Convert SGR Encoded Strings to their HTML equivalents */ -SEXP FANSI_esc_to_html(SEXP x, SEXP warn, SEXP term_cap, SEXP color_classes) { +SEXP FANSI_esc_to_html( + SEXP x, SEXP warn, SEXP term_cap, SEXP color_classes, SEXP carry +) { if(TYPEOF(x) != STRSXP) error("Internal Error: `x` must be a character vector"); // nocov if(TYPEOF(color_classes) != STRSXP) @@ -364,12 +366,19 @@ SEXP FANSI_esc_to_html(SEXP x, SEXP warn, SEXP term_cap, SEXP color_classes) { struct FANSI_buff buff; FANSI_INIT_BUFF(&buff); + SEXP ctl = PROTECT(ScalarInteger(1)); // "all" + int do_carry = STRING_ELT(carry, 1) != NA_STRING; + struct FANSI_sgr sgr_carry = FANSI_carry_init(carry, warn, term_cap, ctl); + UNPROTECT(1); + R_xlen_t x_len = XLENGTH(x); struct FANSI_state state, state_prev, state_init; SEXP empty = PROTECT(mkString("")); - state = state_prev = state_init = - FANSI_state_init(empty, warn, term_cap, (R_xlen_t) 0); + state = FANSI_state_init(empty, warn, term_cap, (R_xlen_t) 0); + state.sgr = sgr_carry; + state_prev = state_init = state; UNPROTECT(1); + const char * span_end = ""; int span_end_len = (int) strlen(span_end); @@ -388,7 +397,10 @@ SEXP FANSI_esc_to_html(SEXP x, SEXP warn, SEXP term_cap, SEXP color_classes) { // Reset position info and string; rest of state info is preserved from // prior line so that the state can be continued on new line. - state = FANSI_reset_pos(state_prev); + + if(do_carry) state = FANSI_reset_pos(state_prev); + else state = state_init; + state.string = string; struct FANSI_state state_start = FANSI_reset_pos(state); state_prev = state_init; // but there are no styles in the string yet diff --git a/src/utils.c b/src/utils.c index ee523675..7ec4f545 100644 --- a/src/utils.c +++ b/src/utils.c @@ -580,6 +580,22 @@ SEXP FANSI_mkChar( return mkCharLenCE(start, len, enc); } +static int is_tf(SEXP x) { + return TYPEOF(x) != LGLSXP || XLENGTH(x) != 1 || + LOGICAL(x)[0] != NA_LOGICAL; +} +/* + * Basic validation on common arguments + * + * Note FANSI_state_init_full also validates many of the common args + */ +void FANSI_val_args(SEXP x, SEXP norm, SEXP carry) { + if(TYPEOF(x) != STRSXP) + error("Argument `x` must be character."); // nocov + if(TYPEOF(carry) != STRSXP || XLENGTH(carry) != 1L) + error("Argument `carry` must be scalar character."); // nocov + if(!is_tf(norm)) error("Argument `norm` must be TRUE or FALSE."); // nocov +} void FANSI_print(char * x) { diff --git a/src/wrap.c b/src/wrap.c index 1ec904b4..05105f79 100644 --- a/src/wrap.c +++ b/src/wrap.c @@ -127,7 +127,7 @@ static SEXP writeline( struct FANSI_prefix_dat pre_dat, int tar_width, const char * pad_chr, R_xlen_t i, - int normalize + int normalize, int terminate ) { // First thing we need to do is check whether we need to pad as that affects // how we treat the boundary. @@ -175,7 +175,7 @@ static SEXP writeline( // Check if we are in a CSI state b/c if we need extra room for // the closing state tag int needs_start = FANSI_sgr_active(state_start.sgr); - int needs_close = FANSI_sgr_active(state_bound.sgr); + int needs_close = terminate && FANSI_sgr_active(state_bound.sgr); // Measure/Write loop (see src/write.c) char * buff_track = NULL; @@ -254,7 +254,10 @@ static SEXP strwrap( SEXP warn, SEXP term_cap, int first_only, SEXP ctl, R_xlen_t index, - int normalize + int normalize, + int carry, + struct FANSI_sgr * sgr_carry, + int terminate ) { SEXP R_true = PROTECT(ScalarLogical(1)); SEXP R_one = PROTECT(ScalarInteger(1)); @@ -294,6 +297,7 @@ static SEXP strwrap( // Need to keep track of where word boundaries start and end due to // possibility for multiple elements between words + if(carry) state.sgr = *sgr_carry; struct FANSI_state state_start, state_bound, state_prev; state_start = state_bound = state_prev = state; R_xlen_t size = 0; @@ -382,7 +386,7 @@ static SEXP strwrap( writeline( state_bound, state_start, buff, para_start ? pre_first : pre_next, - width_tar, pad_chr, index, normalize + width_tar, pad_chr, index, normalize, terminate ) ); first_line = 0; @@ -393,7 +397,13 @@ static SEXP strwrap( SETCDR(char_list, list1(res_sxp)); char_list = CDR(char_list); UNPROTECT(1); - } else break; + } else { + // Need end state if in trim mode and we wish to carry + if(carry) + while(state.string[state.pos_byte]) + state = FANSI_read_next(state, index); + break; + } // overflow should be impossible here since string is at most int long ++size; @@ -450,6 +460,7 @@ static SEXP strwrap( res = res_sxp; } UNPROTECT(2); + *sgr_carry = state.sgr; return res; } @@ -473,27 +484,25 @@ SEXP FANSI_strwrap_ext( SEXP tabs_as_spaces, SEXP tab_stops, SEXP warn, SEXP term_cap, SEXP first_only, - SEXP ctl, SEXP norm + SEXP ctl, SEXP norm, SEXP carry, + SEXP terminate ) { + FANSI_val_args(x, norm, carry); + // FANSI_state_init does validations too if( - TYPEOF(x) != STRSXP || TYPEOF(width) != INTSXP || + TYPEOF(width) != INTSXP || TYPEOF(indent) != INTSXP || TYPEOF(exdent) != INTSXP || TYPEOF(prefix) != STRSXP || TYPEOF(initial) != STRSXP || TYPEOF(wrap_always) != LGLSXP || TYPEOF(pad_end) != STRSXP || - TYPEOF(warn) != LGLSXP || TYPEOF(term_cap) != INTSXP || TYPEOF(strip_spaces) != LGLSXP || TYPEOF(tabs_as_spaces) != LGLSXP || TYPEOF(tab_stops) != INTSXP || TYPEOF(first_only) != LGLSXP || - TYPEOF(ctl) != INTSXP || - TYPEOF(norm) != LGLSXP + TYPEOF(terminate) != LGLSXP ) error("Internal Error: arg type error 1; contact maintainer."); // nocov - if(XLENGTH(norm) != 1) - error("Internal Error: arg norm should be scalar."); // nocov - int normalize = asLogical(norm); const char * pad = CHAR(asChar(pad_end)); @@ -543,20 +552,17 @@ SEXP FANSI_strwrap_ext( // Set up the buffer, this will be created in FANSI_strwrap, but we want a // handle for it here so we can re-use. // WARNING: must be after pad_pre as pad_pre uses R_alloc. - struct FANSI_buff buff; FANSI_INIT_BUFF(&buff); // Strip whitespaces as needed; `strwrap` doesn't seem to do this with prefix // and initial, so we don't either - int strip_spaces_int = asInteger(strip_spaces); if(strip_spaces_int) x = PROTECT(FANSI_process(x, &buff)); else PROTECT(x); // and tabs - if(asInteger(tabs_as_spaces)) { x = PROTECT(FANSI_tabs_as_spaces(x, tab_stops, &buff, warn, term_cap, ctl)); prefix = PROTECT( @@ -568,10 +574,8 @@ SEXP FANSI_strwrap_ext( } else x = PROTECT(PROTECT(PROTECT(x))); // PROTECT stack balance - // Check that widths are feasible, although really only relevant if in strict // mode - int width_int = asInteger(width); int wrap_always_int = asInteger(wrap_always); @@ -588,10 +592,14 @@ SEXP FANSI_strwrap_ext( "and `prefix` width must be less than `width - 1` when in `wrap.always`." ); + // Prep for carry + int do_carry = STRING_ELT(carry, 1) != NA_STRING; + struct FANSI_sgr sgr_carry = FANSI_carry_init(carry, warn, term_cap, ctl); + UNPROTECT(1); + // Could be a little faster avoiding this allocation if it turns out nothing // needs to be wrapped and we're in simplify=TRUE, but that seems like a lot // of work for a rare event - R_xlen_t i, x_len = XLENGTH(x); SEXP res; @@ -601,8 +609,8 @@ SEXP FANSI_strwrap_ext( } else { res = PROTECT(allocVector(VECSXP, x_len)); } - // Wrap each element + // Wrap each element for(i = 0; i < x_len; ++i) { FANSI_interrupt(i); SEXP chr = STRING_ELT(x, i); @@ -618,7 +626,10 @@ SEXP FANSI_strwrap_ext( strip_spaces_int, warn, term_cap, first_only_int, - ctl, i, normalize + ctl, i, normalize, + do_carry, + &sgr_carry, + asLogical(terminate) ) ); if(first_only_int) { SET_STRING_ELT(res, i, str_i); From 7f58d7ea474b63f833336202846a74fe17941a86 Mon Sep 17 00:00:00 2001 From: brodieG Date: Sun, 13 Jun 2021 08:15:23 -0400 Subject: [PATCH 04/20] implement carry/terminate in substr2 --- R/substr2.R | 29 ++++++++++++++++------------- 1 file changed, 16 insertions(+), 13 deletions(-) diff --git a/R/substr2.R b/R/substr2.R index c62846f9..4117ccc7 100644 --- a/R/substr2.R +++ b/R/substr2.R @@ -67,7 +67,7 @@ #' @seealso [`fansi`] for details on how _Control Sequences_ are #' interpreted, particularly if you are getting unexpected results, #' [`normalize_sgr`] for more details on what the `normalize` parameter does. -#' @param x a character vector or object that can be coerced to character. +#' @param x a character vector or object that can be coerced to such. #' @param type character(1L) partial matching `c("chars", "width")`, although #' `type="width"` only works correctly with R >= 3.2.2. With "width", whether #' C0 and C1 are treated as zero width may depend on R version and locale in @@ -264,12 +264,14 @@ substr_ctl_internal <- function( # If we want to carry, we'll do this manually as too much work to try to do it # in C given the current structure using ordered indices into each string. + # Do before `unique` as this to equal strings may become different. - stop("Implement carry.") - - x.scalar <- length(x) == 1 - x.u <- if(x.scalar) x else unique_chr(x) - + if(!is.na(carry)) { + ends <- .Call( + FANSI_sgr_at_end, x, warn, term.cap.int, ctl.int, normalize, carry + ) + x <- paste0(c(carry, ends[-length(ends)]), x) + } # We compute style at each start and stop position by getting all those # positions into a vector and then ordering them by position, keeping track of # original order and whether they are starting or ending positions (affects @@ -278,6 +280,9 @@ substr_ctl_internal <- function( # We do this for each unique string in `x` as the indices must be incrementing # for each of them. + x.scalar <- length(x) == 1 + x.u <- if(x.scalar) x else unique_chr(x) + for(u in x.u) { elems <- which(x == u & s.s.valid) elems.len <- length(elems) @@ -316,14 +321,12 @@ substr_ctl_internal <- function( start.tag <- state[[1]][start.ansi.idx] stop.tag <- state[[1]][stop.ansi.idx] - # if there is any ANSI CSI at end then add a terminating CSI + # if there is any ANSI CSI at end then add a terminating CSI, warnings + # should have been issued on first read - if(normalize) { - end.csi <- close_sgr(stop.tag) - } else { - end.csi <- character(length(stop.tag)) - end.csi[nzchar(stop.tag)] <- '\033[0m' - } + end.csi <- + if(terminate) close_sgr(stop.tag, warn=FALSE, term.cap.int, normalize) + else "" tmp <- paste0( start.tag, substr(x.elems, start.ansi, stop.ansi) From 5f98c47e0f1f82f3c1eae9b1f9ab863d297ff589 Mon Sep 17 00:00:00 2001 From: brodieG Date: Sun, 13 Jun 2021 08:17:57 -0400 Subject: [PATCH 05/20] docs --- DESCRIPTION | 2 ++ DEVNOTES.md | 8 +++++++- R/normalize.R | 2 ++ R/tohtml.R | 6 ++++++ 4 files changed, 17 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index c4e0e02e..1ea10369 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -43,3 +43,5 @@ Collate: 'tohtml.R' 'unhandled.R' 'normalize.R' + 'carry.R' + 'sgr.R' diff --git a/DEVNOTES.md b/DEVNOTES.md index 6eb024ee..a93b6028 100644 --- a/DEVNOTES.md +++ b/DEVNOTES.md @@ -4,7 +4,11 @@ These are internal developer notes. ## Todo -* Are we checking byte encoding on e.g. pre/pad, etc.? +* It's possible we messed up and `sgr_to_html` had carry semantics whereas other + stuff did not. + +* Check whether anything other than `substr_ctl` uses `state_at_pos` and thus + the assumptions about carry being handled externally might be incorrect. * Rationalize type checking on entry into C code given that state init already checks many of them. * Move the interrupt to be `_read_next` based with an unsigned counter? With @@ -40,6 +44,8 @@ These are internal developer notes. ## Done +* Are we checking byte encoding on e.g. pre/pad, etc.? + * Write docs about behavior of bleeding. * Can we manage the stack better with the growing buffer so we don't keep all diff --git a/R/normalize.R b/R/normalize.R index 7cdc8c72..b5ec6294 100644 --- a/R/normalize.R +++ b/R/normalize.R @@ -81,6 +81,8 @@ normalize_sgr <- function( normalize_sgr_list <- function(x, warn, term.cap.int) .Call(FANSI_normalize_sgr_list, x, warn, term.cap.int) +# Given an SGR, compute the sequence that closes it + close_sgr <- function(x) { .Call(FANSI_close_sgr, x, seq_along(VALID.TERM.CAP)) } diff --git a/R/tohtml.R b/R/tohtml.R index 942d70a6..0d4e0681 100644 --- a/R/tohtml.R +++ b/R/tohtml.R @@ -85,9 +85,15 @@ #' * character(512): Like character(16), except the basic, bright, and all #' other 8-bit colors are mapped. #' +#' @note Up to version 0.5.0, `html_esc` implicitly operated as if +#' `carry = TRUE`. This was different from other functions and was +#' changed to be consistent with them after that version. #' @return A character vector of the same length as `x` with all escape #' sequences removed and any basic ANSI CSI SGR escape sequences applied via #' SPAN HTML tags. +#' @note `sgr_to_html` always terminates as not doing so produces +#' invalid HTML. If you wish for the last active SPAN to bleed into +#' subsequent text you may do so with e.g. `sub("$", "", x)`. #' @examples #' sgr_to_html("hello\033[31;42;1mworld\033[m") #' sgr_to_html("hello\033[31;42;1mworld\033[m", classes=TRUE) From a107bbb2078e309349492f70f3cfbccb95c7a844 Mon Sep 17 00:00:00 2001 From: brodieG Date: Sun, 13 Jun 2021 08:18:58 -0400 Subject: [PATCH 06/20] fix validation bugs --- R/internal.R | 29 +++++++++++++++++++---------- 1 file changed, 19 insertions(+), 10 deletions(-) diff --git a/R/internal.R b/R/internal.R index fa79423e..996dd03f 100644 --- a/R/internal.R +++ b/R/internal.R @@ -59,37 +59,41 @@ ctl_as_int <- function(x) .Call(FANSI_ctl_as_int, as.integer(x)) ## Common argument validation and conversion. Missing args okay. validate <- function(...) { - call <- sys.cal(-1) + call <- sys.call(-1) stop2 <- function(x) stop(simpleError(x, call)) args <- list(...) if( - !all(names(args)) %in% - c( - 'x', 'warn', 'term.cap', 'ctl', 'normalize', 'carry', 'terminate', - 'tab.stops', 'tabs.as.spaces', 'strip.spaces' - ) - ) + !all( + names(args) %in% + c( + 'x', 'warn', 'term.cap', 'ctl', 'normalize', 'carry', 'terminate', + 'tab.stops', 'tabs.as.spaces', 'strip.spaces' + ) ) ) stop("Internal Error: some arguments to validate unknown") if('x' %in% names(args)) { - if(!is.character(x)) x <- as.character(x) + x <- args[['x']] + if(!is.character(x)) x <- as.character(args[['x']]) x <- enc2utf8(x) if(any(Encoding(x) == "bytes")) stop2("BYTE encoded strings are not supported.") args[['x']] <- x } if('warn' %in% names(args)) { - if(!is.logical(warn)) warn <- as.logical(warn) + warn <- args[['warn']] + if(!is.logical(warn)) warn <- as.logical(args[['warn']]) if(length(warn) != 1L || is.na(warn)) stop2("Argument `warn` must be TRUE or FALSE.") args[['warn']] <- warn } if('normalize' %in% names(args)) { + normalize <- args[['normalize']] if(!isTRUE(normalize %in% c(FALSE, TRUE))) stop2("Argument `normalize` must be TRUE or FALSE.") args[['normalize']] <- as.logical(normalize) } if('term.cap' %in% names(args)) { + term.cap <- args[['term.cap']] if(!is.character(term.cap)) stop2("Argument `term.cap` must be character.") if(anyNA(term.cap.int <- match(term.cap, VALID.TERM.CAP))) @@ -100,6 +104,7 @@ validate <- function(...) { args[['term.cap.int']] <- term.cap.int } if('ctl' %in% names(args)) { + ctl <- args[['ctl']] if(!is.character(ctl)) stop2("Argument `ctl` must be character.") ctl.int <- integer() @@ -114,6 +119,7 @@ validate <- function(...) { args[['ctl.int']] <- ctl.int } if('carry' %in% names(args)) { + carry <- args[['carry']] if(length(carry) != 1L) stop2("Argument `carry` must be scalar.") if(!is.logical(carry) && !is.character(carry)) @@ -125,11 +131,13 @@ validate <- function(...) { args[['carry']] <- carry } if('terminate' %in% names(args)) { + terminate <- args[['terminate']] if(!isTRUE(terminate %in% c(TRUE, FALSE))) stop2("Argument `terminate` must be TRUE or FALSE") terminate <- as.logical(terminate) } if('tab.stops' %in% names(args)) { + tab.stops <- args[['tab.stops']] if( !is.numeric(tab.stops) || !length(tab.stops) || any(tab.stops < 1) || anyNA(tab.stops) @@ -138,9 +146,10 @@ validate <- function(...) { "Argument `tab.stops` must be numeric, strictly positive, and ", "representable as an integer." ) - ags[['tab.stops']] <- as.integer(tab.stops) + args[['tab.stops']] <- as.integer(tab.stops) } if('tabs.as.spaces' %in% names(args)) { + tabs.as.spaces <- args[['tabs.as.spaces']] if(!is.logical(tabs.as.spaces)) tabs.as.spaces <- as.logical(tabs.as.spaces) if(length(tabs.as.spaces) != 1L || is.na(tabs.as.spaces)) stop("Argument `tabs.as.spaces` must be TRUE or FALSE.") From 4b0190e70e10f318481bd4cebd9dbaead9fe023c Mon Sep 17 00:00:00 2001 From: brodieG Date: Sun, 13 Jun 2021 08:19:16 -0400 Subject: [PATCH 07/20] cleanup --- R/strtrim.R | 2 +- R/strwrap.R | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/strtrim.R b/R/strtrim.R index 73d60030..bff51552 100644 --- a/R/strtrim.R +++ b/R/strtrim.R @@ -88,7 +88,7 @@ strtrim2_ctl <- function( ) { args <- validate( x=x, warn=warn, ctl=ctl, - tabs.as.spaces=tabs.as.spaces, tab.stops=tab.stops + tabs.as.spaces=tabs.as.spaces, tab.stops=tab.stops, normalize=normalize, carry=carry, terminate=terminate ) diff --git a/R/strwrap.R b/R/strwrap.R index b834b22d..9149dea4 100644 --- a/R/strwrap.R +++ b/R/strwrap.R @@ -241,7 +241,7 @@ strwrap2_sgr <- function( validate_wrap_basic <- function( width, indent, exdent, prefix, initial, pad.end ) { - call <- sys.cal(-1) + call <- sys.call(-1) stop2 <- function(x) stop(simpleError(x, call)) is_scl_int_pos <- function(x, name, strict=FALSE) { x <- as.integer(x) From cc65e59e5a168437c0b80cec20f0854e3472b14f Mon Sep 17 00:00:00 2001 From: brodieG Date: Sun, 13 Jun 2021 08:34:12 -0400 Subject: [PATCH 08/20] remove files with moved code --- R/has.R | 54 --------------------------------- R/strip.R | 89 ------------------------------------------------------- 2 files changed, 143 deletions(-) delete mode 100644 R/has.R delete mode 100644 R/strip.R diff --git a/R/has.R b/R/has.R deleted file mode 100644 index 10ac5521..00000000 --- a/R/has.R +++ /dev/null @@ -1,54 +0,0 @@ -## Copyright (C) 2021 Brodie Gaslam -## -## This file is part of "fansi - ANSI Control Sequence Aware String Functions" -## -## This program is free software: you can redistribute it and/or modify -## it under the terms of the GNU General Public License as published by -## the Free Software Foundation, either version 2 of the License, or -## (at your option) any later version. -## -## This program is distributed in the hope that it will be useful, -## but WITHOUT ANY WARRANTY; without even the implied warranty of -## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -## GNU General Public License for more details. -## -## Go to for a copy of the license. - -#' Checks for Presence of Control Sequences -#' -#' `has_ctl` checks for any _Control Sequence_, whereas `has_sgr` checks only -#' for ANSI CSI SGR sequences. You can check for different types of sequences -#' with the `ctl` parameter. -#' -#' @export -#' @seealso [fansi] for details on how _Control Sequences_ are -#' interpreted, particularly if you are getting unexpected results. -#' @inheritParams substr_ctl -#' @inheritParams strip_ctl -#' @inheritSection substr_ctl _ctl vs. _sgr -#' @param which character, deprecated in favor of `ctl`. -#' @return logical of same length as `x`; NA values in `x` result in NA values -#' in return -#' @examples -#' has_ctl("hello world") -#' has_ctl("hello\nworld") -#' has_ctl("hello\nworld", "sgr") -#' has_ctl("hello\033[31mworld\033[m", "sgr") -#' has_sgr("hello\033[31mworld\033[m") -#' has_sgr("hello\nworld") - -has_ctl <- function(x, ctl='all', warn=getOption('fansi.warn'), which) { - if(!missing(which)) { - message("Parameter `which` has been deprecated; use `ctl` instead.") - ctl <- which - } - args <- validate(x=x, ctl=ctl, warn=warn) - if(length(ctl.int)) { - with(args, .Call(FANSI_has_csi, x, ctl.int, warn)) - } else rep(FALSE, length(x)) -} -#' @export -#' @rdname has_ctl - -has_sgr <- function(x, warn=getOption('fansi.warn')) - has_ctl(x, ctl="sgr", warn=warn) diff --git a/R/strip.R b/R/strip.R deleted file mode 100644 index 115ab791..00000000 --- a/R/strip.R +++ /dev/null @@ -1,89 +0,0 @@ -## Copyright (C) 2021 Brodie Gaslam -## -## This file is part of "fansi - ANSI Control Sequence Aware String Functions" -## -## This program is free software: you can redistribute it and/or modify -## it under the terms of the GNU General Public License as published by -## the Free Software Foundation, either version 2 of the License, or -## (at your option) any later version. -## -## This program is distributed in the hope that it will be useful, -## but WITHOUT ANY WARRANTY; without even the implied warranty of -## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -## GNU General Public License for more details. -## -## Go to for a copy of the license. - -#' Strip ANSI Control Sequences -#' -#' Removes _Control Sequences_ from strings. By default it will -#' strip all known _Control Sequences_, including ANSI CSI -#' sequences, two character sequences starting with ESC, and all C0 control -#' characters, including newlines. You can fine tune this behavior with the -#' `ctl` parameter. `strip_sgr` only strips ANSI CSI SGR sequences. -#' -#' The `ctl` value contains the names of **non-overlapping** subsets of the -#' known _Control Sequences_ (e.g. "csi" does not contain "sgr", and "c0" does -#' not contain newlines). The one exception is "all" which means strip every -#' known sequence. If you combine "all" with any other option then everything -#' **but** that option will be stripped. -#' -#' @note Non-ASCII strings are converted to and returned in UTF-8 encoding. -#' @seealso [fansi] for details on how _Control Sequences_ are -#' interpreted, particularly if you are getting unexpected results. -#' @inheritParams substr_ctl -#' @inheritSection substr_ctl _ctl vs. _sgr -#' @export -#' @param ctl character, any combination of the following values (see details): -#' * "nl": strip newlines. -#' * "c0": strip all other "C0" control characters (i.e. x01-x1f, x7F), -#' except for newlines and the actual ESC character. -#' * "sgr": strip ANSI CSI SGR sequences. -#' * "csi": strip all non-SGR csi sequences. -#' * "esc": strip all other escape sequences. -#' * "all": all of the above, except when used in combination with any of the -#' above, in which case it means "all but" (see details). -#' @param strip character, deprecated in favor of `ctl`. -#' @return character vector of same length as x with ANSI escape sequences -#' stripped -#' @examples -#' string <- "hello\033k\033[45p world\n\033[31mgoodbye\a moon" -#' strip_ctl(string) -#' strip_ctl(string, c("nl", "c0", "sgr", "csi", "esc")) # equivalently -#' strip_ctl(string, "sgr") -#' strip_ctl(string, c("c0", "esc")) -#' -#' ## everything but C0 controls, we need to specify "nl" -#' ## in addition to "c0" since "nl" is not part of "c0" -#' ## as far as the `strip` argument is concerned -#' strip_ctl(string, c("all", "nl", "c0")) -#' -#' ## convenience function, same as `strip_ctl(ctl='sgr')` -#' strip_sgr(string) - -strip_ctl <- function(x, ctl='all', warn=getOption('fansi.warn'), strip) { - if(!missing(strip)) { - message("Parameter `strip` has been deprecated; use `ctl` instead.") - ctl <- strip - } - args <- validate(x=x, ctl=ctl, warn=warn) - - if(length(ctl)) { - with(args, .Call(FANSI_strip_csi, enc2utf8(x), ctl.int, warn)) - } else x -} -#' @export -#' @rdname strip_ctl - -strip_sgr <- function(x, warn=getOption('fansi.warn')) { - args <- validate(x=x, warn=warn) - ctl.int <- match("sgr", VALID.CTL) - with(args, .Call(FANSI_strip_csi, x, ctl.int, warn)) -} - -## Process String by Removing Unwanted Characters -## -## This is to simulate what `strwrap` does, exposed for testing purposes. - -process <- function(x) .Call(FANSI_process, enc2utf8(x)) - From f24c8107e48844c83013f3104949e3c7f66f51b8 Mon Sep 17 00:00:00 2001 From: brodieG Date: Sun, 13 Jun 2021 08:34:54 -0400 Subject: [PATCH 09/20] close_sgr moved to sgr.R --- R/normalize.R | 6 ------ 1 file changed, 6 deletions(-) diff --git a/R/normalize.R b/R/normalize.R index b5ec6294..d6a30e92 100644 --- a/R/normalize.R +++ b/R/normalize.R @@ -81,9 +81,3 @@ normalize_sgr <- function( normalize_sgr_list <- function(x, warn, term.cap.int) .Call(FANSI_normalize_sgr_list, x, warn, term.cap.int) -# Given an SGR, compute the sequence that closes it - -close_sgr <- function(x) { - .Call(FANSI_close_sgr, x, seq_along(VALID.TERM.CAP)) -} - From df2f973b45a8c39dd53517334c5924f3f8fd7511 Mon Sep 17 00:00:00 2001 From: brodieG Date: Sun, 13 Jun 2021 08:35:04 -0400 Subject: [PATCH 10/20] cleanup bad args --- R/carry.R | 4 +++- R/substr2.R | 5 +++-- 2 files changed, 6 insertions(+), 3 deletions(-) diff --git a/R/carry.R b/R/carry.R index a4a02138..1e62ef73 100644 --- a/R/carry.R +++ b/R/carry.R @@ -26,6 +26,8 @@ sgr_at_end <- function( ) with( args, - .Call(FANSI_sgr_at_end, x, warn, term.cap.int, ctl.int, normalize, carry) + .Call( + FANSI_sgr_at_end, x, warn, term.cap.int, ctl.int, normalize, carry + ) ) } diff --git a/R/substr2.R b/R/substr2.R index 4117ccc7..30640af5 100644 --- a/R/substr2.R +++ b/R/substr2.R @@ -202,7 +202,8 @@ substr2_ctl <- function( round.start=round == 'start' || round == 'both', round.stop=round == 'stop' || round == 'both', x.len=length(x), - ctl.int=ctl.int, normalize=normalize + ctl.int=ctl.int, normalize=normalize, + carry=carry, terminate=terminate ) ) res[!no.na] <- NA_character_ @@ -325,7 +326,7 @@ substr_ctl_internal <- function( # should have been issued on first read end.csi <- - if(terminate) close_sgr(stop.tag, warn=FALSE, term.cap.int, normalize) + if(terminate) close_sgr(stop.tag, warn=FALSE, normalize) else "" tmp <- paste0( start.tag, From 538adf53d06365a749ab77e42907ee45078fd1cf Mon Sep 17 00:00:00 2001 From: brodieG Date: Sun, 13 Jun 2021 08:36:41 -0400 Subject: [PATCH 11/20] actually add R/sgr.R --- R/sgr.R | 192 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 192 insertions(+) create mode 100644 R/sgr.R diff --git a/R/sgr.R b/R/sgr.R new file mode 100644 index 00000000..b86f1079 --- /dev/null +++ b/R/sgr.R @@ -0,0 +1,192 @@ +## Copyright (C) 2021 Brodie Gaslam +## +## This file is part of "fansi - ANSI Control Sequence Aware String Functions" +## +## This program is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 2 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## Go to for a copy of the license. + +#' Strip ANSI Control Sequences +#' +#' Removes _Control Sequences_ from strings. By default it will +#' strip all known _Control Sequences_, including ANSI CSI +#' sequences, two character sequences starting with ESC, and all C0 control +#' characters, including newlines. You can fine tune this behavior with the +#' `ctl` parameter. `strip_sgr` only strips ANSI CSI SGR sequences. +#' +#' The `ctl` value contains the names of **non-overlapping** subsets of the +#' known _Control Sequences_ (e.g. "csi" does not contain "sgr", and "c0" does +#' not contain newlines). The one exception is "all" which means strip every +#' known sequence. If you combine "all" with any other option then everything +#' **but** that option will be stripped. +#' +#' @note Non-ASCII strings are converted to and returned in UTF-8 encoding. +#' @seealso [fansi] for details on how _Control Sequences_ are +#' interpreted, particularly if you are getting unexpected results. +#' @inheritParams substr_ctl +#' @inheritSection substr_ctl _ctl vs. _sgr +#' @export +#' @param ctl character, any combination of the following values (see details): +#' * "nl": strip newlines. +#' * "c0": strip all other "C0" control characters (i.e. x01-x1f, x7F), +#' except for newlines and the actual ESC character. +#' * "sgr": strip ANSI CSI SGR sequences. +#' * "csi": strip all non-SGR csi sequences. +#' * "esc": strip all other escape sequences. +#' * "all": all of the above, except when used in combination with any of the +#' above, in which case it means "all but" (see details). +#' @param strip character, deprecated in favor of `ctl`. +#' @return character vector of same length as x with ANSI escape sequences +#' stripped +#' @examples +#' string <- "hello\033k\033[45p world\n\033[31mgoodbye\a moon" +#' strip_ctl(string) +#' strip_ctl(string, c("nl", "c0", "sgr", "csi", "esc")) # equivalently +#' strip_ctl(string, "sgr") +#' strip_ctl(string, c("c0", "esc")) +#' +#' ## everything but C0 controls, we need to specify "nl" +#' ## in addition to "c0" since "nl" is not part of "c0" +#' ## as far as the `strip` argument is concerned +#' strip_ctl(string, c("all", "nl", "c0")) +#' +#' ## convenience function, same as `strip_ctl(ctl='sgr')` +#' strip_sgr(string) + +strip_ctl <- function(x, ctl='all', warn=getOption('fansi.warn'), strip) { + if(!missing(strip)) { + message("Parameter `strip` has been deprecated; use `ctl` instead.") + ctl <- strip + } + args <- validate(x=x, ctl=ctl, warn=warn) + + if(length(ctl)) { + with(args, .Call(FANSI_strip_csi, enc2utf8(x), ctl.int, warn)) + } else x +} +#' @export +#' @rdname strip_ctl + +strip_sgr <- function(x, warn=getOption('fansi.warn')) { + args <- validate(x=x, warn=warn) + ctl.int <- match("sgr", VALID.CTL) + with(args, .Call(FANSI_strip_csi, x, ctl.int, warn)) +} + +#' Checks for Presence of Control Sequences +#' +#' `has_ctl` checks for any _Control Sequence_, whereas `has_sgr` checks only +#' for ANSI CSI SGR sequences. You can check for different types of sequences +#' with the `ctl` parameter. +#' +#' @export +#' @seealso [fansi] for details on how _Control Sequences_ are +#' interpreted, particularly if you are getting unexpected results. +#' @inheritParams substr_ctl +#' @inheritParams strip_ctl +#' @inheritSection substr_ctl _ctl vs. _sgr +#' @param which character, deprecated in favor of `ctl`. +#' @return logical of same length as `x`; NA values in `x` result in NA values +#' in return +#' @examples +#' has_ctl("hello world") +#' has_ctl("hello\nworld") +#' has_ctl("hello\nworld", "sgr") +#' has_ctl("hello\033[31mworld\033[m", "sgr") +#' has_sgr("hello\033[31mworld\033[m") +#' has_sgr("hello\nworld") + +has_ctl <- function(x, ctl='all', warn=getOption('fansi.warn'), which) { + if(!missing(which)) { + message("Parameter `which` has been deprecated; use `ctl` instead.") + ctl <- which + } + args <- validate(x=x, ctl=ctl, warn=warn) + if(length(ctl.int)) { + with(args, .Call(FANSI_has_csi, x, ctl.int, warn)) + } else rep(FALSE, length(x)) +} +#' @export +#' @rdname has_ctl + +has_sgr <- function(x, warn=getOption('fansi.warn')) + has_ctl(x, ctl="sgr", warn=warn) + +#' Utilities for Managing SGR In Strings +#' +#' `sgr_at_end` read input strings computing the accumulated SGR codes until the +#' end of the string and outputs the active SGR code at the end of it. +#' +#' `close_sgr` produces the ANSI CSI SGR sequence that closes active SGR codes +#' at the end of the input string. If `normalize = FALSE` (default), it will +#' issue the global closing SGR "ESC[0m", so it is only interesting if +#' `normalize = TRUE`. Unlike `sgr_at_end` and other functions `close_sgr` has +#' no concept of `carry`: it will only close SGR codes activated within each +#' element. +#' +#' @export +#' @inheritParams substr_ctl +#' @return character vector same length as `x`. +#' @examples +#' x <- c("\033[44mhello", "\033[33mworld") +#' sgr_at_end(x) +#' sgr_at_end(x, carry=TRUE) +#' (close <- close_sgr(sgr_at_end(x, carry=TRUE), normalize=TRUE)) +#' writeLines(paste0(x, close, " no style")) + +sgr_at_end <- function( + x, + warn=getOption('fansi.warn'), + term.cap=getOption('fansi.term.cap'), + normalize=getOption('fansi.normalize', FALSE), + carry=getOption('fansi.carry', FALSE) +) { + args <- validate(x=x, ctl='sgr', warn=warn, term.cap=term.cap, carry=carry) + with( + args, + .Call( + FANSI_sgr_at_end, + x, + 0L, # character type + warn, + term.cap.int, + ctl.int, + normalize, + carry + ) ) +} + +# Given an SGR, compute the sequence that closes it + +#' @export +#' @rdname sgr_at_end + +close_sgr <- function( + x, + warn=getOption('fansi.warn'), + normalize=getOption('fansi.normalize', FALSE) +) { + args <- validate( + x=x, warn=warn, normalize=normalize + ) + with( + args, + .Call(FANSI_close_sgr, x, warn, seq_along(VALID.TERM.CAP), normalize) + ) +} + + +## Process String by Removing Unwanted Characters +## +## This is to simulate what `strwrap` does, exposed for testing purposes. + +process <- function(x) .Call(FANSI_process, enc2utf8(x)) + From 52b8189605cb6cc47bd785004e76f5161373ac98 Mon Sep 17 00:00:00 2001 From: brodieG Date: Sun, 13 Jun 2021 20:37:51 -0400 Subject: [PATCH 12/20] fix bad protection/arg counts --- src/carry.c | 15 +++++++++------ src/init.c | 2 +- src/state.c | 37 ++++++++++++++++++++----------------- 3 files changed, 30 insertions(+), 24 deletions(-) diff --git a/src/carry.c b/src/carry.c index da383b66..299d20df 100644 --- a/src/carry.c +++ b/src/carry.c @@ -83,13 +83,16 @@ SEXP FANSI_sgr_at_end_ext( struct FANSI_sgr FANSI_carry_init( SEXP carry, SEXP warn, SEXP term_cap, SEXP ctl ) { + int prt = 0; int do_carry = STRING_ELT(carry, 1) != NA_STRING; SEXP carry_string; - if(do_carry) carry_string = PROTECT(carry); - else carry_string = PROTECT(mkString("")); - - SEXP R_true = PROTECT(ScalarLogical(1)); - SEXP R_zero = PROTECT(ScalarInteger(0)); + if(do_carry) { + carry_string = PROTECT(carry); ++prt; + } else { + carry_string = PROTECT(mkString("")); ++prt; + } + SEXP R_true = PROTECT(ScalarLogical(1)); ++prt; + SEXP R_zero = PROTECT(ScalarInteger(0)); ++prt; // Read-in any pre-existing state to carry struct FANSI_state state_carry = FANSI_state_init_full( @@ -98,7 +101,7 @@ struct FANSI_sgr FANSI_carry_init( ctl, (R_xlen_t) 0 ); state_carry = state_at_end(state_carry, (R_xlen_t) 0); - UNPROTECT(3); + UNPROTECT(prt); return state_carry.sgr; } diff --git a/src/init.c b/src/init.c index 7cdb905c..a2da6c80 100644 --- a/src/init.c +++ b/src/init.c @@ -24,7 +24,7 @@ R_CallMethodDef callMethods[] = { {"has_csi", (DL_FUNC) &FANSI_has, 3}, {"strip_csi", (DL_FUNC) &FANSI_strip, 3}, {"strwrap_csi", (DL_FUNC) &FANSI_strwrap_ext, 18}, - {"state_at_pos_ext", (DL_FUNC) &FANSI_state_at_pos_ext, 11}, + {"state_at_pos_ext", (DL_FUNC) &FANSI_state_at_pos_ext, 10}, {"process", (DL_FUNC) &FANSI_process_ext, 1}, {"check_assumptions", (DL_FUNC) &FANSI_check_assumptions, 0}, {"digits_in_int", (DL_FUNC) &FANSI_digits_in_int_ext, 1}, diff --git a/src/state.c b/src/state.c index ae8cefaf..9d668a44 100644 --- a/src/state.c +++ b/src/state.c @@ -447,25 +447,27 @@ int FANSI_sgr_active(struct FANSI_sgr sgr) { * @param x should be a vector of active states at end of strings. */ SEXP FANSI_sgr_close_ext(SEXP x, SEXP warn, SEXP term_cap, SEXP norm) { + if(TYPEOF(x) != STRSXP) error("Argument `x` should be a character vector."); // nocov - if(TYPEOF(norm) != INTSXP || XLENGTH(norm) != 1) - error("Argument `normalize` should be an integer vector."); // nocov + if(TYPEOF(norm) != LGLSXP || XLENGTH(norm) != 1) + error("Argument `normalize` should be TRUE or FALSE."); // nocov + int prt = 0; R_xlen_t len = xlength(x); - SEXP res = PROTECT(allocVector(STRSXP, len)); + SEXP res = PROTECT(allocVector(STRSXP, len)); ++prt; PROTECT_INDEX ipx; // reserve spot if we need to alloc later - PROTECT_WITH_INDEX(res, &ipx); + PROTECT_WITH_INDEX(res, &ipx); ++prt; struct FANSI_buff buff; FANSI_INIT_BUFF(&buff); int normalize = 1; - SEXP R_true = PROTECT(ScalarLogical(1)); - SEXP R_one = PROTECT(ScalarInteger(1)); - SEXP R_zero = PROTECT(ScalarInteger(0)); + SEXP R_true = PROTECT(ScalarLogical(1)); ++prt; + SEXP R_one = PROTECT(ScalarInteger(1)); ++prt; + SEXP R_zero = PROTECT(ScalarInteger(0)); ++prt; for(R_xlen_t i = 0; i < len; ++i) { FANSI_interrupt(i); @@ -494,7 +496,7 @@ SEXP FANSI_sgr_close_ext(SEXP x, SEXP warn, SEXP term_cap, SEXP norm) { } } FANSI_release_buff(&buff, 1); - UNPROTECT(4); + UNPROTECT(prt); return res; } @@ -527,7 +529,8 @@ SEXP FANSI_state_at_pos_ext( if(XLENGTH(pos) != XLENGTH(ends)) error("Argument `ends` must be the same length as `pos`."); // nocov - SEXP R_true = PROTECT(ScalarLogical(1)); + int prt = 0; + SEXP R_true = PROTECT(ScalarLogical(1)); ++prt; R_xlen_t len = XLENGTH(pos); int normalize = asInteger(norm); @@ -551,7 +554,7 @@ SEXP FANSI_state_at_pos_ext( const char * rownames[4] = { // make sure lines up with res_cols "pos.byte", "pos.raw", "pos.ansi", "pos.width" }; - SEXP res_rn = PROTECT(allocVector(STRSXP, res_cols)); + SEXP res_rn = PROTECT(allocVector(STRSXP, res_cols)); ++prt; for(int i = 0; i < res_cols; i++) SET_STRING_ELT( res_rn, i, @@ -564,9 +567,9 @@ SEXP FANSI_state_at_pos_ext( // position as well as the various position translations in a matrix with as // many *columns* as the character vector has elements - SEXP res_mx = PROTECT(allocVector(REALSXP, res_cols * len)); - SEXP dim = PROTECT(allocVector(INTSXP, 2)); - SEXP dim_names = PROTECT(allocVector(VECSXP, 2)); + SEXP res_mx = PROTECT(allocVector(REALSXP, res_cols * len)); ++prt; + SEXP dim = PROTECT(allocVector(INTSXP, 2)); ++prt; + SEXP dim_names = PROTECT(allocVector(VECSXP, 2)); ++prt; INTEGER(dim)[0] = res_cols; INTEGER(dim)[1] = len; @@ -575,10 +578,10 @@ SEXP FANSI_state_at_pos_ext( SET_VECTOR_ELT(dim_names, 1, R_NilValue); setAttrib(res_mx, R_DimNamesSymbol, dim_names); - SEXP res_str = PROTECT(allocVector(STRSXP, len)); + SEXP res_str = PROTECT(allocVector(STRSXP, len)); ++prt; const char * empty = ""; SEXP res_chr, res_chr_prev = - PROTECT(FANSI_mkChar(empty, empty, CE_NATIVE, (R_xlen_t) 0)); + PROTECT(FANSI_mkChar(empty, empty, CE_NATIVE, (R_xlen_t) 0)); ++prt; struct FANSI_state state = FANSI_state_init_full( x, warn, term_cap, R_true, R_true, type, ctl, (R_xlen_t) 0 ); @@ -648,10 +651,10 @@ SEXP FANSI_state_at_pos_ext( } FANSI_release_buff(&buff, 1); - SEXP res_list = PROTECT(allocVector(VECSXP, 2)); + SEXP res_list = PROTECT(allocVector(VECSXP, 2)); ++prt; SET_VECTOR_ELT(res_list, 0, res_str); SET_VECTOR_ELT(res_list, 1, res_mx); - UNPROTECT(9); + UNPROTECT(prt); return(res_list); } From 4fe1f01fb8118eb5c03ea61bc68bec711c7e9729 Mon Sep 17 00:00:00 2001 From: brodieG Date: Sun, 13 Jun 2021 20:38:07 -0400 Subject: [PATCH 13/20] bad 'with' usage --- R/nchar.R | 2 +- R/strsplit.R | 4 ++-- R/strtrim.R | 8 ++++---- R/substr2.R | 4 ++-- R/unhandled.R | 2 +- 5 files changed, 10 insertions(+), 10 deletions(-) diff --git a/R/nchar.R b/R/nchar.R index 07deb121..d0e204a8 100644 --- a/R/nchar.R +++ b/R/nchar.R @@ -85,7 +85,7 @@ nchar_ctl <- function( "Argument `type` must partial match one of 'chars', 'width', or 'bytes'." ) type <- valid.types[type.int] - with(args, stripped <- strip_ctl(x, ctl=ctl, warn=warn)) + stripped <- with(args, strip_ctl(x, ctl=ctl, warn=warn)) R.ver.gte.3.2.2 <- R.ver.gte.3.2.2 # "import" symbol from namespace if(R.ver.gte.3.2.2) nchar(stripped, type=type, allowNA=allowNA, keepNA=keepNA) diff --git a/R/strsplit.R b/R/strsplit.R index 04e4c2b7..37a35f84 100644 --- a/R/strsplit.R +++ b/R/strsplit.R @@ -125,8 +125,8 @@ strsplit_ctl <- function( starts <- starts[!sub.invalid] ends <- ends[!sub.invalid] } - with(args, - res[[i]] <- substr_ctl_internal( + res[[i]] <- with(args, + substr_ctl_internal( x=x[[i]], start=starts, stop=ends, type.int=0L, round.start=TRUE, round.stop=FALSE, diff --git a/R/strtrim.R b/R/strtrim.R index bff51552..7fe97f6c 100644 --- a/R/strtrim.R +++ b/R/strtrim.R @@ -56,9 +56,9 @@ strtrim_ctl <- function( # a bit inefficient to rely on strwrap, but oh well - with( + res <- with( args, - res <- .Call( + .Call( FANSI_strwrap_csi, enc2utf8(x), width, 0L, 0L, # indent, exdent @@ -106,9 +106,9 @@ strtrim2_ctl <- function( # a bit inefficient to rely on strwrap, but oh well - with( + res <- with( args, - res <- .Call( + .Call( FANSI_strwrap_csi, enc2utf8(x), width, 0L, 0L, # indent, exdent diff --git a/R/substr2.R b/R/substr2.R index 30640af5..98cb685b 100644 --- a/R/substr2.R +++ b/R/substr2.R @@ -192,9 +192,9 @@ substr2_ctl <- function( res <- x no.na <- !(is.na(x) | is.na(start & stop)) - with( + res[no.na] <- with( args, - res[no.na] <- substr_ctl_internal( + substr_ctl_internal( x[no.na], start=start[no.na], stop=stop[no.na], type.int=type.m, tabs.as.spaces=tabs.as.spaces, tab.stops=tab.stops, warn=warn, diff --git a/R/unhandled.R b/R/unhandled.R index f858634b..ad447caf 100644 --- a/R/unhandled.R +++ b/R/unhandled.R @@ -75,7 +75,7 @@ unhandled_ctl <- function(x, term.cap=getOption('fansi.term.cap')) { args <- validate(x=x, term.cap=term.cap) - with(args, res <- .Call(FANSI_unhandled_esc, x, term.cap.int)) + res <- with(args, .Call(FANSI_unhandled_esc, x, term.cap.int)) names(res) <- c("index", "start", "stop", "error", "translated", "esc") errors <- c( 'unknown', 'special', 'exceed-term-cap', 'non-SGR', 'malformed-CSI', From b80a83298492c51e7c46a23a3bcad155e0e53782 Mon Sep 17 00:00:00 2001 From: brodieG Date: Sun, 13 Jun 2021 20:38:26 -0400 Subject: [PATCH 14/20] remove files from collate --- DESCRIPTION | 2 -- 1 file changed, 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 1ea10369..d4cecc84 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -30,12 +30,10 @@ Encoding: UTF-8 Collate: 'constants.R' 'fansi-package.R' - 'has.R' 'internal.R' 'load.R' 'misc.R' 'nchar.R' - 'strip.R' 'strwrap.R' 'strtrim.R' 'strsplit.R' From 8217743dffc92ec010d9a7d7384d27bea633cfbd Mon Sep 17 00:00:00 2001 From: brodieG Date: Sun, 13 Jun 2021 21:31:15 -0400 Subject: [PATCH 15/20] more protection issues --- R/normalize.R | 11 ++++++----- src/carry.c | 13 +++++++------ src/normalize.c | 8 ++++---- src/state.c | 13 +++++++------ 4 files changed, 24 insertions(+), 21 deletions(-) diff --git a/R/normalize.R b/R/normalize.R index d6a30e92..58598f7d 100644 --- a/R/normalize.R +++ b/R/normalize.R @@ -71,13 +71,14 @@ #' ) ) normalize_sgr <- function( - x, warn=getOption('fansi.warn'), term.cap=getOption('fansi.term.cap') + x, warn=getOption('fansi.warn'), term.cap=getOption('fansi.term.cap'), + carry=getOption('fansi.carry', FALSE) ) { - args <- validate(x=x, warn=warn, term.cap=term.cap) - with(args, .Call(FANSI_normalize_sgr, enc2utf8(x), warn, term.cap.int)) + args <- validate(x=x, warn=warn, term.cap=term.cap, carry=carry) + with(args, .Call(FANSI_normalize_sgr, x, warn, term.cap.int, carry)) } # To reduce overhead of applying this in `strwrap_ctl` -normalize_sgr_list <- function(x, warn, term.cap.int) - .Call(FANSI_normalize_sgr_list, x, warn, term.cap.int) +normalize_sgr_list <- function(x, warn, term.cap.int, carry) + .Call(FANSI_normalize_sgr_list, x, warn, term.cap.int, carry) diff --git a/src/carry.c b/src/carry.c index 299d20df..224ea2c2 100644 --- a/src/carry.c +++ b/src/carry.c @@ -33,16 +33,17 @@ SEXP FANSI_sgr_at_end_ext( ) { FANSI_val_args(x, norm, carry); + int prt = 0; int normalize = asInteger(norm); // Read-in any pre-existing state to carry int do_carry = STRING_ELT(carry, 0) != NA_STRING; SEXP carry_string; - if(do_carry) carry_string = PROTECT(carry); - else carry_string = PROTECT(mkString("")); + if(do_carry) { carry_string = PROTECT(carry); ++prt; } + else { carry_string = PROTECT(mkString("")); ++prt; } - SEXP R_true = PROTECT(ScalarLogical(1)); - SEXP R_zero = PROTECT(ScalarInteger(0)); + SEXP R_true = PROTECT(ScalarLogical(1)); ++prt; + SEXP R_zero = PROTECT(ScalarInteger(0)); ++prt; struct FANSI_state state_prev = FANSI_state_init_full( carry_string, warn, term_cap, R_true, R_true, @@ -55,7 +56,7 @@ SEXP FANSI_sgr_at_end_ext( struct FANSI_buff buff; FANSI_INIT_BUFF(&buff); - SEXP res = PROTECT(allocVector(STRSXP, len)); + SEXP res = PROTECT(allocVector(STRSXP, len)); ++prt; for(R_xlen_t i = 0; i < len; ++i) { FANSI_interrupt(i); @@ -76,7 +77,7 @@ SEXP FANSI_sgr_at_end_ext( state_prev = state; } FANSI_release_buff(&buff, 1); - UNPROTECT(3); + UNPROTECT(prt); return res; } diff --git a/src/normalize.c b/src/normalize.c index 5ada94ff..13bd9784 100644 --- a/src/normalize.c +++ b/src/normalize.c @@ -97,16 +97,16 @@ static SEXP normalize_sgr_int( if(TYPEOF(x) != STRSXP) error("Internal Error: `x` must be a character vector"); // nocov + int prt = 0; R_xlen_t x_len = XLENGTH(x); SEXP res = x; // Reserve spot on protection stack PROTECT_INDEX ipx; - PROTECT_WITH_INDEX(res, &ipx); + PROTECT_WITH_INDEX(res, &ipx); ++prt; - SEXP ctl = PROTECT(ScalarInteger(1)); // "all" + SEXP ctl = PROTECT(ScalarInteger(1)); ++prt; // "all" int do_carry = STRING_ELT(carry, 1) != NA_STRING; struct FANSI_sgr sgr_carry = FANSI_carry_init(carry, warn, term_cap, ctl); - UNPROTECT(1); struct FANSI_state state_prev = FANSI_state_init(x, warn, term_cap, (R_xlen_t)0); @@ -140,7 +140,7 @@ static SEXP normalize_sgr_int( UNPROTECT(1); state_prev = state; } - UNPROTECT(2); + UNPROTECT(prt); return res; } diff --git a/src/state.c b/src/state.c index 9d668a44..123d42b2 100644 --- a/src/state.c +++ b/src/state.c @@ -115,10 +115,11 @@ struct FANSI_state FANSI_state_init_full( struct FANSI_state FANSI_state_init( SEXP strsxp, SEXP warn, SEXP term_cap, R_xlen_t i ) { - SEXP R_false = PROTECT(ScalarLogical(0)); - SEXP R_true = PROTECT(ScalarLogical(1)); - SEXP R_zero = PROTECT(ScalarInteger(0)); - SEXP R_one = PROTECT(ScalarInteger(1)); + int prt = 0; + SEXP R_false = PROTECT(ScalarLogical(0)); ++prt; + SEXP R_true = PROTECT(ScalarLogical(1)); ++prt; + SEXP R_zero = PROTECT(ScalarInteger(0)); ++prt; + SEXP R_one = PROTECT(ScalarInteger(1)); ++prt; struct FANSI_state res = FANSI_state_init_full( strsxp, warn, term_cap, R_true, // allowNA for invalid multibyte @@ -127,7 +128,7 @@ struct FANSI_state FANSI_state_init( R_one, // Treat all escapes as special by default (wrong prior to v1.0) i ); - UNPROTECT(3); + UNPROTECT(prt); return res; } @@ -463,7 +464,7 @@ SEXP FANSI_sgr_close_ext(SEXP x, SEXP warn, SEXP term_cap, SEXP norm) { struct FANSI_buff buff; FANSI_INIT_BUFF(&buff); - int normalize = 1; + int normalize = asInteger(norm); SEXP R_true = PROTECT(ScalarLogical(1)); ++prt; SEXP R_one = PROTECT(ScalarInteger(1)); ++prt; From b51bcb5d99d19e3a33dd49ef0850716ad8a03970 Mon Sep 17 00:00:00 2001 From: brodieG Date: Mon, 14 Jun 2021 06:47:34 -0400 Subject: [PATCH 16/20] actually enable carry/terminate for substr_ctl --- R/substr2.R | 2 +- src/state.c | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/substr2.R b/R/substr2.R index 98cb685b..e5a9f217 100644 --- a/R/substr2.R +++ b/R/substr2.R @@ -143,7 +143,7 @@ substr_ctl <- function( ) substr2_ctl( x=x, start=start, stop=stop, warn=warn, term.cap=term.cap, ctl=ctl, - normalize=normalize + normalize=normalize, carry=carry, terminate=terminate ) #' @rdname substr_ctl diff --git a/src/state.c b/src/state.c index 123d42b2..0c2dc28b 100644 --- a/src/state.c +++ b/src/state.c @@ -536,7 +536,7 @@ SEXP FANSI_state_at_pos_ext( int normalize = asInteger(norm); // Read-in any pre-existing state to carry; we don't need to worry about - // explicitly handling carrying across positions as that + // explicitly handling carrying across positions as that is done at R level struct FANSI_sgr sgr_carry = FANSI_carry_init(carry, warn, term_cap, ctl); const int res_cols = 4; // if change this, need to change rownames init From 0f04753bd47c5b105901b1186f36210db7be8700 Mon Sep 17 00:00:00 2001 From: brodieG Date: Mon, 14 Jun 2021 20:50:31 -0400 Subject: [PATCH 17/20] carry/terminate working --- DEVNOTES.md | 5 ++ R/internal.R | 9 ++-- R/strwrap.R | 21 +++++--- src/carry.c | 2 +- src/fansi.h | 2 +- src/init.c | 2 +- src/normalize.c | 23 +++++---- src/state.c | 16 +++--- src/tohtml.c | 2 +- src/wrap.c | 19 ++++--- tests/run.R | 2 +- tests/unitizer/interactions.R | 94 +++++++++++++++++++++++++++++++++++ 12 files changed, 153 insertions(+), 44 deletions(-) create mode 100644 tests/unitizer/interactions.R diff --git a/DEVNOTES.md b/DEVNOTES.md index a93b6028..e4953c37 100644 --- a/DEVNOTES.md +++ b/DEVNOTES.md @@ -4,6 +4,11 @@ These are internal developer notes. ## Todo +* This is definitely not parsimonious... Maybe fix when we move substr to C? + + > substr_ctl("", 2, 4, carry = "\033[33m") + [1] "\033[33m\033[0m" + * It's possible we messed up and `sgr_to_html` had carry semantics whereas other stuff did not. diff --git a/R/internal.R b/R/internal.R index 996dd03f..da404f08 100644 --- a/R/internal.R +++ b/R/internal.R @@ -124,10 +124,10 @@ validate <- function(...) { stop2("Argument `carry` must be scalar.") if(!is.logical(carry) && !is.character(carry)) stop2("Argument `carry` must be logical or character.") - if(is.na(carry)) carry <- as.character(carry) - else { - if(is.logical(carry)) if(carry) carry <- "" else carry = NA_character_ - } + if(is.na(carry)) + stop2("Argument `carry` may not be NA.") + + if(is.logical(carry)) if(carry) carry <- "" else carry = NA_character_ args[['carry']] <- carry } if('terminate' %in% names(args)) { @@ -156,6 +156,7 @@ validate <- function(...) { args[['tabs.as.spaces']] <- tabs.as.spaces } if('strip.spaces' %in% names(args)) { + strip.spaces <- args[['strip.spaces']] if(!is.logical(strip.spaces)) strip.spaces <- as.logical(strip.spaces) if(length(strip.spaces) != 1L || is.na(strip.spaces)) stop("Argument `strip.spaces` must be TRUE or FALSE.") diff --git a/R/strwrap.R b/R/strwrap.R index 9149dea4..e900ff21 100644 --- a/R/strwrap.R +++ b/R/strwrap.R @@ -55,6 +55,11 @@ #' are implicit in boundaries between vector elements. #' @param tabs.as.spaces FALSE (default) or TRUE, whether to convert tabs to #' spaces. This can only be set to TRUE if `strip.spaces` is FALSE. +#' @note For the `strwrap*` functions the `carry` parameter affects whether +#' styles are carried across _input_ vector elements. Styles always carry +#' within a single wrapped vector element (e.g. if one of the input elements +#' gets wrapped into three lines, the styles will carry through those three +#' lines even if `carry=FALSE`, but not across input vector elements). #' @export #' @examples #' hello.1 <- "hello \033[41mred\033[49m world" @@ -120,7 +125,8 @@ strwrap_ctl <- function( FALSE, 8L, warn, term.cap.int, FALSE, # first_only - ctl.int, normalize + ctl.int, normalize, + carry, terminate ) if(simplify) { if(normalize) normalize_sgr(unlist(res), warn, term.cap) @@ -180,13 +186,14 @@ strwrap2_ctl <- function( FANSI_strwrap_csi, x, width, indent, exdent, - enc2utf8(prefix), enc2utf8(initial), + prefix, initial, wrap.always, pad.end, strip.spaces, tabs.as.spaces, tab.stops, warn, term.cap.int, FALSE, # first_only - ctl.int, normalize + ctl.int, normalize, + carry, terminate ) if(simplify) { if(normalize) normalize_sgr(unlist(res), warn, term.cap) @@ -256,13 +263,13 @@ validate_wrap_basic <- function( ) ) x } - width <- is_scl_int_pos(x, 'width', strict=TRUE) - exdent <- is_scl_int_pos(x, 'exdent', strict=FALSE) - indent <- is_scl_int_pos(x, 'indent', strict=FALSE) + width <- is_scl_int_pos(width, 'width', strict=TRUE) + exdent <- is_scl_int_pos(exdent, 'exdent', strict=FALSE) + indent <- is_scl_int_pos(indent, 'indent', strict=FALSE) width <- max(c(as.integer(width) - 1L, 1L)) list( - width=width, indent=indent, exdent=extent, prefix=prefix, initial=initial + width=width, indent=indent, exdent=exdent, prefix=prefix, initial=initial ) } diff --git a/src/carry.c b/src/carry.c index 224ea2c2..6ffcb017 100644 --- a/src/carry.c +++ b/src/carry.c @@ -85,7 +85,7 @@ struct FANSI_sgr FANSI_carry_init( SEXP carry, SEXP warn, SEXP term_cap, SEXP ctl ) { int prt = 0; - int do_carry = STRING_ELT(carry, 1) != NA_STRING; + int do_carry = STRING_ELT(carry, 0) != NA_STRING; SEXP carry_string; if(do_carry) { carry_string = PROTECT(carry); ++prt; diff --git a/src/fansi.h b/src/fansi.h index 7d5a4268..0e9e8099 100644 --- a/src/fansi.h +++ b/src/fansi.h @@ -355,7 +355,7 @@ Go to for a copy of the license. SEXP FANSI_strip(SEXP x, SEXP ctl, SEXP warn); SEXP FANSI_state_at_pos_ext( SEXP x, SEXP pos, SEXP type, SEXP lag, SEXP ends, - SEXP warn, SEXP term_cap, SEXP ctl, SEXP norm, SEXP carry + SEXP warn, SEXP term_cap, SEXP ctl, SEXP norm ); SEXP FANSI_strwrap_ext( SEXP x, SEXP width, diff --git a/src/init.c b/src/init.c index a2da6c80..77fcb869 100644 --- a/src/init.c +++ b/src/init.c @@ -24,7 +24,7 @@ R_CallMethodDef callMethods[] = { {"has_csi", (DL_FUNC) &FANSI_has, 3}, {"strip_csi", (DL_FUNC) &FANSI_strip, 3}, {"strwrap_csi", (DL_FUNC) &FANSI_strwrap_ext, 18}, - {"state_at_pos_ext", (DL_FUNC) &FANSI_state_at_pos_ext, 10}, + {"state_at_pos_ext", (DL_FUNC) &FANSI_state_at_pos_ext, 9}, {"process", (DL_FUNC) &FANSI_process_ext, 1}, {"check_assumptions", (DL_FUNC) &FANSI_check_assumptions, 0}, {"digits_in_int", (DL_FUNC) &FANSI_digits_in_int_ext, 1}, diff --git a/src/normalize.c b/src/normalize.c index 13bd9784..1c125fb7 100644 --- a/src/normalize.c +++ b/src/normalize.c @@ -105,13 +105,9 @@ static SEXP normalize_sgr_int( PROTECT_WITH_INDEX(res, &ipx); ++prt; SEXP ctl = PROTECT(ScalarInteger(1)); ++prt; // "all" - int do_carry = STRING_ELT(carry, 1) != NA_STRING; + int do_carry = STRING_ELT(carry, 0) != NA_STRING; struct FANSI_sgr sgr_carry = FANSI_carry_init(carry, warn, term_cap, ctl); - struct FANSI_state state_prev = - FANSI_state_init(x, warn, term_cap, (R_xlen_t)0); - state_prev.sgr = sgr_carry; - for(R_xlen_t i = 0; i < x_len; ++i) { FANSI_interrupt(i + index0); SEXP chrsxp = STRING_ELT(x, i); @@ -120,10 +116,12 @@ static SEXP normalize_sgr_int( // Measure struct FANSI_state state_start, state; state = FANSI_state_init(x, warn, term_cap, i); - if(do_carry) state.sgr = state_prev.sgr; + if(do_carry) state.sgr = sgr_carry; state_start = state; int len = normalize(NULL, &state, i); + sgr_carry = state.sgr; + if(len < 0) continue; // Write @@ -138,7 +136,6 @@ static SEXP normalize_sgr_int( PROTECT(FANSI_mkChar(buff->buff, buff->buff + len, chr_type, i)); SET_STRING_ELT(res, i, reschr); UNPROTECT(1); - state_prev = state; } UNPROTECT(prt); return res; @@ -148,8 +145,12 @@ SEXP FANSI_normalize_sgr_ext(SEXP x, SEXP warn, SEXP term_cap, SEXP carry) { if(TYPEOF(x) != STRSXP) error("Internal Error: `x` must be a character vector"); // nocov - struct FANSI_buff buff = {.buff=NULL, .len=0}; - return normalize_sgr_int(x, warn, term_cap, carry, &buff, 0); + struct FANSI_buff buff; + FANSI_INIT_BUFF(&buff); + SEXP res = PROTECT(normalize_sgr_int(x, warn, term_cap, carry, &buff, 0)); + FANSI_release_buff(&buff, 1); + UNPROTECT(1); + return res; } // List version to use with result of `strwrap_ctl(..., unlist=FALSE)` // Just a lower overhead version. @@ -162,7 +163,8 @@ SEXP FANSI_normalize_sgr_list_ext(SEXP x, SEXP warn, SEXP term_cap, SEXP carry) // Reserve spot on protection stack PROTECT_INDEX ipx; PROTECT_WITH_INDEX(res, &ipx); - struct FANSI_buff buff = {.buff=NULL, .len=0}; + struct FANSI_buff buff; + FANSI_INIT_BUFF(&buff); R_xlen_t i0 = 0; // for interrupt across vector elements R_xlen_t llen = XLENGTH(x); @@ -179,6 +181,7 @@ SEXP FANSI_normalize_sgr_list_ext(SEXP x, SEXP warn, SEXP term_cap, SEXP carry) } UNPROTECT(1); } + FANSI_release_buff(&buff, 1); UNPROTECT(1); return res; } diff --git a/src/state.c b/src/state.c index 0c2dc28b..6e12b776 100644 --- a/src/state.c +++ b/src/state.c @@ -505,22 +505,28 @@ SEXP FANSI_sgr_close_ext(SEXP x, SEXP warn, SEXP term_cap, SEXP norm) { * R interface for state_at_position * @param string we're interested in state of * @param pos integer positions along the string, one index, sorted + * + * No carry param, that should be R-level. */ SEXP FANSI_state_at_pos_ext( SEXP x, SEXP pos, SEXP type, SEXP lag, SEXP ends, SEXP warn, SEXP term_cap, SEXP ctl, - SEXP norm, SEXP carry + SEXP norm ) { /*******************************************\ * IMPORTANT: INPUT MUST ALREADY BE IN UTF8! * \*******************************************/ // errors shoudl be handled R side, but just in case - FANSI_val_args(x, norm, carry); if(XLENGTH(x) != 1 || STRING_ELT(x, 0) == NA_STRING) error("Argument `x` must be scalar character and not be NA."); // nocov + if( + TYPEOF(norm) != LGLSXP || XLENGTH(norm) != 1 || + asLogical(norm) == NA_LOGICAL + ) + error("Argument `normalize` must be TRUE or FALSE."); // nocov if(TYPEOF(pos) != INTSXP) error("Argument `pos` must be integer."); // nocov if(TYPEOF(lag) != LGLSXP) @@ -535,10 +541,6 @@ SEXP FANSI_state_at_pos_ext( R_xlen_t len = XLENGTH(pos); int normalize = asInteger(norm); - // Read-in any pre-existing state to carry; we don't need to worry about - // explicitly handling carrying across positions as that is done at R level - struct FANSI_sgr sgr_carry = FANSI_carry_init(carry, warn, term_cap, ctl); - const int res_cols = 4; // if change this, need to change rownames init if(len > R_XLEN_T_MAX / res_cols) { // nocov start @@ -586,8 +588,6 @@ SEXP FANSI_state_at_pos_ext( struct FANSI_state state = FANSI_state_init_full( x, warn, term_cap, R_true, R_true, type, ctl, (R_xlen_t) 0 ); - state.sgr = sgr_carry; - struct FANSI_state state_prev = state; state_pair.cur = state; state_pair.prev = state_prev; diff --git a/src/tohtml.c b/src/tohtml.c index dd484385..32abcc3d 100644 --- a/src/tohtml.c +++ b/src/tohtml.c @@ -367,7 +367,7 @@ SEXP FANSI_esc_to_html( FANSI_INIT_BUFF(&buff); SEXP ctl = PROTECT(ScalarInteger(1)); // "all" - int do_carry = STRING_ELT(carry, 1) != NA_STRING; + int do_carry = STRING_ELT(carry, 0) != NA_STRING; struct FANSI_sgr sgr_carry = FANSI_carry_init(carry, warn, term_cap, ctl); UNPROTECT(1); diff --git a/src/wrap.c b/src/wrap.c index 05105f79..83680642 100644 --- a/src/wrap.c +++ b/src/wrap.c @@ -504,6 +504,7 @@ SEXP FANSI_strwrap_ext( error("Internal Error: arg type error 1; contact maintainer."); // nocov int normalize = asLogical(norm); + int prt = 0; const char * pad = CHAR(asChar(pad_end)); if(*pad != 0 && (*pad < 0x20 || *pad > 0x7e)) @@ -559,20 +560,19 @@ SEXP FANSI_strwrap_ext( // and initial, so we don't either int strip_spaces_int = asInteger(strip_spaces); - if(strip_spaces_int) x = PROTECT(FANSI_process(x, &buff)); - else PROTECT(x); + if(strip_spaces_int) {x = PROTECT(FANSI_process(x, &buff)); ++prt;} // and tabs if(asInteger(tabs_as_spaces)) { x = PROTECT(FANSI_tabs_as_spaces(x, tab_stops, &buff, warn, term_cap, ctl)); + ++prt; prefix = PROTECT( FANSI_tabs_as_spaces(prefix, tab_stops, &buff, warn, term_cap, ctl) - ); + ); ++prt; initial = PROTECT( FANSI_tabs_as_spaces(initial, tab_stops, &buff, warn, term_cap, ctl) - ); + ); ++prt; } - else x = PROTECT(PROTECT(PROTECT(x))); // PROTECT stack balance // Check that widths are feasible, although really only relevant if in strict // mode @@ -593,9 +593,8 @@ SEXP FANSI_strwrap_ext( ); // Prep for carry - int do_carry = STRING_ELT(carry, 1) != NA_STRING; + int do_carry = STRING_ELT(carry, 0) != NA_STRING; struct FANSI_sgr sgr_carry = FANSI_carry_init(carry, warn, term_cap, ctl); - UNPROTECT(1); // Could be a little faster avoiding this allocation if it turns out nothing // needs to be wrapped and we're in simplify=TRUE, but that seems like a lot @@ -605,9 +604,9 @@ SEXP FANSI_strwrap_ext( if(first_only_int) { // this is to support trim mode - res = PROTECT(allocVector(STRSXP, x_len)); + res = PROTECT(allocVector(STRSXP, x_len)); ++prt; } else { - res = PROTECT(allocVector(VECSXP, x_len)); + res = PROTECT(allocVector(VECSXP, x_len)); ++prt; } // Wrap each element @@ -639,6 +638,6 @@ SEXP FANSI_strwrap_ext( UNPROTECT(1); } FANSI_release_buff(&buff, 1); - UNPROTECT(5); + UNPROTECT(prt); return res; } diff --git a/tests/run.R b/tests/run.R index ff2c8308..0a608d7b 100644 --- a/tests/run.R +++ b/tests/run.R @@ -21,7 +21,7 @@ if(getRversion() < "3.2.2") { ) on.exit(old.opt) pattern <- "^[^.].*\\.[Rr]$" - # pattern <- "over" + pattern <- "interact" unitize_dir( 'unitizer', pattern=pattern, diff --git a/tests/unitizer/interactions.R b/tests/unitizer/interactions.R new file mode 100644 index 00000000..306224d6 --- /dev/null +++ b/tests/unitizer/interactions.R @@ -0,0 +1,94 @@ +library(fansi) + +unitizer_sect("substr", { + str.0 <- c("\033[44mhello", "world") + substr_ctl(str.0, 2, 4) + substr_ctl(str.0, 2, 4, carry=TRUE) + substr_ctl(str.0, 2, 4, carry="\033[33m") + + substr2_ctl(str.0, 2, 4, carry="\033[33m") + substr_sgr(str.0, 2, 4, carry="\033[33m") + substr2_sgr(str.0, 2, 4, carry="\033[33m") + + str.1 <- c("hello", "\033[44mworld", "barrow") + substr_ctl(str.1, 2, 4) + substr_ctl(str.1, 2, 4, carry=TRUE) + substr_ctl(str.1, 2, 4, carry="\033[33m") +}) +wrp.0 <- c( + "once upon \033[44ma time in a land far away over ", + "the mountains and \033[7m sea lived a fair creature ", + "with \033[4mdark itentions and a yappy dog." +) +unitizer_sect("wrap/trim", { + strwrap_ctl(wrp.0, 20) + strwrap_ctl(wrp.0, 20, carry=TRUE) + strwrap_ctl(wrp.0, 20, carry="\033[33m") + + strwrap_sgr(wrp.0, 20, carry="\033[33m") + strwrap2_ctl(wrp.0, 20, carry="\033[33m") + strwrap2_sgr(wrp.0, 20, carry="\033[33m") + + strtrim_ctl(wrp.0, 20, carry="\033[33m") + strtrim_sgr(wrp.0, 20, carry="\033[33m") + strtrim2_ctl(wrp.0, 20, carry="\033[33m") + strtrim2_sgr(wrp.0, 20, carry="\033[33m") + + wrp.1 <- c( + "once upon \033[44ma time in a land far away over ", + "the mountains and \033[7m sea lived a \033[32mfair creature ", + "with \033[4mdark itentions and a yappy dog." + ) + strtrim_ctl(wrp.0, 20, carry="\033[33m") +}) + +unitizer_sect("normalize", { + str.2 <- c("\033[44mhello", "wo\033[mrld", "barrow") + normalize_sgr(str.2) + normalize_sgr(str.2, carry=TRUE) + # unlike substr/wrap normalize does not add the color from carry, + # it just accounts for its presence from prior strings in e.g. computing + # the close string. + normalize_sgr(str.2, carry="\033[33m") +}) + +unitizer_sect("carry corner cases", { + substr_ctl("", 2, 4, carry="\033[33m") + substr_ctl(character(), 2, 4, carry="\033[33m") + substr_ctl(NA, 2, 4, carry="\033[33m") + substr_ctl(environment(), 2, 4, carry="\033[33m") + + substr_ctl(str.0, 2, 4, carry=NA_character_) + substr_ctl(str.0, 2, 4, carry=character()) + substr_ctl(str.0, 2, 4, carry=1) + substr_ctl(str.0, 2, 4, carry=Inf) + + normalize_sgr(str.2, carry=NA_character_) + normalize_sgr(str.2, carry=character()) + normalize_sgr(str.2, carry=1) + normalize_sgr(str.2, carry=Inf) + + strwrap_ctl(wrp.0, 20, carry=NA_character_) + strwrap_sgr(wrp.0, 20, carry=character()) + strwrap2_ctl(wrp.0, 20, carry=1) + strwrap2_sgr(wrp.0, 20, carry=Inf) +}) + +unitizer_sect("terminate", { + str.0 <- c("hel\033[33m", "wo\033[44mrld") + substr_ctl(str.0, 2, 5, terminate=FALSE) + substr_sgr(str.0, 2, 5, terminate=FALSE) + substr2_ctl(str.0, 2, 5, terminate=FALSE) + substr2_sgr(str.0, 2, 5, terminate=FALSE) + + strwrap_ctl(wrp.0, 20, terminate=FALSE) + strwrap_sgr(wrp.0, 20, terminate=FALSE) + strwrap2_ctl(wrp.0, 20, terminate=FALSE) + strwrap2_sgr(wrp.0, 20, terminate=FALSE) + + strtrim_ctl(wrp.0, 20, terminate=FALSE) + strtrim_sgr(wrp.0, 20, terminate=FALSE) + strtrim2_ctl(wrp.0, 20, terminate=FALSE) + strtrim2_sgr(wrp.0, 20, terminate=FALSE) +}) + From b74f8c7c99d6752b8d546976fc3074149fba6065 Mon Sep 17 00:00:00 2001 From: brodieG Date: Tue, 15 Jun 2021 19:58:34 -0400 Subject: [PATCH 18/20] fix regressions, tweak validation mechanism --- R/carry.R | 9 +-- R/internal.R | 30 +++++--- R/nchar.R | 10 +-- R/normalize.R | 15 ++-- R/sgr.R | 48 ++++++------- R/strsplit.R | 27 ++++---- R/strtrim.R | 23 +++---- R/strwrap.R | 156 +++++++++++++++++++++++------------------- R/substr2.R | 25 +++---- R/tohtml.R | 9 +-- R/unhandled.R | 4 +- tests/run.R | 2 +- tests/unitizer/wrap.R | 3 + 13 files changed, 185 insertions(+), 176 deletions(-) diff --git a/R/carry.R b/R/carry.R index 1e62ef73..2ece382f 100644 --- a/R/carry.R +++ b/R/carry.R @@ -20,14 +20,9 @@ sgr_at_end <- function( normalize=getOption('fansi.normalize', FALSE), carry=getOption('fansi.carry', FALSE) ) { - args <- validate( + VAL_IN_ENV( x=x, warn=warn, term.cap=term.cap, normalize=normalize, carry=carry, ctl='sgr' ) - with( - args, - .Call( - FANSI_sgr_at_end, x, warn, term.cap.int, ctl.int, normalize, carry - ) - ) + .Call(FANSI_sgr_at_end, x, warn, term.cap.int, ctl.int, normalize, carry) } diff --git a/R/internal.R b/R/internal.R index da404f08..3ad6f74b 100644 --- a/R/internal.R +++ b/R/internal.R @@ -57,10 +57,14 @@ check_enc <- function(x, i) .Call(FANSI_check_enc, x, as.integer(i)[1]) ctl_as_int <- function(x) .Call(FANSI_ctl_as_int, as.integer(x)) ## Common argument validation and conversion. Missing args okay. +## +## DANGER: will modify values in calling environment! Also may add `ctl.int` +## and `term.cap.int` to them. -validate <- function(...) { +VAL_IN_ENV <- function(...) { call <- sys.call(-1) - stop2 <- function(x) stop(simpleError(x, call)) + par.env <- parent.frame() + stop2 <- function(...) stop(simpleError(paste0(..., collapse=""), call)) args <- list(...) if( !all( @@ -75,8 +79,16 @@ validate <- function(...) { x <- args[['x']] if(!is.character(x)) x <- as.character(args[['x']]) x <- enc2utf8(x) - if(any(Encoding(x) == "bytes")) - stop2("BYTE encoded strings are not supported.") + if(length(which.byte <- which(Encoding(x) == "bytes"))) + stop2( + "Argument `x` contains a \"bytes\" encoded string at index [", + which.byte[1],"] ", + if(length(which.byte) > 1) { + sprintf( + "and %d other%s ", which.byte - 1, if(which.byte > 2) "s" else "" + ) }, + "which is not supported." + ) args[['x']] <- x } if('warn' %in% names(args)) { @@ -112,8 +124,7 @@ validate <- function(...) { # duplicate values in `ctl` are okay, so save a call to `unique` here if(anyNA(ctl.int <- match(ctl, VALID.CTL))) stop2( - "Argument `ctl` may contain only values in `", - deparse(VALID.CTL), "`" + "Argument `ctl` may contain only values in `", deparse(VALID.CTL), "`" ) } args[['ctl.int']] <- ctl.int @@ -152,18 +163,17 @@ validate <- function(...) { tabs.as.spaces <- args[['tabs.as.spaces']] if(!is.logical(tabs.as.spaces)) tabs.as.spaces <- as.logical(tabs.as.spaces) if(length(tabs.as.spaces) != 1L || is.na(tabs.as.spaces)) - stop("Argument `tabs.as.spaces` must be TRUE or FALSE.") + stop2("Argument `tabs.as.spaces` must be TRUE or FALSE.") args[['tabs.as.spaces']] <- tabs.as.spaces } if('strip.spaces' %in% names(args)) { strip.spaces <- args[['strip.spaces']] if(!is.logical(strip.spaces)) strip.spaces <- as.logical(strip.spaces) if(length(strip.spaces) != 1L || is.na(strip.spaces)) - stop("Argument `strip.spaces` must be TRUE or FALSE.") + stop2("Argument `strip.spaces` must be TRUE or FALSE.") args[['strip.spaces']] <- strip.spaces } - # we might not have validated all, so we should be careful - args + list2env(args, par.env) } diff --git a/R/nchar.R b/R/nchar.R index d0e204a8..a0e1e8d2 100644 --- a/R/nchar.R +++ b/R/nchar.R @@ -63,8 +63,6 @@ nchar_ctl <- function( x, type='chars', allowNA=FALSE, keepNA=NA, ctl='all', warn=getOption('fansi.warn'), strip ) { - args <- validate(x=x, ctl=ctl, warn=warn) - if(!is.logical(allowNA)) allowNA <- as.logical(allowNA) if(length(allowNA) != 1L) stop("Argument `allowNA` must be a scalar logical.") @@ -84,8 +82,10 @@ nchar_ctl <- function( stop( "Argument `type` must partial match one of 'chars', 'width', or 'bytes'." ) + + VAL_IN_ENV(x=x, ctl=ctl, warn=warn) type <- valid.types[type.int] - stripped <- with(args, strip_ctl(x, ctl=ctl, warn=warn)) + stripped <- strip_ctl(x, ctl=ctl, warn=warn) R.ver.gte.3.2.2 <- R.ver.gte.3.2.2 # "import" symbol from namespace if(R.ver.gte.3.2.2) nchar(stripped, type=type, allowNA=allowNA, keepNA=keepNA) @@ -105,13 +105,13 @@ nchar_sgr <- function( #' @rdname nchar_ctl nzchar_ctl <- function(x, keepNA=NA, ctl='all', warn=getOption('fansi.warn')) { - args <- validate(x=x, ctl=ctl, warn=warn) + VAL_IN_ENV(x=x, ctl=ctl, warn=warn) if(!is.logical(keepNA)) keepNA <- as.logical(keepNA) if(length(keepNA) != 1L) stop("Argument `keepNA` must be a scalar logical.") term.cap.int <- seq_along(VALID.TERM.CAP) - with(args, .Call(FANSI_nzchar_esc, x, keepNA, warn, term.cap.int, ctl.int)) + .Call(FANSI_nzchar_esc, x, keepNA, warn, term.cap.int, ctl.int) } #' @export #' @rdname nchar_ctl diff --git a/R/normalize.R b/R/normalize.R index 58598f7d..e97f70d5 100644 --- a/R/normalize.R +++ b/R/normalize.R @@ -33,7 +33,7 @@ #' The underlying assumption is that each element in the vector is #' unaffected by any styles in any other element or elsewhere. This may #' lead to surprising outcomes if these assumptions are untrue (see -#' examples). +#' examples). You may adjust this assumption with the `carry` parameter. #' #' Normalization was implemented primarily for better compatibility with #' [`crayon`][1] which emits SGR codes individually and assumes that @@ -43,7 +43,6 @@ #' [1]: https://cran.r-project.org/package=crayon #' #' @export -#' @param x character vector to normalize the SGR control sequences of. #' @seealso [`fansi`] for details on how _Control Sequences_ are #' interpreted, particularly if you are getting unexpected results. #' @inheritParams substr_ctl @@ -63,19 +62,21 @@ #' normalize_sgr("\033[31;32mhello\033[m"), #' normalize_sgr("\033[31mhe\033[49mllo\033[m") #' ) -#' ## External SGR will defeat normalization +#' ## External SGR will defeat normalization, unless we `carry` it +#' red <- "\033[41m" #' writeLines( #' c( -#' paste("\033[31m", "he\033[0mllo", "\033[0m"), -#' paste("\033[31m", normalize_sgr("he\033[0mllo"), "\033[0m") +#' paste(red, "he\033[0mllo", "\033[0m"), +#' paste(red, normalize_sgr("he\033[0mllo"), "\033[0m") +#' paste(red, normalize_sgr("he\033[0mllo", carry=red), "\033[0m") #' ) ) normalize_sgr <- function( x, warn=getOption('fansi.warn'), term.cap=getOption('fansi.term.cap'), carry=getOption('fansi.carry', FALSE) ) { - args <- validate(x=x, warn=warn, term.cap=term.cap, carry=carry) - with(args, .Call(FANSI_normalize_sgr, x, warn, term.cap.int, carry)) + VAL_IN_ENV(x=x, warn=warn, term.cap=term.cap, carry=carry) + .Call(FANSI_normalize_sgr, x, warn, term.cap.int, carry) } # To reduce overhead of applying this in `strwrap_ctl` diff --git a/R/sgr.R b/R/sgr.R index b86f1079..03c175a7 100644 --- a/R/sgr.R +++ b/R/sgr.R @@ -66,19 +66,18 @@ strip_ctl <- function(x, ctl='all', warn=getOption('fansi.warn'), strip) { message("Parameter `strip` has been deprecated; use `ctl` instead.") ctl <- strip } - args <- validate(x=x, ctl=ctl, warn=warn) + VAL_IN_ENV(x=x, ctl=ctl, warn=warn) - if(length(ctl)) { - with(args, .Call(FANSI_strip_csi, enc2utf8(x), ctl.int, warn)) - } else x + if(length(ctl)) .Call(FANSI_strip_csi, enc2utf8(x), ctl.int, warn) + else x } #' @export #' @rdname strip_ctl strip_sgr <- function(x, warn=getOption('fansi.warn')) { - args <- validate(x=x, warn=warn) + VAL_IN_ENV(x=x, warn=warn) ctl.int <- match("sgr", VALID.CTL) - with(args, .Call(FANSI_strip_csi, x, ctl.int, warn)) + .Call(FANSI_strip_csi, x, ctl.int, warn) } #' Checks for Presence of Control Sequences @@ -109,9 +108,9 @@ has_ctl <- function(x, ctl='all', warn=getOption('fansi.warn'), which) { message("Parameter `which` has been deprecated; use `ctl` instead.") ctl <- which } - args <- validate(x=x, ctl=ctl, warn=warn) + VAL_IN_ENV(x=x, ctl=ctl, warn=warn) if(length(ctl.int)) { - with(args, .Call(FANSI_has_csi, x, ctl.int, warn)) + .Call(FANSI_has_csi, x, ctl.int, warn) } else rep(FALSE, length(x)) } #' @export @@ -149,19 +148,17 @@ sgr_at_end <- function( normalize=getOption('fansi.normalize', FALSE), carry=getOption('fansi.carry', FALSE) ) { - args <- validate(x=x, ctl='sgr', warn=warn, term.cap=term.cap, carry=carry) - with( - args, - .Call( - FANSI_sgr_at_end, - x, - 0L, # character type - warn, - term.cap.int, - ctl.int, - normalize, - carry - ) ) + VAL_IN_ENV(x=x, ctl='sgr', warn=warn, term.cap=term.cap, carry=carry) + .Call( + FANSI_sgr_at_end, + x, + 0L, # character type + warn, + term.cap.int, + ctl.int, + normalize, + carry + ) } # Given an SGR, compute the sequence that closes it @@ -174,13 +171,8 @@ close_sgr <- function( warn=getOption('fansi.warn'), normalize=getOption('fansi.normalize', FALSE) ) { - args <- validate( - x=x, warn=warn, normalize=normalize - ) - with( - args, - .Call(FANSI_close_sgr, x, warn, seq_along(VALID.TERM.CAP), normalize) - ) + VAL_IN_ENV(x=x, warn=warn, normalize=normalize) + .Call(FANSI_close_sgr, x, warn, seq_along(VALID.TERM.CAP), normalize) } diff --git a/R/strsplit.R b/R/strsplit.R index 37a35f84..da191a02 100644 --- a/R/strsplit.R +++ b/R/strsplit.R @@ -58,16 +58,16 @@ strsplit_ctl <- function( carry=getOption('fansi.carry', FALSE), terminate=getOption('fansi.terminate', TRUE) ) { - args <- validate( + VAL_IN_ENV( x=x, warn=warn, term.cap=term.cap, ctl=ctl, normalize=normalize, - carry=carry, terminate=terminate, + carry=carry, terminate=terminate ) - if(is.null(split)) split <- "" split <- enc2utf8(as.character(split)) if(!length(split)) split <- "" if(anyNA(split)) stop("Argument `split` may not contain NAs.") - + if(any(Encoding(split) == "bytes")) + stop("Argument `bytes` may not be \"bytes\" encoded.") if(!is.logical(fixed)) fixed <- as.logical(fixed) if(length(fixed) != 1L || is.na(fixed)) stop("Argument `fixed` must be TRUE or FALSE.") @@ -125,16 +125,15 @@ strsplit_ctl <- function( starts <- starts[!sub.invalid] ends <- ends[!sub.invalid] } - res[[i]] <- with(args, - substr_ctl_internal( - x=x[[i]], - start=starts, stop=ends, type.int=0L, - round.start=TRUE, round.stop=FALSE, - tabs.as.spaces=FALSE, tab.stops=8L, warn=warn, - term.cap.int=term.cap.int, x.len=length(starts), - ctl.int=ctl.int, normalize=normalize, - carry=carry, terminate=terminate - ) ) + res[[i]] <- substr_ctl_internal( + x=x[[i]], + start=starts, stop=ends, type.int=0L, + round.start=TRUE, round.stop=FALSE, + tabs.as.spaces=FALSE, tab.stops=8L, warn=warn, + term.cap.int=term.cap.int, x.len=length(starts), + ctl.int=ctl.int, normalize=normalize, + carry=carry, terminate=terminate + ) } else { res[[i]] <- x[[i]] } diff --git a/R/strtrim.R b/R/strtrim.R index 7fe97f6c..a11cdf3e 100644 --- a/R/strtrim.R +++ b/R/strtrim.R @@ -40,25 +40,23 @@ strtrim_ctl <- function( carry=getOption('fansi.carry', FALSE), terminate=getOption('fansi.terminate', TRUE) ) { - args <- validate( + VAL_IN_ENV( x=x, warn=warn, ctl=ctl, normalize=normalize, carry=carry, terminate=terminate ) - width <- as.integer(width) if(!is.numeric(width) || length(width) != 1L || is.na(width) || width < 0) stop( "Argument `width` must be a positive scalar numeric representable ", "as an integer." ) + width <- as.integer(width) # can assume all term cap available for these purposes term.cap.int <- seq_along(VALID.TERM.CAP) # a bit inefficient to rely on strwrap, but oh well - res <- with( - args, - .Call( + res <- .Call( FANSI_strwrap_csi, enc2utf8(x), width, 0L, 0L, # indent, exdent @@ -72,7 +70,7 @@ strtrim_ctl <- function( normalize, carry, terminate - ) ) + ) if(normalize) normalize_sgr(res) else res } #' @export @@ -86,29 +84,26 @@ strtrim2_ctl <- function( carry=getOption('fansi.carry', FALSE), terminate=getOption('fansi.terminate', TRUE) ) { - args <- validate( + VAL_IN_ENV( x=x, warn=warn, ctl=ctl, tabs.as.spaces=tabs.as.spaces, tab.stops=tab.stops, normalize=normalize, carry=carry, terminate=terminate ) - width <- as.integer(width) if(!is.numeric(width) || length(width) != 1L || is.na(width) || width < 0) stop( "Argument `width` must be a positive scalar numeric representable ", "as an integer." ) - # can assume all term cap available for these purposes + width <- as.integer(width) + # can assume all term cap available for these purposes term.cap.int <- seq_along(VALID.TERM.CAP) width <- as.integer(width) tab.stops <- as.integer(tab.stops) # a bit inefficient to rely on strwrap, but oh well - - res <- with( - args, - .Call( + res <- .Call( FANSI_strwrap_csi, enc2utf8(x), width, 0L, 0L, # indent, exdent @@ -120,7 +115,7 @@ strtrim2_ctl <- function( TRUE, # first only ctl.int, normalize, carry, terminate - ) ) + ) if(normalize) normalize_sgr(res) else res } #' @export diff --git a/R/strwrap.R b/R/strwrap.R index e900ff21..8ac3bfb2 100644 --- a/R/strwrap.R +++ b/R/strwrap.R @@ -109,31 +109,29 @@ strwrap_ctl <- function( carry=getOption('fansi.carry', FALSE), terminate=getOption('fansi.terminate', TRUE) ) { - args <- validate( + VAL_IN_ENV( x=x, warn=warn, term.cap=term.cap, ctl=ctl, normalize=normalize, carry=carry, terminate=terminate ) - args.basic <- validate_wrap_basic(width, indent, exdent, prefix, initial) - with( - c(args.basic, args), { - res <- .Call( - FANSI_strwrap_csi, - x, width, indent, exdent, - enc2utf8(prefix), enc2utf8(initial), - FALSE, "", - TRUE, - FALSE, 8L, - warn, term.cap.int, - FALSE, # first_only - ctl.int, normalize, - carry, terminate - ) - if(simplify) { - if(normalize) normalize_sgr(unlist(res), warn, term.cap) - else unlist(res) - } else { - if(normalize) normalize_sgr_list(res, warn, term.cap.int) else res - } } ) + VAL_WRAP_IN_ENV(width, indent, exdent, prefix, initial, pad.end="") + res <- .Call( + FANSI_strwrap_csi, + x, width, indent, exdent, + prefix, initial, + FALSE, "", + TRUE, + FALSE, 8L, + warn, term.cap.int, + FALSE, # first_only + ctl.int, normalize, + carry, terminate + ) + if(simplify) { + if(normalize) normalize_sgr(unlist(res), warn, term.cap) + else unlist(res) + } else { + if(normalize) normalize_sgr_list(res, warn, term.cap.int) else res + } } #' @export #' @rdname strwrap_ctl @@ -150,57 +148,43 @@ strwrap2_ctl <- function( carry=getOption('fansi.carry', FALSE), terminate=getOption('fansi.terminate', TRUE) ) { - args.basic <- - validate_wrap_basic(width, indent, exdent, prefix, initial, pad.end) - args <- validate( - x=x, warn=warn, term.cap=term.cap, ctl=ctl, normalize=normalize, - carry=carry, terminate=terminate, tab.stops=tab.stops, - tabs.as.spaces=tabs.as.spaces, strip.spaces=strip.spaces - ) - if(!is.character(pad.end) || length(pad.end) != 1 || nchar(pad.end) > 1) - stop("Argument `pad.end` must be a one character or empty string.") if(!is.logical(wrap.always)) wrap.always <- as.logical(wrap.always) if(length(wrap.always) != 1L || is.na(wrap.always)) stop("Argument `wrap.always` must be TRUE or FALSE.") if(!is.logical(tabs.as.spaces)) tabs.as.spaces <- as.logical(tabs.as.spaces) if(wrap.always && width < 2L) stop("Width must be at least 2 in `wrap.always` mode.") - if(!is.character(prefix)) prefix <- as.character(prefix) - if(length(prefix) != 1L) - stop("Argument `prefix` must be a scalar character.") - if(!is.character(initial)) initial <- as.character(initial) - if(length(initial) != 1L) - stop("Argument `initial` must be a scalar character.") - prefix <- enc2utf8(prefix) - if(Encoding(prefix) == "bytes") - stop("Argument `prefix` cannot be \"bytes\" encoded.") - initial <- enc2utf8(initial) - if(Encoding(initial) == "bytes") - stop("Argument `initial` cannot be \"bytes\" encoded.") + VAL_IN_ENV ( + x=x, warn=warn, term.cap=term.cap, ctl=ctl, normalize=normalize, + carry=carry, terminate=terminate, tab.stops=tab.stops, + tabs.as.spaces=tabs.as.spaces, strip.spaces=strip.spaces + ) + if(tabs.as.spaces && strip.spaces) + stop("`tabs.as.spaces` and `strip.spaces` should not both be TRUE.") + # This changes `width`, so needs to happen after the first width validation + VAL_WRAP_IN_ENV(width, indent, exdent, prefix, initial, pad.end) tab.stops <- as.integer(tab.stops) - with( - c(args.basic, args), { - res <- .Call( - FANSI_strwrap_csi, - x, width, - indent, exdent, - prefix, initial, - wrap.always, pad.end, - strip.spaces, - tabs.as.spaces, tab.stops, - warn, term.cap.int, - FALSE, # first_only - ctl.int, normalize, - carry, terminate - ) - if(simplify) { - if(normalize) normalize_sgr(unlist(res), warn, term.cap) - else unlist(res) - } else { - if(normalize) normalize_sgr_list(res, warn, term.cap.int) else res - } } ) + res <- .Call( + FANSI_strwrap_csi, + x, width, + indent, exdent, + prefix, initial, + wrap.always, pad.end, + strip.spaces, + tabs.as.spaces, tab.stops, + warn, term.cap.int, + FALSE, # first_only + ctl.int, normalize, + carry, terminate + ) + if(simplify) { + if(normalize) normalize_sgr(unlist(res), warn, term.cap) + else unlist(res) + } else { + if(normalize) normalize_sgr_list(res, warn, term.cap.int) else res + } } #' @export #' @rdname strwrap_ctl @@ -245,10 +229,11 @@ strwrap2_sgr <- function( carry=carry, terminate=terminate ) -validate_wrap_basic <- function( +VAL_WRAP_IN_ENV <- function( width, indent, exdent, prefix, initial, pad.end ) { call <- sys.call(-1) + env <- parent.frame() stop2 <- function(x) stop(simpleError(x, call)) is_scl_int_pos <- function(x, name, strict=FALSE) { x <- as.integer(x) @@ -259,17 +244,48 @@ validate_wrap_basic <- function( stop2( sprintf( "Argument `%s` %s.", name, - "must be a positive scalar numeric representable as integer." + "must be a positive scalar numeric representable as integer" ) ) x } - width <- is_scl_int_pos(width, 'width', strict=TRUE) exdent <- is_scl_int_pos(exdent, 'exdent', strict=FALSE) indent <- is_scl_int_pos(indent, 'indent', strict=FALSE) - width <- max(c(as.integer(width) - 1L, 1L)) + if(is.numeric(width)) + width <- as.integer(min(c(max(c(min(width), 2L)), .Machine$integer.max))) + else stop2("Argument `width` must be numeric.") + # technically + width <- is_scl_int_pos(width, 'width', strict=TRUE) + width <- width - 1L + + if(!is.character(prefix)) prefix <- as.character(prefix) + if(length(prefix) != 1L) + stop2("Argument `prefix` must be a scalar character.") + prefix <- enc2utf8(prefix) + if(Encoding(prefix) == "bytes") + stop2("Argument `prefix` cannot be \"bytes\" encoded.") + + if(!is.character(initial)) initial <- as.character(initial) + if(length(initial) != 1L) + stop2("Argument `initial` must be a scalar character.") + initial <- enc2utf8(initial) + if(Encoding(initial) == "bytes") + stop2("Argument `initial` cannot be \"bytes\" encoded.") + + if(!is.character(pad.end)) pad.end <- as.character(pad.end) + if(length(pad.end) != 1L) + stop2("Argument `pad.end` must be a scalar character.") + pad.end <- enc2utf8(pad.end) + if(Encoding(pad.end) == "bytes") + stop2("Argument `pad.end` cannot be \"bytes\" encoded.") + if(nchar(pad.end, type='bytes') > 1L) + stop2("Argument `pad.end` must be at most one byte long.") - list( - width=width, indent=indent, exdent=exdent, prefix=prefix, initial=initial + list2env( + list( + width=width, indent=indent, exdent=exdent, prefix=prefix, initial=initial, + pad.end=pad.end + ), + env ) } diff --git a/R/substr2.R b/R/substr2.R index e5a9f217..dcab6f00 100644 --- a/R/substr2.R +++ b/R/substr2.R @@ -159,7 +159,7 @@ substr2_ctl <- function( carry=getOption('fansi.carry', FALSE), terminate=getOption('fansi.terminate', TRUE) ) { - args <- validate( + VAL_IN_ENV( x=x, warn=warn, term.cap=term.cap, ctl=ctl, normalize=normalize, carry=carry, terminate=terminate, tab.stops=tab.stops, tabs.as.spaces=tabs.as.spaces @@ -192,19 +192,16 @@ substr2_ctl <- function( res <- x no.na <- !(is.na(x) | is.na(start & stop)) - res[no.na] <- with( - args, - substr_ctl_internal( - x[no.na], start=start[no.na], stop=stop[no.na], - type.int=type.m, - tabs.as.spaces=tabs.as.spaces, tab.stops=tab.stops, warn=warn, - term.cap.int=term.cap.int, - round.start=round == 'start' || round == 'both', - round.stop=round == 'stop' || round == 'both', - x.len=length(x), - ctl.int=ctl.int, normalize=normalize, - carry=carry, terminate=terminate - ) + res[no.na] <- substr_ctl_internal( + x[no.na], start=start[no.na], stop=stop[no.na], + type.int=type.m, + tabs.as.spaces=tabs.as.spaces, tab.stops=tab.stops, warn=warn, + term.cap.int=term.cap.int, + round.start=round == 'start' || round == 'both', + round.stop=round == 'stop' || round == 'both', + x.len=length(x), + ctl.int=ctl.int, normalize=normalize, + carry=carry, terminate=terminate ) res[!no.na] <- NA_character_ res diff --git a/R/tohtml.R b/R/tohtml.R index 0d4e0681..4dfc3d91 100644 --- a/R/tohtml.R +++ b/R/tohtml.R @@ -94,6 +94,8 @@ #' @note `sgr_to_html` always terminates as not doing so produces #' invalid HTML. If you wish for the last active SPAN to bleed into #' subsequent text you may do so with e.g. `sub("$", "", x)`. +#' Additionally, `sgr_to_html` uses `carry = TRUE` by default, unlike other +#' `fansi` functions that share that parameter. #' @examples #' sgr_to_html("hello\033[31;42;1mworld\033[m") #' sgr_to_html("hello\033[31;42;1mworld\033[m", classes=TRUE) @@ -150,10 +152,9 @@ sgr_to_html <- function( x, warn=getOption('fansi.warn'), term.cap=getOption('fansi.term.cap'), classes=FALSE, - carry=getOption('fansi.carry', FALSE) + carry=getOption('fansi.carry', TRUE) # different from other functions ) { - args <- validate(x=x, warn=warn, term.cap=term.cap, carry=carry) - + VAL_IN_ENV(x=x, warn=warn, term.cap=term.cap, carry=carry) classes <- if(isTRUE(classes)) { FANSI.CLASSES } else if (identical(classes, FALSE)) { @@ -163,7 +164,7 @@ sgr_to_html <- function( } else stop("Argument `classes` must be TRUE, FALSE, or a character vector.") - with(args, .Call(FANSI_esc_to_html, x, warn, term.cap.int, classes, carry)) + .Call(FANSI_esc_to_html, x, warn, term.cap.int, classes, carry) } #' Generate CSS Mapping Classes to Colors #' diff --git a/R/unhandled.R b/R/unhandled.R index ad447caf..2f818e81 100644 --- a/R/unhandled.R +++ b/R/unhandled.R @@ -74,8 +74,8 @@ #' unhandled_ctl(string) unhandled_ctl <- function(x, term.cap=getOption('fansi.term.cap')) { - args <- validate(x=x, term.cap=term.cap) - res <- with(args, .Call(FANSI_unhandled_esc, x, term.cap.int)) + VAL_IN_ENV(x=x, term.cap=term.cap) + res <- .Call(FANSI_unhandled_esc, x, term.cap.int) names(res) <- c("index", "start", "stop", "error", "translated", "esc") errors <- c( 'unknown', 'special', 'exceed-term-cap', 'non-SGR', 'malformed-CSI', diff --git a/tests/run.R b/tests/run.R index 0a608d7b..9b0e3024 100644 --- a/tests/run.R +++ b/tests/run.R @@ -21,7 +21,7 @@ if(getRversion() < "3.2.2") { ) on.exit(old.opt) pattern <- "^[^.].*\\.[Rr]$" - pattern <- "interact" + # pattern <- "interact" unitize_dir( 'unitizer', pattern=pattern, diff --git a/tests/unitizer/wrap.R b/tests/unitizer/wrap.R index 5a9442a7..22506775 100644 --- a/tests/unitizer/wrap.R +++ b/tests/unitizer/wrap.R @@ -297,6 +297,9 @@ unitizer_sect("term cap and bright", { unitizer_sect("corner cases", { strwrap_ctl("a", -1) strwrap2_ctl("a", -1) + strwrap2_ctl("a", Inf) + strwrap2_ctl("a", NA_real_) + strwrap2_ctl("a", NA_integer_) strwrap2_ctl("a", -1, wrap.always=TRUE) strwrap2_ctl("a", 0, wrap.always=TRUE) strwrap2_ctl("a", 1, wrap.always=TRUE) From eb9b31023605eaae9609079e84c6b23c6c7308c6 Mon Sep 17 00:00:00 2001 From: brodieG Date: Wed, 16 Jun 2021 06:44:42 -0400 Subject: [PATCH 19/20] update docs and tests --- NAMESPACE | 2 + R/fansi-package.R | 91 +++++++++--------- R/misc.R | 6 +- R/nchar.R | 4 +- R/normalize.R | 6 +- R/sgr.R | 11 +-- R/strsplit.R | 19 ++-- R/strtrim.R | 13 ++- R/strwrap.R | 8 +- R/substr2.R | 40 ++++++-- R/tohtml.R | 5 +- R/unhandled.R | 3 +- man/fansi.Rd | 74 ++++++++++---- man/has_ctl.Rd | 8 +- man/html_esc.Rd | 3 + man/nchar_ctl.Rd | 9 +- man/normalize_sgr.Rd | 33 ++++--- man/sgr_at_end.Rd | 75 +++++++++++++++ man/sgr_to_html.Rd | 33 +++++-- man/strip_ctl.Rd | 8 +- man/strsplit_ctl.Rd | 54 ++++++++--- man/strtrim_ctl.Rd | 45 +++++++-- man/strwrap_ctl.Rd | 48 +++++++-- man/substr_ctl.Rd | 63 +++++++++--- man/tabs_as_spaces.Rd | 4 +- man/term_cap_test.Rd | 2 +- man/unhandled_ctl.Rd | 4 +- tests/special/utf8.unitizer/data.rds | Bin 21457 -> 21439 bytes tests/unitizer/interactions.R | 1 + tests/unitizer/interactions.unitizer/data.rds | Bin 0 -> 7243 bytes tests/unitizer/misc.unitizer/data.rds | Bin 45391 -> 45733 bytes tests/unitizer/normalize.unitizer/data.rds | Bin 5747 -> 5630 bytes tests/unitizer/strsplit.unitizer/data.rds | Bin 5964 -> 6311 bytes tests/unitizer/substr.R | 16 +++ tests/unitizer/substr.unitizer/data.rds | Bin 10036 -> 10324 bytes tests/unitizer/wrap.unitizer/data.rds | Bin 25614 -> 26616 bytes 36 files changed, 489 insertions(+), 199 deletions(-) create mode 100644 man/sgr_at_end.Rd create mode 100644 tests/unitizer/interactions.unitizer/data.rds diff --git a/NAMESPACE b/NAMESPACE index 00017b96..58385457 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,5 +1,6 @@ # Generated by roxygen2: do not edit by hand +export(close_sgr) export(fansi_lines) export(has_ctl) export(has_sgr) @@ -14,6 +15,7 @@ export(nzchar_ctl) export(nzchar_sgr) export(set_knit_hooks) export(sgr_256) +export(sgr_at_end) export(sgr_to_html) export(strip_ctl) export(strip_sgr) diff --git a/R/fansi-package.R b/R/fansi-package.R index 4371ea60..778c7e65 100644 --- a/R/fansi-package.R +++ b/R/fansi-package.R @@ -116,40 +116,42 @@ #' the effect is the same as replacement (e.g. if you have a color active and #' pick another one). #' -#' @section SGR Interactions +#' @section SGR Interactions: #' #' The cumulative nature of SGR means that SGR in strings that are spliced will -#' interact with each other, and that a substring does not contain all the -#' formatting information that will affect its display. Since context affects -#' how SGR should be interpreted and output, `fansi` provides mechanisms by -#' which to communicate the context. -#' -#' One form of interaction is how a character vector provided to `fansi` -#' functions interact with itself. By default, `fansi` assumes that each -#' element in an input character vector is independent, but if the input -#' represents a single document with each element a line in it, this is an -#' incorrect interpretation. In that situation SGR from a prior line should -#' bleed into a subsequent line. Setting `carry = TRUE` enables the "single -#' document" interpretation. -#' -#' Another form of interaction is when `fansi` processed substrings are spliced -#' with or into other substrings. By default `fansi` automatically terminates -#' strings it processes if they contain active SGR. This prevents the SGR -#' therein from affecting display of external strings, which is useful e.g. when -#' arranging text in columns. We can allow the SGR to bleed into appended -#' strings by setting `terminate = FALSE`. `carry` is unaffected by `terminate` -#' as `fansi` records the ending SGR state prior to termination internally. +#' interact with each other. Additionally, a substring does not inherently +#' contain all the information required to recreate its formatting as it +#' appeared in its source string. +#' +#' One form of possible interaction to consider is how a character vector +#' provided to `fansi` functions interacts with itself. By default, `fansi` +#' assumes that each element in an input character vector is independent, but +#' this is incorrect if the input is a single document with each element a line +#' in it. In that situation unterminated SGR from each line should bleed into +#' subsequent ones. Setting `carry = TRUE` enables the "single document" +#' interpretation. [`sgr_to_html`] is the exception as for legacy reasons it +#' defaults to `carry = TRUE`. +#' +#' Another form of interaction is when substrings produced by `fansi` are +#' spliced with or into other substrings. By default `fansi` automatically +#' terminates substrings it produces if they contain active SGR. This prevents +#' the SGR therein from affecting display of external strings, which is useful +#' e.g. when arranging text in columns. We can allow the SGR to bleed into +#' appended strings by setting `terminate = FALSE`. `carry` is unaffected by +#' `terminate` as `fansi` records the ending SGR state prior to termination +#' internally. #' #' Finally, `fansi` strings will be affected by any active SGR in strings they #' are appended to. There are no parameters to control what happens -#' automatically, but `fansi` provides several functions that can help the user -#' get their desired outcome. `sgr_at_end` computes the active SGR at the end -#' of a string, this can then be prepended onto the _input_ of `fansi` functions -#' so that they are aware of what the active style at the beginning of the -#' string. Alternatively, one could use `close_sgr(sgr_at_end(...))` and -#' pre-pend that to the _output_ of `fansi` functions so they are unaffected by -#' preceding SGR (one could also just prepend "ESC[0m", see `?normalize_sgr` for -#' why that may not make sense). +#' automatically in this case, but `fansi` provides several functions that can +#' help the user get their desired outcome. `sgr_at_end` computes the active +#' SGR at the end of a string, this can then be prepended onto the _input_ of +#' `fansi` functions so that they are aware of what the active style at the +#' beginning of the string. Alternatively, one could use +#' `close_sgr(sgr_at_end(...))` and pre-pend that to the _output_ of `fansi` +#' functions so they are unaffected by preceding SGR. One could also just +#' prepend "ESC[0m", but in some cases as described in +#' [`?normalize_sgr`][normalize_sgr] that is sub-optimal. #' #' @section Encodings / UTF-8: #' @@ -197,24 +199,12 @@ #' computations, but for simplicity and also because R and our terminal do not #' do it properly either we are deferring the issue for now. #' -#' @section R < 3.2.2 support: -#' -#' Nominally you can build and run this package in R versions between 3.1.0 and -#' 3.2.1. Things should mostly work, but please be aware we do not run the test -#' suite under versions of R less than 3.2.2. One key degraded capability is -#' width computation of wide-display characters. Under R < 3.2.2 `fansi` will -#' assume every character is 1 display width. Additionally, `fansi` may not -#' always report malformed UTF-8 sequences as it usually does. One -#' exception to this is [`nchar_ctl`] as that is just a thin wrapper around -#' [`base::nchar`]. -#' #' @section Overflow: #' -#' The native code in this package assumes that all strings are NULL terminated -#' and no longer than (32 bit) INT_MAX (excluding the NULL). This should be a -#' safe assumption since the code is designed to work with STRSXPs and CHRSXPs. -#' Behavior is undefined and probably bad if you somehow manage to provide to -#' `fansi` strings that do not adhere to these assumptions. +#' The maximum length of input character vector elements allowed by `fansi` is +#' the 32 bit INT_MAX, excluding the terminating NULL. This appears to be the +#' limit for R character vector elements generally, but is enforced at the C +#' level nonetheless. #' #' It is possible that during processing strings that are shorter than INT_MAX #' would become longer than that. `fansi` checks for that overflow and will @@ -224,6 +214,17 @@ #' your system if `R_len_t`, the R type used to measure string lengths, is less #' than the processed length of the string. #' +#' @section R < 3.2.2 support: +#' +#' Nominally you can build and run this package in R versions between 3.1.0 and +#' 3.2.1. Things should mostly work, but please be aware we do not run the test +#' suite under versions of R less than 3.2.2. One key degraded capability is +#' width computation of wide-display characters. Under R < 3.2.2 `fansi` will +#' assume every character is 1 display width. Additionally, `fansi` may not +#' always report malformed UTF-8 sequences as it usually does. One +#' exception to this is [`nchar_ctl`] as that is just a thin wrapper around +#' [`base::nchar`]. +#' #' @useDynLib fansi, .registration=TRUE, .fixes="FANSI_" #' @docType package #' @name fansi diff --git a/R/misc.R b/R/misc.R index e665441d..20c1444f 100644 --- a/R/misc.R +++ b/R/misc.R @@ -27,8 +27,7 @@ #' `ctl` parameter only affects which _Control Sequences_ are considered zero #' width. Tabs will always be converted to spaces, irrespective of the `ctl` #' setting. -#' @seealso [fansi] for details on how _Control Sequences_ are -#' interpreted, particularly if you are getting unexpected results. +#' @inherit has_ctl seealso #' @export #' @inheritParams substr_ctl #' @param x character vector or object coercible to character; any tabs therein @@ -112,8 +111,7 @@ tabs_as_spaces <- function( #' codes in terminals that do not support them are more likely to be silently #' ignored, so `fansi` functions do not warn about those. #' -#' @seealso [fansi] for details on how _Control Sequences_ are -#' interpreted, particularly if you are getting unexpected results. +#' @inherit has_ctl seealso #' @export #' @return character the test vector, invisibly #' @examples diff --git a/R/nchar.R b/R/nchar.R index a0e1e8d2..6b8e54a3 100644 --- a/R/nchar.R +++ b/R/nchar.R @@ -34,9 +34,7 @@ #' @inheritSection substr_ctl _ctl vs. _sgr #' @note the `keepNA` parameter is ignored for R < 3.2.2. #' @export -#' @seealso [fansi] for details on how _Control Sequences_ are -#' interpreted, particularly if you are getting unexpected results, -#' [`strip_ctl`] for removing _Control Sequences_. +#' @inherit has_ctl seealso #' @examples #' nchar_ctl("\033[31m123\a\r") #' ## with some wide characters diff --git a/R/normalize.R b/R/normalize.R index e97f70d5..b0bba0d4 100644 --- a/R/normalize.R +++ b/R/normalize.R @@ -37,15 +37,13 @@ #' #' Normalization was implemented primarily for better compatibility with #' [`crayon`][1] which emits SGR codes individually and assumes that -#' individual each opening code is paired up with its specific closing -#' code. +#' each opening code is paired up with its specific closing code. #' #' [1]: https://cran.r-project.org/package=crayon #' #' @export -#' @seealso [`fansi`] for details on how _Control Sequences_ are -#' interpreted, particularly if you are getting unexpected results. #' @inheritParams substr_ctl +#' @inherit has_ctl seealso #' @return `x`, with all SGRs normalized. #' @examples #' normalize_sgr("hello\033[42;33m world") diff --git a/R/sgr.R b/R/sgr.R index 03c175a7..fb26a053 100644 --- a/R/sgr.R +++ b/R/sgr.R @@ -29,10 +29,9 @@ #' **but** that option will be stripped. #' #' @note Non-ASCII strings are converted to and returned in UTF-8 encoding. -#' @seealso [fansi] for details on how _Control Sequences_ are -#' interpreted, particularly if you are getting unexpected results. #' @inheritParams substr_ctl #' @inheritSection substr_ctl _ctl vs. _sgr +#' @inherit has_ctl seealso #' @export #' @param ctl character, any combination of the following values (see details): #' * "nl": strip newlines. @@ -87,7 +86,7 @@ strip_sgr <- function(x, warn=getOption('fansi.warn')) { #' with the `ctl` parameter. #' #' @export -#' @seealso [fansi] for details on how _Control Sequences_ are +#' @seealso [`?fansi`][fansi] for details on how _Control Sequences_ are #' interpreted, particularly if you are getting unexpected results. #' @inheritParams substr_ctl #' @inheritParams strip_ctl @@ -123,16 +122,16 @@ has_sgr <- function(x, warn=getOption('fansi.warn')) #' #' `sgr_at_end` read input strings computing the accumulated SGR codes until the #' end of the string and outputs the active SGR code at the end of it. -#' #' `close_sgr` produces the ANSI CSI SGR sequence that closes active SGR codes #' at the end of the input string. If `normalize = FALSE` (default), it will #' issue the global closing SGR "ESC[0m", so it is only interesting if #' `normalize = TRUE`. Unlike `sgr_at_end` and other functions `close_sgr` has -#' no concept of `carry`: it will only close SGR codes activated within each -#' element. +#' no concept of `carry`: it will only close SGR codes activated within an +#' element that are still active at the end of that element. #' #' @export #' @inheritParams substr_ctl +#' @inherit has_ctl seealso #' @return character vector same length as `x`. #' @examples #' x <- c("\033[44mhello", "\033[33mworld") diff --git a/R/strsplit.R b/R/strsplit.R index da191a02..81e23982 100644 --- a/R/strsplit.R +++ b/R/strsplit.R @@ -16,7 +16,7 @@ #' ANSI Control Sequence Aware Version of strsplit #' -#' A drop-in replacement for [base::strsplit]. It will be noticeably slower, +#' A drop-in replacement for [`base::strsplit`]. It will be noticeably slower, #' but should otherwise behave the same way except for _Control Sequence_ #' awareness. #' @@ -28,20 +28,18 @@ #' You can however limit which control sequences are treated specially via the #' `ctl` parameters (see examples). #' -#' @note Non-ASCII strings are converted to and returned in UTF-8 encoding. The -#' split positions are computed after both `x` and `split` are converted to -#' UTF-8. -#' @seealso [`fansi`] for details on how _Control Sequences_ are -#' interpreted, particularly if you are getting unexpected results, -#' [`normalize_sgr`] for more details on what the `normalize` parameter does, -#' [base::strsplit] for details on the splitting. +#' @note The split positions are computed after both `x` and `split` are +#' converted to UTF-8. #' @export -#' @param x a character vector, or, unlike [base::strsplit] an object that can +#' @param x a character vector, or, unlike [`base::strsplit`] an object that can #' be coerced to character. #' @inheritParams base::strsplit #' @inheritParams strwrap_ctl +#' @inherit substr_ctl seealso +#' @note Non-ASCII strings are converted to and returned in UTF-8 encoding. +#' Width calculations will not work properly in R < 3.2.2. #' @inheritSection substr_ctl _ctl vs. _sgr -#' @return list, see [base::strsplit]. +#' @inherit base::strsplit return #' @examples #' strsplit_sgr("\033[31mhello\033[42m world!", " ") #' @@ -50,7 +48,6 @@ #' strsplit_sgr("\033[31mhello\033[42m\nworld!", "\n") #' strsplit_ctl("\033[31mhello\033[42m\nworld!", "\n", ctl=c("all", "nl")) - strsplit_ctl <- function( x, split, fixed=FALSE, perl=FALSE, useBytes=FALSE, warn=getOption('fansi.warn'), term.cap=getOption('fansi.term.cap'), diff --git a/R/strtrim.R b/R/strtrim.R index a11cdf3e..e7c89dc1 100644 --- a/R/strtrim.R +++ b/R/strtrim.R @@ -16,21 +16,20 @@ #' ANSI Control Sequence Aware Version of strtrim #' -#' One difference with [base::strtrim] is that all C0 control characters such as -#' newlines, carriage returns, etc., are treated as zero width. +#' One difference with [`base::strtrim`] is that all C0 control characters such +#' as newlines, carriage returns, etc., are always treated as zero width, +#' whereas in base it may vary with platform / R version. #' #' `strtrim2_ctl` adds the option of converting tabs to spaces before trimming. #' This is the only difference between `strtrim_ctl` and `strtrim2_ctl`. #' -#' @note Non-ASCII strings are converted to and returned in UTF-8 encoding. -#' Width calculations will not work correctly with R < 3.2.2. #' @export +#' @note Non-ASCII strings are converted to and returned in UTF-8 encoding. +#' Width calculations will not work properly in R < 3.2.2. #' @inheritSection substr_ctl _ctl vs. _sgr -#' @seealso [`fansi`] for details on how _Control Sequences_ are -#' interpreted, particularly if you are getting unexpected results, -#' [`normalize_sgr`] for more details on what the `normalize` parameter does. #' @inheritParams base::strtrim #' @inheritParams strwrap_ctl +#' @inherit substr_ctl seealso #' @examples #' strtrim_ctl("\033[42mHello world\033[m", 6) diff --git a/R/strwrap.R b/R/strwrap.R index 8ac3bfb2..cbb5b66e 100644 --- a/R/strwrap.R +++ b/R/strwrap.R @@ -33,15 +33,13 @@ #' Additionally,`indent`, `exdent`, `initial`, and `prefix` will be ignored when #' computing tab positions. #' -#' @note Non-ASCII strings are converted to and returned in UTF-8 encoding. -#' Width calculations will not work correctly with R < 3.2.2. -#' @seealso [`fansi`] for details on how _Control Sequences_ are -#' interpreted, particularly if you are getting unexpected results, -#' [`normalize_sgr`] for more details on what the `normalize` parameter does. #' @inheritParams base::strwrap #' @inheritParams tabs_as_spaces #' @inheritParams substr_ctl #' @inheritSection substr_ctl _ctl vs. _sgr +#' @inherit substr_ctl seealso +#' @note Non-ASCII strings are converted to and returned in UTF-8 encoding. +#' Width calculations will not work properly in R < 3.2.2. #' @param wrap.always TRUE or FALSE (default), whether to hard wrap at requested #' width if no word breaks are detected within a line. If set to TRUE then #' `width` must be at least 2. diff --git a/R/substr2.R b/R/substr2.R index dcab6f00..5268b057 100644 --- a/R/substr2.R +++ b/R/substr2.R @@ -25,7 +25,7 @@ #' `substr2_ctl` and `substr2_sgr` add the ability to retrieve substrings based #' on display width, and byte width in addition to the normal character width. #' `substr2_ctl` also provides the option to convert tabs to spaces with -#' [tabs_as_spaces] prior to taking substrings. +#' [`tabs_as_spaces`] prior to taking substrings. #' #' Because exact substrings on anything other than character width cannot be #' guaranteed (e.g. as a result of multi-byte encodings, or double display-width @@ -62,11 +62,14 @@ #' `*_ctl` versions with the `ctl` parameter set to "sgr". #' #' @note Non-ASCII strings are converted to and returned in UTF-8 encoding. +#' Width calculations will not work properly in R < 3.2.2. #' @inheritParams base::substr #' @export -#' @seealso [`fansi`] for details on how _Control Sequences_ are +#' @seealso [`?fansi`][fansi] for details on how _Control Sequences_ are #' interpreted, particularly if you are getting unexpected results, -#' [`normalize_sgr`] for more details on what the `normalize` parameter does. +#' [`normalize_sgr`] for more details on what the `normalize` parameter does, +#' [`sgr_at_end`] to compute active SGR at the end of strings, [`close_sgr`] +#' to compute the SGR required to close active SGR. #' @param x a character vector or object that can be coerced to such. #' @param type character(1L) partial matching `c("chars", "width")`, although #' `type="width"` only works correctly with R >= 3.2.2. With "width", whether @@ -99,18 +102,32 @@ #' @param warn TRUE (default) or FALSE, whether to warn when potentially #' problematic _Control Sequences_ are encountered. These could cause the #' assumptions `fansi` makes about how strings are rendered on your display -#' to be incorrect, for example by moving the cursor (see [fansi]). +#' to be incorrect, for example by moving the cursor (see [`?fansi`][fansi]). #' @param term.cap character a vector of the capabilities of the terminal, can #' be any combination of "bright" (SGR codes 90-97, 100-107), "256" (SGR codes #' starting with "38;5" or "48;5"), and "truecolor" (SGR codes starting with #' "38;2" or "48;2"). Changing this parameter changes how `fansi` #' interprets escape sequences, so you should ensure that it matches your -#' terminal capabilities. See [term_cap_test] for details. +#' terminal capabilities. See [`term_cap_test`] for details. #' @param normalize TRUE or FALSE (default) whether SGR sequence should be #' normalized out such that there is one distinct sequence for each SGR code. #' normalized strings will occupy more space (e.g. "\033[31;42m" becomes #' "\033[31m\033[42m"), but will work better with code that assumes each SGR #' code will be in its own escape as `crayon` does. +#' @param carry TRUE, FALSE, or a scalar string, controls whether active SGR +#' present at the end of an input vector element is carried into the next +#' vector element. If FALSE each vector element is interpreted as if there +#' were no active SGR present when they begin. If character, then the active +#' SGR at the end of the `carry` string is carried into the first element of +#' `x`. For every function except [`sgr_to_html`] this argument defaults to +#' FALSE. See the "SGR Interactions" section of [`?fansi`][fansi] for +#' details. +#' @param terminate TRUE (default) or FALSE whether substrings should have +#' active SGR closed to avoid it bleeding into other strings they may be +#' prepended onto. See the "SGR Interactions" section of [`?fansi`][fansi] for +#' details. +#' @return a character vector of the same length and with the same attributes as +#' x (after possible coercion and re-encoding to UTF-8). #' @examples #' substr_ctl("\033[42mhello\033[m world", 1, 9) #' substr_ctl("\033[42mhello\033[m world", 3, 9) @@ -118,9 +135,7 @@ #' ## Width 2 and 3 are in the middle of an ideogram as #' ## start and stop positions respectively, so we control #' ## what we get with `round` -#' #' cn.string <- paste0("\033[42m", "\u4E00\u4E01\u4E03", "\033[m") -#' #' substr2_ctl(cn.string, 2, 3, type='width') #' substr2_ctl(cn.string, 2, 3, type='width', round='both') #' substr2_ctl(cn.string, 2, 3, type='width', round='start') @@ -128,10 +143,19 @@ #' #' ## the _sgr variety only treat as special CSI SGR, #' ## compare the following: -#' #' substr_sgr("\033[31mhello\tworld", 1, 6) #' substr_ctl("\033[31mhello\tworld", 1, 6) #' substr_ctl("\033[31mhello\tworld", 1, 6, ctl=c('all', 'c0')) +#' +#' ## `carry` allows SGR to carry from one element to the next +#' substr_sgr(c("\033[33mhello", "world"), 1, 3) +#' substr_sgr(c("\033[33mhello", "world"), 1, 3, carry=TRUE) +#' substr_sgr(c("\033[33mhello", "world"), 1, 3, carry="\033[44m") +#' +#' ## We can omit the termination +#' bleed <- substr_sgr(c("\033[41hello", "world"), 1, 3, terminate=FALSE) +#' \dontrun{writeLines(bleed)} # Style will bleed out of string +#' writeLines("\033[m") # Stop bleeding if needed substr_ctl <- function( x, start, stop, diff --git a/R/tohtml.R b/R/tohtml.R index 4dfc3d91..ed8c31e6 100644 --- a/R/tohtml.R +++ b/R/tohtml.R @@ -50,10 +50,7 @@ #' @export #' @family HTML functions #' @inheritParams substr_ctl -#' @seealso [`fansi`] for details on how _Control Sequences_ are -#' interpreted, particularly if you are getting unexpected results, -#' [`set_knit_hooks`] for how to use ANSI CSI styled text with knitr and HTML -#' output, [`sgr_256`] to generate a demo string with all 256 8 bit colors. +#' @inherit substr_ctl seealso #' @param classes FALSE (default), TRUE, or character vector of either 16, #' 32, or 512 class names. Character strings may only contain ASCII #' characters corresponding to letters, numbers, the hyphen, or the diff --git a/R/unhandled.R b/R/unhandled.R index 2f818e81..4c3559d6 100644 --- a/R/unhandled.R +++ b/R/unhandled.R @@ -58,8 +58,7 @@ #' #' @note Non-ASCII strings are converted to UTF-8 encoding. #' @export -#' @seealso [fansi] for details on how _Control Sequences_ are -#' interpreted, particularly if you are getting unexpected results. +#' @inherit has_ctl seealso #' @param x character vector #' @inheritParams substr_ctl #' @return data frame with as many rows as there are unhandled escape diff --git a/man/fansi.Rd b/man/fansi.Rd index 8d90179d..e3bbffcb 100644 --- a/man/fansi.Rd +++ b/man/fansi.Rd @@ -111,6 +111,45 @@ the effect is the same as replacement (e.g. if you have a color active and pick another one). } +\section{SGR Interactions}{ + + +The cumulative nature of SGR means that SGR in strings that are spliced will +interact with each other. Additionally, a substring does not inherently +contain all the information required to recreate its formatting as it +appeared in its source string. + +One form of possible interaction to consider is how a character vector +provided to \code{fansi} functions interacts with itself. By default, \code{fansi} +assumes that each element in an input character vector is independent, but +this is incorrect if the input is a single document with each element a line +in it. In that situation unterminated SGR from each line should bleed into +subsequent ones. Setting \code{carry = TRUE} enables the "single document" +interpretation. \code{\link{sgr_to_html}} is the exception as for legacy reasons it +defaults to \code{carry = TRUE}. + +Another form of interaction is when substrings produced by \code{fansi} are +spliced with or into other substrings. By default \code{fansi} automatically +terminates substrings it produces if they contain active SGR. This prevents +the SGR therein from affecting display of external strings, which is useful +e.g. when arranging text in columns. We can allow the SGR to bleed into +appended strings by setting \code{terminate = FALSE}. \code{carry} is unaffected by +\code{terminate} as \code{fansi} records the ending SGR state prior to termination +internally. + +Finally, \code{fansi} strings will be affected by any active SGR in strings they +are appended to. There are no parameters to control what happens +automatically in this case, but \code{fansi} provides several functions that can +help the user get their desired outcome. \code{sgr_at_end} computes the active +SGR at the end of a string, this can then be prepended onto the \emph{input} of +\code{fansi} functions so that they are aware of what the active style at the +beginning of the string. Alternatively, one could use +\code{close_sgr(sgr_at_end(...))} and pre-pend that to the \emph{output} of \code{fansi} +functions so they are unaffected by preceding SGR. One could also just +prepend "ESC[0m", but in some cases as described in +\code{\link[=normalize_sgr]{?normalize_sgr}} that is sub-optimal. +} + \section{Encodings / UTF-8}{ @@ -160,27 +199,13 @@ computations, but for simplicity and also because R and our terminal do not do it properly either we are deferring the issue for now. } -\section{R < 3.2.2 support}{ - - -Nominally you can build and run this package in R versions between 3.1.0 and -3.2.1. Things should mostly work, but please be aware we do not run the test -suite under versions of R less than 3.2.2. One key degraded capability is -width computation of wide-display characters. Under R < 3.2.2 \code{fansi} will -assume every character is 1 display width. Additionally, \code{fansi} may not -always report malformed UTF-8 sequences as it usually does. One -exception to this is \code{\link{nchar_ctl}} as that is just a thin wrapper around -\code{\link[base:nchar]{base::nchar}}. -} - \section{Overflow}{ -The native code in this package assumes that all strings are NULL terminated -and no longer than (32 bit) INT_MAX (excluding the NULL). This should be a -safe assumption since the code is designed to work with STRSXPs and CHRSXPs. -Behavior is undefined and probably bad if you somehow manage to provide to -\code{fansi} strings that do not adhere to these assumptions. +The maximum length of input character vector elements allowed by \code{fansi} is +the 32 bit INT_MAX, excluding the terminating NULL. This appears to be the +limit for R character vector elements generally, but is enforced at the C +level nonetheless. It is possible that during processing strings that are shorter than INT_MAX would become longer than that. \code{fansi} checks for that overflow and will @@ -191,3 +216,16 @@ your system if \code{R_len_t}, the R type used to measure string lengths, is les than the processed length of the string. } +\section{R < 3.2.2 support}{ + + +Nominally you can build and run this package in R versions between 3.1.0 and +3.2.1. Things should mostly work, but please be aware we do not run the test +suite under versions of R less than 3.2.2. One key degraded capability is +width computation of wide-display characters. Under R < 3.2.2 \code{fansi} will +assume every character is 1 display width. Additionally, \code{fansi} may not +always report malformed UTF-8 sequences as it usually does. One +exception to this is \code{\link{nchar_ctl}} as that is just a thin wrapper around +\code{\link[base:nchar]{base::nchar}}. +} + diff --git a/man/has_ctl.Rd b/man/has_ctl.Rd index b09cc783..7c134e65 100644 --- a/man/has_ctl.Rd +++ b/man/has_ctl.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/has.R +% Please edit documentation in R/sgr.R \name{has_ctl} \alias{has_ctl} \alias{has_sgr} @@ -10,7 +10,7 @@ has_ctl(x, ctl = "all", warn = getOption("fansi.warn"), which) has_sgr(x, warn = getOption("fansi.warn")) } \arguments{ -\item{x}{a character vector or object that can be coerced to character.} +\item{x}{a character vector or object that can be coerced to such.} \item{ctl}{character, which \emph{Control Sequences} should be treated specially. See the "_ctl vs. _sgr" section for details. @@ -28,7 +28,7 @@ above, in which case it means "all but". \item{warn}{TRUE (default) or FALSE, whether to warn when potentially problematic \emph{Control Sequences} are encountered. These could cause the assumptions \code{fansi} makes about how strings are rendered on your display -to be incorrect, for example by moving the cursor (see \link{fansi}).} +to be incorrect, for example by moving the cursor (see \code{\link[=fansi]{?fansi}}).} \item{which}{character, deprecated in favor of \code{ctl}.} } @@ -66,6 +66,6 @@ has_sgr("hello\033[31mworld\033[m") has_sgr("hello\nworld") } \seealso{ -\link{fansi} for details on how \emph{Control Sequences} are +\code{\link[=fansi]{?fansi}} for details on how \emph{Control Sequences} are interpreted, particularly if you are getting unexpected results. } diff --git a/man/html_esc.Rd b/man/html_esc.Rd index 8067895c..6e8a372a 100644 --- a/man/html_esc.Rd +++ b/man/html_esc.Rd @@ -17,6 +17,9 @@ be sufficient. @return \code{x}, but with the \code{what} characters replaced b their HTML entity codes, and Encoding set to UTF-8 if non-ASCII input are present in \code{x}.} } +\value{ +x possibly re-encoded to UTF8, with \code{what} characters escaped. +} \description{ Arbitrary text may contain characters with special meaning in HTML, which may cause HTML display to be corrupted if they are included unescaped in a web diff --git a/man/nchar_ctl.Rd b/man/nchar_ctl.Rd index 8fb12cd9..89fe0294 100644 --- a/man/nchar_ctl.Rd +++ b/man/nchar_ctl.Rd @@ -30,7 +30,7 @@ nzchar_ctl(x, keepNA = NA, ctl = "all", warn = getOption("fansi.warn")) nzchar_sgr(x, keepNA = NA, warn = getOption("fansi.warn")) } \arguments{ -\item{x}{a character vector or object that can be coerced to character.} +\item{x}{a character vector or object that can be coerced to such.} \item{type}{character(1L) partial matching \code{c("chars", "width")}, although \code{type="width"} only works correctly with R >= 3.2.2. With "width", whether @@ -66,7 +66,7 @@ above, in which case it means "all but". \item{warn}{TRUE (default) or FALSE, whether to warn when potentially problematic \emph{Control Sequences} are encountered. These could cause the assumptions \code{fansi} makes about how strings are rendered on your display -to be incorrect, for example by moving the cursor (see \link{fansi}).} +to be incorrect, for example by moving the cursor (see \code{\link[=fansi]{?fansi}}).} \item{strip}{character, deprecated in favor of \code{ctl}.} } @@ -126,7 +126,6 @@ nchar_sgr("\t\n\n123") nzchar_ctl("\n\033[42;31m\033[123P\a") } \seealso{ -\link{fansi} for details on how \emph{Control Sequences} are -interpreted, particularly if you are getting unexpected results, -\code{\link{strip_ctl}} for removing \emph{Control Sequences}. +\code{\link[=fansi]{?fansi}} for details on how \emph{Control Sequences} are +interpreted, particularly if you are getting unexpected results. } diff --git a/man/normalize_sgr.Rd b/man/normalize_sgr.Rd index 2b2f1c53..3aa23013 100644 --- a/man/normalize_sgr.Rd +++ b/man/normalize_sgr.Rd @@ -7,23 +7,33 @@ normalize_sgr( x, warn = getOption("fansi.warn"), - term.cap = getOption("fansi.term.cap") + term.cap = getOption("fansi.term.cap"), + carry = getOption("fansi.carry", FALSE) ) } \arguments{ -\item{x}{character vector to normalize the SGR control sequences of.} +\item{x}{a character vector or object that can be coerced to such.} \item{warn}{TRUE (default) or FALSE, whether to warn when potentially problematic \emph{Control Sequences} are encountered. These could cause the assumptions \code{fansi} makes about how strings are rendered on your display -to be incorrect, for example by moving the cursor (see \link{fansi}).} +to be incorrect, for example by moving the cursor (see \code{\link[=fansi]{?fansi}}).} \item{term.cap}{character a vector of the capabilities of the terminal, can be any combination of "bright" (SGR codes 90-97, 100-107), "256" (SGR codes starting with "38;5" or "48;5"), and "truecolor" (SGR codes starting with "38;2" or "48;2"). Changing this parameter changes how \code{fansi} interprets escape sequences, so you should ensure that it matches your -terminal capabilities. See \link{term_cap_test} for details.} +terminal capabilities. See \code{\link{term_cap_test}} for details.} + +\item{carry}{TRUE, FALSE, or a scalar string, controls whether active SGR +present at the end of an input vector element is carried into the next +vector element. If FALSE each vector element is interpreted as if there +were no active SGR present when they begin. If character, then the active +SGR at the end of the \code{carry} string is carried into the first element of +\code{x}. For every function except \code{\link{sgr_to_html}} this argument defaults to +FALSE. See the "SGR Interactions" section of \code{\link[=fansi]{?fansi}} for +details.} } \value{ \code{x}, with all SGRs normalized. @@ -47,12 +57,11 @@ other than it should be consistent for any given SGR state. The underlying assumption is that each element in the vector is unaffected by any styles in any other element or elsewhere. This may lead to surprising outcomes if these assumptions are untrue (see -examples). +examples). You may adjust this assumption with the \code{carry} parameter. Normalization was implemented primarily for better compatibility with \href{https://cran.r-project.org/package=crayon}{\code{crayon}} which emits SGR codes individually and assumes that -individual each opening code is paired up with its specific closing -code. +each opening code is paired up with its specific closing code. } \examples{ normalize_sgr("hello\033[42;33m world") @@ -69,14 +78,16 @@ identical( normalize_sgr("\033[31;32mhello\033[m"), normalize_sgr("\033[31mhe\033[49mllo\033[m") ) -## External SGR will defeat normalization +## External SGR will defeat normalization, unless we `carry` it +red <- "\033[41m" writeLines( c( - paste("\033[31m", "he\033[0mllo", "\033[0m"), - paste("\033[31m", normalize_sgr("he\033[0mllo"), "\033[0m") + paste(red, "he\033[0mllo", "\033[0m"), + paste(red, normalize_sgr("he\033[0mllo"), "\033[0m") + paste(red, normalize_sgr("he\033[0mllo", carry=red), "\033[0m") ) ) } \seealso{ -\code{\link{fansi}} for details on how \emph{Control Sequences} are +\code{\link[=fansi]{?fansi}} for details on how \emph{Control Sequences} are interpreted, particularly if you are getting unexpected results. } diff --git a/man/sgr_at_end.Rd b/man/sgr_at_end.Rd new file mode 100644 index 00000000..46d353f5 --- /dev/null +++ b/man/sgr_at_end.Rd @@ -0,0 +1,75 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/sgr.R +\name{sgr_at_end} +\alias{sgr_at_end} +\alias{close_sgr} +\title{Utilities for Managing SGR In Strings} +\usage{ +sgr_at_end( + x, + warn = getOption("fansi.warn"), + term.cap = getOption("fansi.term.cap"), + normalize = getOption("fansi.normalize", FALSE), + carry = getOption("fansi.carry", FALSE) +) + +close_sgr( + x, + warn = getOption("fansi.warn"), + normalize = getOption("fansi.normalize", FALSE) +) +} +\arguments{ +\item{x}{a character vector or object that can be coerced to such.} + +\item{warn}{TRUE (default) or FALSE, whether to warn when potentially +problematic \emph{Control Sequences} are encountered. These could cause the +assumptions \code{fansi} makes about how strings are rendered on your display +to be incorrect, for example by moving the cursor (see \code{\link[=fansi]{?fansi}}).} + +\item{term.cap}{character a vector of the capabilities of the terminal, can +be any combination of "bright" (SGR codes 90-97, 100-107), "256" (SGR codes +starting with "38;5" or "48;5"), and "truecolor" (SGR codes starting with +"38;2" or "48;2"). Changing this parameter changes how \code{fansi} +interprets escape sequences, so you should ensure that it matches your +terminal capabilities. See \code{\link{term_cap_test}} for details.} + +\item{normalize}{TRUE or FALSE (default) whether SGR sequence should be +normalized out such that there is one distinct sequence for each SGR code. +normalized strings will occupy more space (e.g. "\033[31;42m" becomes +"\033[31m\033[42m"), but will work better with code that assumes each SGR +code will be in its own escape as \code{crayon} does.} + +\item{carry}{TRUE, FALSE, or a scalar string, controls whether active SGR +present at the end of an input vector element is carried into the next +vector element. If FALSE each vector element is interpreted as if there +were no active SGR present when they begin. If character, then the active +SGR at the end of the \code{carry} string is carried into the first element of +\code{x}. For every function except \code{\link{sgr_to_html}} this argument defaults to +FALSE. See the "SGR Interactions" section of \code{\link[=fansi]{?fansi}} for +details.} +} +\value{ +character vector same length as \code{x}. +} +\description{ +\code{sgr_at_end} read input strings computing the accumulated SGR codes until the +end of the string and outputs the active SGR code at the end of it. +\code{close_sgr} produces the ANSI CSI SGR sequence that closes active SGR codes +at the end of the input string. If \code{normalize = FALSE} (default), it will +issue the global closing SGR "ESC[0m", so it is only interesting if +\code{normalize = TRUE}. Unlike \code{sgr_at_end} and other functions \code{close_sgr} has +no concept of \code{carry}: it will only close SGR codes activated within an +element that are still active at the end of that element. +} +\examples{ +x <- c("\033[44mhello", "\033[33mworld") +sgr_at_end(x) +sgr_at_end(x, carry=TRUE) +(close <- close_sgr(sgr_at_end(x, carry=TRUE), normalize=TRUE)) +writeLines(paste0(x, close, " no style")) +} +\seealso{ +\code{\link[=fansi]{?fansi}} for details on how \emph{Control Sequences} are +interpreted, particularly if you are getting unexpected results. +} diff --git a/man/sgr_to_html.Rd b/man/sgr_to_html.Rd index ee990ad7..63dad1b6 100644 --- a/man/sgr_to_html.Rd +++ b/man/sgr_to_html.Rd @@ -8,23 +8,24 @@ sgr_to_html( x, warn = getOption("fansi.warn"), term.cap = getOption("fansi.term.cap"), - classes = FALSE + classes = FALSE, + carry = getOption("fansi.carry", TRUE) ) } \arguments{ -\item{x}{a character vector or object that can be coerced to character.} +\item{x}{a character vector or object that can be coerced to such.} \item{warn}{TRUE (default) or FALSE, whether to warn when potentially problematic \emph{Control Sequences} are encountered. These could cause the assumptions \code{fansi} makes about how strings are rendered on your display -to be incorrect, for example by moving the cursor (see \link{fansi}).} +to be incorrect, for example by moving the cursor (see \code{\link[=fansi]{?fansi}}).} \item{term.cap}{character a vector of the capabilities of the terminal, can be any combination of "bright" (SGR codes 90-97, 100-107), "256" (SGR codes starting with "38;5" or "48;5"), and "truecolor" (SGR codes starting with "38;2" or "48;2"). Changing this parameter changes how \code{fansi} interprets escape sequences, so you should ensure that it matches your -terminal capabilities. See \link{term_cap_test} for details.} +terminal capabilities. See \code{\link{term_cap_test}} for details.} \item{classes}{FALSE (default), TRUE, or character vector of either 16, 32, or 512 class names. Character strings may only contain ASCII @@ -57,6 +58,15 @@ mapped. \item character(512): Like character(16), except the basic, bright, and all other 8-bit colors are mapped. }} + +\item{carry}{TRUE, FALSE, or a scalar string, controls whether active SGR +present at the end of an input vector element is carried into the next +vector element. If FALSE each vector element is interpreted as if there +were no active SGR present when they begin. If character, then the active +SGR at the end of the \code{carry} string is carried into the first element of +\code{x}. For every function except \code{\link{sgr_to_html}} this argument defaults to +FALSE. See the "SGR Interactions" section of \code{\link[=fansi]{?fansi}} for +details.} } \value{ A character vector of the same length as \code{x} with all escape @@ -97,6 +107,16 @@ cannot reproduce all inputs anyway does not seem worthwhile. } \note{ Non-ASCII strings are converted to and returned in UTF-8 encoding. + +Up to version 0.5.0, \code{html_esc} implicitly operated as if +\code{carry = TRUE}. This was different from other functions and was +changed to be consistent with them after that version. + +\code{sgr_to_html} always terminates as not doing so produces +invalid HTML. If you wish for the last active SPAN to bleed into +subsequent text you may do so with e.g. \code{sub("$", "", x)}. +Additionally, \code{sgr_to_html} uses \code{carry = TRUE} by default, unlike other +\code{fansi} functions that share that parameter. } \examples{ sgr_to_html("hello\033[31;42;1mworld\033[m") @@ -151,11 +171,6 @@ in_html(html.256, css=desaturated) # desaturated CSS } } \seealso{ -\code{\link{fansi}} for details on how \emph{Control Sequences} are -interpreted, particularly if you are getting unexpected results, -\code{\link{set_knit_hooks}} for how to use ANSI CSI styled text with knitr and HTML -output, \code{\link{sgr_256}} to generate a demo string with all 256 8 bit colors. - Other HTML functions: \code{\link{html_esc}()}, \code{\link{in_html}()}, diff --git a/man/strip_ctl.Rd b/man/strip_ctl.Rd index c4262311..8333cde1 100644 --- a/man/strip_ctl.Rd +++ b/man/strip_ctl.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/strip.R +% Please edit documentation in R/sgr.R \name{strip_ctl} \alias{strip_ctl} \alias{strip_sgr} @@ -10,7 +10,7 @@ strip_ctl(x, ctl = "all", warn = getOption("fansi.warn"), strip) strip_sgr(x, warn = getOption("fansi.warn")) } \arguments{ -\item{x}{a character vector or object that can be coerced to character.} +\item{x}{a character vector or object that can be coerced to such.} \item{ctl}{character, any combination of the following values (see details): \itemize{ @@ -27,7 +27,7 @@ above, in which case it means "all but" (see details). \item{warn}{TRUE (default) or FALSE, whether to warn when potentially problematic \emph{Control Sequences} are encountered. These could cause the assumptions \code{fansi} makes about how strings are rendered on your display -to be incorrect, for example by moving the cursor (see \link{fansi}).} +to be incorrect, for example by moving the cursor (see \code{\link[=fansi]{?fansi}}).} \item{strip}{character, deprecated in favor of \code{ctl}.} } @@ -84,6 +84,6 @@ strip_ctl(string, c("all", "nl", "c0")) strip_sgr(string) } \seealso{ -\link{fansi} for details on how \emph{Control Sequences} are +\code{\link[=fansi]{?fansi}} for details on how \emph{Control Sequences} are interpreted, particularly if you are getting unexpected results. } diff --git a/man/strsplit_ctl.Rd b/man/strsplit_ctl.Rd index 851a846c..4cd5d50e 100644 --- a/man/strsplit_ctl.Rd +++ b/man/strsplit_ctl.Rd @@ -14,7 +14,9 @@ strsplit_ctl( warn = getOption("fansi.warn"), term.cap = getOption("fansi.term.cap"), ctl = "all", - normalize = getOption("fansi.normalize", FALSE) + normalize = getOption("fansi.normalize", FALSE), + carry = getOption("fansi.carry", FALSE), + terminate = getOption("fansi.terminate", TRUE) ) strsplit_sgr( @@ -25,11 +27,13 @@ strsplit_sgr( useBytes = FALSE, warn = getOption("fansi.warn"), term.cap = getOption("fansi.term.cap"), - normalize = getOption("fansi.normalize", FALSE) + normalize = getOption("fansi.normalize", FALSE), + carry = getOption("fansi.carry", FALSE), + terminate = getOption("fansi.terminate", TRUE) ) } \arguments{ -\item{x}{a character vector, or, unlike \link[base:strsplit]{base::strsplit} an object that can +\item{x}{a character vector, or, unlike \code{\link[base:strsplit]{base::strsplit}} an object that can be coerced to character.} \item{split}{ @@ -57,14 +61,14 @@ be coerced to character.} \item{warn}{TRUE (default) or FALSE, whether to warn when potentially problematic \emph{Control Sequences} are encountered. These could cause the assumptions \code{fansi} makes about how strings are rendered on your display -to be incorrect, for example by moving the cursor (see \link{fansi}).} +to be incorrect, for example by moving the cursor (see \code{\link[=fansi]{?fansi}}).} \item{term.cap}{character a vector of the capabilities of the terminal, can be any combination of "bright" (SGR codes 90-97, 100-107), "256" (SGR codes starting with "38;5" or "48;5"), and "truecolor" (SGR codes starting with "38;2" or "48;2"). Changing this parameter changes how \code{fansi} interprets escape sequences, so you should ensure that it matches your -terminal capabilities. See \link{term_cap_test} for details.} +terminal capabilities. See \code{\link{term_cap_test}} for details.} \item{ctl}{character, which \emph{Control Sequences} should be treated specially. See the "_ctl vs. _sgr" section for details. @@ -84,12 +88,35 @@ normalized out such that there is one distinct sequence for each SGR code. normalized strings will occupy more space (e.g. "\033[31;42m" becomes "\033[31m\033[42m"), but will work better with code that assumes each SGR code will be in its own escape as \code{crayon} does.} + +\item{carry}{TRUE, FALSE, or a scalar string, controls whether active SGR +present at the end of an input vector element is carried into the next +vector element. If FALSE each vector element is interpreted as if there +were no active SGR present when they begin. If character, then the active +SGR at the end of the \code{carry} string is carried into the first element of +\code{x}. For every function except \code{\link{sgr_to_html}} this argument defaults to +FALSE. See the "SGR Interactions" section of \code{\link[=fansi]{?fansi}} for +details.} + +\item{terminate}{TRUE (default) or FALSE whether substrings should have +active SGR closed to avoid it bleeding into other strings they may be +prepended onto. See the "SGR Interactions" section of \code{\link[=fansi]{?fansi}} for +details.} } \value{ -list, see \link[base:strsplit]{base::strsplit}. +A list of the same length as \code{x}, the \code{i}-th element of which + contains the vector of splits of \code{x[i]}. + + If any element of \code{x} or \code{split} is declared to be in UTF-8 + (see \code{\link[base]{Encoding}}), all non-ASCII character strings in the + result will be in UTF-8 and have their encoding declared as UTF-8. + (This also holds if any element is declared to be Latin-1 except in a + Latin-1 locale.) + For \code{perl = TRUE, useBytes = FALSE} all non-ASCII strings in a + multibyte locale are translated to UTF-8. } \description{ -A drop-in replacement for \link[base:strsplit]{base::strsplit}. It will be noticeably slower, +A drop-in replacement for \code{\link[base:strsplit]{base::strsplit}}. It will be noticeably slower, but should otherwise behave the same way except for \emph{Control Sequence} awareness. } @@ -103,9 +130,11 @@ You can however limit which control sequences are treated specially via the \code{ctl} parameters (see examples). } \note{ -Non-ASCII strings are converted to and returned in UTF-8 encoding. The -split positions are computed after both \code{x} and \code{split} are converted to -UTF-8. +The split positions are computed after both \code{x} and \code{split} are +converted to UTF-8. + +Non-ASCII strings are converted to and returned in UTF-8 encoding. +Width calculations will not work properly in R < 3.2.2. } \section{_ctl vs. _sgr}{ @@ -132,8 +161,9 @@ strsplit_sgr("\033[31mhello\033[42m\nworld!", "\n") strsplit_ctl("\033[31mhello\033[42m\nworld!", "\n", ctl=c("all", "nl")) } \seealso{ -\code{\link{fansi}} for details on how \emph{Control Sequences} are +\code{\link[=fansi]{?fansi}} for details on how \emph{Control Sequences} are interpreted, particularly if you are getting unexpected results, \code{\link{normalize_sgr}} for more details on what the \code{normalize} parameter does, -\link[base:strsplit]{base::strsplit} for details on the splitting. +\code{\link{sgr_at_end}} to compute active SGR at the end of strings, \code{\link{close_sgr}} +to compute the SGR required to close active SGR. } diff --git a/man/strtrim_ctl.Rd b/man/strtrim_ctl.Rd index 6dd0b851..d45ab9c1 100644 --- a/man/strtrim_ctl.Rd +++ b/man/strtrim_ctl.Rd @@ -12,7 +12,9 @@ strtrim_ctl( width, warn = getOption("fansi.warn"), ctl = "all", - normalize = getOption("fansi.normalize", FALSE) + normalize = getOption("fansi.normalize", FALSE), + carry = getOption("fansi.carry", FALSE), + terminate = getOption("fansi.terminate", TRUE) ) strtrim2_ctl( @@ -22,14 +24,18 @@ strtrim2_ctl( tabs.as.spaces = getOption("fansi.tabs.as.spaces"), tab.stops = getOption("fansi.tab.stops"), ctl = "all", - normalize = getOption("fansi.normalize", FALSE) + normalize = getOption("fansi.normalize", FALSE), + carry = getOption("fansi.carry", FALSE), + terminate = getOption("fansi.terminate", TRUE) ) strtrim_sgr( x, width, warn = getOption("fansi.warn"), - normalize = getOption("fansi.normalize", FALSE) + normalize = getOption("fansi.normalize", FALSE), + carry = getOption("fansi.carry", FALSE), + terminate = getOption("fansi.terminate", TRUE) ) strtrim2_sgr( @@ -38,7 +44,9 @@ strtrim2_sgr( warn = getOption("fansi.warn"), tabs.as.spaces = getOption("fansi.tabs.as.spaces"), tab.stops = getOption("fansi.tab.stops"), - normalize = getOption("fansi.normalize", FALSE) + normalize = getOption("fansi.normalize", FALSE), + carry = getOption("fansi.carry", FALSE), + terminate = getOption("fansi.terminate", TRUE) ) } \arguments{ @@ -50,7 +58,7 @@ strtrim2_sgr( \item{warn}{TRUE (default) or FALSE, whether to warn when potentially problematic \emph{Control Sequences} are encountered. These could cause the assumptions \code{fansi} makes about how strings are rendered on your display -to be incorrect, for example by moving the cursor (see \link{fansi}).} +to be incorrect, for example by moving the cursor (see \code{\link[=fansi]{?fansi}}).} \item{ctl}{character, which \emph{Control Sequences} should be treated specially. See the "_ctl vs. _sgr" section for details. @@ -71,6 +79,20 @@ normalized strings will occupy more space (e.g. "\033[31;42m" becomes "\033[31m\033[42m"), but will work better with code that assumes each SGR code will be in its own escape as \code{crayon} does.} +\item{carry}{TRUE, FALSE, or a scalar string, controls whether active SGR +present at the end of an input vector element is carried into the next +vector element. If FALSE each vector element is interpreted as if there +were no active SGR present when they begin. If character, then the active +SGR at the end of the \code{carry} string is carried into the first element of +\code{x}. For every function except \code{\link{sgr_to_html}} this argument defaults to +FALSE. See the "SGR Interactions" section of \code{\link[=fansi]{?fansi}} for +details.} + +\item{terminate}{TRUE (default) or FALSE whether substrings should have +active SGR closed to avoid it bleeding into other strings they may be +prepended onto. See the "SGR Interactions" section of \code{\link[=fansi]{?fansi}} for +details.} + \item{tabs.as.spaces}{FALSE (default) or TRUE, whether to convert tabs to spaces. This can only be set to TRUE if \code{strip.spaces} is FALSE.} @@ -81,8 +103,9 @@ applying tab stops, each input line is considered a line and the character count begins from the beginning of the input line.} } \description{ -One difference with \link[base:strtrim]{base::strtrim} is that all C0 control characters such as -newlines, carriage returns, etc., are treated as zero width. +One difference with \code{\link[base:strtrim]{base::strtrim}} is that all C0 control characters such +as newlines, carriage returns, etc., are always treated as zero width, +whereas in base it may vary with platform / R version. } \details{ \code{strtrim2_ctl} adds the option of converting tabs to spaces before trimming. @@ -90,7 +113,7 @@ This is the only difference between \code{strtrim_ctl} and \code{strtrim2_ctl}. } \note{ Non-ASCII strings are converted to and returned in UTF-8 encoding. -Width calculations will not work correctly with R < 3.2.2. +Width calculations will not work properly in R < 3.2.2. } \section{_ctl vs. _sgr}{ @@ -112,7 +135,9 @@ only treat ANSI CSI SGR sequences specially, and are equivalent to the strtrim_ctl("\033[42mHello world\033[m", 6) } \seealso{ -\code{\link{fansi}} for details on how \emph{Control Sequences} are +\code{\link[=fansi]{?fansi}} for details on how \emph{Control Sequences} are interpreted, particularly if you are getting unexpected results, -\code{\link{normalize_sgr}} for more details on what the \code{normalize} parameter does. +\code{\link{normalize_sgr}} for more details on what the \code{normalize} parameter does, +\code{\link{sgr_at_end}} to compute active SGR at the end of strings, \code{\link{close_sgr}} +to compute the SGR required to close active SGR. } diff --git a/man/strwrap_ctl.Rd b/man/strwrap_ctl.Rd index 9114967f..99de4ab9 100644 --- a/man/strwrap_ctl.Rd +++ b/man/strwrap_ctl.Rd @@ -18,7 +18,9 @@ strwrap_ctl( warn = getOption("fansi.warn"), term.cap = getOption("fansi.term.cap"), ctl = "all", - normalize = getOption("fansi.normalize", FALSE) + normalize = getOption("fansi.normalize", FALSE), + carry = getOption("fansi.carry", FALSE), + terminate = getOption("fansi.terminate", TRUE) ) strwrap2_ctl( @@ -37,7 +39,9 @@ strwrap2_ctl( warn = getOption("fansi.warn"), term.cap = getOption("fansi.term.cap"), ctl = "all", - normalize = getOption("fansi.normalize", FALSE) + normalize = getOption("fansi.normalize", FALSE), + carry = getOption("fansi.carry", FALSE), + terminate = getOption("fansi.terminate", TRUE) ) strwrap_sgr( @@ -50,7 +54,9 @@ strwrap_sgr( initial = prefix, warn = getOption("fansi.warn"), term.cap = getOption("fansi.term.cap"), - normalize = getOption("fansi.normalize", FALSE) + normalize = getOption("fansi.normalize", FALSE), + carry = getOption("fansi.carry", FALSE), + terminate = getOption("fansi.terminate", TRUE) ) strwrap2_sgr( @@ -68,7 +74,9 @@ strwrap2_sgr( tab.stops = getOption("fansi.tab.stops"), warn = getOption("fansi.warn"), term.cap = getOption("fansi.term.cap"), - normalize = getOption("fansi.normalize", FALSE) + normalize = getOption("fansi.normalize", FALSE), + carry = getOption("fansi.carry", FALSE), + terminate = getOption("fansi.terminate", TRUE) ) } \arguments{ @@ -100,14 +108,14 @@ strwrap2_sgr( \item{warn}{TRUE (default) or FALSE, whether to warn when potentially problematic \emph{Control Sequences} are encountered. These could cause the assumptions \code{fansi} makes about how strings are rendered on your display -to be incorrect, for example by moving the cursor (see \link{fansi}).} +to be incorrect, for example by moving the cursor (see \code{\link[=fansi]{?fansi}}).} \item{term.cap}{character a vector of the capabilities of the terminal, can be any combination of "bright" (SGR codes 90-97, 100-107), "256" (SGR codes starting with "38;5" or "48;5"), and "truecolor" (SGR codes starting with "38;2" or "48;2"). Changing this parameter changes how \code{fansi} interprets escape sequences, so you should ensure that it matches your -terminal capabilities. See \link{term_cap_test} for details.} +terminal capabilities. See \code{\link{term_cap_test}} for details.} \item{ctl}{character, which \emph{Control Sequences} should be treated specially. See the "_ctl vs. _sgr" section for details. @@ -128,6 +136,20 @@ normalized strings will occupy more space (e.g. "\033[31;42m" becomes "\033[31m\033[42m"), but will work better with code that assumes each SGR code will be in its own escape as \code{crayon} does.} +\item{carry}{TRUE, FALSE, or a scalar string, controls whether active SGR +present at the end of an input vector element is carried into the next +vector element. If FALSE each vector element is interpreted as if there +were no active SGR present when they begin. If character, then the active +SGR at the end of the \code{carry} string is carried into the first element of +\code{x}. For every function except \code{\link{sgr_to_html}} this argument defaults to +FALSE. See the "SGR Interactions" section of \code{\link[=fansi]{?fansi}} for +details.} + +\item{terminate}{TRUE (default) or FALSE whether substrings should have +active SGR closed to avoid it bleeding into other strings they may be +prepended onto. See the "SGR Interactions" section of \code{\link[=fansi]{?fansi}} for +details.} + \item{wrap.always}{TRUE or FALSE (default), whether to hard wrap at requested width if no word breaks are detected within a line. If set to TRUE then \code{width} must be at least 2.} @@ -172,7 +194,13 @@ computing tab positions. } \note{ Non-ASCII strings are converted to and returned in UTF-8 encoding. -Width calculations will not work correctly with R < 3.2.2. +Width calculations will not work properly in R < 3.2.2. + +For the \verb{strwrap*} functions the \code{carry} parameter affects whether +styles are carried across \emph{input} vector elements. Styles always carry +within a single wrapped vector element (e.g. if one of the input elements +gets wrapped into three lines, the styles will carry through those three +lines even if \code{carry=FALSE}, but not across input vector elements). } \section{_ctl vs. _sgr}{ @@ -231,7 +259,9 @@ W <- strwrap2_ctl(NEWS.C, 25, pad.end=" ", wrap.always=TRUE) writeLines(c("", paste(W[1:20], W[100:120], W[200:220]), "")) } \seealso{ -\code{\link{fansi}} for details on how \emph{Control Sequences} are +\code{\link[=fansi]{?fansi}} for details on how \emph{Control Sequences} are interpreted, particularly if you are getting unexpected results, -\code{\link{normalize_sgr}} for more details on what the \code{normalize} parameter does. +\code{\link{normalize_sgr}} for more details on what the \code{normalize} parameter does, +\code{\link{sgr_at_end}} to compute active SGR at the end of strings, \code{\link{close_sgr}} +to compute the SGR required to close active SGR. } diff --git a/man/substr_ctl.Rd b/man/substr_ctl.Rd index 337f5e83..a283a4b2 100644 --- a/man/substr_ctl.Rd +++ b/man/substr_ctl.Rd @@ -14,7 +14,9 @@ substr_ctl( warn = getOption("fansi.warn"), term.cap = getOption("fansi.term.cap"), ctl = "all", - normalize = getOption("fansi.normalize", FALSE) + normalize = getOption("fansi.normalize", FALSE), + carry = getOption("fansi.carry", FALSE), + terminate = getOption("fansi.terminate", TRUE) ) substr2_ctl( @@ -28,7 +30,9 @@ substr2_ctl( warn = getOption("fansi.warn"), term.cap = getOption("fansi.term.cap"), ctl = "all", - normalize = getOption("fansi.normalize", FALSE) + normalize = getOption("fansi.normalize", FALSE), + carry = getOption("fansi.carry", FALSE), + terminate = getOption("fansi.terminate", TRUE) ) substr_sgr( @@ -37,7 +41,9 @@ substr_sgr( stop, warn = getOption("fansi.warn"), term.cap = getOption("fansi.term.cap"), - normalize = getOption("fansi.normalize", FALSE) + normalize = getOption("fansi.normalize", FALSE), + carry = getOption("fansi.carry", FALSE), + terminate = getOption("fansi.terminate", TRUE) ) substr2_sgr( @@ -50,11 +56,13 @@ substr2_sgr( tab.stops = getOption("fansi.tab.stops"), warn = getOption("fansi.warn"), term.cap = getOption("fansi.term.cap"), - normalize = getOption("fansi.normalize", FALSE) + normalize = getOption("fansi.normalize", FALSE), + carry = getOption("fansi.carry", FALSE), + terminate = getOption("fansi.terminate", TRUE) ) } \arguments{ -\item{x}{a character vector or object that can be coerced to character.} +\item{x}{a character vector or object that can be coerced to such.} \item{start}{integer. The first element to be replaced.} @@ -63,14 +71,14 @@ substr2_sgr( \item{warn}{TRUE (default) or FALSE, whether to warn when potentially problematic \emph{Control Sequences} are encountered. These could cause the assumptions \code{fansi} makes about how strings are rendered on your display -to be incorrect, for example by moving the cursor (see \link{fansi}).} +to be incorrect, for example by moving the cursor (see \code{\link[=fansi]{?fansi}}).} \item{term.cap}{character a vector of the capabilities of the terminal, can be any combination of "bright" (SGR codes 90-97, 100-107), "256" (SGR codes starting with "38;5" or "48;5"), and "truecolor" (SGR codes starting with "38;2" or "48;2"). Changing this parameter changes how \code{fansi} interprets escape sequences, so you should ensure that it matches your -terminal capabilities. See \link{term_cap_test} for details.} +terminal capabilities. See \code{\link{term_cap_test}} for details.} \item{ctl}{character, which \emph{Control Sequences} should be treated specially. See the "_ctl vs. _sgr" section for details. @@ -91,6 +99,20 @@ normalized strings will occupy more space (e.g. "\033[31;42m" becomes "\033[31m\033[42m"), but will work better with code that assumes each SGR code will be in its own escape as \code{crayon} does.} +\item{carry}{TRUE, FALSE, or a scalar string, controls whether active SGR +present at the end of an input vector element is carried into the next +vector element. If FALSE each vector element is interpreted as if there +were no active SGR present when they begin. If character, then the active +SGR at the end of the \code{carry} string is carried into the first element of +\code{x}. For every function except \code{\link{sgr_to_html}} this argument defaults to +FALSE. See the "SGR Interactions" section of \code{\link[=fansi]{?fansi}} for +details.} + +\item{terminate}{TRUE (default) or FALSE whether substrings should have +active SGR closed to avoid it bleeding into other strings they may be +prepended onto. See the "SGR Interactions" section of \code{\link[=fansi]{?fansi}} for +details.} + \item{type}{character(1L) partial matching \code{c("chars", "width")}, although \code{type="width"} only works correctly with R >= 3.2.2. With "width", whether C0 and C1 are treated as zero width may depend on R version and locale in @@ -112,6 +134,10 @@ defined tab stops the last tab stop is re-used. For the purposes of applying tab stops, each input line is considered a line and the character count begins from the beginning of the input line.} } +\value{ +a character vector of the same length and with the same attributes as +x (after possible coercion and re-encoding to UTF-8). +} \description{ \code{substr_ctl} is a drop-in replacement for \code{substr}. Performance is slightly slower than \code{substr}. ANSI CSI SGR sequences will be included in @@ -123,7 +149,7 @@ the source string. Additionally, other \emph{Control Sequences} specified in \code{substr2_ctl} and \code{substr2_sgr} add the ability to retrieve substrings based on display width, and byte width in addition to the normal character width. \code{substr2_ctl} also provides the option to convert tabs to spaces with -\link{tabs_as_spaces} prior to taking substrings. +\code{\link{tabs_as_spaces}} prior to taking substrings. Because exact substrings on anything other than character width cannot be guaranteed (e.g. as a result of multi-byte encodings, or double display-width @@ -147,6 +173,7 @@ implementation of the calculation is different. } \note{ Non-ASCII strings are converted to and returned in UTF-8 encoding. +Width calculations will not work properly in R < 3.2.2. } \section{_ctl vs. _sgr}{ @@ -171,9 +198,7 @@ substr_ctl("\033[42mhello\033[m world", 3, 9) ## Width 2 and 3 are in the middle of an ideogram as ## start and stop positions respectively, so we control ## what we get with `round` - cn.string <- paste0("\033[42m", "\u4E00\u4E01\u4E03", "\033[m") - substr2_ctl(cn.string, 2, 3, type='width') substr2_ctl(cn.string, 2, 3, type='width', round='both') substr2_ctl(cn.string, 2, 3, type='width', round='start') @@ -181,12 +206,24 @@ substr2_ctl(cn.string, 2, 3, type='width', round='stop') ## the _sgr variety only treat as special CSI SGR, ## compare the following: - substr_sgr("\033[31mhello\tworld", 1, 6) substr_ctl("\033[31mhello\tworld", 1, 6) substr_ctl("\033[31mhello\tworld", 1, 6, ctl=c('all', 'c0')) + +## `carry` allows SGR to carry from one element to the next +substr_sgr(c("\033[33mhello", "world"), 1, 3) +substr_sgr(c("\033[33mhello", "world"), 1, 3, carry=TRUE) +substr_sgr(c("\033[33mhello", "world"), 1, 3, carry="\033[44m") + +## We can omit the termination +bleed <- substr_sgr(c("\033[41hello", "world"), 1, 3, terminate=FALSE) +\dontrun{writeLines(bleed)} # Style will bleed out of string +writeLines("\033[m") # Stop bleeding if needed } \seealso{ -\link{fansi} for details on how \emph{Control Sequences} are -interpreted, particularly if you are getting unexpected results. +\code{\link[=fansi]{?fansi}} for details on how \emph{Control Sequences} are +interpreted, particularly if you are getting unexpected results, +\code{\link{normalize_sgr}} for more details on what the \code{normalize} parameter does, +\code{\link{sgr_at_end}} to compute active SGR at the end of strings, \code{\link{close_sgr}} +to compute the SGR required to close active SGR. } diff --git a/man/tabs_as_spaces.Rd b/man/tabs_as_spaces.Rd index 44aee520..3205e3a7 100644 --- a/man/tabs_as_spaces.Rd +++ b/man/tabs_as_spaces.Rd @@ -24,7 +24,7 @@ count begins from the beginning of the input line.} \item{warn}{TRUE (default) or FALSE, whether to warn when potentially problematic \emph{Control Sequences} are encountered. These could cause the assumptions \code{fansi} makes about how strings are rendered on your display -to be incorrect, for example by moving the cursor (see \link{fansi}).} +to be incorrect, for example by moving the cursor (see \code{\link[=fansi]{?fansi}}).} \item{ctl}{character, which \emph{Control Sequences} should be treated specially. See the "_ctl vs. _sgr" section for details. @@ -78,6 +78,6 @@ writeLines( ) ) } \seealso{ -\link{fansi} for details on how \emph{Control Sequences} are +\code{\link[=fansi]{?fansi}} for details on how \emph{Control Sequences} are interpreted, particularly if you are getting unexpected results. } diff --git a/man/term_cap_test.Rd b/man/term_cap_test.Rd index 82adb34a..6c856d8b 100644 --- a/man/term_cap_test.Rd +++ b/man/term_cap_test.Rd @@ -43,6 +43,6 @@ ignored, so \code{fansi} functions do not warn about those. term_cap_test() } \seealso{ -\link{fansi} for details on how \emph{Control Sequences} are +\code{\link[=fansi]{?fansi}} for details on how \emph{Control Sequences} are interpreted, particularly if you are getting unexpected results. } diff --git a/man/unhandled_ctl.Rd b/man/unhandled_ctl.Rd index 383eac42..3b525512 100644 --- a/man/unhandled_ctl.Rd +++ b/man/unhandled_ctl.Rd @@ -14,7 +14,7 @@ be any combination of "bright" (SGR codes 90-97, 100-107), "256" (SGR codes starting with "38;5" or "48;5"), and "truecolor" (SGR codes starting with "38;2" or "48;2"). Changing this parameter changes how \code{fansi} interprets escape sequences, so you should ensure that it matches your -terminal capabilities. See \link{term_cap_test} for details.} +terminal capabilities. See \code{\link{term_cap_test}} for details.} } \value{ data frame with as many rows as there are unhandled escape @@ -77,6 +77,6 @@ string <- c( unhandled_ctl(string) } \seealso{ -\link{fansi} for details on how \emph{Control Sequences} are +\code{\link[=fansi]{?fansi}} for details on how \emph{Control Sequences} are interpreted, particularly if you are getting unexpected results. } diff --git a/tests/special/utf8.unitizer/data.rds b/tests/special/utf8.unitizer/data.rds index e12ac3fe567c9898e8e1fa02c6bee188f8b08e52..55f406b036c1a45a2ec596cb749574097e2233da 100644 GIT binary patch literal 21439 zcmX_{V|*md*Y{(4<7{jj8=D*3wryu)PV8)K+u3+y+qSJ|_WFPBXTC4abXPT|rn>sn zIlm%|f&uyO1Afs3pY(kpodTPtO9l;%@s0{2^=EwfPa4&9Rq|vNfZ(wq_E?&jfmd;) zkYaj5vLOj6AY3x}uWcOs9+n>)$6SnU9<=wlq3spNQ1seR>zYUN)cNJP;bdP&Lql9c zN6uw2$W&`bdiLhV<%!+WrgJ45nfDBPGlVjVT zQ+hTuW=U$c81#Fy&?=ej@Ng9t#+(u&zW>G^>?U9=*4%k7aD>Npu)eC&bj)o6P#Due z_Ifk8l246=F|qq%d-yx^GMQe+M}W2h_pAGcz*KL3zcHV>S!rK@GnZMmAHk%%Eib_b z%$0r=GE+3!4?n!yR;@XyGGCvpNV>EB{h3hH=S2FwCDmWQqKCaYxMzw#KMm@vp=vD9 zxntznT&BF(guMU-JM_H|8Aq!sUjzDz&w1+wdDHoJT}ZhMcd-vpseLNM?TVzOT9o&9 zwJ$?AV|){9#4piFaq-$QK6F98>SEt#QH>Vv(=i>djA3_CtBESH3_W{kfmd3sxgmpO z&kV;)$THqwt^mch1dgf+;WJ{a^%wB3$b)iums<-ea@=gs=^~W z$hTlsdhqY*vy&6U?Zg;>b*qJr(xKXRbXMz5YvIA8*{ZZ%HiPCOG6PLhMv-7N<*>_m z0@~!8-EBZigL_1GM`rSAE~{$WbvSPc1e8VQ+SYH`<%4_gW)gKz+2E$mp%|5T_KClk z$>la$`IQFuXQcV&C-<b5H8NG!(;sK=&!7}0gXg9_N^q2eo(`SDVi1cBc| z$~4#~hPntb&5aeSuFVi?=hDc*NaG5QS-NRFjG;V^t`c;_SEB3kio+K%5W2#LN2ei2 zZJ4dxn#`j520b-R9A4x-7nyMQA%^eZ8StUUcf7cgb7cN26C=FQ*muUH1n?^1l8jWsG!uPcJRquU$nY z`aXBbgTGJulZ&Q4uP@B`+wQB(9im&hZ}+F~J-X}f+lEv5-z?u+J;m7-uqkh{7$Qmax`8y;d^`zS6cMnhj;{hUl~8QBLsAPY>X^# z?yh_eJ4EIRFiPQ6$o*7}WM5<>^~eN8LhcWFxSBTtpB>W(C0-nL&~gp}=L?co#1P!>+gKE9IYS)-sO6TZ=eQ)=SdkA-^e%6ycuPnAA?H_>~z868J_ z6mHk#t-a*Fl2MpuwXba9$zv7Nm!{de47-ZvVsv>3WmF!%irq`nQdI$VH;qUe%)cw; zHmQ6C&Yrbh;>n11jmcgwore7Rr_L++Rx|_ZO+;c9)%eAgSTS(SHeI_mL|j#+3IpO5 zXi84H^7`~%*S_aW&bIhYG7 zd}sCRC)s9ocTO2CjQiZ{glLBiRL>5GjGWD+;-Y+7toWO>k@wNw#xgt2f`eiurouG- zy{vL829qtYwz0AJg1>gq6Zgvyqz!+_A;qH0JIZVmO&TScyK9&X)AHl=_LGj;eGy_D z@jmk{Sim)buMMYsgPI)7{HoKBGqwaF87)2z{?ImWTFk~rpP0Yh?B7H`Lk zZxoXYn+`A+nRSCa-)up6UWD1=c;xBkLt(Op8L!jix1m`ubmR!85NE;ua>7aK_xF6~ zOz9^MhVgf}rb5c?-FZR4&BX>Kg8*{QNVYzICHb7RbtV*0OQYS)5*b*VCIp(5HOZGG zRPI;zDf&r_6y;o;lbu}=#}rDM=G?H7K>)aDm8?1z3s3|y^BFWV@qtwE)+zH7LbQto zAViCr2x1FjizcWoAhed^7uIaOe2d1OkStL~?}NS85n%d{k6)(RZ}?-?L~A5e0Op?^ zh%unipwUtw#$9m6N-)v3Q2}-IoxIIIBA2FGIOBgox`WkCw^u1JtS4-6c2Wn*#%O23 z6J6F7!0^VTbWGSAu*M55){)sGRva#A&Oj@yHkd2Gj!eMk~k>? z2OkgKjR6s_s!-wH+=2T_>ipteBVxES;$(YT-^d5|fSHSr0qqSs7OJi;>Zbq~-;V6K zL{d@oca?-SqU#;FDscYu?#ivrtNKq!Lc^myI-{b$k;ORF-5Fv_Ie$_bl|~q7i-Q~n z#NoBseES#Zzy72Q*e4MsNrbhEwCu&d4@>5_P+sFN)hlIvY7AmnKj3d%pR(Wip+he z03L?*eF_*S$Z+ErSk^3Cn@%rO2;?Wu^;7`C#ScF2#emrx^b?%?YSIcMN` z6V%vw^!2VFwi{v1_#a5N{jMFLW?0jXE->0%k^JVV4N#aa!=URRKwc5o-5z;b7wnPK zK(N8F6G4W&Fop_Iu-7m^jn|Cqkgwl{@oaHm+QHVAC2J?zRJ8cq&@-ViHMg6&us3#M zAYaTlF&iV+KQZEe!$4OLC-@?+32omUFWNG}w0nH4eLLoEI(vA?;vJD6a)fxA-3&q& zy`(qzz%x!1+#mqof*JTr)H(+e2e8isB`C$XgSF#y2xE4`@Xwu|*7V;AyM+oqd5K`1*fjQ+_Z}?p(smrjijNJXI$;koiE8 zrP|j*kc8iS;8TbLddz!rmyakPpEgG0+;8^y0MBfi;v<_xb(F{9RMrWpP1s7}c%le? z$|VMZk0Xnq_3nf#Pxn0a`kF28iDPZpes(wx2o9Cqc%Z{*(ZFXVR+k{qcsoTpL;FDL|v?1+*vmH5IoC}Y5K1m4bMx6NKdQ)O4F19uJ7R@ zmnM}x%6X}s5)Ikc1XbIDvyIPf9=?*U1Z4ajNrwyi2<=5emem z3V0Z&ho{BPLNBs0j?e~xHGF|!INs9s|*0{$rX>-Ni5 z-e0|i(GHJ3L~uK71y{b})9Q0~)t0FWN8u|l{HHC**TBbjG!R?4J`mf4DsYRl?y#3~ z7z;d`{{Hipw2UWiXhk;)!!{^B9`_*lyq19k!$AgFHpLj=|G1=D4;nVdA{n#@+cyjSg&wvpJYyI-)l__i-wbYMUF3HJSr@_R@1mZJ?; zA9HNV#x3RPf!q5IV6XhJ5#R;xtSa4Q~Gq#!{p_5xK zzvQ({3yLvjDupjA1R+2Rwb2PA(KtvSMH#c7*>j-=~Q#)&>yAg zu2^O&mEx^2y@xSJmx26o)bIw-SW)T1xIg2J^Zixje!H{e<=bRX`tYop}a~2p) z8uJbtnvQqnMQnpuh|5VE?*-Nd*uL5jxZML-Ubb_)560)v4>v-&n|h92@^N_|kr0oBbz{mOORV!1`;@UBsXIH^$hUl3 zhPdP}-W;378r1I5w|j?;hcVaZw~{g%@kH$NjhKSxTbh z3yn6rm%V&cSoFK+Oc&96lT7z*#UnVpmvVi*kif@`;g}!m{KB1~)c;|xFzWS*5jtKT z3^;6qW6Q8bOA#}<8AC(|3Lw2ZD#C}gxnUu#nIQLsot|SKB*X&_gZpSlg%As$^<=lL`|#TH7n(8JQH}^Zl$84Nt%m9)vNY z{gPp)h87D?@cCx6e=*#>BIC8+hv|OL7Ed;DmY|UV5hpuWU#KZNo5Rp2f;@HMC9s+A#o*f&v2n$uNkTEI2lRCaw_)wQX zj0@zM!I}=$h}-YzNcLYgdup!h)0(Qv7mz9}F>u_!*begZf5S&w;vPb(5V^ONac3yo zWZHva1!svDW#|!&{4{146aQSy7O*f9XVcwp|WWD_*(X1sZ?0!%qtSy``{mD81>_#_=s) zjYzveCee=m__a5-*;@<4d0)7H(on)=iX9*Yh%IA4NL8v^(4 z4I@ZBD3Ay2dMVOZ>D1k zYtKm)($DldTdJfy~(k^jz!Ale1$XOsZ;=b`Olf>$#8vntQ4EdGdj0D z-(6)?Mi82_cL|ya+IfDqGkCab0Iuv;#qHBwFsB2FmOzDKL4?4Bs;Pxy2Z=_~$(KkeJ*G^XnLEf3`9CU2=E+dH0jwk zZq`!QzlVwU-F^#FH z#SI;+S(6NEaN-efFwhxo1aYKlZl42gA8Nn3cwen$7BhGq?%%2Y5i?2;{jb1nAG0}z z45|$ya6RBZa1*r&fJfS1jM)CNC2tUa&XFnt-b8aUNE>LIYwY^aziNv~>$p{IVhP%1 zTO#e7^&q>Je^h=ei^6vW zo#6<^r!%%Te5ikxrY+mfI4YvL)J>DQ|M{Z-W7NKO z4B{E_xyt#S1NI&2y}9^((E_#_w1*E2xb=_4w5?c>9?+gD{GO`X!9vg;%a4Bh%G_pU zzcWN9(pZ1LFJmw8IMI^pZF4d#;B$6RvgvghQFPUHJ!YQc`!;Cbc{f+`wTqndJU2K@ zk%B4kHEG^G=D_uPAyQ1jh-E8Tyu=!=9#MrILx!30FT`hpqOge(?SGLF)A(vCF|-O2 zfqbHhP-{N>v^Wh50#3vUV;aofWN{4MVTUo3tf=a|sCqT!j9q?8n{rf`3p9)W!XRwW z0#X$6gjf`jq|mhN6Kcp*8G;rDqx{BF)FI??61Dp|994ph(>3574sp()PszTml(D6j zn!Vp)m&1IzO%x2%&b4uf^~3R83j3mzD#kz$6EjFid!S%#P)~IC=rHrI6==0lkM<7WWp-6M=y64};Z_D}o6!_ez7hVe6a zannVj*m3lSlCJLOnp{#js;ac|Vf6-BA9Bm=SNr0kRxxFwHGHaCM?dTE(QR&LI5~7O z{a*#x;pL#B6lvxCN^@RdM?9}sS(=kexij!kngaO6&p(6>UjyH!2-5BY8k!Kcp@1y* zZ&UmVSQ~|L=-?fv?0>-EvcToBU~sQKYvOlHN`nH<<_;WT%1v2tAGxiLeF~o1Y;|UXdRYfs`ajs(P@A}--6zrFuZgkk3f%< zaE?;u3WXWb!J?p@Mv;St!DQn}ctycvTY;lW3x-JDF>hc9g#h+DjJ#)t2N?cH!DSi` zG^ixgYvUZGaepUb_o=E^Pl_>7IDHsolGHs$D+D-Y1tEQ|Wsmz3k#8F}p;1=*WAo#ZN0e?Yv)O*{f@qF7Sk+O#NJHSq^ zFTgIq&N|3W38wv{3&y3RUJ5yOT6=rS@_edow(T&{?VKtK5jabr-K*6c8)sKKTEc<% zm+lybvrHU*e;hEg`$?AVpN80y$gO0N+!sLtibWn1wTY|)p|d|3!@r$h%W34x*BOXuC0!$}N=Q6e4 zJIFQ3bv_U0YcLkxMHFV|GxN3>CxQp6hvUbs(Q@}MZxRnh;7Df0c&TlGwT&`3<~Wto zIDd9N7;0$o64xG{Qb|UN*MzVK8c*ud4P?bO0HXEp8@<`VW}+d1LjTSrxkq?$EMXj_o46OT7ax&rT3e zx+&uAGbBeZ&Z`QS7&)s$b`X%HB4FLpxcVFLK9D{O+snZ|uDa;@p3hR)$%I$=iYv|8 zt&|sNzsZ|T4$lOyo)4Op+aXH6Ul;XQML7KZz(Vz*ZX1>(DK;J0eu8;BFw9>!9B;Cj`7hy{4a6>-j0k_#~D;;BZ?GdtMAh7=X| zVy-*N^+g1oZJ5&xg{caj@=I7zLzG=b37%GTn65CnfU}ltj<>A}1r-u@7+vb%hYe^G z*`$midi|!$?00!=Blv-4=E>)jt6>+leR`VY!@nwg9xfuqMiP*`NKcy$tp=v1)l!Mx zhH?1~_0bqPJ)k%K9~Z3qAOGxG05PhmWV>V&;DSQqHnA7b3&`>41)Qaj6N02br06Ws z;aJM}!D*mr%zi`GaN4Nf4+|gW3lOmIvS#mE?6k2>* zlT@a|({!s+5x%W-R1|Xe+txFgKew6?um5$Z+GR1WO~wLrc|)K_lp;&j#2Vm%5pTCp za}TB%gpSHI;2bi~^SwuLF0wG7KAN=&QKf&U5qYLEALou9@E|Ck;7TxpJHjnw@<9~O z9{<2ibQX*_+CJHfNPIO#me5H~BnxChwVQB;!>aa%nx1CRH>9p@pZnv2|Zmli*!xAMW&d7XhlDTUMf4-2BetXDZl;GkWAqdDyIT1P z({;B!vq?Sii7u(KqD>T&;p4XLCU^JmEc90FX?&2GeD$HILDUH+7U@)n!G&2EO3i+& zwUr(>2i&l2d`00ImETsDmpuwMOYt3L%Mnt_XtHkvu+)LM2Gi`IRmwHc}`Gw>kzu=>7I%gd`06NdUKU8 zeAQR(+Z>lmQ=M3QMsz+c@=VwrMs5=@kw&Lv(lGjz-OH~~Vz3>Au?nLz?aScNy47Yd zva&UK&FO9 zyM{^N(!lTGl(Op`1xCWmkMoVF?Ax0rsgmvETX8T6tPzlS&?;S!Wox2g zvjz^&XIu_Txc)MIzR&)z>%^KO7OIC=W0tQ_@t(H9~(w85fW#mr; z<)??f_jy%Ilg#?^U)gy1+Foq7#B^|Jl?L_Fy{ZvMG}Iv#W~8mBt02`upqW(QY6w%O zI5~WVBYJoea7{KN1h8Fw>AFNXA+Vm~U0o|!r>Fw@R!gFYI@_b>9Tx-qonPJ1lK~M> zjj8CXv>+E!g5K5+=Mt-9VY7P2i3dIN#S>c?XF6bTP(bud;TXUmWd!?xRe0bge zP|@Gl{#SGs6T}&!aIFIYDFe7FKOekkr#qs9>bD6zUu-HbE?+C!nIAu1UcP_UI8cl7 z>dtmcqf;;j+5O&Vwez~= zuIAoy_3WaUe+h>#xQ|ly@J+HFy(At5A_O9Q6Aq<`CyqBXiuDx<^+d*zUXS%_N95rq zF0R~i*}7oekoZO3t*mjGQ#+2*d=cE`c9fXCLnq{Y-=$jw~+2JxF3o#bMw{AEVP!q5bh*= z$7B1?I-etNFcDPa<(v?1pjdxT9DmCaHS`8SaTbnf0~*ksIDc{-sPQ|_JrP~q2zx#(xfQ9;JBYr$a{2WoVe~V<!y_vI56wGN77lqH~n=9~tkSPn$l9>&m$HK>ey z)P0BI?xb`LmxOw5+q*Vo1XDGgmyq4{_F<~%6!q>*SM;Y+%G}?oP6j)SGT#PN^@WH^*A_oAR#(<@&X_PFq`i|nKe!AS!Fe)fL3jf#v z99-eN!>)Shu;lBIllH!5Sn=plJN>}(2<6N^$dI;qv^n@5=pOmUa&WXe4&*FKb7E`Y zTMPqkD}82F{^Q$RsY%+1igaYzF(fciXeuM*9BE6uAbwZ;dy06CDWEj4l$_{vf#?($ zg&oCpHjYnnzKna0ZOChrGf{F=DaxkvcgZprv`we*UO-GokElCyPz><5(?4FKZ5-VF zXy<-9q>ZxgzFp3&;ms+R=(BGM4sXgP+O2pd*h*1o z->D_zkG961GaS@$tkrix_ov_9-Cw_X2w^wAY})8&V2BRU5r{AsxIpSIy@MIV0+tcC z5l{K-<7q>Jan%t@=39nioi2b5P$x0cQS&+T>Va4Ep))D|o>~hUp7$@fG7&R`?<}-z zNHBG8A*~=GFd@sx!vtglT?E3>cl#W|NxltU^+hEkuPE^ka53QZm)-D}q^KtJQr*^d zSh@~$N5Q6IbJ3OMmVdJy=?~Zd4U3$`w8D%^h#hbJH;NZC^K{vgTHvJp6 zcKBSy8L`DwbMYPnk6?7&JpU7RC^O{yo43&y!IlDBpcL2wf=!p+Y5cf>R^Ex{hH#}k z4m?eVZfM4I4UTAEjDADggh_Hggh}O!~-bTQjG*`b*_na zIs)!@orruYej?O(%Sq2Z1(h`O=2NLU9g@ozoD~nK@ehJA?)rVyf*U$yBMZ zA4FT?7Fz`GzSM2Zzy)S-Wo1|GGSo@!bvnz=)31;W=3j`H$1c+w8s&YLp#EWkLWumH z=|4uqfy5Q!iz6g4LnO>hF`icu1qJ52Ef)}~3wH~=yUpJjQqD`2j*qJ zsPOH|dplY}PHJ811D^rK%a7Qe6o+hfElTcv-&@Qr0g{hRDC_7cE5x-60~h-HmT&Br zMDI=Sjj#W?P;8If*GMEkn$YPNZ$u#jEt^iX=e3;%Qf!sbi_SQX}nV zw7o{`!;-vv0(!5eB<^n&rZ@A*{``OngMgY)LxxUsJXiW(lq&+^vXF+mU|*npRK_--_d$ZNQ98xjGUx;Rl+z{UscTK3T*OZ3Wj z1nvt_j?Tj{D^PPAvd8R> zXEI7r=>8)1itl6!@4!ba@``^@00|u#{R;oOsYEaDSu(O`y}_N#f(BmhOHshV3uFi| zb+R^Cjco7${L3mgKNdRW#cSKiUKoZqbtgI!@(8^fZ=?B*0ls)ok+uY^PUQp``kLS> zWUdZ1LRxzU(1@3~?WvbD%edK)bmD)E$O0Vg1M1MhhH@i8_A=3IjhI`(yeqUHQ?Nf4 zTD%uumoYldin-7VP1_RgI@5k~sh>asgx(dMNO9O0Gr75ACxI^Rrg!jWT6LPd^`@iOLEolMboO#{Y^ zN6y$aBgXVch0z}HI-O&Ohy5}WkuS{C#9po_t z&4=T~D0m2rKsmu1@IPF2-@1PN39(wR$=r#38i)a$kpKMoYoWmp;C3F#9=Z#Yn<6&p zX%=IsSKPep;ZP8DWT`ukeV1wWzSuniUH)G9?GaavY8EL%NN$R6JY=&kYm7K4Od%uFixOD7=Kj5>C(UXN}1cs zsvsytCMm=V3I~P`K^5Muj8cDw>Y&DBW>dF{+KLF3&2`zPN{U@bK z0E^g~Y}7o0%vsah8^I?RWgr{B$lH%v>DxA@|J>d;Rng5I4UWT^PQ%F&EoRlY6@d#P zv&7Dg;tmX#^2wBpnj%+xT-gineiW?P2*P=ShzrUMW-X%Opw zNQJReLo9ZqfLe0~>)Y|Y9&}o9uPReggf(8q;UByM6H*?|-!JXck7}F^a=dnUO}3ar z%@yj!oUZb&tIH#poIY7{#6vFbLoO25Qz zYh$phcddB7#x?ZxK6%Q**e3N8TG)1xL>fy_PDu8BEGUUv+~co;-z=CUdg}a<6YM=h zd>R78is0v{juWuQJIb8*&I!M4Zi?Ob*W;ME4yAlW-}n6FVnU0}G)JUdeg-w4Ioo2H z)%!6EuSo%r=e?Iqy84J~vd*&hvFe8Pl3S4hwOW)*F_NFeej{1RGDGxhnoUgojq2!W zYX)}UWKSGqUur!fPT^S0yD`XL`Fwcb20+D<0iuDeZCALwc(0apFO~=DQVZ5hMQmFp z#Xt>JaTJ6EW32mXPg-OF9QUREJwJ1U?B&xNR+pcc(>m_+WtGmf>G2s|?m~0Is&)6J zd@P}Z<|%QqlHDRQ_WdWm*_Y_sRoWo3U(0J_Ug%=)$eU6KE`W@1nS5>p&j#k^+_%PG z*agRXUe>CZgPZ$@^yb`a)Y3@L*X3E%en7BH5!%b+a1`6NddjDD(gB5NvzM3=vvU8-~gF{P9TG4|yTbvVAG9hwMl z6&|)yKjARqbrJbX4j*Kxg{a#>#i;;8Yk+BgX_+(!01xuO6 zNb8bYtgH6$13vj63T{*`w?8E0M2Zul&tCG5@k+knZ7i~Ax?D57)32*k<1{N)c^Rst z9Z+dyLRzYIYxBxD!}pniq5BuiLWhG!x%+wIKlkc}~BfFDh76({GsvZRr*2S22M`A{ErkV7!`ByO^;X~5c+@5$2egz{(yHAFYUD9E|T%5NS4~`l?*Pz!H zb+fF_Z64TC4BWfZSGl0wF;BH0iQJ#;cmMgE-^d<7PtId8&o{t)BlqoXa6Vxho6AiF_n$t;<$J_*{deqqarOnU^keh)CTbXs6a*q{K_*d{&`jPMH%mHPvTg{G zfqpB7z5%Vuc){L)08r39`Wk4+pJ~ufEu;|9WG~h4n-AN1SMdz~zmJMm06zuFyske| zbwTu%Lf7P4IOO^T9BI9zlx7xAr|3 zTB)lM-4u1bKUP#?JTP4GYqiqghXnM0g&oI!@kan-{g}_iF1R}~!>y%x0K-T;mxS_y zx1sv5EZUt{wtB0E6x&d?w82)zfzoegId&2B&Yjb|3Ig6x4EszH?u77579#}OSlxYAp#YT|p$5j~K4mWsHUp_Z6 z>YE-fF5z9ktodA2{@8+1`>2QddsE`nzB%{{q@ zrw@ymqpzKvocn7aZD&LLFAq7k{bO_VzmED14QIKl z-8*=nperCiUg1~#+&_r$nw0*xy$D|ak?1GU+=WyR`wgQP5r{2cz}nphyxsVP8;-7A zk;miE9n3TWkV^ZR^E2N#GnY(6v4&hmunbTj4~!YU1^zR1HgyIFm2!d{g3S*BHeW8l zOJLXp{KpySO83guh+C>RD-5){m%TzIfr)}0NpNi;ZCUEHqbO&PNxU?-)}jN5 zwgBXJ2q5Rs-;;zLuC-CQp7jFVeQ!&lo>G|oRKxh&12+_pUWjQLHVIC9ufp%%9YReP z2%mb57dCXLic2Aek??tFJpbiiz4s(@Q%qy+wOk}i!w*}$udHUtVYSP-BnbHw{0Y^4 zm6Z+M85=r?p9|ms&w`-woM)n&A?co9bi$jGN>iDh=cip+07^BDdFO}61_8-7CaRkf zSQM_pt~R)-A!1W+@kI5>DmKWmnARLxb7w9tD)(YkF>ibsq#8v$t7(Fg{6S{(IMy$M zDNB<7pBQjtpka;HWf;v%VmB`qXURd6$RI(jb;}M4L<&Fx7+!Rv2tl_5Ho-4mYH4;b z$Z!~cL{fKnE$(>za2tf{rjKQ@S%Ks4O;*_SWgyCtzb^}L*&SK!>@-*qXnHxK#rX?C z)ZziRdO{zb{Y9AS**PZ3`(^x<<-)_e5PzCfQxh%=l$McWWr{ubL7&W>(Xfw+H^2dG z3#nN?b10`2JGV!_z{;`3$j{u&3)8nGC2e68MDZ4StKM=`)GsUjzZrg;mmRF~Akn(b z@?hJgpfhUfy+@PJSvM?8E-%hvmKEt8GaI}!?jU{AfZ9SHH&qNXIg^TMjzbVsUIOKg zghI7);)T||;6|}{A4AQC&cI}|ePX-thXsD2x6tC^;C@Ufo~X&QB)@!kf1&Z>Gwxt1 z3h1WDMx{o+iXSLR;5{#Gr{|MQf=~^YNU&unef?gKxVm!>Osz5O-Q8(eEt_gm%CmAF zfQh5Jxxr~hUVM}LzgRqAQ-w~XV_5@z*qS|jH(B(CQypz^2MY~ru!03qP$oDmGkvCNEWxv9E5X4*FqM@9M&ddZM+|0$$9MIP-7bxCO%PVpidH8bc`1VQfm%Vv1;)tbMV(U}=t(lnx<9|HdnBotP1dsgwn6c{#HBa3 zQz}EMNbu4O*8F=&#IzwGiUJ@^bTR1kitaofv{C^1D0#)%86~1%1=FR23uX%w?+>TCTptcs|8t(DLAA zkVm|#cwz3-$9WYGajaqsdG?P#y6LxE(n?eZKfgQii*1n8wzBv1zYRMRihYO$#3GS2 z4mpoHGeTPEO?Ot9PxoN|_9P#b0PnJ%)<2-3u^Ra%d9!?j_EeAdd3FzmNxj$OeAa*L z(BDyI?#8v;N;?q}sjRR&}e zC~V#Y*#zvE`BH;z_D;arsW~+KQ8d!$E_DEoVFvCSm0=fu-fOQGzcr(V@fiyQBYAEv z?$7X%;w$rfo_2nL(O!TZYHp;cZV1Pgz+u=Zi-h7h*lSvFjTf;4E-hkMT#>$|=)P=C^C6wOiilB$Bc5#bF= zZ6XG?7PjxIl;#s}w=6k?!d`=(31+R~=l};r22Cap1^Bx2lej(0hE#<+v7t})djNU* zYFbZ0fHVO*PbT0dGNGK;(5NF&n}XL+L7XW6bx_Cubx_34AqFabXreiGV56~q?oQ^i z9a&+Bwah?X)&HgwRq5ru-+&4@9JBfztzyQC##n5)DqUy3_|v>po}nDvOapnmaUODe z4!kRgPUiZF^d3O=5J29_3gvKF(5a=!=($-d2bu&6=|d8H`;Fjxaw|{V_K6jJQhfae zF(&&VeVedON#l@Yl~xlR4em3R{v9?>2Emy6KgAaCwc>GvEYNoUmog>i70e5`oKO38 z*FK@2N8ayhLR}v}gP`gfxIU$C`hKTOXHdyD#CwAR+ngFwyUw~;z{>9Q8a9w{Em7qHO(GR7}xYZIFtDcY>M8%cv)H7!y^sD-UzQ z2(jN`LOg>v${U2bnQ~B)2=W38Qg#1_u6TVhzgD87l6(*?IP5X?VjT3DT!NhM5$l%k z*+DLyuOlkG@9CP%l&{~3bKITW!4H!4`kS&F=5b6b$WgJ7ikKdq0fB?ao^ra)0`>*m z3<3eA8AM)UYq3HdrSYK18seV@IS?)J5Xl+Eqsc*iTJqRpO)5USBlE2-m(*E?2N${T z1}8ECx?U$OTd#i;kE?P!#gVRfADW6Ndk#ij@gh#7Jn>#WCe?EaEpy&B^t<1`e?C55 z@de_&B)aQ)*qjX3bUyItd!MyY@@f(R3e6fmRV!LQB@=ES%D06cCd0?1c)4q?nQDcO z7c+>sjI)Biku!vrwx+3Huy`h<2sfw8l4vsKvmVI@jvvdU6aN~CCKMk*a75;9HC;w_ z81o=Aon2?yx&8TbXTe#&vc*_^ojsi^MRH6n%p3sIv5S=rTt`F?(k%G33?`MjaR19R zGnVA@{kRvnKu(1FmNmTi&cu7`cv&N>0x$$zh85%)?RlFwTxz|L3o7@6L5ZW&?(FX% zH6<9e$QkD9u81KuDTBLwHP?Zm{$Gr0Z%%5tA2=B-@2^j(o@8tXkyZFvlQH5YHV7Eh zlu=o%wFzmcYTvS0uH>Z@LO!EG&=TO~PUMOmxD1bA@}DDzsIy1sVRZ7nk&c*l4pE%> zBa*__lbE-u^XHH{(nUelME^>07J(ZwYsHJ&3t;b`O%fsBy?s&rAxb4HTl)AsXD{%N zV;q~A=tQ4Gl8^b8L?Ifz^E_D7{cs<*^>T@os^@bETxj|NltfY}-0sUWd;R?W=lY^| zJ3;#I!Zn&c-t!<$HDX9Ls*Pcl^V-jYwS9%es_(n9(F`+nY6H%XZpEmfh#P9~^&I2< zm(s?yd)Blj30hU!hEkf&W>z89jVAGUA{tU8U{m(SxG`*|-vghPsIf<&Mkp*z?xeo} zh`C3TZpNWwJ5zSAdyl+=AWlG`xf6(!l=kkcBg69$o?_>C$7FHfkq ziU$t^n2!~c9^bf?C*AMHLae2qOEDb?Dud-b=y#9}>BJXBZhXQ7sw ztyeVOpOHS3{57lN`t;cSJjH;DVI;_z*d72?H$Q9EC;m~TLEES=_4B@S4CCr*G z9BEP;qcTyd$?2Ul!)H=8ZaKP8l{v88iz3~+CB?M7v3h5I_ne_=G-x~HOpLZuV`Oh0~ zU#uf@4>?!$Y+b>v1yGG>wl`9kLOxSPuGunQAW`+>&T!2mEiI&fKR1kdoQuY?(0Fyk ze9iv(mAQf@k<*{S;_uA|WWB&El{6s^<(KS*0P51ZfLpwYbH1WksmbvpsMjTxlB0A} z0Q_>vit;#Tt^H(9WWvPfx7ew?D&YvREzyMao7zaRTMZw;`>6EZfbRE-6-wt{v6!ho zhO*hkcvCYAXsvbt-;KiMNR=;rjyk(E$y3Vz*T-20MFD+#eCZYe2}x48NaLMK2Z{EClf4q6~{pbF1@67q0nKN_d z-t)OhDG-O!zdf1ETVa=9Nx5HST?}A@UndRwbuY>Kj2*YaZQ|e}+f|g1PfAp`>*}W~=ZFm@ixfd!!VN5YTH11m?*V+`gW^ z5<;8WHpWwY<*BD6ZugoiV>{o2>gY3-GRW>3jF%{PaX?-qLm_wJUvcEQB0MFYB z_Y`WOaj3l*;Kh@#pGQFe}IJyeCIt_)PVA+zW1^4%_9mpp^vV$sS zJ0~GQ5?=CtNu$#mJ=H}m$eOzLq&B@&p)RycVy|*HVQGxa zzG3J3;gX7zY>WSTNy$rynwwh|!kCFPaB7ssb|r|SKZepl`6Tu9`_?bCNb_)a(1d+S z)_|qSLl?4H3uLh|@A6ZyjB3D1je_UMR=+q3%lX%Rg-?TbjYP_`I>4pCM(jLEebb>p zIxdv?9g2sVkVh;cz{;B;WzNy0>P|}YeGT?4OQs2z=XY*?Vb&~wu|5p_eI;_?_z7r9 z_i!hTm$)4Jim<=!dAbrY_?m`j_7Ml0PZp49FoV0!{{^O})$$oNN7$vr&W9M*~6UB?7vnst5B%U!n6 zK&OT%RM2IcbZ`e}nhcz$O>QArCKempT;VIPipq_g(^(3nw|$lxsmPN7C0{Xp?oE!e zv3-%9sJq;T6)eKbmEX4Gmn-?RmG!QT9Rs(fy?|TBNgNd2C5v65Uz!ogU#ehyu43t1 z62K4jE#)GTR*QPdNm6^ZlDRqDXVp)rCu{`Sxy;jsh9WLR)5epF?F*My z{)F<_N`L*F_O5rcQ0=M4$J71Mnk(M#CS1Xy;-o5Oqf>ule~##qA*^)se7M)adSnP@ z9wnp~nh@=}lKN+9#aPR+aN(6!P{j1V)$%J2=|5h{35DCcXZLHrBlTToE7LdJTAsLF zK2ktwx$PwD1{&>lF$bBLgw%fjHNG`h*$f-;jDu2d1*LSt?ztFjYOZi|vgY$kRIV#% ziC9eMWD1aaX5bkz=HnehZ4DQG3p_NkJiFNFiG=>{4y`LSis;OYyMr-})+(lR=Bl1{ z#Q1FvSDvYuB%SaZW-~IVNS^92WbSprYF}KiSWQj|o8>Mgl59LTz2-yyse0NIP@$C< zJ=xe+VP_vWLLucSTuR0r^n%%QEd3)HvxJ{}G=_mTHc)7%oU;wS`ZM$OHEVuw|faS@xORJoGJ)c`|XhXVc;Wa$wQ1@0qZ$lj3eFi7m{_J zzFJ<`KF5C)pdRDDG1Ykqm0kvW-#lmH+UIv_P5H?`!@OsG695G~x}^P67M#l0zV4cq zfx*fxmioaGX^pl5E9;jv2*?>n zFgf_?s#8(;*uyVYC*&&U7wCc0usA&;rTBnRVfE9;?$x4^rb)SzlBkpaHHqYJuo=VO zQ9nK&rh@L!Q+l2GCE|N~b4p3d0hQ$GSuf1u>8!A|d3_RBd)`P6o7-%P8_+?!f{w~p z#Z=Tnoqi+DbGwhGrwx041jf}Yc=U1FHXyvYQjEp;+`+RE6dFHPyAy6*^~EplA_zo8JnMvX ze{Qy@1Qi^mxkYtmQ@|g>y#oWYq7hO| z=;GC zN6lc{6d zI@1$15uLbG6>cG(k@hTixKZ(!)oyK%ZFm7u4ZoyVW0|l5XF?kB;PgYtFh{Fw3!UnWH}=p&QbH%2Ou% z3{z?%jU~$9DffNPB)fv~uoq@evm;-4`51RR()emM7I+aeMh$ zf7%)pC1jSXYm*|zCzN#%uN0`nibyrqtW3Qu=Y)qrp3tz*4yM{=;j&$`=Hbp&TKnCL zi9I;!QB7J)Fp%IsyiB38-hYwcXbke0!uNBDDZ1V zqVT=N5}V>bFdGk0b^)3fJ8AI6C1HoZ}AriTU|kMtX>}C)?DHZZ#a6a z;|-+l2tfAEaqrKuK<<$>u-N8Z*7M~b=K%jJTL39QfCrGwPLym<@-vu)2`WoQIkEX8 z#(+Nt`-Fq^x5HFE%XQ3>7TO`dAyw6O=PliL5l582VxS(pK)oF)T)=lQ1s`>5PXrZN z>NhqAX#G}Iz`{fozMMhA4pdQyew+#0VT0|R-CcX)BJ;x=;RI{72O{A64@4eY!9gB) zG6{sefPa!9S!8txh#FsCWHr}ZWL@4?4&B5{a0rU(0Qli;;KT0#h{>Y*j`17-H3V>I z9f-n$Ey69xE44v^_`g|9FqD6hZC7@Pf^3s$h~gnb@oN+(o;cuEQ7F7%l0`NLkX$f= zo+cRaLQaujieKfy(LKo*32&(HGCz=d>>fpg-}?YhoKOWo>F_#=X!;b0M^SnpoKZ`| zFtjg8|MROL6UVNSJ0+PEu{))>3V?|R5Z_A@g_lY#uJUOj{Vh`-(5ub?9Our zS^hFaB$brU?_UuJ5{yv;h-o;Y`p$1tcaFF9bfJ@IEWKM&Rpx0P zhx+W*e=Z9<>Z1PG8aFxAo~9;JcZw3 zo*e(?G~8TnJYu#f$dUR!gqSl4!lHQ9K78E%NgZO%eC2Ih*5hr9TV}_|GX3;H2;S^b zo-fm5K$brqA%V!I+Lu8ttD2t_hg*ZoG*maSRlNr@uh-o0dnSn^7i>4wHaD^f)9scEX@w@Ul&&z(VMFknLyvZL>W&V4o>ZA z1WSdz43v`XFR>9TPK5oi__Pa_krj2?rIpaO6@ER>69Z+KDKj z3R!KIt7p{aqUYzoCekmIY%7z@1-=}HdArB&655DtjBm_#Y;-Ikr)XA1Vlq+FJ>KzE z02KcJqiNlCsgpNJnzHK+x*S&-A8-GC2s&Jq#1`KCQ0AXxlX_F_$W~eyoFO+;8x`i= zyt4%BckC>AciE{?QB?OrkOIT@$_W#2wv%;IwAP1!Jk$Zz;0}>kz3CE;?9xni++p91 zWtK|d7ammP07o4z%x3eF$79RBw$R7d^P})i0N6kdg%*{5`|?fqO!PeRXCiiRNqeOP zcyGA2+d96=G&QCBU4OB+7*n}r&61GTit!tf8qxU#b1O;tLF*-}r{0qELVBXf#Mz_S SPrDxBARb9;Gm?tLfd2yMZRM2! literal 21457 zcmYJ41CS(5w5Z3nXUDd=W81c8$F{vY*s*Qfwr$(C{d)guC+SqXW91V?Q1Bte0@aX3WzM`AwI6fB-d(g z$tBlVgZtSf(hF=}S`NdFQp&1!tG#r3`%|6iGe=*EuWQiendghhwAqy7*sl^!vMHwQ zHCyu%WV5z^;kTXg)>(vKADcE#blY|4Ya+4zEKfj}rn<>apT_=e`@+1P!4U85?Ls%^ z5h0TJwS?(&o?%UGA=)k^mFRBzdfQ#|GUxJApY5k#KK*04cirq-87}j2H3@yYHPhr{ zUbL~IVBB+y18%jyyC~TTeURrP%L!4(`}wn&0hc|Y%od-1EUgs3Ncp%%Q}wP)hfk+I zeEt;Dd(}>m`&6GYyrAZK%hLPxk`7Dqj7q z`(*JQ-JaxT-JWZeI-QEBj|t+B(YJwYT;8~Apt&!7<<$?Ut4q6+I5=bP99yl6V5L;q zWfYV6-zJG>=bhic&>8!bcFNf+Sj4fMF`*yovhIdgri>`zTtV}#jTJ{oVWWDW`xGX$ zR{J^$(9DblD{p?m)y}7od6Puvn=^M&yBq&@KfaE|6ZvHRc;k}$HdABU^*2Q-YXTKgG0@WxRWKXq$GTJ>H05hqV|m3Cc3mx}*r?Tp z-=>%IiVIQwgfM)t@Kg)!i?vhtb|zV5G9(|cIeeqX1vt2#|}A7K>9{9lS6F25W-$+=mW;z#8sOen~y z$K|_UhEVl=_FE~E{9ZnnyWc0yr+FJcE~~%qRv9{P`_#8SMvuQPp0nTf3n_|{lKEbb zhP&9fxD^A+1XT0X$>tKa3(UbmSVbi4y3&o;H$w@AUmOAnoZ?>YkLz*txuimLcvMwK zX`&8?Jr9zGGJB0LpIo32@qhXB`E4!=iHp#6k|nH|a-bW_a2faO;|_0)2c`tUjpJW7 zcMpoYFz}PV+{*b*w1{&v4%2ybDk-u`-zoKQ$A^|+Kg*5U)3tCTPb39vYNl58O?OP!c>{JtPdBW^-_L)U%{A_&HK5xM&W!$ z-91bfG#!U*UH!!!oH1KMd}mpR$~LJ~S*OH#C@*^P&=B4poul@-uwqMH7t2ssUZ?69 zIVI-j^+=7gVNdgz2EOSovv@QQzNipdZK(*OuDcGeNppg3w9+=X8sn#>m>U|YMwWBX zmer;Au)|$qx5u}2^3>+VqSz2VZ~R=rxjcit{9IpkeXO%RUCr8ZRCT}fKulLw=(%Lt z+Rr;ld~C{bEzslQ&PX_6ta!8gL)*ey{BMM3gBjNbRk(Acm$CFNz5bwRaUlq`-w2zW zh2NALv`v&8uFz{OSo}d4nv}s$IfN!Od3)&{#wnvfGdC5JVH&>6{(fT`xo-l@W1Sb? zd2<*SkaY?*BZxVQ&s+E2Vxhimd`8(e_zt)CefadopYzNstMfE^<~JnAss6S+I0li~ zuqkoJpmR@P7hAO;FH2C{>6ihW-a6EHno^7Yg70qbCw!#aL0Hi~%8SK@1{=8B26QOqp&e zf2>b%|6WIK;qlQqiOe3<(1%W25x7Y@YAJdp5F-o#E)B*uj~T-Uf3L7G{}OF6W^*zl zlpOdRSrBs^Qga-9XY=*|ItE2lO^=MVKJnU4SPcjO>>3(PrZcq{T6J`R#Mu1}?K7l3 zSUo9Vj7!yw|jj_?0 z&UQPFnH^!750@v7qAP!d%_Pvi$r;o$glVVXe$Kj|V@jjBxhG3>z^ATGkWe~U7&*>u zx3XI2#R=^Ck<@Fd8@U~eOYxk_$w2=3LfN0EjE-H+khs9({4p>@&-yuXk-*JFpqRw$ ztRQMj((^}F3(|YVOS9W%#`JTUH#jr0E;Nyn>aZ?rr(DzdlFD3?CZHnDh!RTNx}ipN zoWp}bEbpFtCoeJ41DoSuu-e^;$nQ*ir2)ZB;1Ka5;SV1#c*4&CYoR{6EyzA zU1sNZH)_-y)j=1jXH7v0Oq|2up(A$cnQ8*VC`7AtPENs$&Sal^DgSR6%h;_Ovs|Ib zEu|f>ofI`mf8{vxM5cQhyu(>p21IQG$@oZZ?TzIRTF&`oQ}QtiW4M)!ahzwrY+zrCZDaQ$p3 z5FvKG9fbMEUXRPqIy(byC?5RHHh2hM%xX6;5Zz+ej;^ZsKd+;dQ9HhC+Ba1*o!}LI zB-SV;>&83S0TS3RZa;Pu@2pvRKo?mFzFk4hut?N<>ks|m8m)?j@;4!Cu7N_?`9#`b zLz}ikmohlG2(`lOtO$eGCvD&}t^WYcLH;k-e5a5I+){bmXJH$y2zO%wc#0g;;05kL>j|+N1W(rj*@}Q>tP|xVQugPw6A$5yo7UX z3P2I-myIkp&o3}T@m})8FCxmc0jlEjpQ;E8e6h)YpB314u1d9Q^Rn+&vprEk9^sPH>#_h`McIJGwvbm9#zly(TkLeVY3x3RO?*iAtH3HY_J2M$$=N{_E z+~)K%+|5IfV=QFd^U+eOsXshKm$mA1 z0CL6D{F;KVb0F$^XV{I-A;BKKaxbSvQ(f zWDH$YSgVq`7)yfT&WvJA)!NYC2`WRFkn>&6zRP9?{1~`-1?Is^-t%+o`g8&rWabwp z+ziGVmw(fi@H%`Dg3aZ|JLCxj0Cu1g*ZrJ)?Ve9NRDWZCW0aj0!rc|wAV3TP9Tj`1 z3TL{CONd370tU5I4Mh%4xH3ru)fAMxy!ur(ihtRf1_yU(PO*gWes{iDTdu;`FaY8v zk{jH#%l}ffJ1TemqsllsvZKRml)Fj=b@$tpwOGp}Rct9HW4at%wElp3j_s?6#(R$T zw9yfG5}h~~Ilr6%TI$-Zxt9m@3^?!|J`Q$Hfyt0>(mOl+ zP0V5jrx)e(fZ^U5bB_sw=#=AFpq*6A0Gt zAX_Rog;w5WQeyJ_Ce#z?sEBljzC*o+MP`U|x*$Jp`|X+dF+g<9%=2ScunV(YCZE)A zd1xJs=I{#ImuD=x_~kZ>j1QqQ3AyGLJc9)&$y_MJg*9nJd$^H<+Z75{Z;9~Ck9^+ z+;%?4#V_4U%(h`FqTsgjd4W}U4KbSKYA*dk1wtAc2akbDJwp8ojUM%6AQ1X>x{Utr z=I1~IUWj|m@LZwW-cdVfVkJy4`TJ;7r|Ou$zSpG0pTK%jbs2j!0diBG*YwiCJ*#rn zNm^!I^_fqNE6IEfnTitmHi0W$8g*QH-$=(fzr_|3O|kMBqDBGMzJ3>?n<*t56X{o(oS(vJ_x4 z&Lqsj$lvn;RB+8*(Csr5>$~t&q%dH#h4!|13G(gIt(F8d{f{?<=_@Q}p7#D(r-vr! zVR!-g0tNDrsMZc3f9rqv{I*sCs>6d4Y}%Z}9ozt`fK{Oys!-qtm#y3IqV zsrde?1zJmsB(VvD(38lEt3V$!NsiPj(Btbm{*_x`en1uZQYY9*y&Bn%k0F~k>z0C{ zQm>VSsf$=@8v&Er+a$bUu_XR%FUj$Gy&Hb7E1`WF8Tkalg>=A0IO0GkK{&!jHZlqY z=0Oz&Mg^SukHOH1D==nIW^HcfaWRs5asP?`;Ya+cuD~yWUsh7TTA@sy5FsKbT-))@ z7v;U17Ak~^z>Q3lYSE5dAjM$E zXv&XXIG1Zne?*fb5H^noN!spsgE@jap5wO`25k6mEG2B5sm&3`r1O{`Kuk&GaOSjZ zDQp=28yoXmawdt9DQ#_MC=oK^1#AUuH_4l!2{{Ox*~psP5}Tk7k{|&~{liMe7W>~s zBS~|P4Jq9t0kaK=RYMVTxEF8`a6mqT1 zfUBSr{00J$mK68j^WR&F+Do%$g3jl30X%q93Q#L>t4sPu6bN8^OxT!mtr-+iRw*yQ z68w1D>OJ6CF$MX6_*mlgO^5IW_0?APwQ2xc_TR<_1>F6^YQk>Vf7^e1DQX+AtVNIA zVec--lKeVl_akI$t-IZQ3=Sg>qjpBhB`089Ph-~3H*JQPP{YRk6_m)a!?Dx6b+Zn4 zgLAXKcB>t4Lk9mM`+rN9!`|PlhavgKlTM?r(@D6%yKpANVY$6h<3m-a6Zf27X3*B3 z(sDUKVM{e`g+lqu`y}qhCtN@LRyJ#2$A;p&Toe3Si}rnZi^$gf8gWa?eqFe8%J%+* z-PZfsfUWLqP*EB)^>KbOH+|jT_S;`YWbnJx#Jzl+=8uF@r8IYDPp+i(+Z#QM_Cxc_ zOwGs|osyX_sY7L14GSB)n`h{{9Z=tPzY04f@cn+g=DUA$lBe@~KkxQ_lD6x(N#yXm zYvq6cEdFvo4J$n?l<#`2wPV7KvS=ipjZK+&CZAnR3#7$Ug&$P;OT!%CSAdC}x&osl zTVIqyRX`;bFi5)N)prU*XGw84yhoJVyMu2V%t=a7xZ zJ`WY_3d72&U9N(m9hA)(U;GEwcrcbEQEOERk;*h+rY8<`C{77TIt$KllowAcz&1x8 z(sdXA9R#29-CiC|alXm_=TSZ4tG8tC2i9scvs@Pv$BBCoW}%w8_XGt%&+5VNtrO36 z4{35)uS;xeSoesX$41Hl;{fA?9o!m{$O%oZO029bsy5Yn9p!=j`p4e@j{8fZ2};SV z2=1({iAng~WZe{w-TK+W?+JFc=Z^1sh%>}ObAXLOA9m#us*sF~pDYJ05mkW|)9 zSdUy6W?sdvoiZ(Vl22pOI*$6-*L6bqD;d`<5nVi27NZKaLCt^p%unzNun4d?6k|^? z%_DDo2irpQeKJtmmES}?!tP%d{iU#k52gU#9gMu00@?+PVK;Iu(9r-Fs2~~dn7gj% z1hX$dajC~DNGMPk*j3-JZjUb;@5D#~3=J9$yV)hNo(PRfGON6mU|Dqq+=Dk{<*(Z! zw_h^}F_2TlgGIwV;bY;5gtoW6;rK2+TOmsr;?NE14Uu=RTMm z901w``RQo>w#ULVmup3Q*hG0f!t*P_PL)21!-p%XT|cyp0+z*gE1Q0nMWWvzK*Or_ z1bF*TqaYb>c*{KhM#?4i zs9N!TV5*IOft0xK=RZKp`-N=fM0 zX-?!tKTj-ta^yd|zSfQ#aoLUkBbOVfmrg@NTR@fq0hzALD8Mb?Wu5cc)f?iPRB!ic z!0i6I<3ocNrXax4ZXm!R(99;tK?St=B?r}}yPO9penNM1%=&b!W2S%a!0nni_&Z5s z$3=0a!sh5l_5HaF1b^YCX^8WPv7VO^3kUh$6#vBUbwNC;hOr%ySpSHy*VVV6AFGpYc}qP}C^g0#E4LsuBsKXg91#9^PO~ew zpFu-W25cY;9as%^yI)9p38d4B zYtio*E8v_`x6H?DaY^nWohyt`bl--EvvCQg94V)v83%(+bRCwJW;)HM7dDb2&}r8k z%7+~R6mnf;J0X`?uDw8OKx?&3zqar|*1Wixe}Rz(Sj?|9tXh!>=tT1}IXsEwUeTv< z{%jNGneQ2R-I0QNzLX-CwTr*+_-RA=2rF-6$`KeCO9ZSx7+Jjq>J9F_xU=%d+eH~m zzx72DE0N$LS8=sAvxVXmiEOU%&PdyObYeO8>vr5G-x*r&=Z>`9qS0=`dpnUg)z4vD z;v%b(_MHSA+t93wGii+RyAH`~LeKNpXdgU3-=660{b5X$N6t49sHix1*Fui@3Ni-9 zO)RzW1vYyd*xkfo_;(FrF)5wHvMx%kGL8ROEfTgRnlRnrCBn?Jgdg7Xy?aICONzA0*NS}e? zKFo0?l^z~_BomSwgD|LRib7<{)o6)5(O9J0Fz;xS)P{s?zbSw`&n4Q&>*=a z>?69QNoYlQjurdZFR&!Abnah)$U%C}1R>Lzlt)%p1DgPj?yR(ctwK!a#Db?f36w zlV$(S+?s6kH#Pe(CG{9*bRF}_hju+J62mlq_ESlTbWO4nJ zSCM*lyFV=1nILX@K3itHh9;58Bd*Jr$@R28asM-0MAFL#B$`+At41okH0LK7Lp(Ta zrv!*X7pc`fj1t>`j?@c}T+x|WIIY#qhAnApt5xuRdQxC91a~*XsIszOLU$AG)Ox%G z9c5bK(cztj`vuzcC;@%lDuL1hS`-J<7RqydzCcRu+bK%}?05a+rCqJQ;c)vi8(*Dc zEN`?qH2eJq`5DPst)z}`OZq(6<;ykQK{F9Ui+p@*pPwB`_p8;PcWK`aKUenq5fYMz zRy^pB?~#!UYYa%jcRTiw>B*wH=)a+SxxLtT)3eB13?l?$T*CxI_?^4KgR=yXb7nqL z*_ttYgg#5P53TuO4-PCH>!Q-E3ft9YqDsVW*QVV<(QbG9m%ZW&#Jozx$|8y~o{3QK z={MBK>M4~X?pTz_3d9bI#K{6-{wSKmQU`UWv{|v0-lO%CL+3Fi>lX1suyuk@@;fy~ zvg4?7Ka_`JWfiWKWR$bi?KS*EUrlgD{~`eaoRZIQB_wU#%d1vvKrMzMjAL6w-Grq& z={B)EC(ky9!WE}*Fg(yX=-7=t3{I5Y1-`f$15H%;m!v+St~jrfW9wg&N`F)>i(q0Ki@7hgRld(|Th4?Ro?y+5JcFcc)3Du*A&fPLhA1<_JK_yMyGDzlv|2-CAD z?!>0Nc;g@Q_r5H)TD6KYjm&^Y^7(u3H&z+Xzu1szGcU_Yz8EpCup;f(Z1{Kyak4|R z%8grFQi#mqZCc(Tda$%gW1u6t;cRSQZ%gsE-n>)`&6rexOz$|0xnlJ!{J1l&M07Tf z-&^0HQ?ev?MOrRVr^Z1P9~1tmZ>&B+VV_kbH%-!XBsftMU&smx;ebGBr7;mX2eQ!u z*@7wAQz<7k6O)#)36b2s)?bEmYEqd#5a`*egmrM!MrPbb5%WV$@%>9>_phIzugJ^WBc zDvj1XHB_@`r?S?5XRQ3r_MBgFZmgAUOGC(~!JLJ>N6&7Q6j`8EGRYr&&g|h+XgAmi zB)0*hKjFpX;X2V_w7j-6d->7P{>h>4Jwgp!23!{A2~swQwO9b8(vBNw$pQ9yAAAFH zy>;gGJm4?k<90z!_wUb$lQ(0$uJU4@lN>$i`*byE`})FFplt8lN)nI{YXUUl@A?<# zrwD|E(l!pq1zSwKlSKrNH+(wlYwbXF*2kCM*DWS0z~&!9r~36negyf&>w6HNC{}<~ zaytaYe&BLol*f^}HrWHl^q0Xi3g23;Hs4*(CcOxWbMAf{u8AmjykEc>s{^|1e*{|z zamsirtEBVlh*A3&JbW1W8#%&gh1JFdkHt=tvK&2_C}C164Cwv&O0MIjqp$7t& z7U%_taKcQ1DcP@#>t+G}HwOWeL<&x+0Rp2JwBMu1*yQFEpk_}W8u*Q@!1y0Er04;G zWH~!*oCvt!#~@Ukm_ohX;An6FI<_b|&D*cMp}?i%j>|5FFWYF3St0tJvo4m{%72$> z4%QA7hK-J{ZkQY*#QSioNfsdWPXN_?Tq5+u9hfeguvCT}Y!XtA-P+ytp=lT}HT4W=RAvn>s3)z+ zDyoRBhwnjDeleSDer9W*hBAc+g)X?=Qgrh^u^hj~9|yn%z!?kurj8+sF|>{X z75=S>i7mAe^`!&p>MSFpS$*2IZrmmhCGGvEW<%Go9k+ZFy=}f}RnuVOG-LByC(oJQ zo3i5dVOfN1H+cVPJ>X>;q1b0913Pt+ckkzE0Z1wkGZ8)WZYLqC0QtZXCl)giDlKXk z5Hqj|$Ou>rv=1dJKIlIg_TkTd)(v-kd+s5Ow_h`B*#@-f4oa zQwtFg^i(UFGw?Y$MtL}6IXD6w|JH0H!mPl_!o%G}vcTP+c+U_q^a4V1k_l@C8GswW zO*bY$sXwlSteSLmx#lS`J7WM=UO)CP4FG_{)CeI1FN2r9zr*Ol4x-G@!6|d8m;SvN zzg-M_)sbwWaliP6N8FH&aZYgizICpCrhER-TmIm3<@yfx@A;Wxp}GEzwLcL;WkwY2 zyp&UKxP!=1gueI0M8yX-2vc9nQfAZHLAW)W3q5OWBOoN$po8DoW% zkstc`@mW8SnhxzUp+cn^;QeYg5k&?J!a|1yMf^iUCmjSt22@y)Z$EZILnT0Q%&>bj z(OuDjl!yIGIlvejk^2_n4qEN^U!4~!;bRjlZg@3>3Si4*vZB*CKgTFg9z$Ob@rlW) z#%&KV^e~IV7rItM%NISXZffQNJT*>#0h}**fvo@$Jt`oNNu-0$R#BW$2z18Or8N^2 z;bkAxUpX?x>G`4l>`>W68+8wdsrvF%IE+#6;^C z%%J&Z=_1#qh7BZP_-e2)#L4ZeC|i9$vH_uro5ns+n-}6HY!Kq+s=~=vF(6J617d17 z0IIDS0uFuL!f|E;8+Z!fDEaOXj6!;{(qYP&>%ngyYZR8Iwbw_RvROB7n7_rMGZ|_h zs&o;+^P?_6NR_l7VYR?TGP;I#K!!qwazKjmkqCX)4aPbgwF#z#{Pk$kQa$np72^^= z1g!bI1^(QHRF_0L-MA7>&zW?;8>d8nZqcZtc67*mJ9IdV!b%$}6b8ruDKHfXmv|syU{HR%?Qk$XPmJOV2)*|B@r0tt^(~kUYTm`>6 z*2b)+4`fQx|G6vZc^k{wT|Q&}&QoylXqac`r(CiwzUR$H?rCt)$+pg^gat?$px9a# z!iJzw`HWxm{3mDai_#T(cT53+yU6(cxU6+4kn)`4*7C$y6`Hb<|)>lxVc6d!bFVAd)bs3K9~-^E4^X z%hL_;(~=`yNmU!m&`7I2n#0`pNl!!2^C2@C{-PgMAh@piv}=w zh-5tUkPivSs2#W}SE`JU{p_ECpM@BFG)}KX_hzg8$*nu6YZN=wdYo3G-60w- zxgMzkU#s0WAg~&x|^D{Xkt|k60U5D`DQ)o+!S)!mh`QqjFIsAeY z*3&$kbNZSe{@hdc2PE#cSJd~Pp4*;Vz@`aDbxV5bD-(nfKKfycD`CP*QXpHwP@jaC z;x#Dfv7?brpRz@04*V&Rv}Q1CCIufMv`NT#%!U6X2CpJf@(*P_CO`rMEE<^eOw&sM zhYS{XFnjjdf--T{NJB;b%e(H%O36L0go^~bu7>}0ro*0U~)RKOgw*ClE-IO zLml-Rhrg*pxG) zjqS;=IL&u$7dNA+V9Ix?94ZEwHTwD}&?;GCoi-g+85PB9YVZO}x?P@%l67!U?qD{A zmE7lx8rGJJ9>=cLEeercW_Q1t>&h2+O_@wPkA=ZO?D za4ikCQM!evxnvmb(r9hA>1ofL<$8b9+r>uYcx_KGzcz#joM1T|K_jbpBYmOF(aaZk zcdX>?1oCrP!@XI5>|WUkRo80k$E_8-_=HAu=X`^t_M| z8F*V&$kIZn8`wRLZK33Mzqw9p0U}|y%^#wH4RjpLRhaS6$JCtyN}>ExwmcyiCc?rL zv#;}*^lf%C@4HgstXCUoZlDn~HdmNWo1;n0$Y}!RFc*2`k)YI9ow^URNYqIMz_k%_ zC@N#Me{|N`cR~!E|4`w3wZ` z*noeBImc$Fo%Wh5Uf84XT2A565wT~Ce;T_pEr8NgsH>%< zz?7SP4qUFFTEU4T^VvjXL`?kX?~t*n&G5^QIJeMUz`9TS^|91716lUbg7fr4jdIR4 zOi*r{cOrPJH)E7AAw)b4D0}$NG(Up(KltpueN(P29gsaqK-?S}2R708^@KS@las7g z0ciqUf|&Dpf;L0H&v^MAY|0!$qXNP#5O81^5VV0FDyY?4sFiZOWZK%b-FA40Os>;5 zRdPbUM?}_6wIDdKgx%MBo&gvnEc<1uXUWe_H3lnn7^-N+>(fYvbkV)~-> z7(O2|7lU?&k+jBGHo@_=Y^YeaxPw}ez1E6OI*=}T=sh|48QyNRQfT{#X=~fE@DXlY z={FFqnMi5J)|isvi)?4)ddV%h`AnEKRWs>Hj=8p|sHi#WuEF!>LYxFKy%fg1>XlbB%hT} z#%s7D@V;v6<1~C|2|!E#*h8>V0;=$#23xWP?cVTw7;jy4ZYh?NL9o~)Xdin87_*xu z%8hOI>1~sKp2xn{kuEE^=^PUc$EzIs>as9KM_){Nl0Mg#z9)&Paa1?814l&;YN_3s z)(Eo!mmM&pFygA6To%;0dlb;;Z0>%#4f=zoJ#r)bJ7t`vm)|ZLaOGv_3FUi`omF5; zsY&$oRMXOU;wAkE`G1M4Y9g_!@+`TpCp0uQUvWyKS*P@4npyV{gd2*HPKiyvXXS+C zt_i0JuJU8yK8L<|g}O|U?2LA`dhUV#y`#zt;xmlTK(YG;0`ZgOtfd>avmQ=hc?&3+C{Ahd3u>pQ=rk2*wL zx3@d`Cg&E{^Qf(hSyp?r@$>oipqECgNR_Jc=WM^bC48b@bsJ;wzigh(2ma6kCAnrH zvXqG9F#x;LFc10jX?^nVuVMy!&o}xGGrI8{leWaXQ{sk*W+l0Poupl#AEv!pE$^4r4C}e> za0AQwKXd)|g1<)ZT`BQlZy%>GTGB`SL$Ce58t}Sa8IqDNP}9H19*tkBlQ+86UaBP! zrZzhkpDAWj-{`KWSk>!i0)?8o^SvcU`F~?b)rE{KS^bPIq@t!-^9~bBRi|a8*vAqT zuD;Q6l5|A{*~~7r6wNTmEtv61Qn0lQ?qCVSr==;$M7%VH8k$2Ih1Yo*>`S_M^!CJK?Dw@eDbTk&f3&N=X!@_&s4UFcDU-I_jR}fsi#>{tFISFN9GBm(d1Q^Zu@h+f&mD&nY2)Rxxs5SVG}bh;E-I9poy>1?!A;)>D_ptqx^BAW2-o9GyQZ2MH{<)d*teCxVaZtg4~ zQlZm8<+7a`UAaoU?ZY3tm95KL4g|rgaL`{?dsPEAW}0$BHh-cNi)V`(2ycA5*i5fw2Yq%1EU`FepVs@lSpRKbo=qP zaI6=M>z{bIR8h`%i}1dDrQ`cEQ1x3BE910hSwFguk5{N&Vk$lNWTnTQY>JvBq9vrZ zNPW+suPUHh)sk^SLN)?A8C-&%fOVentNgrXcDZ)8(yVXl*8Q62VkN*;0Nq?FRx^A8 zjay!`e3*fj&FfXnH+cb=mGq>_n8an+2kNNtl7Yq}wdHe$=3(Gl_@Y7$beOiru#Qt; z<~xSx3XC`5bgQ>})7RRe#xUNp0{6E$uhXED|EPYfMYQ-rFvF%pS(M($mZtP0#F!Uw z^}hgGoz1#<0U1Gv!6W2edRzHZw=WRe5q9=+yI-I;mS6X1uFAm+LmKprID_{sjO+5p zo%W`3l(a87%2!lSbQ4g&BUTkglqrf{QSY0SG+8>58HX}wjBtnuRiv2E*+kJiYRUB| z@qL23?EAL%dDp&BZx>giuPa6-V3u2L4toprv_@$O80M925l{erwHblEnl~xC*-590Y8Dp@^_M2S`6eN$uh+!g;h8Y`|H)1VUUB!}XV|+xu~WByYM=Xl z8s=aMGE_C`!D$(P8-)UDA<>^0(`-+d@D`E0YbJh+3In#3Z=Pe;hl|Ij`-5f_)M1|N z?*zgte+TNz+cg&#+GJ(9#mp!uX!x~-@;Q%dMB=+da2&i#ZQ7jP?0RF$PdiGDMkyh} z(d{GJ)h>DmtNFg`3)S^KAKRl%FYUXyu?}05HKujGmmYGkC~}xU0q!7*S^=!4gEh=$n4%r=^zAK$lw;|&X0UOMUXLI z0PwV9yc{i*!#{@$0MpZ39kR2N333f_pa?%jXZ%ry;Oz|Bo{ ztn#aqcOhUK`S{HcalDNGDqy&*y;VU*5jskj%T@Ib4iNZp=SyTanMRpuIZKv=9=Um5 zTW*j+YnQbM5b!Ga5vcnpqYAn))VCA8gpGlELz2K!0 zniX-(XR-?N2HDNznZNO;EvUm50`oL2_2{E_byR*~aqGkhK|5_p{4LfYi)t1jHn>~^ z2gL)z8|YvA^n}9O0AHflXty%G+Y{FOyEt=Mrf_RU;&0#0`6Y*v!GEg@lZqbLHo z*i-qQt(NAtf3GjQ=XZI91E{vi*Iamt$&xh zD<_-+Y3%DF^HLkmC6@Oi za~6N*NfxEj{!TL(lo}?QMDk2-#N194P$!9VX8vC$-cy+A@h)*Fk5j8$5RC(M zP~V0;JcxmmK3v`Ohkp_T9UcwcC;ZG@PNAT5f9ayP&kR>;vOD(lbJ^ zf(PxO@J=lq{>3Jvi4~-EHAp8KP3ME`jC4-207Gx>Y%SvBobU6cV_2Q9C=~<7!Jsp7 z2s0}1+le1Ou8)auoVnA7DGDaB3VG`g%mPYDp+;$;U4RxyBbX(0RAiJ-Nm3pDb(}uE zs58?iLlAN9K#WcOdjO>M2@X}`G)*B2Wh{oNk&ws$|^pkE>zr z4~;2{-qkA1INdg_3HjUdjS8XvE4t0Rb+h}cp**9?g-vjGWuxDz*+VO-+q`x0sOBAHecZA>{t7AGmkmjIl>X+_HpcY^Nk2Eckz&lUvL^}}pd^dnpHewXY z`<$rHzZNmC^WFB*PJC+e6g#>GVcz~ZYm`nw;E?ou?GU0ddE5F+MPRcDT6lCiLpN^k z7>UNT-_=}&{w6B1Nj4Iplk-UfP@V>ej!_qM=LRZY zWw-dN-YL%*K%Bk7a@n$^tGuWL?gNi>d4s+}kS1v)@qe7?2l-a#my{666AqdVOK*%z zy;QHmY83qa-YP}R?}xW*%wARW+pm%)-qSon1nwqIw%U6G;s<*nBJDZo8aS{+( z5ETfFFmVu?bNxNTlRe)MN+=ZMbFy|;PFDV$omOa;?^#%-d5=zA$Vf?URLhg9Hh;e1 zwO<#qn`|QK^JDprcee0-sAYFlh7TGy7sZfabxlck*DHb-f=kh;*}h!=rlbRue+NI$ ze|JZm33gGZWw$uH&1oUG#3f#F9zINj}lXkD_ zDHO&`Ehz!IMD4$`Y4AoB1lR!*>;g^h?x5Y6fz~_lV0MJ=pu3c{47z9>fS|Fad8-Gf zqGQhih*_6qi;Zoc?#jp?Uczs!87$Q2JJq?SlM)A}5jzZ1nS-`)hQq4JFZ=Dla|U>4 z7PJwKf&1oJXd#aDF#xZH1jHIYr$S4yx^1gkZa01u%$qo*PMIDpv4tf%=hTueKBg{{ z2!rj2u2oH^xM4`5GOZDiHhaO;zr`W|9K=)mcLEMzN1l%eyxm_55$X8vsQ@|Q?)Hz< zZPGs+*(0BsxT0{lRqQA@GYm2Bfc4#TU zVmT;I3YmH!JOe4ws)sx1!>lpDl#Se{{XM9AbC(^G)P=6PC(9|;;K#4x7Ug=JjP^Ny zy#8{3otHL$CE3>Sy^0^tc8_zTo<`nHI{f7rk1ncABSBB7WAkwc^F^iJp=x@IUtM~1 zVtu6{I)58nfgaCuvu7)z7ct?NtJ~_=VJJ0jX-TiUp^s1S19*RFIB&< zzw!_n)&5Zebds47Om)`1Q74|)UWKG+t;kvvmrlIM3OfJwZ#M{Q;2Lm8Viit60=1 zt{B)}2Et4vCFGo@OX+brP@mW!q{NsRbEz`D_I*>xBDZLf%4_kZ$SuLoxKoB>qeOe& zC{)p$R3tsh62*8f%+R0}F$wc>QaF9Y4TMo!zKkQwnS%HS&)!3#7;^FNwa%rt*1v~(?jyNoBU*8lfRNFYSoQ~#6S~~Skw<> z?R0_rHAzjxk)Jk8t3b^+534-(G|D9a%LOWMS$5S~AmSK99BHJ&xfhG`@jsquFNwSq=W^ zso3YV%hlgNSVvy&`&%5OX7k-FftB`Xp7XXpE$`7NM6G!SYJ8?Cuca;fWo2vJM z;|wtzKhQQ6O_q^3XniF?7Uo;~;NprblMAEy(oT$1#-pw_u|G0L*ZNUXsD=gs8jo(b zhwAh?=TPoAh9l)?NVHtWg|(rF(nbRW9)}MXYTi8fa;eX8IVB(L)_hz6$)a`e<3g zJmS9td_rWc0(y|jv(=O%)TQKeY~Z^EFw_fZZ+R(k?yxiFD2D0Em1&$9>=p>JfJ6@a z0S|lH9Nj6ced#Lru++>2;k>Azd*4B&5Gpum`P^I&WeNdeRiNR|>w7vh8Hj4M4+pa& zlAbg`IIk7Y4pQ;xYq9ezYyh7GVPKJSSO~l>wd;dFp9u2&k+jnyHC#2852zBPL=nfY zC5gD9nNF%i6L1_yiqm~68lgnR`r!{U8kZN`R#}il+jQ@aQ%sb}=mocFsLA0^#KZ3o zE8b~DeQ-G4{J$=)GpGrm+a}Va2uLpi(m}ek&_s|T9hBaSND-w;3B8GQB$QAjGy#!L zq$@>3i9l##2pF1?-a;p|hu_S5^Ua(6vp;rr&+Oc}yZ7F6kEyBu6~YNJQl*twQd(#A zcD4P_<38ajW$}fFn0%+MXrldJ`f*;=u%>WQ4n|#30#gz$?X8(8WMC;1$2`)X*aNs>w3Grc(7`8=x&g>Kum_>iI(TPoh=&m6jL2G z+WA>m0RjK8LmxGVg%>V)6jnB4bi#%^zw>l&Jk&pM)9?)^f>zE)XTSbQo-4Tn#QKFD6M z;)8sAJYn&V5ZXVe^5I%yAtm*Xly0WzmeOOC;CM`l^$!xWr^AisEJ%?zH$-naIWF8W zyd&Vc=%<4n9J!~NF@c4;)_f188V`d?a0CD8@Sobpu~ z%N#!wON6WNY}?`^+COIZq_F&;y1mBgPafAv9L}^-*o?Vu=tkV1qemoLxfEKd_=L!0zgC+R~unK66zu%A2~c%qfxG!xp4 z?Y2KtDJ~gMvFDS#_zQ)%hDI|YaJu^DWg<0p~JQA@uzI$-2Y(-67eLd*uhgT8T@xWx(iYAxWkD%FEH}{X__}AIRx>j`;x4KFgb(p`pk4&QNp(rS&?`?Nhio-R8Hq^pI=-~p2%AT>3%spXU>Vqp@+7MUKhT0^6PeV9#Fph zjH#__O={6g5&69$m(ZgEBmNNUb46T8fBhVdJN%^~dgW=LdwOZxP! zE!&e-5XNB)n}=&+h!3+nz`hgTZYNn(CvD&)^oOkO?)gJ8&hs-X-o`phpGz1fi9Ls3 zt5rd^c$Eu^W(a15($8FcQ?}1&LuIzl2|^Rjc#7;gtOm_5W^&*IXVA4(NChnOwr~WYFTk zYdM3VKU?HbFu^T4N5HyA-=Xqe z2N=o=RQhOd@>M46vloplv!SMuY0qnZzkmx^;B1cQF@^d2?rH;ns z!zP(P5-0s3z@eKqVw;sPjr^lIJ&SCYlTYe24jtAY^*XkUjD3(ZTLGhH_e^v9cl={T z&-eg#g=nPGo3upr4JwWgT*@*(Sy-%>^cQMW6r8T4uFV6$_S}U$+RB!8u;H zRD9H6)OAfL zez!)ARN2m*bXX}++OD$fgNEy(h~CwYesiYG5;0vu&qRIVU^4(lD|7B3-WrdkCXrs?baU&Mbo z#s2v5x;1N{(qBhI>9?e{-7=4rbVqv0^m zwA0V@Vx|Z>xm-u?T&-|LW(0>gfYq1hcY#+6^EeBb&mann$)3Gmc3M70%&Sjb02>=* zeMTfbs5N|-K37d3gp@v|YU9PbNBR~PSRN^ObyF>3RA%AxyYn((63)m^ zK$7jn(B@UfFhaIb!p5=nTZ&++vmC4V^{z1uyYmLRdMn3{wPt9}wK7d2+CJpIQ_ z$j6}|^H{w<5ZZR*QRrENn;Ww>`QoSn?UUQutXCK$om>}qf~@Cvs-f5ylRlrg_eR{T zSJrJ;GLiF9wVa=i-?$DcR%sk}g2h3ocjxgzx{ys+pfAaU{Pc4{5%)S#s6L6;mF844#>+_YvQsVJ~}OYjE_;hY~w7pzJ%t zPtaOCPB6EJXyRGX2zrw7xRw>zK81MRt4>Bt(T6i4%=_IKX4Dn+(_sin6H5CRo@n5h zN2IVOcWiTAtaE^&T=#7r({?QdSJXn4PwsKD$c`2mL(yB6fz8*;aZmNWIaZZf=R}b( z`lUSjkKA9casMjf_pv9#%N3tY+p-TxO0nX|G}ho3h1PmT#KW}($~IM4-#3JSKoY`F zXB}^2^D$*=ks+q-?z`)n%EeuBQc?!Je^w+iBd;c*P$9@qfuug3(<5y?nFR}p$;n9d z$j0ieC$&CVeW#P7yBeCX)!NYpQz$1Pl?wUs1W0W(iOXZ$PS2d3TC(lYp@SX2?L;vW zjbemw<3Yf1Sx^5c*7#?wAvd{YW=2o~hTHx{B0mo5dv{65QL~oW??F!dbBm@mU>wn{ zQ~rg}&+;~@_g8o&t%mxy}Rc&&l^10XB5B=Mfd$xJbhK$^@ zqM4LbyY~EBZsl7``f0OA9BxM`zOFdG1#>)j64y$e$AO#5JVdashLlztik7BYJ8O4d zl?p5EyhP1Vw!>O`bg<#wE%OevyL4tu<#4EfhUfyv{pt&9R`Fi82PbnIdN20)EVuPG zPA9*_h`=a61`ita9@vuETooE*q9O*8Y_q3PLq+0?kqbmchXlMGpN+vALJTsMx=v}! zE(i?YuhSdka)l;5$-botS9ji`CCQ+KFt-e04qpziAK{v~i+_Cg8qG3oeS=MF#9Ye{ zO{2Z$GhdfhjPHIEb~q3t>4Qu)34>pa_!_PpQdDKF#6t;5-lD$-vCO!_;z*=l2BMG? zh4Pw<(N~0`aOYc1&s^-e#jdJ5*nU#Y312>CpInontO)Hw7HG)t!7yTtt?6?;p&qKL zK@a`r?C;@0XkAn+gWUcO?q$VyWe21g?wvJG;hl6OYLv9^j=4dpa9E>!9AYkh1o3$< z*g(9KZlSx|5`THAH@|b$@=cmxgB}l<+pm!bI^ncfgoucx9i#b1uYP>5Tj988e=Wx` z#%(dcGuKY1+MT!3J9JsVXklLvY#(Zemv8#xP}4TC*v9U0&MyetF$5YZ9SK=fbqH9@ zgyWXM$UGK<9~VRRSt5IwF23eH^b=NINKnf0<3ksb^~M6UixBQl74el<;Dg$qL&au+YOma1<+rUUX5d#HI-1yKJa-9_Me+;1dHyr(= zMu2i;(|1}%8n21W)4Dt3yfh%ll6T#ir*5D~R%$UIIzenXP7IJw-p6 z5)Ip<8>v7xq7)hcDS1@yFQ5a%rA%LD&1nBM~!|0$YPX4EkL zV>|WG0>5%c&jG#y<8K0DiF+0ZM2>(*#8eruAW9Y_Our*^&I13O^z5-f*tF zk`EoDdH_R@Za4xQch9e3{RQUygC&|C4Of z+lzG7S@j3Jw;#+}oWgk*;L4{eM1Ipk@oyEJb*EuzB<`4Xeh1z)zY^9x zdKQ7UTPjqN${eC$^ShKXE9iD#i=SBji<*s=IEo7NTFQI5lA%3Ov*16&$m!?L zXrTtPNK1Aeo6i1^kLm}fv?j7>T1lIQh483k!)V=tlHecMDgd6hLEeK?kbLGvG-%N+ zTg1~|>Z1LpXtOO;Pp#$I(?)EwxJ!Mltw%G=7@thg`GT5Tn%lfhwXVxNt aN#+%nil2614Us=rWD3Uf$ChHGfd2tH47pDL diff --git a/tests/unitizer/interactions.R b/tests/unitizer/interactions.R index 306224d6..90f48643 100644 --- a/tests/unitizer/interactions.R +++ b/tests/unitizer/interactions.R @@ -57,6 +57,7 @@ unitizer_sect("carry corner cases", { substr_ctl(character(), 2, 4, carry="\033[33m") substr_ctl(NA, 2, 4, carry="\033[33m") substr_ctl(environment(), 2, 4, carry="\033[33m") + substr_ctl("hello", carry=c("\033[33m", "\033[44m")) substr_ctl(str.0, 2, 4, carry=NA_character_) substr_ctl(str.0, 2, 4, carry=character()) diff --git a/tests/unitizer/interactions.unitizer/data.rds b/tests/unitizer/interactions.unitizer/data.rds new file mode 100644 index 0000000000000000000000000000000000000000..5f8f8d025a4f958b923709fd1705462c973d0021 GIT binary patch literal 7243 zcmY+{Rag|v`!L|8ySo?ZSU|cxmioe&@}C(~xgB^8i^t4TIgPI|o7RH*Mac%^ z%nbcOi%wnTg7s3YB%nxwNVZ-?>_okmWi@@6Q?S^Pj@vSe)5P^T5#mYB@=n8Y^}-)B z8wK+n3Z)5OF9vctgy(ofW)-=9fgH9HxXGYZbRAlrlq+~_ok)q1=>>@dxX<@?UwiTY*YhFh`n<4kl- zeX`bM;IbGegJY!d6e)++p*1V*$@u^b;EdC)&`QU zt1X#Q`9J*0^!ez&S?@ZaSI71GMCidR`Qz`Gf?=*fEn0jvyR`+oMZ37!hlGXKTKftW zuPgLRXBV}{{Pq)Gw-<&`uTG2k_b5292x+%SbDKV}HZ7Z3SE=nd(IvI^v1h(?=5B1N z#p7UUJ;)rl2W6NA$!bptn1XaX)*Io$ZF~|)8=Aq(j${LhsV@3W$q_+&5c&lHZeJmE zlf1v1TpazaUD}=ij-Q|(>Ps5FD@jm+iDia;rITqTU9q(=oWN;QjdT&1g>^8@DfEaR zFJT`Ysfcy4B0}Hlgh_=R04m#Pl9FXI*UwbJ%6bq!7I()cKM$1UHGy+q#r}PiTus z4Z~93;m0EwyrTS;*En`p0{|GW1Tg<(Ut=P2%6`_^xC*r7EFnD)-e}B0tGqVp{=w^d z_d0x?46|RAU}VErnu2jefNxm1NL8SyzdKzkz*s7?VUeRYc0e+aUYaH&d>L^sn>$b_ z`&pyWO9@3Lt#=Ceru1vyXe=;118fy>B-hFRQmQ#W-T1bGVNvXX(!HI1r^x%2SR9ge z?p1T27ZIJijfMx^W2S)QhIhmlfAQvd+5=|quS+6FS}>=U>=Bs1o~S*2072`Xi9u%E zm>_qnA;3q;+gkY#mqx)B<-IxZ$LiZJ$D>PR;oyt zoUX)b9;Hn>Tubv;o6A(6?lh?)wa$ysYm)2$x%x8de3G2?>3lz3dk*N9M?Qv!wZfaW zqX|KdJa`NHYXFebN3y6E_BDytc3ZCo9bi58SV=Yi>clfj-~)C$-)p}r?O?sxv?phP ztxPbMeB+b6XgF)+A&p21$dRDiFQ7rkn`} zqiS#u8j1^w3lXCW2N-?EV)sJ>93%Lw$j}&g>_9}fo}bV529}1p%-Q_5xs`UqeF}sV zTpW&ai+W2)bgRvXgLs4e5DeA1f#IIw{YT34M#i6YEi1v&WAX?stomQme+cQr%E0Ki zFV~yoZo3M$#QSD$r?H&Q+hRBIo z9YVJ_=G{Jv1SMj{F9voe!Qd7a_D3~UAucF~7tvuBfF%kP_Y%OdDW+#~{6K9<^yl#b z%WGxLWOjya6gPmGwj1CsGyo8s@#36X!B%!IP78-O2k33Mc2E~(#P*Qd6vlPU;pjIZ zG6%%O77xV^ymw@QwE4LHTpRf@N@Oz1IA^M;;7ZsXtM#oOqDxs41l(h<(tiWkQR>-wH=8N^Xfru03Z(F5s$_Z>j<2BlCz zv@Q~LK$j;UNisQLFWG;|A5qRL15!JvXD~|;&UmR~KcQ(RRG(=r)D!Au|^9 z>2nb|)&!XApf7XJ=vd$gqvDM#W|S(Z(N^~BSiS8g)XFrC#hu(mZSag_=Xt|rLYENO z7t%A=<84^V9q%(WW4Q^1_Veor==5Oe8M?SVoL5QfQS4YVs3y4-mAz1Pn?yKUAl^)( z+Di!z`_pD?1@-CW%m=Ta{Ctdb(7bD`Y&^-kQzD*A4|EvxXz|VHh9%dq;@(!(m9OyL zi^su8OR5AZBFY3P`ad;#R}k~#NyL--=Ghny=tVY=)mPCz_$D=6YQ)h83G<}|%N7kQ?$|xz%^;J|_js;;u?hww_OwfW^_50i%LA5$r7| znVa{LL?>!@1w}m!rGKm+eZ06akaA@GSKASw&4`&gT#d*G)g@M5P7HJk2>qgkB9QTj z)D$>G5j=p>V2sd3SL5K~#6@4_D#n|VMV|mf2~)pxIwe+p=jtS1@RgT`U`Tth| zaMQJO^Te!=I?qIf;oq8y242^wzI&e9CYnA6~VU>qwl~>mxKA$)_YKveOAp9R~+a2_cJhVQ&?-3J2kY6Fi zCn#Hh|55VS)*T6gj_dpXc<2e(-NmvO&-@B!}F zVbJac)wP0>oYnFo-iV7qL3Mkj{_b=iLV$JGgh7A-rId)JRE{v4Fee751q}Qkn|sFOK3QS#U=O_zDkg+5Mek>EoiqF&ZT{Wa1#ghPm7xOMv8yOFBj%_7efs!@HP+Hk z=fiXZJyBiHt^EA1uw8Kizu9zY$pN=|d?{68jw=5Jr*k>e1Lil$V1r98$hSZxQUeja z_ut+JNX{NWEq3p>tV_73untvDNtQ^zPdv=~#NE|(hw32UV^CVKi%r%|R=+i|z%8~F zf-G|UEcR31t{qA-omq^FaOmO4pDfe^vyT{+dWJPfTWJH03&0>?up48LR^D6sSxDL+ zu^DydvuZ|4*3yWw)=f)8VkEWUkk||$0VUxhUP1vnFIc5Sn9`EGhI(l`!wvDaEiI@XAmLWpEeNAOmu#;8kO%YatY ziOuy@5hOJP8~)u~@{B!8*y9D5`Z}~MY0REGwBOV1edFdSS5Z9(W}PBkN-st!yv^fX z(`*r%r7YS4=lGnG>9&BiwSV;6af0=c?DXCJD^0BMw5oP;!3wTI|5>Kv_CF&W$ixOf)qsxM0kq2c}OpxH#=m^@@F zvq3D%2rG*6@3M{ZS8MC zdeFkFO{ZO9S1*&O-!tTg#A~y;W1fzmgGbWuD)0#Fp!PU({_s#z*UYy3v&;er_E5kp z)!lSC&3g1*=;SYhLB{7vkqS?|j-l~Ns5i41AOlYrJ*!GFl7{|5eQJ6_B`4>^iq?Quc zh|QsDW^eSF#1R-k2}S-WR@dHF1I3nd+~=z1M4u@=*686MxS&S+J|Jh#UeZbqLvv7PFzEnWiU!V4 z1pWXtP)U6V8qEK*zLHq&mzRN(KJnx2XmLFx;eEz{<~K))Ty|@`Bw|BW-ing6-`DuU zlf*8i9!%Nx`Ym{zoVvQ*P)I%o2F2eg#<=w5$GFUd6^`jz%IVYYAIK$7M8}{KV9??U zlRI*b>F$m>mhZ^F_!p2DZw6$7s%JAx?+jD)>#Npfn$qL=J~CdgMOD;Z@n?+l=UsS< z45TjNA!Y*}hxPeMV!oR7fj8OH2N{y$45kP?a7V^E?b<*E8-F zyCPme+QY2RS(;x#W2>V2p(qCDH&h8{&4Hi0z$B0}?ui@evB1Bva=MQ*57l*}LfTIc z-jN@L2h$C7;Ly8cvAScCGvEOOom4Z>BPysn`LB!oOj5AYssV#?M667I$C(x(NX0TG zMH_ynI~E#ThB|hyFdpj78@UZ-Hk`OWdMm8MZw(9v-tLnnaV^v`zd6;Vi#0p}4-xY1EE*C~|v<3_N2 zgOXT>=eduRiof_(G;{og0?9g$i61NWs$Jwh6wrC zP!-B$Zh$`{1ck84!doLhsonILSY-?T-j@F~NwUOT=q@`{x-V+uVOnA+> z&$VP$?s8Zc5^0-$uf{bW3bnOKwnev6ENF#9P}LJF4xF40MN>Y*!omL4vB!j6V$KF# z!UJxtlk9CEl8GgaYD+`D9nt?X#=zjhl4kqk z{$}y`z>znP2}E_8AF8D(Q%&d+lMs|T6tAn438@CX5-l>%2Y2ypA)nNaWB>i}%|7LegtAf*_5Sj5%gpr6nwHk&KF&%diV><2A({~%no$wVhAkqqjM&J# z@ctbN?iN}aEOPN5tf)nv$i;s*^AX;9)F3qKZWPd5e2&umkDk|BJ9Y;{vg%XEa@P8z z58${w6yW}k0e!PEO7jK@7s1j6O|k%0)X^_--Wr+S#Itf6v6>ktsYXgbVmgW?p((AfoizVYj6z zeEqyZpL~cH0Tr2w7cw*JLaOwavYDL-!S#3h+qqKR6C6;TBSlQ3OZ{T2>E!$rkD@3G zCop&JD$oAe#cV?`eWrly7F$(g_?b~&G@$}9?_)(77K>`cXF)T!2jzS@8Fp(u>C9yH zqUeQNyEHj!NDavZ^>ol9g80J`7B>br115JENx3j%>f={~h1@sq)t^Yq$^Qr8sk_Gp znFv(6UD*8=N?(he^+@5#^*?*?wTYn)=vnMxl*V0l)}zS(SCbW~u|cxu5;q&5RZ-xy zw@OdRy`{4d@hm}IWTe44cG`Yi!-aIN^kQ9 zuBXc1N7WiwcAFsrYYF8q5)snojVPafMt+7LBWaCE>!Z2Cb;s)jU-G36_OzBn&57#X zey_1DGu>vG^$ge%#a|TKdA&Qio|<(3cCo7}lZNOpHr7-p?RDPND@aBds{;VEKcy&aA@AW{DR(X^~PT00)lA{2}C( zIiJm_!Mbm;9PV7Eh$N90lx~F<2CGVaoI3Y#aXAljOkyt3)@y9`Cy zawKH=t7G*}NQqW1&+k;Pdf0DdaGNj-zXsg2IhuQxY+BzVyzZ0G{j=A&v*&g4m$JZ* z_%4<|^uaWg6UhOYOmWjzm?=r^3MtT+$wG}ArY{qSU%WTqk^cTY_LU`;&rhyNP(GPw zsl^F_;E-Z4{7n%|D4t^3kVfoIe^@x6>b<_X-2%K1AMC!JhDuJZUfhqsW@pKw93&tuzZ{4F|f zT?&nty%Vm(p{8je=c}Ql8%pCgwL#!@hYEHda)}exLSXzCH#R#i3yruPBorSui!7QlJ=f^ZV z19~Q;6W8s2;#@sY<61r-o@?~y3OKvhkU9=O)tDImR+}vTrlBsAmKvO+x#4#|4IU>I zOo@=&XODO?xn-aR;9!L3CF-bp`{jk3)T0o@+_`_A{Soz_8&=v*S+cV-&DOLvb)Z61cPr-G6}5Fl z)0uGy=w>{l_PS>07Y#ro?o!a}=+3g0ne&0p%<`V(1>x;Of7dnE2hJxxive7EWE?#| zbH5H75CD+}kW*m9Kc!3_iwU$DkWxR}v3kcS{w}aEnHzsNNg|VeN{0I5zleNA>+K!g5P-u9k*%qwVDuW~UWd3^cjT`I+sTANLPH2xhYhBW;A zCH39t#KS|x-nTMYAjpIP2$DCY_j5w=Aw=&0{NqEI?bDHmwoN~tx1rRRXOpuMYhH4F zX0?E_j~dki@I#p-1Yn|f0PoSPBAu`_rLLBF1&+jhC&6cxPAc^ml%)(1KH_pbT`GYi zfR#J|ze^5)neE?EZ?pObbrSqS>?n}aX5q~9#@D>t%k9vapnC&Lv*VuSoEXy}EM*v${j{a#Vv=2Jk1CUMMlEX>YoD9IXTJDpYAlXjtS-HwV z-1+TY(@mU+>;*WBJEU_&|JtEVYAuBYO$L}R?Tpoij}^~PJWxA)U~q_Y2{t(s3CaB+ zJ;SagAbQ5rM(gG-CB2czG%q&v3SGrJeV6S)IZQ1g$canR_?%Toaj{DWSpbj9{XV`T zNGE+?D1OhqLI`%rQs28lsEU0hzkP;9qyjD2hW|a&^Vo^w9hn^Qj)=4ijq~!|d zBQz~@9PGayb@Cb>`84v7Q#%R_jX&4m19(pl>+OE+CCW4E?^;=xnq7e*uaX)L68PMu zR^D3GEB}tkfB(7oxy76P?KWlR;D?TBu-y@*ikfW5=R0P_opznaM-D}g&sbPf{j_E= zFtt8?FYoOb>qgJ?hS%AKtoliM-{aG<(<_<@sV1*muDP9B;LYx3N7tI-^P7v=&fMQo2DwU}+=-i3OFAP6>%s8tHBp6h&IPyQQQhmlRmKyIEj?C6|WX zyZr8bp35K0?tF7*&N*|=JMWoqn8P1G`0oz~;g9!;zBl2#`Xcx3Sv59WOzr!hpJHT1 zl(821 zx8wGU?uz31dek zPQr>OT*dXbO`in&v-nBmbCHevGMB;^o7GOj>G&jLGhzOrvXX0LCZu6XuPfS!@!oNI z7atez9qn#(n9njtWyF@#O&a8a)tDW5$Sg$sfgqUVMMp`EVOOZvN2?Fyd}VKjAz(2w zqMN+qU$%5UqSAa!jLbwFqM(Mu>u)nmv&~>v7D*~~2PWcwu`xr5a66`GIW5w$&aJWc zf}4kFBC0%xc`?XUS>W=L|dsS9Az=$}%zr20C@0YUe0>KO&*p-_j7C)N( z?xpkFxgzhL;LnDBFj>-%h6O9TB4=F6FjSS-i^SM>B6KZwomqq->enIa8|D)c@!`*t za_i~!J@pC<-RXw(1>6L^SoTwMb|cyn-dX=SJ76Y?(o|n+HA;OApooxJ zFNRbei7h(LMgI<(7Y-3~Y>hWa^H}a0zbX`g0dx8MWyKI)2_cjDBr)=Zz`(b%Ea?o< zg~8_^dgF=YjhvG40u&tIw^(}biz zFTK9lN%q8Xo3p_-$7fcLy;u;>7Ec?W);bx8u}vlnrfYLMmkrYWE4H*3LFFK!KQ_4iWhd-;(BMZa<+&08^2k81>vBg1Rba1IIu zp7usp*90glc*w}N<+@=+HTwmxXo(di`n@O;sGtQGn%z}j4EQr*OAQHfV>UuRt=mZ$ z+J@XrdcH6Vx9lHHS1o+Yxob)Lf!Dy>>)9XH(IrtINz&IZV+B=RVQUAPZ+o_v?Io@~ zAL7>U@5C|tVCPBQ8LI4&MD6{F+M64jSb^jj-p+79`bct3g%fBG^1PBpzssXH7%N#yfox8he6Fnw&cB6RR| zEjhVcPJ8k-Hm|DQjqJhEe8*k# zN7>e&X~Etjj54B);=@XNI_6J|1=Ir?Hszy&rtzb&S1p}&M4gcWcxUA^u#;3+KtBK!rPx?`(s$j!Q8XiVo6EuAOi!yE@(hFYE>`eqH@J zrXHIby$%U(AR_h&;-5=nRdwV3Kc!PAGiBL%yMui}?X~WmPXMu30P1AKe8y0=1UIK< z@)~rUP|?A*FW1Zz<$}5q3E(-tTRp&npDQiu6?n&Y>*x4;@Ck=w%azk=F?;|v_9@HeE9 z{cIYzy8Ea?GUJcB?`OpK@P7n)Mh{H9BI`s1Xd=5i`_J!gh#BWS?>f|kQt+cwng@A* znVrfvx=r@D$XR~uFqLE1M>?>DOiMKB`O(jgi3BV+3;Jcb>{Rz7M;f$LcY`wL{WNfyolQ3TWABS%K5_&h}0@)*5K z2Toq}09Lry)g^WPAq#a8p)117PB^|TfQ8w4ZT*GE zY90FvE+;T%zYklNPoSRP1 zR;gGA!S`6P;`ih-&kFa%%pB+DV{zADb5y$Dh^V&Gh-(b5TGM2kQrN`pfNx!fz zoOnEcDgQ*`sXdo62&-#(Te0@OVU;Y_qAJm~Z;BkwX!Q2F<_D|4EZ_5SMX}%=J7cT8 zZB|1)`)_(a=6gTZ`bfiF>05ZBb?$cG^CZOItmd3o$ar3$)M{*HZWZaCqWka_E#zbZ zXy1dYcbnO?xMyHg;VhL9w=nP4cr(u`BafILA4FfiJZ=gNJwzLfK1s!UJxQk((qf}$ zB1!$_i!Bt=>iP#bI)k(SBOF?%M=Yl%tEGsT*e*~Pr2w`1S6MspJEJpcvFbtBK^lq}GR6gv$T zx5W?2oj41$8Sfu^adubV@f9C+uhKH6s=hx?1QoS6X>thk2YZKEleXDWEy%Jc<)sE;#Y9X9IIPR zs=mSt9kKS(rl?EL+Dr#G>zW~>i~eVl?iVoczc*AK#~nG(2O9BY=PUXq_|r@?O=Pd! zr=RHG2DE4$2%l5rC6%%Gjyarsb&eCE{*z_|^N5oYy}%vho9Hq$0aCZHAxsQ<+Uj|J zSaTi3v>uEWvs>i%joS={dY$A3rL zE`IBC`LU!6Y+z{1n)PjMUyWhndIbD?BG7@J+pyu;FG{N615A6i@18UXot zr_QXgqXcp|ZUxJA@{_Kdrcw^UtP6FTnu_AGiIKBYjq9bfjrjGO^xfE)u_|k^J1=a( zSOLG1s&}70%6L3IiDuiZOf{B%xZXyourDH+dr&OmFhJpQ`Ovj_@glt*Ys&JiU&+jf zM5zmxwiUKGc`{rjTh|KvcTJmN%oC%R)Ph*7S?&|sW&VwgRSsXOr&WX6%KaC78j$u= z1OUXV@OJxY<8}wvx&?a=g8jc$Q;j|Ws*nwyfan8Mj0fKaXXbE zsz$l)!fnauDE-fc@Z9iwOSH9iq07ewwrG~ZS;03~zs;C3x)IW;T}#wmCKG4mVL_P+ za+w3I#kNLP!WTJW>y>MyjvJZ2YHE%GH_d8zlE|X2HsTv0e_Q)+3bUew3L2clhPK=% zKM|hn+E1?biw=;8I{3o!4R#*unzgV)W)w&6JKd?`$_XS<@5XdeX6DlL1@h1a4_7`K zj~v)EFzqSn#Vr-|Y;@k1kt)BE14ga?C55fK7QSVUo8kDd}LYu8mbU6W-J+XkPZC zZHBZw7j@(sTN-P&rtzXLda;r&IwPV-y?3@C5;w2wxZB#RcyIih-to&Sud=;W%9#zl z&_b(%P7U z7r*-CzgvYuD6br(qgc6>z>R)~sBbqrST9^MZ6^p@-I{AJ^AzHf&F$yx#-Dxh6+$H6 z#fp3q-zS|DOfk0q5!3`Nk69A`X!b9z&gKVi3b+9~tyE-hM2RZgnO?sa?#)#6fxENt zs*R;3v(qk6H~8;P4YlLAGoeb`-5m-E|Ul_?yf7f840CI_gZbe{>O1v6++v%X+T5}L*yU8# z*sZ97gZEr$qK7Io=1pccmMAxY!L6x|Bguzda^f^wjD&cSUq6pT$y`Kb9x%2(lI^As zf5}2uLxD_<k}o9IfQFR`7N(GDg)O@EVX*u?MxVPM&1z`m6?57e(5xz zW17wNU|Eyij+YoGSlG%O{kZN6K$1%3MHj9kZ&4|I&*O@wL9q48*~}&Xk}u;9eaeLMYs2CV zg@`#Pn7%*?zGrhP&*{ybLr?Jfn6(oRJYcN#jsJ6H1&QP_<|-zD1|-Krjk-s1Vge#Z zcC+MnLKyo+O!B3fd=XOWy0@_6I%z@rRYvNDGWxN*rD_fhIOaEb5rKg7m$6XoAz%$;byQ-)Anq_ z>B}!>wTi+|%2Pj>YtO?>1o%8lJQ}^57u7-rR9C8Jg}(e|V$OGIXFVOl60HnAu9O_q zQwv`quN-dCloWcfXY1+QcAzh@MKJu5eXH1FW3D*DJTqs=STsmqy231QP*bLWc8aUuFymD?AH4TD_Z1AcFiJ zO{?jl&Teh5*T3tU+WBrY#?w~1n*S3B6&IZ*Zu-f97#BWgMnUj>$49yekS(EmK}^BAxSf> zc*vvq`Hv!G4P~KVX-X+&yva~1GUleACuyhN+yRdEnRUmy;Cz*TsO{(1R5=KqKX!Lm zD*Y?WNMO7jZuRi?8IkdFck&^vl|!Y-(5bbC6Mufxy!e+9k4cmAJdb5f-*6uT*by7t zV(P_9$yY0;mt?ly-#hFJbUM=`V8>778gzf-72|jXVflS?eOW5$F4=WeB-Q2JR+LM8 zApRF5)8QXUeBh0DVY`Fe(QKla=*n|TEm=Lzmrh1<^nUFO7&6|<*>jvN`gvt`%DdH& ze<+eIT~g3kTe|DI?D!yWbm8}W2z3kzsMOzU8R*As^}V0`NfCiG*&w{z;w!sRLqa>J z-v#-0(IM493YYGH(aF+Y4Han$d}`Uy_mJgex$u11+xL)Tp4Kbpz%b>TCv=-6nRv#5 z5uQW>i^VJP*djZfm>3vLG`=%BL6%qWF!H>S@Ima1#O3j8ie0-iMJ)?3Y&$u(mAqm; zT(n1gLtZw+(!QL|G4*>?^wYXjXgOH2G=eHn>rt&Kt!C13s5#w$Qg2Byb6j$c*hk)W zce)16pAr9BLyDFz_qX?eB%&rUF#Ey;h~Dh9zsbpEn8DD7-dbH_`}wlkshc@KghlW` zMl^r1B$W2O>y?tt6Yj?R5NYHv|Fv8 zmjRj%%r2h}pJgDwg$aPa5Qkh%)EB-V5ie91Eo`nW$$QOYR-siy<NkK||6^oYt&u^ZcH@{h&X8lg zr^C?lj_drDr@JaoCJm8%kIg3PMPBE8#G)LTU> zLY7hdm+)OmaZB~8EZau-~5HV1MB!>&3jvxPW!end!WxQsMH24X|T5qsltRy363RT=T_+T$!G zVi)tNlIPufy1hj|a(1^XUIu#n**}hWZ-RI)jpLXtZsiXuqVefG99ktvBckN)wE{KT zu~=7`^Z*)+3S?qVH2($UW`CAUYqv4BXlp;z$$}zx7rR8tp^L2Pjt4o8A7*TN7}UAN z-9NrW)SB8dIk4bXZ_sB>NVs4bl}dkA^6yW$<^|scZ8dQ zcuaq>9*3YSPt5V2tmQuwGGOTTpOv?hY=^;z8u>3rGD2(yYdF6e6OBp4jn`Un6_Krn zaShGE9%I4hhP}W|Z&x_GRAguS4Q}WHifAKe8g_(kW})%&T>56O|8(inx(J*)n2;Y{A+`38N9q}k@eGUTk+}S z6uLciD~%t+*@b3O;y2C)-vw{HhjePP_P5``yA?Qqqsx+teogM{LVJ+Q{=1fb>fx?< ztHMmt*W8>VkFFS?@ZoedQKOnt711b)Sce@v&E4S72W*5`83HO2pLd29BsP7>VBuS~ z>w&*hm*W6dY~bW&a;_}s`jY7x4rlaGarsU}j|B}h0`}p%70-2Oy!b++Ms)^L24Zv2 z9NZ!(&ShP&VVX>Q} z+IYvq%`XztYo>_k=ciF$E|t2fmAcC1Q3qx_ZStoOM5QP0RvRhqMV5NySV)8-1tJH1 zcp(zgejZD9ypZ|Iu!7D|eSt3@xntFYsEA2Y*0k4>X^DE(eg@zD#t9)__R3iCjpy%j z-x2;-kfa~STUAk;q#rh+z>{;5F<@#$1{d?m=@|nuDikp)=mB(Px7ceIm^FeYl7^3+ zc8P^&)M>syWb_>vNsIxW=T#EcMpcz@_i8%Jr?GEcu@_1|jgO>1G>;p_{8iDVlQ!(3Bj zP}!JOskpECod00v_cC1}5uAhR4~)A*y9(zIVSn<5UMQ4sSMTg z6myKk{S~BD&#xX?W6%{IBJr;|ds8r+g33Pv2%UZ2EA#Jrb&zr`AYjW}J#v|=@QLMCOVx9&TNz*2xTbc)IEj-3Rj69v^H@W|i9G=~gLz87Fag?6jG7@CN&)>&3g z@gQXRE=?X|n^Tjq#e2f1><#EQn)!m87Zdkcw5TQPxr?df@Rerf3=X1+x3PK@R}GJ! zo|#d~P#IW~_w4`~B2Q!Q<1>g;i^p5Jmy=8Zi zYFF1IQCd)q3Hyx0%!-6@v9%p9`lQo# z50|fu^OZIbOKZq0y}Q($BijYZ+mDnDNgGWyt(61IyshtKBd$R471g{D4e>l+12W3Z z;sdbF6B^(#0griaop1aiZtU_&<0l8^FhY`nL*(qY^IAFy@uNnc31kDDZ+di`)Y?YH+Vnc1@%l^dYCO7#EXE-Aqn(CK+ zGRgSIpS4Vq8n4G-E}(FtyLptuy}i1mKj8fbvv3aWb;*xRlK_(7g)HVF_?WB2GFh}? zBeU(wsO=JV%MwHM_mPP2?_8K)tGw*nuL4F5u*$g$Sjd~cTNAQucQoN*wtA|RlGpL` z%n0YEhHZDh?LY7)0P@Tg&}Vykq_a48K?fFf4WT` zrmON}M`fvgkNbnWx|E_E2M>4wltKS@x;x(o z6N$(Ie0D@7Fo`?vThdSKq+v}tt<-wl5y=nEcH@NXot8YAf^i#WW{D-R##bqJ$v*ai z2Kr4Rz4M!PmiB@KLS=d!m|{>PGeoA*5D#if5MNr85i^qdC`-ubq(UX;g^uBO5~IaWX8`i{=(= z&fQb*etXhE9DrVK)7qy-$2%XU{WA^2#~;_M&&-kpf0M!I29*E`D>Hs@EZb*Jo^ z#^XIp0Xhj5#tO;_?{>%YEQh_Nao?24`*MQv*$PG0WRz-CEbPsw9~82PBakR{7*RoQasjs zwz}!v|TVwi$7mMg2>`EKP;&)x;|f}j|=X#%oQPD=T|5e z4&wysi_SC5mQvfz$54l|LX0F%OkFp_?G+9dUXv{YCLs$&N9&GR(k7Bp2jA)QN*GPs zJI1OQO-Jd~^F0PBA#Fz2?jR4e|NMllI_O0v3LgOvADZCr^SZu-M;2{xiGoM`Tu((z zi^t_MqedtXm+ibgn-}IwY>P~I)b5lJli@=p4OV=qR!s7%5{&Bm5yS|!uo1lTutVUK zJJNSMypn%AwECYqi0(VFc^Cs@Y>D&uYAb!O5j9x&?|2w4JX8cBo#pBTd^u2fIiQPbb2Fo+wxgVZDHL{RT*gFYPPGQ)RrmdHI%bz;MzbNo=&6KzeK&~C)|@N zDV~3ldpJB1t^{nZ6C6ub)^;D|(R(wo{58CtXfLUGmdMtsJVS)Z6Bv79E1B+&c&!5E zCD~5Mnwj60*W8BJ)ua|xR-d?CaYb}&jCt+k_mWhs2)+D9>oPOESFvLCBe%ocC27Q` zLRQaDQsh^bcM20@0#P;Oq?iSo~vxumdJ!EDT zQ!g!vyOXIrBaXcSdvCVh{)%D$p$@fnA>woG^Y+8McYWV&mX!=&Ci zd?-`7Z~wHnH8b5W5&2b1;g}_KeP#~;#LM-H-bgB-cSY6e+}3D&H(%myzts_C56vE$ z_L_ZF!0va7@GL<7!S+o&>%w=7PubAi%8n8|<%jO;qArm@Mhmz2enJ%mT1JcE5Am<_ z^9C7y3bsC~uz1BqEySGa__;8k+eZiHM=T-?#1|ExG;b<-H^e|7BD$j?g!fhz^f{++ zh;`b}tF0&X(PlWj-{O>Sm7yc>-8U5l#;LqHoe|4ZKe068x8jc}m7n^g6TfwR_Sl|N z@-gFaN$04-mLbi@b>!&jDQAwR91rxaSYsqPUWgAqn{TE~+EduOH!DnH7DuQGEd?@9 zRVnteGp4!Or4m%Z#A5BGh3i z@XGw(I_Jv^)M;t9`kxO{yUqdd6{_Z4M^99}7Z*pv4M*=4eK-nUH7pbM0_Sy^(686O zg7yJ@ij1=o*3B7jO$XmZuqeGwExAK#eYB!|?UpMP*)JGbq{2Jll-Vsl)0b(Q zVLMo5wDEITWJ{)k6ws&osQ!XmFan%KK#MCkdRk{WvN1Lhju2;xo2i+6<@5bVKU0CF zG9bxs^j$pAHu}Tq_Kf}ZY4i4YFr1>lK*J)8BI{$=3xD;4?)TD4Mn$r68Dxx8oMQ~{ zL$3)So^QOjJ2|%Bel%Ah+fFM#&Zo=+cl`!;rAn!b;}2B<+-jmQ%a2ca{p`EY?lUC3 z@oDfd`as&CY0|V1BGhy#^{ej7lT49~svQIE;6FMVWk1fDT9Cg>1;dl`;R}Ew-=bTq zhT9_5TUIKyHdf%ul@Y`CXtK$zTK%Oze3A;{7T{Y3F0xSc@h=mKJN=as4-kxd6Ft~1 zz~F3Fi2Yin&htT%f}M-I5$)vO$>UvhrenN&QmrGFd~PmgaUh7P+@8Z-=kEf*A+-2~ z^Zs~`1jwSZR2)QmyuU=2FRlLyd2FR&dndmAUPb%|IsWru$2KpwKK`DP@oyt4u}pm% zh~=cvWrBhttHRpq!AE-R`Uss;D1_YY0mX21IHvfMj;IbpK6?K-x@ znU<4C`6!OBp*0A*BgU2!i*~Zb&k|^1k*lK)bFmlfx|i!?9U4w{8Xht#2z$3h!3m0z zDq+H2QUp(BXD57sZlacszE*s`4ZM=`&NL#!Qjn5qq3*kZlH<1efN=&*So+WW*wO2R z!bNUX=+--ganQlRU54dM;ANcfGgJ&^EHo_eR`3_fe9F`Cr(`O9*{h+^m*vZkv5 z80hP8K$L83xvb#sX^y)N{5>FU7q=lGwEfvQXkW9!CDKLm6KQ@bHjxb=o7`Vo8^Z{Xv8NmCd@?yrXkuX0=%gX9$z z`A%98^pc+>czKvfNH+R8!7@0Odc&Cz;+^#8Bt};+) zZqf9dT#ed!RyT3elQAi?G*eUC-Dl2dFMd3_ySm$Pm@|{68g{d2_p%bVNs7+N#k|2O zCXGJ<2#f(bb}L$W6AF#u#8o=L}&y4zv?(vl)yzdh~D?l&K6% zSE0E!gY%iQs#v`Uft__LWU zQ{IFP-FVkNH~vhCFd(vh`At*4L?1&&<7@0C;nzC^^BmixXU$Dg!{n743sHDx>k#v_ zg+IE@Wx6E=XBFREN^B-x^l~95MV^FfX-Wp7B$JJQ__BW(RF@*RX#IVuPj-VFC&B&KfK77VBX(amR4hm>TJ|j~BDc}{ zHkiTeM#J1oKOj2P-I9gui@GvmXQwYy-&349>igj6doee%EsrXj%ot;F+t+LVTVL1Y zQ5tNw=>vc-CZ_`myTqT-QOr3#ApT>e2W6z-t<4HLBP21WeJ`Gt=yqGCZ@Wd|ru*Ew ze7D{0eD_wIlr-yZegnV`;%JqmEE7fTR_uXl@0oL(ba`D`fs_ z!+c2U>jH-lgO$E^e|+Ia$(HAS$5wggrvH8%*P0NYRjl~Tnsfl$8(d$sXbyHbNEq?F z6%O#(fQ#W8^|A}AW}4#AVTZ=C&Qyp9@wy?^Z|4~Gw`8!TT6L*Ctax3!wM5<7VfyR5 zwJw}q-x^xq8-IG9TxYfY&UUaYDT2$=T=85pm!7c#{*a=m9MrFJ_;QKzi(}1-((<%T zy#YVFV~ycC%v@Iv4yz?TsE!k6snX^DSB;NWRixW@Zku;KYdeTkFd$W;cHv~>Q9 zI5Fz$7M_IzDJF*4e|Uwjsxy9*bDXj|`ie-OG5;-++vm~<9=AQC0(3W>Ee<~@^a!8U zDL)`|vT8vICe1X|?{}<(BOf)~luS3-yw4YDF8p(xwR}2aCzI@Q1J(;jL(i#=?t(_j z&K&caz`!fzg6t*L%7C-sj}Shs3*`zN%o(trRS(vAeDlrp_Q3+X`-%}uoR&F9^=5MG zqPCuG#!PfHhgy^C)(2e$Ty^{jhFYCi-Cz}0@%H1AsGxd_V7Ra`#rB+TWI$eUHF!9yzw& z+?aT2ssua>8@p#qI-|B?gXzlwnh_3oPXNU=3Z}mg!dlD+rPG0&_K0vvl${UmPO?_dX8|gm5%~K zXR>Kq<$dn;-g5qQo!6ml+ zRdOGcYVg>&(6PpHzUoo&-z8HJkGa^PZSntI7$Q7tB}jvsa@s(v%ZzDK|55%f>F$}2fp_bg+|5`V*p7^{%}f5ak| zB^^d)2b)$T=@ft5&XlGNTue_4ss?n$2(9JdtWEf(DX6JNhJH5?^OsI*DS<&9+dJHF zQu5gl$kqt!y6}2>r|^Ps5Q_1c$v@kO!Ak!8TP{|AJr%YoekV;EASKf+4@7GWh23ro zcjf$CP;o3WuN%Wet<40A11M8s9?~Ashd?39!WQVNmuJ+lLAq%LdWIKl!K~Kn>5Y$ zst_Dm$atgf@KF}+E9E=V>r(kyN}b%s*Klf!QfwLI~2$WF_WLeS<%TI{R^YYngt< ztdKR=@NulWZxBsRxR*i=x5v(wM2E;-m3+;DF=Mra0Iy`AxO2#5A&pFQniR%Q z&sGP5s?on1|B*x@8+)pLu18vc1%GB`Uw_FJrWybfhPz~a&03Jg@?zAOUik@V(D0Yi zmBXG-#WKbpgtrMXj`ziMh2ULYU|U>W zUtr|2j}u9IZc(hci|S`nGIQtv zop?uXjQj3_m9vcB#GfjAFG503p8T%Ff?nVJ#e_Hd;Tln}sQIOGegKdax=mDcSahk$ za@S#nwcUyO5OwGpsP|wPp}fDRgYn_sHbG$J3n)r63LT#7m$Ey94ZFIF#glG8TeNcr zW*t|?1<=_9Bv;=${@sdp-bzZYjb>l}485AVc(UCRglU*nFKMFyG@x0#QqTg!x6%b8 zL-Ll0u&XJ4IqzSXtg1#aKV{CUShcz$!Cp2upUz7M-6_SdXxs^A+hsw{G3^j6zegIw zl>z)fC{2AJl8-YBtR)SmfQ{&YRBNaEW)IOgEm44NewSM?b_=1?K~^_=vBPsrK)nm( z$A+TzK5L?KF^&cWf?r}9L0BN{co_O!JebQV5v{%o!jDJnk+u&!utGf?(1Uw9WTzdgX&{SYMgoiNClTcsc7uyE@s{t)#0dMKumVlD=wt41gEOB1`h+gKGSO z5`?wxOtZC6LvV(re}+H5qLjOnm3Aq`1}gDT7BZaDJfzznpG4cle8pf3rA(v0vs!{M zx6_s*E-FE$zfFk>fDE}MzycA)FHrmQ8vJfg0dpQzVkw>LRTCZwVt!H1t*~^m$=wLa z*%V;%#~Qr%pi)S1``JPk3FdjDe^3J9UpqX6qtvRtzBJ2r-8t5x*Z{SDKl^V(!gxd_ z(Ge9!2C<2^BsOsP0He_yO18qNdTvT|bLHVBe)eKpZ4Td~;alT&2pM1@3zQ?hxk7mP zC3`WT65x-YesvQFCeo;f1pMbItZGP4uyWWrhs$!Tln%(=eEO#yxETwh4=@vPXo~5x zef~(-C2tL>Y7O?qQlMYIYL$)e)sUi^&gv^s=F?tXY-?Al$Zev+Eb`3*&|5doK8R5~ z_kHMNUnb!soD?8JjaoJXOC9^blo5_G*kHn=%7@Uq=8y4r7-cSS&|KMekQo3n`WEj2 z2q%64ViNxi^MC{!{SosZzxrAE&bun|SpKqk_y%;rXSJJRB z9TupQ&w}ZqB30%BqOqcY5eQL$Qn%AQ)BK^c=39KsWBvZeQ)ZuU7_t4HU}XLPx-cj} zf`fL!%)lW_>wZRZrSQowoWkqjr5-j6wZsBd#5j;62u!I_zf$}b-6xHINtZ1ttxjQ) zexEofHd#eX&}BUgAO|dXDvbe8qH#=cZzHnUZnmYsg|$HL#*8CNRz^=6tAHSbJ#qs~ zY~FZ=tQkqa9KKaA8cBCm#^0-nwF*Bm`tA4-y4~v<{Fj3Zlj^Qm+qRgK!lcHFQ(14U zsmce?Q?wsRKq4BuT@S0^%%ETSA>Tz{QVfa>c4w1f*cx#J3s#1r*hkKJ&mxJZejeeRMwklN)*T9uI*#I`aPuBK28!ZeFi<}J-ZRtT$VXw z*O)%syT^I@2N$GEgeNOJP{ZOjdcXjh`hIq*cHf^SgeQljFh(5+9$)}6^DPSo`F4~b z42;U*LAU0%tTK6SUh6N9_C1)M0H}5Y*f)j_crgR|lPV*PkvR7pH8sDID0V^6uHMjg&ZGnJt zlCsm&fn2|Y-6R~?F}Me#1^B}l@H)wH^m6(s22ViaV867Zy5Lihrw1z+vR7DBm^(F6 zZ_k-ms9~QmJ2o1pJuR?001SXem$cCW_AV51Zw)ZofmQz6BV@ zjXVN0Yi7ee<%wNzS~_`8dJM5H$iH7|&$BDxO*vvV8T$*20~o`O?Xgj zBtHaRkS*b#RFc9z{$9b2Kl5zI_zP4@v+}B)Bo@{5_|OG@c$~W^dxlvZuxOZI8AfSQ zthV;PMgHCm->(3LV&DUe)GS5{LvNA*8CfUua`2a$QQCL9m^rdB8>w^!4fC#NGE(8? zN@4ZSI(s;8@M%+|^H%iuwc2zNCf_5Qrn4f1(ByETZHm~=>w2BC5oL94e^!l5h&D^P zHzwO)S-2SLWCZ4sVuhCLKnMXND+ZWk0CTT$2Py?rwek8_w_i-8Cz19XFFl85=&U@B z@4e8`G|6AxK0kce61u}hvoay;jXPC|3*GQ-!YG9yEw({QSAw3uZU{y`tPY}$Rz-uV z{Uz030?98yveyJpnVjJ22PBJf7!qj!=BI`Y;bSJGUR9Ol$G&TQ8?Q$@Jd1sSj&B>s zm=3{rLXwtASE2a*TQMAT1_#0n*gGT&JAQ-WeW?tV3cmP@ym+N~kaI1MaZ1B~d=9pP z<3+C7*2Z$iF^w)b%)b`F%yW2z@$cco#fQ*q-%7xtHbybvDhMzB>>{A&avBTmpARwV z^fkV|DF!g-{WsW++*K~dK^Wj?XN`OJ2Zd6NSEost?Zb#T-{ZxT_B+hDSyV6~4DL(g z+}=kQu#|>*Ya8_9?u>MKdpt{jB`F}|KaSDH4voIgqP;*-Qe&L!8xqYn#WP!sMB9Cc zL7rTSW7I$Vd18zK@Rdga%ow6@L9ua)g^qp?z6-u+MsiGF6i65Sr&w0#iNYfcje3o7 znZz3~@h>m1U|0STZ_zh_=m$fGYMq{R!>1QM zn#A`8X0Ck8l~lyIhJ>_j;QiqUW`B*Y?hSQeopQu1sDBG)6)Ny+kmM-hdR>8>t91dc$s@i(F>mk#66`BS5ixWJhQ zFq9ltCENVtJ9(yci}i~fjcfcAhLTt2GmyVdG~uYds1@RBxCKo**x3YpB!jvX1ng?2|JZQfAq6=|B8HQp-b7O&2;w!<5Hvzo& z6`ntY_=r+=tPR8urKb>UK;y209>pVWBEznN?)XCuPQkQmNsU`*MDC*UedUV6Fap+l z(Ba2q(A9Oir1bK0XmfD@r^Yl|;vT!3AAr>2FRb!WD|i?JRffL6X-fo@gUV0$Kyp{l zrW&vtpT(gbl2m||Q-oQ#W%rCxqF3|7x#{c2!OQ4~A z->@wqgoG3^zY+%3gd|y}#S*d%N>WW5Dn(IQVn#_>DwSo(GMbVtlokmy+Ne>q$yUbF zm~7d%+1~Gdr~h}(cfQj(of@y1XYS`-uKT*L=Y0kFbqq!9EO~i%sqHHprnflw;cT#3 z_bJ;RVRndddPvG(^~DK(`E)l&n3Xs`Bpqel-f(0g`C88&A|+{$SC`|o3)tW?&WM4g zIZN?iX(m@auq%Wi0f;$m)=PkybXGzaF(V_%hWByGjNu!cAnb;g8oxFJbA>XMO!hM!UQc@+(4m4TXh#59^l4)q~5kY!gu0Lq#lDFOiF1!zBEB z=eH;Vk&2Qcd?zm+dj>Xb5I0Yl5N16^Zeq8?vM~}umn{*b*K&d_LS18Lq;)arx-)W* z_O^&Fiygx2F->8!@QUH4gzrcOR#x<;h%F>=su=pFh(TQ|#1mEe=jxY=Q)K(pC-9zl zdA?2FPsCT8==M~BJA1UQ^I`~+D-kY3pxYQu3{6$=H$ z?G4W^6Nf62IY|@SiXp+xj7t!@ioqvv3&3C<4N0~UvMo4CNUV?1N-5iI6i?iSs-mz3IiM7-#l_qjp#8OAV}Q~ zvZ)WaHhI}(lEfG(Zwe@@!K?Wr?tJOBmP7}A0%ald&6;g9+}x#UssH6?Q1 zBnMiHcaxlEn$=DSz6g@`689JSpB zBmQ%BBBvQioFIc;5qvk4Vj=Xzk+jo7uT+UHsZ_2vLHY#-^3S%1J%)y=o2K0kZ$$j_ zj^fqQ66a$DY6(6wXX3}UyYdPbhk87|2~l`E+H1|?{O#~r>JnW$Rfq2#zJ*CsU16f3Pl$^+pDVJh$iQ+FD(QERtB~X_ba-y9r0k2k_;TZi8?}9?jk*v|e&bmEp zG5TS2`Y$W8+krXrc&jn_w7}tTdi2jNa|-Kti=Xd%oCzOZ5xvm2^u<2-aC1rc@R57I zsoJ7=(nQg%bxiqxi8GI-L_z8cK}w50sp7Wm}>E0_)qn+vGcTF zmz`OU9a5dqR)a$>m%+~>OWyIN#2DGbeP>pu6s@V0A2z-mtS2yS;`0V(aTUO%&5mlk zndhyj&qN+i&5vJpmTQ$Uv?Uv9yNSv}Tn*C|uqoL}R9R!bk6x!)T^xj7WWM$TqD!R7QEw=N*WdpvKVp^3?NefoUh^VwW!(K0j7ZoimNo%@(z17TuOS{( zb9=zG178c0iZX^oernDUrC(*|d?5+{EQ9F6FGt^Cz~U98=cTD?!OT}Tn5XaA8qhUC*~c3w0^8e_=1ka8$SK-Gnbqtp%K&T!wt z9*3{fyOE=Rr|n-SFIjios5@9M>gL$iM;Hr6usZudak(UOlAH`p&sZq(SE?o#+hAVA z2#cR^g=S-Pfe`JS!VEeZ_`}f~=trOlpRHu_hhu3`@qBsAxD6>b#fiSC|-8XR``P3V_;-3G@fxln{}7fr0`+qyqhj z)b8=+#pV|$=6Rzr*xod`6P$PD)rOHGfzv?dPc979aYbK(+@&X1R2f1p)J3 zJ-YbeJ??I}zU?%78~QpBMqh4Ri}p&~v%h`Ew7R%1uka+ARjwz_^a!OB+WR^eq_S}y ze`Nj!-^?gQT=PCMcA{Bo-{I%cXT|-5Epog|L!2c~hQs2+GnlJ>=%r~c_<}Gd8?WWaijTAb`-hWm7&_NDMD%{LHo#C4boUpTM z?{@Y(+CJ0?FNlFh35kQj3)V6bR>#h5d-EXZHPd&e*%o(I#C?{W2LpVs4BCFwV@9iv+bL4fq2 z?ZA0&_*JHVrsyXdKd>OcfuknUa!IWgCO`9w75 z8x4p+yFKZs_Q9$yh`&%Jd5hEr-Q%6~_+t{g&IAivuQ z7}EcH^DgJ z%AdV0Jo5HU>ST48N>hY<-$&efBgU=i{4G_2+2u|Aq%-};)ijvBD!+2L`-WM|Eo(U4A8~%5Y2997%3vkY>XE}6+4OSAH#XUt|DTvtGNtv;zT@n zphFDV0?G~|6{YKb8@Fr!E?S)<{q0HNt}TwFT?XBOF%?md(@Tq?Ne6_3uD&G(O3sAc zy1gxVbv`7?F&@CC-DZaUGBXs&-((~Ae&PbuLl~*UmcYLpWbNA4x+}1deh1qY)?x_W zcPZMtR2l$45b@xy3x#wkYgWJ7?R1nA0`YtR~3!vZiE1m-M_2!9|=SO z?!8TH&IuCR;M^)O6HWq_=_Aw=**ME?U^gsMQ?y9&x>f+20@_JJ_ZqT1tg#{*^g2o% zvx*tWZpdybu+N!frS`Dfryal0aVl&%)RHr`O5g~`SQMC?Y^uaPDqbuyWX%$h7wn?# zbAge%339}?3JCfUqQaa>o)wvAS7i_7+YEJr&IWNHTKwi)lS15KYh&xc{~Ga71OUg| z6M|5tL$8|%$e1H5CqQYj8Ggo=OlZAeHF(<@$|`N(dZ%4lWM5kZ2V~Fdq_P^h9(g~7 zYp;X~UTvCe_%pc)(ku6YQ#Njw0qXQKy7iuwI{-6!0{0jf) z=6gO>uM1pY6Nrp!Ka5-qw74~;ba$z|%f z>!bT=HCIIo=~@eo7G!wsx*=#}?@i%G)!0yP7GP%)wA>&9;5GO!lk3BbdMaPm>(7#H z?4dG5M1>%nZ|LtCqrW#DYGG4_OhP}q04VW)jIbT=5rQ=ijH*;7Wd%l2)!9j2KruJW zN)bpUP=<&LYP6yMxs4^>}f`=?r5gh=CG8?*#Z7JQGTb|RUF zN!`K)3GI_)Wk?@+ui<}E(9+DWM(4QvSS*r^mJk7-aDN&l;SofvT!uM;tY&WaVu`_! z+Gng4rFyouEKysaX#-m>6~o0y7I5o0rInB_g*FrT3);@@bZp?T(c{2eqce3Vn0J3+gR@1 zru37#%DB-cSbv|#qvjJm&czhe5i6)CdXkF0(IMaxu>LwR!9w4{1FqBZzza}NYq1k& zR+4sn)L^B^k}CqEUbpV5^gtb$x~I{bcpt1>8q=y0H+gSw+lgtYFVd+Em9L&XOlnvx{C+d%m&`5pH-0w&hvTVcv}H8=+2JIgTe&3}LaX z1v(=EW(o|^pgOW$xDLFuc{M+?Z2WqBh22A4R92d{j&;CF*rf}puIzTxJ5~2J_Z=tY~>nhR)U0drW8KvN^&Dg{$ zrlRAKiMhDi-He^Dngtj1y7dT5>RQBz?v1}XXfDnk$9JL)r3|p+wf`Yfw3_%qNa2E- z&+sZ^hcVrzjwsC?0(T~sJxV5Zqw<9(vgGGIfG`p!q>IsZ42dLkmBLpJ7K>6QJY|?C zhM1$vf;pnbEGG)y>K7K_) zfoGY_Qi>13v_N4Iklj-;sJli(w)30EEMe=2Vv4*cH5eV4JBV@4j0rQJBFTvp#>GTM zNTMXvD8^_Xr8M!6GDed`3L5pEF_p^f>Dp^bR23kVVBDm{*MhLeiO~~)i$RQNQP&5n z;oC>GpkaUKFzIykv`Yr?Q-4`xi7ppaL2H=ZyiE(re?&K9XNk}v@=ofLQ>x`!f8U>WA=nP^@E$Cf z^&kWDhzwa3UGUI?nyh1(DYx$}Q|{4VZz9YEI!6g@`oF2r3n5add2v5Zn?c!B#CCEN zLD&Hwr7{+ow}wo?s(VI*!JuK$L<{3#D1XP03$|70gxyatiVpID0k{n&W7GCIPHO^G zGeT2L8n}ZUkA-8JfiIMc3l*XMi`SXMYal~`+zl%of&pBmpbM zPmLC0W4#zsz~lG>z9zdLqWX#{-4ZZv0?HA(#V@%FIqoD?hgO3!+&UuXt&CriFDh8~ z{}p{~x0T{kgg^jlW(6?3{cvF)h_n)CsA&6vx{CqW6R#MqNqCApq5VVw@a}FHsE+{U ztw%eCxGA%X{;g6G#rQ>u^ILgj>5nkmogK}L2~+tcCs3J>{4`la(gY8lMEhZm(Qv3{ zH%^a7R_?h?6M$I98?6h^o2zZ-U%*B)Bv6wgX|$R<&;V8Ny%Q$NQ9nK*vMEgA&xsa` z00X`TIVV~zqDSc3DKcs`I`qjB57vQD*hqlhC=(eGZ9hY1%mrMVrON~qDv#}Kg)5=G z!1l|GAjCsL0dTSy)MGo)(ui#d24amDkNPwrE}AAFXAdJHnG#|^u=&?q;@2`q(V3U2 z$gos3_T;~;;F?NBvjRt)b0$wf-kORd2tt68$D#8g(2$@m&}uucRE(Bo@-H;#WMFFX zMaa-)R)VvVHRmj06v+~gQUQ}=;wN;_iSW$ycGSEMsCf~Cf94GU^8%%ZxsTY)r!QsF!jesi$IKscSZA4 z`6UKAz(k}WGc+gv>m<-thlSb{kH#6is^WJ^);1^aO&P0RNKtJ{?$}M(C;|_xy~eH2pmbIV6hwB{v^!paIyAA( zcH{sQs9+h$5*&xp?>%~=RLoh0<^x$sYp|eSYn)<4i$`^>Fc;P&SmEF9eRMtvI-|8B zFJZ}T8WL|#)}js5xa*);zznfUus?DB)#MS}KdXZ}Ght$WC1)mtPF04y`^L ze;_rh5KVOqLh5A{0xv)}pj zzF;g&j6LHZ#A5hd zB-CAPoORudoM9wQR7AW8xhPIz_j|U$xJ}3K8x~RYC!z4c_Lzf6|Ruk?YJROdJw@8~kdfIU31t z;M^{g&0AUVx184|0}D14hgoFrDhvSa6qr`Bg&TYl}B zmIrQavp8|bS>y4>$6?}K5~(B2N^>5x#;y2Yv?+I>#DCJ?vj>BqZ6HO0OFvZ@cK*Hh zoWP5vm^xAd(2G4QNm3@@r(os_qQvFcS>o@!bIB;Vt_7KS1PI$w@5(F`$^xfS(pdm| zQ!O4~JvNOyj;JS9PzEcZaqkrM6NVjE1zJGNYC>$`y#L6|IOzHhku8C@DG_HmP94rb z0_`H!w2X=~M~I-48^P~BM7|)#5FfsPgR0u6%E3&qcFbvBo0?y1kjruq2MHHv_ESvj z;!_(-p0Zx#vUjX69-fr%Eo7oRTurLRw#&Oi38XB ze6&E~!1kx@@7r2)Xf+gcmLs%Q7>fff2vrdl{5&~8jGl_EFAqqVSW!#_Ku3O#9rb|C z$(4lR`!YtZ5p%MLu7%}MIA|BiK{w|b5x10`FWMYLm-Z74C7cu#`TBB7LWnwmXvj|L z>~oOeK(!`-HKU?6f?y-8vK-A?OIwILa3bHhQA$&_422A{~9D8!hf&p1a zzlbCbr!16E>N%GM+CV8##NCU*>AqB+f~kwmN;;BsYlgZr6Y2X*{v9BQlK9<<9dmoh z*KZ8qKUs&2)Z^X8d)9g(OW!QV&{s3Pq20ySU&ST)O=>_bMC2egjBTQJrIw47g4A+Z z;Vv|rpL@-68lkuN;aLzG;1}lN5E&`sFj4L)L=;n3l3rlOG+H? zxj^H`40^+tW#E_yU>rP9o4SN+N-%Y4K%=6Wg+VQk5m{adufkUUXL-*5B(CD&=5RHT zo?D?GU`}8bvuDxO{D)fJhA&d;qn7`t)Q5rjc+c!V%PWE9qvlNih$7;u7;5=9B2_CI z5J)l#d&1%bBjSAWEBY)bp9Iui{&u14Yr7Rsnt~mB_+>a5_?|heX*E$u3{O_mJyQM9 zm}qy4R_m5ecs;+Lr~pp(l^Cti?VRv+-e{zf?wSg{rEF?vxw_xuOVlZyh*Q}O?YA;n zkv+~sSw+HCkiGRFS+O1-Lsr$Pf19(_J~U5$u!fufa%~30MkaN97aAL_?);ZmfgM;e zUP8*jmU)X{Z~uBU|NN*~_RKFu zQFtiU1;%gGT+UnivW&G=l)W~Jqa%wjeG!>oEk<-w9r2yxa>ZK87cfV{k}6zYHFIUf zz$H4ulCjZVz#RQ0!eqE{6i&O$R4LR~%3|lsx#DrcTV$D@(Y*QStAV6hu>%UJoG@Is zne7=8PMQ5!G_#%cKr_dD?V_=zz?wvZJIL`&rvdn^ZGqYN2vPP0aN$I$7s-G0GFT1q zA=l@Gt~${q6F;FK4+D-%l$@X#js+fyGLz#!E}Nuu2JodR$mzahePn7~F`06!%ElnN zS!E$vsR!&d$|}RC>Y^FC0*-`+I6-8|K%#ys^&6w^7e9z{$14fBg%F=`EJMnW-PoqN z)Nc>4vM^tfWO7<%L6hS*uWy$C3VDnaoQY^B*{k*W%JSV72udZGeAzgVOyEZuwUn{h zm;JN53AwiDX9VIE$e`3avkIgkmI4rnQFW4l5^-Xn17=}X zHq34V1uhIBfZQ&H?lnnG;2@+J_N)KUU-D!mKodU2DGs<}I}i{sl21DtUEe937Ez`r zXlC|$NMs6j7UhS2!Aw9GIoLj%Wfy^V$1oqk(W17%s#y}CqbSKkfWbk|7sHv5k)cy) z<1_+tDyLS=!#Pm30Es(?g0aQ<(^YH)I8`_}REcP#ecmMRKpbg3o*Q$Rw3w0Hj|eU^ zSf`s12iq#@U`c!kNvCxkMvaYfsboC(jQa9Se)kbtR5r|+()uh7ACV_vn=mqv*(S+O zU+`1O5+#US3vMNI-0jAwX$(&1KftbQ1Gp2fl&_v4Bn6^NtM9RE1H-}MOhmqDEo=f zKM_bf(fJgKj2;FcFM??AM>1*TV?pZ%DtXjG;FD1T0Oxpu+3*-ChOJTQ2rOXxSL%_&HEJ6v_(JA3wO8GT4gBdC>`DP7E)`glrCi4Hy<^NEg!8 zuv8XkUG!gSad9WB?otQCV3IXB30(jW#;c@ynfG)Xr#T0}2>aJCLH)2&PFQ{@8QY3B z*av_-u0YggI!-5GWeQ1fAgeh)rV@_%9j;NJh|?Efc~>D(NizA~Vszj(;4F&w687}t z_of=!I?NWi>;|&gSgX;Pq?}+SY3-+G!DZIy9qN#sh3zz&`VB{R$*^Kk0SKRqn&dfdPq;bKWtB`axnnkWaKhzErxJybV=R4JVvCHHqht2 zM~+f4I&kW!`98J}97lD;RF^pk=$5?g(wob>_lmqWx#Ae+q3=f0f}64C3ZBQ3uOqI4TsgvN&qMv z1lb*`(E=y|L=YoIQ0LO69^n}7;27|JMoYTEHR%86eU80 zepMK~>n{g-TSv3Cuyil{*`f>{DzIP>+>jvxgf{k_si=b1OAERL*Jw&CXn?F`W?}( z2y>mEunpy6QTksRx6kbtHl4?SW2}hz;&r{L=SYrwl_o=# zyA>cbH-fzB?A=3D*7XVnJgUzc2}2!00IFR$**gTvKEOh_Zli<{((3xoHhm`s$Rc?O z#J9&A$tE!68Jr-)X&Xffa;~rXJ%b!Ks4InZVSmuBQwY&&gcmm7!;7#yw7D?>RQ7uM zZhbUu-&QCu%yBKXHa5D!a-at>L0S@puclWfn867*=lFGTQa|SQ7DK>!(`OMuR{`o$<9x{Han4&6Z5D`q?%J1f;VO)f677$EVperWEPl%y@Bjiy~9~Kum zPOz%r&7AI|`m2Q`S?H)4l2OYEDqMs`<6ji{Fd0rBjv(TvF#xDcMYa7WgRB3~iPv`z zB^(y6oh=vIPiLVZNi@~c6oDlC2ReQGT-c(5XzM%YD|bU&JuR2L2!mlq`tN7s8nlB% zmrEOsS%>rPvmSUrB_T?qn62DnN@>{nu!}spnn&dipu8xX-9=XUo3)^`^`E31lxtRc zp@f|@M}-|Q_dIR^i_zts*t-x^vo|qjvimna?s^WgxD$JUSskeqLtO`_&*N(M+}@~p zp7i}``WR-hQ1Xp3Bg;0+MHB7PwW;yvT=t`YO$Y54g`|{tWfv_kmPBd;+WJpef`m8v z+?P4hjya|MeJYPDibNE~ctS?&)BW&sIHb5kwLx@75lUm<5PGoD7tUAAJ^waGvYkub z2fy?DxKaxa0D_9~vjI7%94tu?d2OQC()Kw`gI+6&f)+eyHTb2nym7(hG3rrnaQmp) zWh8Zs`m&x}i-jG6l_Fcw$y5-O1NnsBx!}d@adepz1rHj~?z{oC2-tnp6Pp)7RZGR2 zX^BUf5mHVo%iOuIRP6%_V{=JlGj!pxP>#9oaFUB`Ki9mEi(l!4)&xHRs654E5+zTcAoVu= zg_H}I;kE*Bl)IUcCep>ZEpOsXnl$mL_nMVp&_iUU&P?hO=-W`~Hl4o4wE%S>Ab?zK z+l6ethyoHA0;f$x`!S*n%;rCkv+9r(*I5}yLkzUDE0KCe6DNC4PB8Lyk`WT@$XEd)Q>5L;$SFK0lrtBQ#IG>!;x#D?`1yHI{d%UnuwLb zO_MLm1~#Qhgg=c;bh4gz$cZw0cHAWR-m~*%Pt(cflM9vKsmm9ytDU(MIMY74sdL~E z-8wtA!DX|66Zvct^5A*fE-TZ$miW@9wiSQ=W*7YZuKnT=BHYIFyk>lSW5G$emHWaR zM1KO7Rv(%CSikY9_U>DXC2ha4Emk?ZY}4rhCPqx_^pS5>itelXH=C-LHM!i5>{?f$ zcAPkAqyOZ|jQqjR>b9k>&WLP76_-@k_*^$&i?s?6=)<|U-~2kg9{ z9&>5>L)gV@5puT}%PK!KvlK9<{kx_XH@#Y%T4}d4tgY7W@pqg{J44UUv@}oeGvwxk z5u1BHMA(!sJCWl``_{g*(0{!5jB#Y1j~Dx6fI{em_c~736;5*Rvu)3|B@qel{*8q7DCe_E=@hnI3QIxcp3(3QwkU@UD}$GM@V2e(m|~ z*x40t=O&*ho%cn z_C9AncvhFq-xa5QQW0m4c^I)9v;Ooe4X3T?#&Lx#i+1sd$cf%jWKG$D2h+~1`G=(j zMu)jR-BPo*k0!?>Uq+OFH^?s!HGZM~>pDH6Kqa)26M3ERVs&l(=hz&ayx~aIQ_k1e z9RAUDUs)tIKTW%e(|6pG2XiLzy;-J4Zw|k(IMrVkxwP-o(a9nGGS2j?nJ3{F?h+0d z+E7mKH;mHLJ@(|-S*hyzW52^!Wo&XLI(H1jZhabQwbaorNFh{3SF23&nw8Y9Md-5@ zj(TXksDj&3rcT^$`RyF1axeC7ciTb3?49#-FI-#C=vF>H?D723*PQ)-H)_4E>6jWe zdEZ~WIq+fZmmO=er*3;cLvK#WE5rY3nVmRlXjR|6PWZ^L;y~I@n|9^-q8A$VXVd+@< zp7eW@7HTWEj5Zaf_4++lyW4lG?PhCDca;AC^UPApDHc8Fy5Xs{v9~hjSkar?TsGNW zm=5}}^JTsI3XR*pvVK0Oz2alHq(*wrlCe8?PrkK|H>hmyvk&rD8ToW#!w}qb^3kkv zXnx#yu%_)zI#)X*cL~Mc;LDv{pRY#` znmk6IOV@vF{pJ;J*REXs7%hWSxDh9R;>0QcE&uLu`B+P~|In(nrTwoSpT?R*?S|tJ z@87Mtq4r&Bb8}?n$RF01Z{Mu%G)L?nvCNH!`%k-cFyKMo9sB>ZEC1>G@~!q>SkUyn zZ8LpQVYGdJ=W|M4xc8~(Cv0-5sXpQmw|TQkYo2DbUU)=srmy}`w9WNW+WW7jC;Bma z{T~eIX>e|}RW18-qIFAAOQ^|Lf7Y!wixq!xDeF=8Q z|1%2Cc6y>|a^(C5s`lifv$WjJUs6ichkn(rFKCsuxo@myl{+PqBK*B)eQNvSUhABR z?X9dwxZt&VZmVm!j4xlv%I5-3E?^hLCS+8z)F`9B$fv*F2-rYA5NV_K%k9wjj~+UA zCiOkXA3sd5P~Q{e((?RHL+p0{^=DqY?q6#({NeE*?AxQi#5Yh?OfO{C8#UfOfYWL# zdOPsm{lweSt6%HxC$&dy?%(Z_TT0Lp~v`~7UWa-A0t{*KZfW3w|FMMe=K}Wa!JPl zZ!bg9!&BNmZJaN<<*>rczhvb0#mOH}54ZhobjTOh;G{<=mcoSZ2al~jr15l3VyDG0GYbSTCs_;HLz3Rnf`?vAi ziXL$ytJd7AGFy!-THnxqJREcToS98Y@A}RiOUg6UK0mJ564u4B|3Fa6GqL`bn>bxD zd}1RO*LmKh{XWItP;~dq1A7bACN-~9Z`S`gw__e|p}9$&d@^c7c6|7OXCWtOF}yW; zHH;+1^=|KdJG-IN^uQ6b z3XSp^yV#-~Yr0zsDGERK6faYC8aH{p6DP;OADLL0`-vRCi{2OD+4FnNwXxyv4x6TT zmwctHtt~zM^?ATx_OY>?^d6&(4F%_}dX&C@A|3l7+dMj)b(<5-yUkH7nWb-Yr0Rbq zJ{ro*8EUTk8hNNFo>M$VZ~i$D#l9Oj(^!&r)RUF6|bb^zA4Y# zV2~YkGG(KQP6@@)_xPqqVV|`>-M?@mC9!0BWQA<7s%zBject61X7R*3w_qzRD*eA; z%iJ}+-?{K8aLaq!t83MZ5(UOK_rIGTXB8Y=YH=37Bq&LH{8Q<;7x#Q3W56w>HaH-! zp!H7Ehg0Qi&eiku7j|g`jVVYq->LqT(f9YiN@>lg;w)D^-=YmZlB!jQ!pFilXm7U2 zqU*DsZ*j>LG<*NJ_Tov=S*yUxHL41FPt2EE>(`d8UFvquhw${1v;VHnJsXxKxX{mS zR5889ikW!%d%Z%iCr7hAT=?sHbj!QSQ0Y}oKbMdET|Sl(>i1NQo}-D&`%pUdY`=S7 z>GS#vM?-GRZ#ZnxE&oTgsjp49wA6o<)lx;K(E^i(e|H0)bWt%oI+Ef>y6*m-Zo4XX zN0X&ib_#oP1)+Wsu8zZe6uJ+SbCwg-WpIxfBB$!)lppCfqPNs|&B5 zDCJO#IdijmHc`>f#XjAwX^q2;w-eM0)t^+pec!WHrj^_KWhKMwP?x1ikl{7B%jvT- zs?}#U@D7isF5i$@(CwrCZCgFB&9J+s@DGdANj@&9oOFO{Nmc<+a}l8-FSo3 zVKSi=U_w2UYkAcw<-m)*Ym&4vZrMkNf>e)aSs7HsY#q9var={c$gT5V(?0Axdo0Ao zurlnI>1I3Q2djGq7=$hv~UhfY{2YgE}uKHE; z@k3WsE?sK#)!nw9FE#|qCBL1>e4A*DoW9}J);V@#K1M4 zd)f+T+rtLUoi^&cx7RX{B!usHK*{m%ymB-v%<#d`@U$JM8!q#OpX z{Fq7(&@n!gE_G$VAg8Wn>RX&6j?rYRe}6B3+uFabn_Lsyhc8a1`v=*uPMZX3y&sKy zvR+||Yw{w(^0v=V$?Qg-bn|n-h^WYy938U_p9mBTnx3Ap`TkrX%;js+<}*893ErQ2 zS(|H^ow?#;Zhxj?OuMOxrQ;rg;=vO>Z4VVW*__m*IM2u4^mUpPo#`gkrr6jIxx*)w zbjVv*B;;finN~MH88r>{@8ssptGp>qXt#Kh6e5h(>|ZAo-RR^^xjty}C)s(smzk=RmY816e326JBhp(W_E2amts=>)q~Yyi}AoH*xIcCdD=EGx{ob;il#*5|hUd*sJX_c(Ercf75DZ z?WXs_VO#F|M^+Qc#pMeWhwj`w`NN=4u}oTd&5O-?CR9`0ibor>OCw9vPFOe}bu5)i z-JPCaJr!~0v`=hd$x^n0hqs zPmd%F-1(Yy-0ODG{btPpURJ=#%kRJZsab9H%V0R?s2s~FHnJp8j&*0<{k_{$ ztGH3h(d5pZH^yF^xI7*1)0%NHv?BPnY%S$VczNK9*$0glnnAav@BU?576#l7qBUpz z;aU1uP*^<&miAup!=-Nz$bC1^8Lh-M5Q6 zR}J1d_%nY~kflY<$*8kaC%Jj~LF}VlO27ZK?LHR%xWseq#D!ShH)X!7hE5cfy)D^( zH~b`amEaG_s2qELd*{yv!W&8L>CVU7uQ*)2Q&n2x(eveO|Lz^s^DmN1c9c7>Ijw)} zwEBsYJ}-kRw!c>Bp}8p&7&QC(^C2bLguy@Y>f7=z8HW5xYMx#GO&Nbn29O z6n&Y^=*8v>q3!*v0yv5fE)|_Vw7+qQPjX6T<(doOnrcgbJ}C5!d5KRi3#2q{(2^eh zw%l!KO+ep^_F@wQdwj0f+1NH*uil|ztvAJ5OP&v5To>LQ(AikExyfnhZBuLh(946l z{Gbm7wjIa+4x6yIWs+(3Uf^RVPwy~RCKjrC5W zJG?jct899(V)gD#<+BAU>@5ZDDW>daBhA8=fLBt)+S>cjT`wNkL)&Wc*r4U{ittf+p{TSz2}+v?}JAw^b@n zHy3`^v1cpl>XxbaUwOIOo-3(6p!zI-!w18ccQ3iQ%(n$oGSkMTN{-svJno46Ev0#O z8U1_P*7a+ zmRx>|&Rsho&8@jeXPE!meaQQ@{E4cZKTEkaetXvrT^^92M&$5&&RlVrnEjspf%QAr zL;uQV<80rAyC?8g!?%`cT+#X5^h+?NI3G){TKRW#quuMy<9iuZCSjQq-n$dObFNC= zx4GRKv_X&^Kc#TZ&(=BQ=R50rv)hjJ>RCMWl~RvyR$KmYPKI#7X8e=tvtL3Ixsse$ zZP~4{CoSrm_qN>2K1a%|wRc_-ta5$dS)^q>mDzu!L8mD7{q(2q(}vkMLk~p{b*)(c zs_*E-pY%iHD+Y%33yoSvn5X6Q?-iI;G+~@MgE#cPGF;AR9av&q!9QaEJ^x*c^zf9;thgEct7pHH{lz^}huCrt6CXLf z-h9mIPt?;vjBa0rLv+?H$BV*kd4qL{J>jcVuf!^7)E?S2S;%lt`tP^7iYq+?NB{aW ziZRh^6gp8gS$*&0><%t3i2pZTCWK^tx2!VFLt}aF@A!&?!^5kudRxgyY zk(_N9a>>{IO^=6%J*NIscVLIFne<)WeD8O)Wob&?k!xetyc>~LX@*yH0$y)FySg4z znLhEkWAxYB&dIcyJd1)2X&EP-Oz|7ew_%bgBaD4!4Hl7t&JX_gH!snY)n8?>;?f+? zbDec-e9zhZ*2NZ@cz9&Z-<=how&VTfk`HNz*3TUA$8O49q?Gw;nP914YR4x3{+mAy z*$LCPt~nlO)NX%U_{btX{_Q~6L*a^!zAv0*ZMc1sp}y?DQT`v~aVv2%>suUII01dC z`Rgd|LFDlUzvEnaEBeK4f%96Kefx$?ufDwVCZK+a$Nup>9!J?drr(pVCg7518uh#9 zGEXu#FlNYR;tkDSyre>RW{B$H>7bo!jv{volVu8%jS4^Ie|HF5aX{ZmbDE;_#YV$d zt>wd}nkz@Y-@LZ@_R8q?B`2Jjdjj`3-qm7h4$S#)rYGFs9NGP~ZK-F@aB^~e#YOJ( z%iNXhk(Dp6-SFLdR`&zZRnR7X>e0y`Zwv>&Y0v@_!pyXuG>zTxNZim@8T2!4E5GS_ zwMiVZJLk=nyEfjT(~W74zpv5AD}VitH*)yZ;JqmsiPbDW+e^-VYi^*^kMzBA)7`;z z^#wFQ+3Y93P~IUxXN^_%@dic9?_HR=3sO_%uihUh`yiZ)53ap+J}zX1=AlJt ztBskt}s?fy|y>{xA(uWbC=UyuWdy%4~6_6AQUY>pQe{wv6$Iw)#!n3)HiV6?=f@8$-Ff-blkqdA7Ot53OO6pChGqN@-kAmV zuV-}M{FgJTUfpq`o0BvD&GO*c<*zz4`>#heXrHk&4x;!Ln3hiH|GFjSz|U(O-|VrS z-PPOk#`Q)B<+6;IV_{Fnc+Sdz!x-P5&7?!z1i}x-{;2D9ckgZfeCuHnVf23Wrft>? zsVUB0En#xtcZ+9rUtV4wjF>uC_N5O)y)x!q=udig=hddnf*k&d#Pc3E5BRrle)K12 z)%H=QnswP;DREG+e^-cJ7fLPyf87>FHwD!*Y;RYtLGzi zw4_%5I&xI|K9_seU?1^-+f%Dx(EZ1rxuIS1F>JB_p}&8Z_8dvY>)+Trx;}4elJ&&A z#-#t@!?bPMPQfy1y)NZ1bUprh{A9e23fQR=vC23jQHj|a63|`Q+pB1AV3+Q;j9E2y z^5ur=c_at>sPyZi=k!O`+g3aj?0$Ok$Z^|#g|jJLIx3lZrk?2}>bCPd%d%<`6~DH> z``iVkjLPd$SFc>g4>-MRc%CK96^{K;Oc}b-;8`?>-NmB6Y5AgY$hh@}pZ4;;(j8K8Fr0M@6MFYr z1umjUE&DFr+Wfj}m2daQx2tM|W9ILU7l*A=s15xPGToGaH*6jJ-BtD7lHv*eL5aBL zJ-Tl&$GJANC~Vzzi<;2PbE^2bdsis_d?TI)Z<BGOK&MFIz`jo#K zC`kG!Ji@v1?VOLB`tid`8!eM_objaC*%twQ%4c0>+Rv8#pT@pBs;MRF_bMtX2v-s5 zaHUF;3g| z_L?=br(|YwGH1`8efF;m0u9Q5es(_m=p=IVq#Y#56hTSY`Snv8q933kEq~CKZ9%z^ zu%4>*=5(yP@w(Qq#_$T1P9uUuX*pqgE=5aNVz=LZDJ6Hb+6?Aptrk>$t_*g^E-!v5 z^^?l^NRe;d@+d`d?yD(?+tslt!TY9eVFg2p-AieODK`^$tEHaUqs8hAh zK^0q{uO4#xV^4A-crKG`b2V(*ue@8TKIfbqDWXJXmXF^$hLzZp8rmeY5zWIQP(d~3k#8GK(0!;l74r5<}sdnsf zO4fiA*8K4wr_I?!0$Y@slK|e}h{1W-OS>(%cwH!@nB(m0I}oAhw5f)L++j15(|p-v zNwh4U>nbCbjskpE+$ZzxbEl*3lBi>iolS5+I5B=nJ(2Jr5LMXeI6nGJV=I%B%hixr zhlPC8(|f}bjU4_F`q!0|RcX%Y23n!&Nw4|JY|y%;knF$^z(5Wokjr&(Ag;|km7j~V z->hPRA6s8ws#xURFNlfLl9nKH`0?r`%2bYclm6ksj|*CYVm>dNd7?SW&f%3ZE7)2g z-GEG%)7WK}fNmhmGG5EXYP;mbnDiidTHU*U<5-Wttg~xKeUb<8rx9KvJ*GY{?C5Vh z)bG5~n>{atF8k|G_Tq9op5<@F5MKD_NP7=wqSazl;yiaeG_GbLL3hj|yT&$S($_Opd z2LH?pE|IYYI^ST3I5TR(CD&vlx*R`Sa@tyK2bGWzfjZOIt{3HPh%rS<=FaHr0+ypp z6<;j(&E{_muIVLi`aN%Iqs&?z(S^+N$*4u*JlVxLhA>J`F{R*3mNsCt(u4?kL}~^M zYGxv~&T@kPuJklgAy65TbRv?yK1*@*Fgft)O zVqe}j*JyKPwJ%4x%*Pi-yPsq|A)VR~s)dfdVc*Rkk;PqDH;C1)mcO4|{W8HR=3HT2 zkjE!45V9NYV{}5FMKRF8LeweYYderpDtomqMe9tQ@RWvyRHpj@0r5=ju87LOoD;vf zjUn?~nrtkfW?t109zZ<*SqJ(8c2^srB8||@3c#@TuT~vOmKFz)fbb}1n6>nmx(@(> zY1T)x_HXLO=WYrQJ&#kb`3fHvKZp&CLF8y;SQz{qZd5RGruj z>O`~r(r%w`8buc&N>z=l1bZdma9GG#>45OBoalBN8z3M3BB`8-*Lg@;ZyeO|+H~t+ zJV6_M?N^!@z{({__TiGal{d`TIpcKL%$4&?YWuB#FY;DW``cgS8s5tllOQP0dtGi^ z-s7q11J~WHaWsC;xiwJNFUNbP1uEJ$OU@cFf!eG-UUqeAyRs{4{zUwPH13>F(zoFKVl{X1O!NquyjCdKlEw};B*ilRgS zY6H`gRA&PN8u+Pn`HpQ?R2~&P%k;t(9 z0hJy*?6PiaSI~a27s;F+YbAj`L&FdDFszTa4j|i7x%jxGDZmTNWrrvLZOihwBh)eK zuEc25eY7-&FrRrhW;t<*IZ6E&gnYvptu`{|ZRU5Q;glZ#Wu1B284YJKf>ie!)GG%~ zQ99s)!r({g?UX+vO){!i!7~CGwOj^>F6LkT@L#IlM;P!7@7yz-^iIn08Pkcv(W~Bc z$OG##C0W#i3krYO#rXN$G`98`jwG76PRrFAJ=VGuV-R87BQlO|N1wg#A<~JH;tA4z zll0L5B1B5}GmB9ri;;^BLt)UHy8kHRV(lUsdD#=VU9IpNXKwOAJo8D6wPc(7i% zz9oKB8Pw`x9YPL18#;z`DY^gJyvG7xF3>Js+#h2AK)Oms<>1Rn#8odG`X2}RWbR%r zVmU1^QB!VmNVhae5U|wt0q0<2jCv9kQ-R&P%4(+=R1X@r63r-z-vZp}8>V!V?L{Q8H7^-R=n zeV@ES7+NRZ-@-es1z8)hnx`IH#P;k=MjgdkVV@{IH~P9nKi1^XIdyeeN@-O zd<|r`$U617WOv^xmq|KM2^v*%9+Fs~G~ZxRY%(sh92KDWBH`&q6;BUKVFm?hTn1pT zNedaHa;wC;cLy0$7)K{%N4vpe=Q1Q>$B5b6l|?hqrc~r_#&7wcg%gdq-igjl_EuI; z9$FyjP#^6E%v+e}TP~Z2QuggkmWRA)r4}*1;LBBWRirc%HpZJ8+g!TJ1fQ&X=g|V} z41?Jkd$Lv~OH%Dll@~C@z9f}q+8Mrz1|elbvWXbTKiUYN7xMON;C>wrsWi0vkR1w0 zN%b~=dtg$h0(kbJSzWRf*rfN+LLQ-lH;b#XNja|!c1l~-Xg`nkCJXv&qs%{|CIrk3Y|A|om;;( zUABe4%sF=!x066)a-G-iKRO-}!;OgTOvda$M@HqQgbE#3Yf@8qF`f z?_F>%utJimt!a+4;40vsuP*1i&um3Po~m96cb^#|K#D}dUTng18862D<-!*UWBzgw ztP=J@{ihc8VvTq^;tTLWxJBq9K`07@=e#X~iI-WcAX zh9O^Dmm`(z3T-E~3N86ftH(1AZ&habe@bB%z`J&LJ!3~H$-LzH;9`j|c_so*CLNAg zf{jGShhwMA3ncKky~=#By>azowiq$Gm^}$=fPg_f#1&Bd_X=nXm#zTYAMaHXSHOn1 zWsL>`DL7pfffTPNO8>=hx{>tU`&t4i#1a1Q|8b&Dhg#A2%NiwHPwIgIAKQ|8i%M8) zQ_Apw@?g-4|C!N6;zEa|-+_KW-&2HnYUN9WEz!lVzV#wpKNPp)Th?0!G@nuvGns)? zUojMpyXXBN(AurK>hhnY8}H~d5sFU@${s=YrM=x3cZY&19wKI6ovttZq^cfuc=+(r zYq3xFJV6cNXNXLA8_ibY!#L*I?Z~nr5$Dn;LUg5kM|Mf`Nocf>rn0n!>)_m6bzW2M z@?DQwu{T$1fTK2>o74H>Z+0_g1&}0W(QlujZ7}XdRWee8+l!m&Z7%N~9HHGHz{DT9 z&XFc7hn8rd2PCwwX0=Bs|I{TnIf5ucZ3EY3lm179LcH)i|EH*TIBfiSwdX0tp1dc! zX}A*T*ph&j7TmQTG+$5G6d@kYCLL-7CW6xDHO^z7R}G1afjPP-GuA5^tX(<5d_HA_ zcSs;6OLrq#BvUVEOtNU0JNv{l&bwd1*!}IU4ttE95NFH@w%f$C%6zZUTC06rnGIa7 zzonWkg&se(FV#~kx9|!yq7D3&{88H#SB?Q%vZ;tX(n^0pCnPT%j}^3Ep*zVD@Y`Kv z{E^zxU${-0>=FomDTL#;d36sHvw0B5f@u$GkZ!5}Y`@Zzgqz6DbmrVf#ZLaQ!ZWGK zt|2I+gokvqzOI83UQ%acUi25WYy+LdU}clW*(R8Ye&P=x+qCt%&|o`Cs7W}ACla#z z^Xo^6uEAGQd3|XsF%Dgkze=f-3!71O>*s}fODN1lmU>B$JJ#6P+$@+i%PBSYd>rwe ziJM@@{(fS;9}Ypa8QwRo9R3D;1RAcdHT8K^+#pyIn1$!7)Jh0DUDtV391t)p9fQ;8 z`=5iPaU{)2JpXvsQQaG|?u{t&6TNRiocQair$!@al3V9Y3+47+m#}$J1k2z{-&Oft?>am!zq~{AA@cE++U51s+#@OBHkZCtcD~ zRT8CVS)ZfzNJbTr_to$GWdI}{em;h^A0?8U^R%2Zcwkb_`5A6xZXq(Z-t(dXv;igt z@>iAcytw4e+@|f^CWhHtM2Gd&e<%nLJT*K}=IiFz?^$ryXSfxfknQTAP_>MbZ22dS@Kdx#lU zFO|}>j>JVI_Nf#4S^B@)d#XnY^$DHqW$|4(uU*JXZ^ymR3>Q|>QHkWeb5?TXuTtjZ zXCE(9om(bY#q-^;w&LmL9Z~zWBbl{N%a{aZQJ1J2+IFwYT7iM*I0{2IF%jsI^2lvD zi**83cnh>Gk43;6-xiQeeq{rPlPu}fi7-l2t8`m?EjDK^*f Qo3L;7)jbv+{w9vfZp&D<$qx6lurUu+2~;6#@K)OPDHRkE)$6c{bKt?~^c6>{Zvfjx zjN85aEie?hAgR?cx{-hZ-<(Pj=IjHB-Bm_=8JK?cv{%Am*wAh#PL{k=6Qwk!7F5_z zp}+$iW7G^|&c7E2do8K89{10)#5QUXQk0FfCOrMiCkpL#hyBXq6@~kedN1y?Mf4Jl zO5*pu|K0u)t+3eYdXgE%g`ZWleGMm`irMnn-lkX^Zj*jJCuG_;6UR;dtZIM)irZ#X z&l%p@m*`@v@COZ7K6Rg7(Zt^sr^@~z>E{yyW`597vUx*`%U6?-_Vq>$0D7ZlwjJst zNFN!NwEKRy92^B24$B%!V<$_HVRT5XltIIMl$M&AE~Kx|E0V0te~IgSuX9sMaBemB z1PDEuD+R|{Kh)EwV4+|X3sh?N_h;f!HZ)>8XtT;E`QS{6Z|6`}kf1oYeWA#?mUG15 zzdeq3HU(9a?A)Y!gB`tQKx#yMUabD*+&wXzKOe+ahM3 zN-83wKypG(wnt6$G#uD67+1&?(zA1 z^!q#8P&3#o8;SMdry|svF%;n;)}dt{!jr>K*5sV`KP(`yqxpf;ER9-o{DU4%gPVmN z+Wv-lF#q6^S+RdE+3$S}wh1e&XZ;63UMOdLyzt=uMu(#bA78yJQ04)HQ)-Ab%EFp( zvMZlJm7wn>_<-uFgs(Cb>b`6pA}{}l{_lD^v!A#AL!Hk-0*{0$7LY(=Qdcj=Mo#1l zbC5UKiz36o6k;_)L)&zo_eb$<{JOvk5Bk550@pbW+i3UBVj|W%lLJZw<}f2-?n^BzVprD%*+h4XH?-@hX!GeeObNUvfCa}`0k(V+y+MXoW(8n-Ec{d`YRKL z(B8vA(ciZ|oPD^igsS9BOOWv3WtqfC@KkjZLEvqH;v*(uYixCVW9E{tP|LIR8eDpV zYOR*sXup7F9Ei)1ClJW$8ucv>Wv`Wo%mMiDQgi}&dG?$?!j$^lARge1vL6S9a%ng& zWC-gGvKGkZ8N*54Xdt@iHvoKb?U|YGPwN{WDhKd;at>tvpBK7b7I71l<48^G;~pka zvm}wumSfhL{=&!~j*$~=vi{~Zmtmq)?b|lHHZRw-B81jle{SiH2n;b#CXAB!lX6Eh z>d%>rE9K1_h~`8mHL|tcUu02>!QwcR*eGuDj4K8b66 zTgfl3@~gF_TYL{6>~!VXnbL$Gx#WIWYF>ZpoSEB3a?=aEQDGV8gIga;v}KN#q`UJ6 z*Zl-1kn&_`_}eX7ll(VSbn0MEscEh*?qFd?W+!Ze)=|*hV3K{Cc6;Fb8-G?AyU2Kq zg%WbvM!VXtDq}CM;Ka|xbxg&=&1{OC2n4^&K5dZiGuCb{dOtSz~nAUEopF09RaNE~fT}gCKR}O_!OeZX!mz zmmniqQ||jp&&Z)b@u9%;O64MN!Q7kcle2~dD5xb zu*CdR>SvuFiv!t$6H6;+ME9T$KU>+@<{Jq*r;)+7d*XBd&@bu23?v?A4uH6$U1$D) ztZ&-1xT45}jm~ksC{G555g=QEa_((`-xi)p!d7#8n~}F&u;83) zH)8`glJET_-v{`y!#~C;CYFIt1xw9~FUWbfjrH>1lrMneb00JC5q>=4NGJg#lbvt$CjY&j|lLIX{w4LY$V7nRf2uBD=zjI z!RzEpPge3^QmIMN26gp3uJXj@Lz92Kg3pcb$(M~N;OiMQ(_woFKvr(k;_0D7dmSd7Y4AtL~v6q&u;D00m!j{f_5bFEnEd$JHhcAW?^E4Y= z6o zfqtFCTATKA$@n#5RWyDijVL=Z^hIOXz&ygJcT#iH>_p{1E%jjF~#8Ik-zA(a;; z$0R14YM^GWq+iHd_QZ0d5z9X($=t9N0fJG~(BCZyNpKkVK!cLr%OB{>awDs_XPE@3 zIw#{t4#i`F3yWw243*YZ`D6e2fjuHUL$9jdq{7%o%Oy^R9^Bv#`v+No`f2?cW9v3G ze+w<}Dq*I#F{5(i7E{CMcXX+#)eQLhT7Y}va<@n}l--urlgWI=6R06be;ko3!5niv zv?I*!+i76Ukw0YS*6o0aNNEe_u;Zc8)@vOcihUfqoQRzW%eOiu+Sc5qDA6ozVwvFn zO+}7W&3AlQE^rBQAYfxpfzc5@421EO>`@fNBSPkW(0F*TWXA5a{R|S-kyDk8DxlKm z5iW`kk~A;(xN&K8_DFH9>Y<_>ZP1Dhxca*(fFiPc=kUPD>RHg2Ay1A&Mfy{d_tB_l z{e}1VccsUZEX{)010O*A<8XJ1n8H90y_a;7&DH^+W~Q#@>rA1pjG~xNLO&uc%C!Y~ z8wMrIP}*_IRGh>Q9Od5cL^tZBQ)UY@P_w{?8I+8_z1txxqNYj30v3cn?>EhoRUkrDndgLP=Y$-P zd8y103^578ESo@*A$+ntD7o+B&J@`uv{Fr@WnmWH4#+nS$iIT;gf_(@EW8KXO>i03 zi&c_5GE%XfC(}ywCyxD5a-vjWAw9br}Q(a+?GPbFh4o5 zQS?gzsYYwTM(cNSyR^8^@&ZzJ=KPQ`A?zcj*UZsz{c1l+c#fe`K&N~?vTPG#ABhcv z$m4z&&XBK>{9SlR2s_1?!t5NE;lXEP;{IZMfFj$RRth#c8)gCeKf|+)umJrYUcL1q zzclgPKqj9Or4VkBG|^*hpHEQ!5m~n7X4t<&tp45nH+cb>-_0)*`@(D?w^Ir`92FxB zC3pbUqbA9qgWzmSS}DZnX;?z48j6fkUi#K9ZKL%l86|xGPf$z4T#Woy@Rprft}J*y zUxX~%cysWjfF$|vVjh2Hh7r>DduG&#Gqd*O*vM<*9`QA>k94u!-yqBXcIf=2fXx4? zK*LPz4Y2|lRI+}*Hg4dfO7ZMPk)) zWwOYkJ(<)qpl6zjhA_2y*hSqwW-!VtwXsPd{Fn=Y1qC8zjsv0F1dC}rAC+Zav%i99 zkPNMC^6hX<#kX7(#Ve8f4~MdQAIF#r#o4k~#!*xsmoO~SNcYInQ<>k+x$Ukc0H4?L zArLMWF5mC%Jtt+V520Mn`B-rM5)hmRg*yCTv$0IvscJoZ#VR5G;Ev}-i28-?vR;C= z1m=@)PSmT0Lh_q>Uu|YSEp{IlEKev0e5`Oji7O!*Ka5s8EU(6qxs7>_xdwwt%ZjG- z_>aJYa}OI${{OG_NE0uM!4=rcUs1Z->&Tvh)q>@<_3ab$;Qcugf4sZq2joiM(5G?n zfeN_F^l?r3U{eYI=jy)gEpHOu#Bg+TH`4cev;4Zev7X)uvkJ zuk)zc8aYcELitO!uQPY7AJbKPNXPLcO-qYJ(5CO%&nbUUS}kEr z)Q_0_uoBt*%gAY*gcljoXEUX<+~;<^HCa(gOyM=xHx-0Tq!%sQ_wO~aSCp16*{TfJ IZ~yhb0J&SCEdT%j literal 45391 zcmXt91yq#Z(zbQfDGei5bpl1Dke4KiA8XAG*sI?O zr%)^?MNC#8m;8&k zNa|chfP|QuoTgP|?erYY+c4BN@wW{3x*C1(Ky}EMq-nC*oIGVOdRG=A#qVw0gKX`L zX$oh%O2O+d{n!QZghtq!>50%8q=PT(znO?oMYo2eV$0-H=o*9vAuH-ndk$;2K|ML~ zq2akj<`t;CDSJ7Z+p)5=6}e-(ELod;0&ea~%v4JI<)+J_GXv*0xS@13AbP&F*I_3k zY7w&k6T1j$=3Z(SUR4}PWmR~<6&#a39oSpAw2Vt|5-8rHN#}KW1|2$+nw)4XJ1oSP z1|1NEr!^W6ma7V$((La-*t~7QctG{m~4plpxfq^h^sfaWtyz zjd92G+>+IyZL$xAb1u=>+7X(RE!V(k4*X;RI4Z-)_Qhvz4 zL;k-1O7Q!$@8@~(*UC8Edqk}d2bqeO&ucPCxgtlkgwj=&1Zr;uZ?1^z=Nwf2n=a&?V*f|^_V?Jva ztLN`r>=SAW&?-uyU#-IWKfSNbv{+bK`jr-55hWu3t6=>r`52Y)QZr>@bTO%8GUv$x z@}8V-x4umVQCSGiD<-gkvuK}$Et)){V=eQHB8Abgq}`!=b6fU#U6c<1^D_PkCzX%)mBfb&3 ztd$kAKgn;E%pbMY>TD59R#8@zk*Pa2EPgxff;@7}9hs0w&(s)QrUtC;XPoM<&)bQ=xx{%*WR)a7^F z-V5H=MjcP6`%RqTQS9{#Irf1dd&-4fBL|0@ z{sR5+j)bAM3AT2+RG+z4UQTCO64%52&9(`<6*^t-xz-8?b1?tnoUn5;rk!eD;Am$* zBFgf>*=#~tZD-&~f^AKgA6@*Iribonf4%GSSdCo8_vJT|i~ide zmbC^7RR$56(+i(yi|P&fbv!(_jz$?}MjaZzi+Lz*y&s#U6r9MC!a+l_r*ZDEvW?6< zx2IV-Iq8qgQHkKast&;W@mp^QQ6Rs`aUao8s=@MQg1-dA3(7zxg`8I56ybhGnS11- z@0D1+pNwe?Jn{`3(FgwM4GEgtMqc8u)3lSVB#6;w;O)~>NL_w4s+t|^{c7ZfWqeZo zi65))bv0*vmy)wysR>yeBO#Q+_g4ko_(C%%abbc9Mvol=|48WtfKFnR#flX4v8cF&M#SVTI0FJy*9(m~CU z$`or9y2rrUZ(Nrl;;?K!<8{QS+p=Olr?P@r+kJVKk~)gwpjf1By`z$(&jCK-Is&_{hPtnsrGeI|T?WPu?rYgrqD9#2PTOhIv9ezF zj?9;+`!W*;g7t(61?DSHB<>%0z9lu% zpFc=g;z8s8ZC9lmiNDxrAeKAg70Eq`m~j{)s=0mP(kgP3S%auuB<)*0Hzv$l!=hF7 z;_}1i7G0znZ-!s#S6NZXofa-%7(Q>+ICz)3vGem^t6vyX+4YPWk+>1xE zD}Q2U6OLvx3Xv)1P}?b6sqQyzarF?%GcucK?^L5N!_4%T{b(|Ijf5-r_5?p}ean_L z+D@NX4*MGc4wG+-^~x3$Z0{P*5u!XB&%t>RI#Ro-sCT3K0^y{PEZ}sgU>l-ofc#YW zw_Tefq}4cAXzz219)lH5n~>%uL=unnNuRDmrO<(yq_)G=?YN<%$X{(~j^A12)y;%a zL&s*9!5;dHz!dv3z3&~_Nha^QxXtJpR*Lk*Ma06dq;0rxgl~epbw_oY{?4Qlhu<+t zXy@{1ZeHgS zPgD7;I?I~Ae~*U)rMqGMm&=q_J*DApL)X=>{!WbG^-u7h1wxdsvEEChk zNn{7&<#o&WYlB*dalL|c24tuW8^m<%F6#lGNaAq9M$bsUusiuTxY*E=k!#z5N)w%` zzeK#4av)|#XFzo}+7n>22gt_c-*P0oY<%L4IA-Y2ltSea+6OM0l(^wK=cC6S3AfJs zX^W?&#FiDoD|wxyd*}VtC$yUhWQ8pO-J(}5`|dX9^6|`E1B=`X`H~+!iVnGa7;HOT z=jmz+blqocP`|Rw$+;gE$C9b(6uoN5hp%9Kt6VG>x2@KT=<5_x9lH>ySj6WWzM)*N zC$dDYqw7)0Y4=Ku%X8Qm$>R0U7H$g`JUSEc@Ivfvp0%lIbS}ZxFLfGZGYB>tvaCF- z^pfNMR`zLF<{Q0vT+as0ly|cna{`eO4_Xj<_8)J;B7P?!0U~=xPNJ^g6LbPeJAWdT zd>Ug^j7sdrYFnCFMbR>Z+cG^@TpdmX-a{FydK~RfUdLSitLy?^r2qG#-^yjTK7MHa z{#e+vnrmUiD3s^G;@hrfPL$4`-%2xN4u!F?s&*d9`C*#)Y;~?c*Q&1SaL^+-WpU1J zw^i~`rB*+d2ri&396Yiy_0XbhOxZFfxo7-K+GF(h(ka%;z8!T@w`hBwbF>?MaYv_z zQQQ*PrAE+T+4MxEm0hc;a?RSGbT*SUexr_I5i+DjVg;%yIJHKqOh)X5Mhn~AM#o-K z*JzjPRZAV@Nc+ong*^(^_dTA`OLYjH4W+%_gW|-UL~gx=8{APpoNkN`_YZ>PgM>OP zp$E6#I2(sjlqN25Ric%*>HbK5y1Kg&hlQEb!AIH}*Y{F!H7aa7lFj>MLabw=+j*=b zh<7`yisAZL)hA=Tm4oC`R;W^cF9yE~mw%&f21@rg6&Yh^x4x9ahQ3x%dd87)Q(|yY54S zMJ?lAjHOpwZ+$xmw_PvxVtGY|$*>i_Of*vU3M&?MGxB?vd{@cQJ=4(&sFwjI{ZQFH z2s&T2&20HOOYKh8UyF-u*A_w$Ha*iSOYq?5Hd$(ZgA=c|B*DC!2SY4mg>PTuax(2= zX^IbL8f!84nAjZj_INd=Sx-hsW|9)N-`&R}&mHTw^KVDGShI1JSogZUgwe6Uus>J{ zr6{ELN$+$za#B$!6lOvE>i31j$>%8Ke7uW2cjU7mAi-%bXyy&>Y0iBnqD0dWVD zakBrCTMP2++~{9l;wtyy-7GWXQc9Q6IImb!HedR5J1&Y$hmI!hnZtuAmtHjfzhCuY zlHFSuk4b`-j0#umN9`NwhP>039cEF^&+m3ZNIQd??k^2L;a6#tNA%(y@K(EzqHJZR z+U{o7y6|O<3Z{4GdVcP>+bsR++*{qe5l&k8=;&QncQ{koh-Y|;aqR8l-tNEMGQS^G z%N~Qan?Yx6%@$+lAd;%{&z6$a?3GMA-z-i`0LA5p<6kcB<94cOS;`~(o(E*v($#tg zSA>D=p|&_9{BwpT7FQi{LOH!`q+ZJco`)TK65ocs_x65~C5_=G-1zmGC0w#uLa#(h zOiIxmS_YIuq;{$?DR1g2m%e1j#{NX^Di%z^+uQ#v(lT^EvB1Sc#*=7vUQ9;*n!8sI zT`%|VXF~t(yQzrRuk>V$Gt}p8KeVPqeqe_8CKo z-OLLvU+a$EGltn~jNm1Vk`O_%A+;FR^m?fkNy^R(thK|e4E^otbFAGQDAsPXsx0NQ zo1=Jq(8E{CWfz!O2wgek=EL7#pIJ5VIYol57GAFk`kXQ?u%7v@G&*CeRyoMe*(YBP zp_vUxl_oZ4>=qTJvKqKwxeQD-HtFntMqiw;l?TO9_$BG@w za>JS2K237a7}@rupK8v|WZY%hE=2pWwEdMMdp_eQ)AiJTj@@=+T3>LmC8s}aLTcZv zgGfE=to?GU&tmM@qxZ`0`oAIWwvnXSQ;P<-oJ2R@g_z1s-HrO@&g&DEo&B@V&U)od z$XS23;$qagxl^l>NUDECx7bE$o!z$3VKTaBJ~?4HH;#XEtSZhmN$}m@(0rUC zmLViG2jgdC;Ai?*{CT;bMMT!r8r?tT$O{b=GA9wZEQMB}6(}CcC$vDrkK_|}ICGY9 zsYbkxFwWoR3!P+pIC*5nwQ9w+lA7NTqFrBO7KEyXY&=Dsk!N+U^IO_RUHba}`;?06 zn$+tYCZ9w(z%{sWG|{Dlw$x1VZSL^1aJw3Lzbk2=>H~}={>DCL^eVuBqrTcI>r4LK zx8tP24rx)rHXmu{e81wh)Gi|bg_htig&Phh^}D}=Z=2S~D{#69L)W?}r2qJ+T7;~> zGb^U6ifco`^Wxv@7oJ)&+-G<}E4J>&AJ?LmKBmz~fAtu8e|e?{T0lBmtb0fjKg(#p zG2Z^@MD;;o@oqHx5HDsMD<02RARccxafs4iG)zO@n9>XL4Yc8)UwFHJDY?w$j1pI_ z7lc0Jw%Q{S(>Z{JCXK;aBM*tSKP6KJx6gSeJKPg@^i5U>4d&`8YadWflTt6LT{Q#M zUCPNto!t2$bgxq)LoG!A?qI$6>QtiWk>82d-cK=v0jQjOkNXO>@4OKM05woLSG+h7 zCS45M@zO|?#-q{NJ(&Y~r8A60l)cXX44xOGp9-6MWpVP6&Z7T&!KDq|YjvwPnf3RQ zdvtES9@4rVI;8Ly++A{08$-EKCNHduH8qK)IMvC5co1Z1AJ-&#kCVTBXXPo=Nq7?b zan`HglztM?lO1gh(-k4x8DUi*Ft6Vqa`ID(_-pA>sfAR5q2fP92^^nl#M zttpFR-8~PdQ46OrgXxTv5Yp^3WQf~*rAfK!Q860c>c%wXK^3XHUv}8@VIrYxb-E*O#!5(R$|G=feX$E zgWu>?JfwC^G&<{;@cz*CWSeC7Rhib4i?41!IGxU6eL`!)NwbK~LWiLe zpW3}?IQvMD`~l1xQoB^w1dke3T>HuWmWYP}iiW!_0xAkv3{c)8>c$m?7R7=meh;c)qj9med3>L2}=7E4Sf|U{Evqi#N?YD)p7L+ zd5Db4Hg@U4(6&i5%(NgOwSA8_+}MSvGu^D#*hSfE1iybOxY%FW^+CkYe)-ET`M!Aj zn|>u-p)@nWZn`vx(8A~JyYG0EeQp#v!A@;jedlE0G0}(M)@(jpx~4gvvYnHumcm6B z%J^sS{R1{B1HC*R5YKKZh@e-bd!!8G!&|L#_=p3wdE%egvd`b!5$hu<3ljBJd0lm=Gn zp{tnYKNOsd5e47q+}>6|Gf5;FX2!TX2es~bwoukfr$fRmo!YL0GzIZnHY6&zO(~pKIJb89S?x+H6}mmlxXZpLi;@qN z4_iW9-mU?~@r0A>pp$E}sl2)Ud*LTUSpmOU3f!U-376xh1hw(%_{VQ#B{kH3$&Wtu zwSJ*g=2kVQLU?LK5mi?>J=c#)lr{(7%cY&agl*BvDx6%s90*%?oSh=3`%>I)miMlD zV&+V-Z)j15d0#C;aDH~GAmaPjPpOcknj>!(dn$54Ds*hkt6*Q^ig597>$s1=4a{Xk-jB4k33D@tgC8HtGjk^ z3(sPLpu_@}n?cwwW!u5>cP@OzJF<`-HpSg{_O(xKrc4x(OHHQ?SPo_5e@0ehT(QjylS zlOkLsF=)MuqUMa@!HVZ<0^YP=vT@{Tp~gK)W_U`sJYSkgg<1#N^j8a*qkjz7vsrQy zh>#NkQ*mJ|~^ek3hnRcOBq5Jh(?4|izP_e5oNshY^OaBO*S2BTwk|VOWEkLvk?tyO zM?d{a;icV{qZLginVz%<*?o*9=taTQflD;d!s~2p_%Iz?@n=)v;9@mK_L|eXOWCI_ zp>|74LxrCzJJ<^TUAy~Y%@IA>l}2h$-}TZ~@Rc{x4+&StX3-k4O!Cr-I#o7}@y`0y zWLfGKEv(pFyQa5i?WCx>*cLTcOdTDHh@ZyItk(b0iS={wn$i0i%x~Z+$Np+;5agR0 z9+$aK4lT$^kt8K3xEOS&(MV}zAjzsO#@q_TP8Ju z=<-?My`!ej?!`Z0hn&;ZW-k-hH+;-GD|S|kY^0RvjNKCmO?#xuc19&DKaHy0troMg zmMR``a6NQ*Sq;2=u690UYcEWFDRupn<#c{rGF)ny3EiUn<0oI98U19c(~z}bzHz)q zDD*kqMjxc1Z4u3+MX-k1tls|a<&C6x%1oY>N1H6wjjQ--N9|k-sb{Mo33e74Hg-Sq zHeT;KiYWJ%#r>T|?S+Cy7MIUu&a=(hUIRo8EKSy+iEk&$IL7q3MqguJ ze-N!SEdSU(TM|`+&hrZQ=Y-y*a!hR8r^1xYRr6f?gZ2TLFZ(I)d=hK-+Xt{>{;X!1 zLk}dpaFDj`DVZ_Z)GG&F<-}}>d`BGzmP%8%{#3A>wQGf~kic|`KCDvFo7jGe;7792 z^`~lqV%D?fsOTCe2eX=3wL;DF#nbjkUptUnV}9dq<@>pkF`TVpS#@Ak%#nplm31{O zpey1X>ejuRB6YdTTeLl98Vvoitav;zMjqcG?{g`2v1gl1CE6+sTJUw=#daCWy7}r+ zx#AVrbkV+;HHPhB&oSOux_mdZ8zeloU0HeHTBP`u%gHG+7g5?TvTJn7j2X&8?8SO4 zVhyV^j$GL52)Cy9{O5fYdqqpm!@M)Q4^XjcnyA0Saa)jls;kpY6IUL~xULOj%Lfe9o54=0UsC{Tl_|Ipvq=22-dz{UJ z<}pMeijBCg-&%4SrCp@?EB_KQ-K^T(W}4D0t+zr0ce&YZeaee+*g4)($3G$xBz$&^<-Z z_YwV#e%z;0J2mDA*NG-075V}%z2V*bmqb*2LbFCr7}6(~tG&6wp;Y`HSHc8k?i9Hyy~i*y zxI_8g&BXG-Z*j_2&E!osjQe;Wb7YD`!RLN{AG^qmg&%%@x3g0wqgxOyLYcw3+CBk2 zaj&h{np168&%EDWEFn$Ta!@jPuO=ST=^;b{AtPJP!pp%uB8K>t9_~4$addPfp$#60 z`<0LieOKD*|7G}^2}`WiDaLJGK6t3Y`ul6WDcFUe@GfEAHzByM*sceqtSiym@667j zakQZ%vV1~$3btDj9Ptv+e|IDbBv|2mb*}C=#}VH=C-sz@7Q9G4+W-2sagfi!QyBq{ z8K(^zSkKNQ!K9Q(`zeLV9qU*i`B)N{bMliTq35LbvM_DuLxgoh71!s< zaE--o(x`B-rq8X^#hFrPH(E-)YpTZFq9n(Ht+5&c1| zwShn*LrIHQoy|&eW;F=26ZZkPUaYUaYENS5C5O zs?5qYt7Gz0(U9(!OX~O@R8{ZCwR^VBsV1qDd9RWBhv7g4&V>2x+HBSdd~&6@I0nB~ z4`bgeh6nf4Wo4P9B~e|&Qxe-dEFkwS806sRQy|dA`?qCe(tw5P6(~Zth(!3%hLm~({4vI zo`*GguR&?!U)K!B@P%~aCxg;{zf_y(oO+|3LW(7pzDe9wqL5KK0 z7`+uO@1(ML`h!GivE!K}Se!Tf7|q?9EH36(6vr(zm@izI7Zb-_OKgF&&&-3CtL%~O z^Ame;WVm(5AgzS5fl6C2M;iMo{%4`X=nbX@5t67nTz2V#YO z04`YL#?9n7XgB(R$@R;TKeetd?R?x?LAgNkP?rgv$DP~L9b;Y2A?T7(A-wXAtR=fx zdXD0yk)Ky6`xUaapy!hT4O$foep@-jkkRlw%D2z(f8HYZ#m}~i7(P7 zZ<~i+Ppg-*u1FX(k7g?$I{5iaf@wuXDU=IAGU=~g$_1TYB4l&{M`^JPz4H%a6+vSC zI#+3ZkCR|F_if0|quseVW8(u;Uo&|$Y`@w#kfyL5Za3FDiTwCUJVEa?U(!OrF zq?meyEnZ$g3PtQk&{x(9T{3;wT;11%74Nf!nv=s^2oCGzcJL1C|4|s&QcT#!3jUdW zxwT!0wB$p~8uPIG7bBQeiNB(9p&DUip%l*FdUdE0`qr zlFX+(UA)m!I0qt{imJ?!V2Gj3o?x12K&uEz^!t)e%}|*tgVIhfRGKQ|@>y{@1Ky4~ zC`>B$o-{@F-wUUXi37C{T=)Ft!0*q^{Je3BXes`E=J#m1>K(Y60(m%6)ITvL_m*>D zi3Lh*g-gN}84zT$)|54U9+KEhUfGvQsJ-^qr(MxiO| z%`M@Li>#p$Cz9CxkyDurNUEy+h0?{68C;k_Y4X9Wom&u%HIcS=Fdt%OVfreriOVRE zB5YAOV2FU+2wNBRDxD(eUMuVg(Zwp93?HYE4gUjhy7#+!FW^$p&L0e3p?Jx-JFWE-}@Ted`a@=}|RK!IF2MO7wl2hq+mpqdmRX^1IP)X)6 zbW)2>%g}fuXo&DU(9>EWDUqdwXy1)i8-GPQ=Vtt7uDOZz#f`cE!H32X&z@F0oY{@3 zV0O{QZ~jv6XnoC1FL)m+MLn+q+aLJ*r1PqKEDw3rGyZ!}jHdh@LENC1-M|C!sW097 z=K1HxZ{*~@!l%Aue_k{$jf%^vu&?I4#Eu9g?(ob9y%AXCAb%5ft;5nd{l0fn?{!$7 z4EYdit>b;o;`@rh`--rJ=SL^L?`<;jBw)p!EdG7h+jw4NQ7MP@-@SVAle1QKGNbtw zvK?jM=;%|%aGcmVla0h99S?mn8RA_5$JM~#X&s(^I&1m+k-*LMz0c%m_BNF@VJb=0 za+Z32^BsOZrGiiE#kb-MjM3GZ1XIIDBhI=GLBYX4@LQ%bQ&c`1NYvG?6o>`1+8^Mg zQCf}`2rW%fI;9@`iL!Gg;;AJ$d})5|Tu_#3HnINMRsE>-R}OFC!t?Fqc5Y<%9~&si zJKpppFw-`tP-`ph%?r6T6)TU2&DcjT*-q4n&-zFU`N?;5mqOB7bJ)dFVA~yO2f;IIs1;j zG*k3I?s$2_U6wV^(5g|R=10iCc<`Bu4Y#QXMz9dvZfZk97S$^+6};0COo}EiU8$L6 z@3bH0D6~8!%(CQ4&-`(}vOs^<*%7$pq!MCHrdtUgA1^MOPl@@e=?7`Z^N@eOei|Z) z>)U2MKN@uRboTiFn<3GJ2)jhWFBc9YIpSB@6_Lx~uf(_l=r}8shYHOtOKAxUqnR6$ z8Sad>HO*##TZ_Wfk$RoCPYUm)A9u<(B5AZb#zsi4N`Fn|Au-8YVv{!A{V0K+Pq*PG zjzV8q{=!5xF-i>P(N2uYskmh^P)*hRzE5M7_!Emt?KT)4Wcr?Y_NW!d$Y({Y@yu^u z?)hN5rgwUX@yV5wYQ^pOM%3;%_PFNT*cuK*{>(&k+13T(s_!+EyapCek>=mtR|Cf& zb~7KuokRqzQ8$?gDziO)GE(0vGNniB2!0Sm|XIWBbSnBIW zwV5;0`Bc?)eiy}|>m@~P;9Tx>9&t}2`{?(lJpK#~N^51}x377?DOtK!MoY(ZC~BQM z7W^Z8ME{*mI_$S+)ig(nu%KZHhav|(8tw1367_@Q17E4%5)X@0FsUvUonJqdQjtq~ zbww7$IVt$j%zn$%@!Dj+!u%Kfw^GW|Ss;xF9&sfnb;(9heWF-jiJX=&{_~H>hVXx9 z14%T|g_M%fWHBLXVasjMX%=78cYHh7%2!eazw^cMF|Zr1=GP_4QTAvGn(K-VZTFL6yI1-3Ht_92f8q!N-^J9+kDM9(QZx#E-qS`HWB&~>pW{WWj zb*jXevuC@$rs8Z(6uc6hYW7+}FilK=eg3=1hTTt@84>>1<@y`9&k{`&v(m1{G)dbG z`&Y~47HzJMla8+a0vEG%v5VfE*u@Mo@_#n%SWqMI)t~ktqs~SbfjY^UE_-3acT(@& zy}S2cp&ItlyvNSoKzNN5nMk)(!ppCzL+Ebx&80_&--~g7euJ%U zR`U$i!6&h$Q_68ByP4{fon@Q(M=n|=Zly@ey4Em4b&3XK2A=jl*EtD;vL_wrtcqpX zl_^xG)zU=AQakB{>!R(~AD)VxHZPB&@IU;g-u(Hjt3NngSe+d*uo|y2Ap_70=?{~b zyS_Q87EA4Y!P1(ZkS*^9EncTdacG0bMIt=V=R;4Wh%9rvjz_jsxxv^map#u(M0)v5 z7UD_WoXG+7el|h$)~DLHYtw(Q-u^YgP`Xi~z^z)=T@mgZWv@ptYhyQDnaR4o%J$!4 zqvVQM&SQb*xP75+Yl~I65oz%f!wsUT#XnsuSwx@y6}v;HM!UQgJN5+hx6Xt$=49R#`zm>9PyQ;VF1pI>lp9d}+9gEx8lvP^ zu_1{tYZ;QkaXpjL(qFnBX@YK#xqB-(1mAVd;$^f)h!1~gz}3HME-sQD-qx1j|I#Ea z_~6#6q+f>o#XZld`ZML%i^$ouyz}{hcl5Kb4hf+(pi*_A5Jg2%;~(#k<+#Y$?EetG zi%-h)p9x~&?fr;a zJN){TJ+xgtaA>YA%-FIcrs^(!;OHs~yN{!}$K*cQ62P|kW`W|3~K zKTZxy>~Z^*@lM9kN%S6*JmeyWU37#+RqqX0AGuDeLt53TR1MQxLZzH)ql`*f$Vl4N zQ03)hDQ7truKnlWlOQ#0+ErXLNRP+J3|duFR|n$n<@@ya-1Z~`#U+}nv4c#>6dPl7wXLs?^{jkvaxz@4%McS&AnwU5rSPnZZ* zg=4)T#I5(b4hFKNCd$nqY+7E{TYZ1JHEo&0U!WQ`-zi;D^%IB`u73(xK?5YZHgegV zbf#Hs(qOXsr7jG580ZYwA)h_W;l9;}z3wEBsHDAv*1r7_57k9ZuHlQUn+?v{en8+4 z`~WkMU3@dS8Jk3zgvW;bG$>{$;YBQC^B7gC*k^>{UkOL*EQ@4Ee6k}d35I3_*1*iE zg^3^EfsxM&B)lGV04Ws-V=f6Wn_xr>)Wk^=AiXIcmrhIGhCD}#AyDN!i zxUfu%X4e?h18G&F4t=pvDIfDK2wlA)XNBtV9bBq2mB2_6YJk%I>MU7;f!*$qpi>ty zxoLVzEP-8n%@AJD34YBSe`@NP zxCu%`6CXN7^CeTirgpA4_oL%&6d=)Pt3FagJts^uQB1lwy^E(wIMF?Gd16ASLL9s& zC)u|gtU?*Q$Be#2L=hhXlbs3u`eAaP0@T*b;B4kzwIP2x+E`}C6mg_SOaQjLsQUzQ z)LYYE%VN#11Xb=-WKty`wt{Sx18X0-)=Y4cmOMUah(mKweHqm4bLtX`G+`{cWxxH@ z_%tuZV{0Fm0zla6_7E+iD>}FqqKVQp+LgFUei5tV4oK*%5n=m22l3WBms|qoBI8|& zWOX-&0@L~R4(=7uNZ5|B1y;x>Wpzw}o324#CT)XXoZ;kVNWzS0+ogczbrC>J>M0=p zH6s}x37D;ncLgxN3I%2i%y$cLU}&M-g3wK75D5%{2+vLt2B8qFTlQSwt4p#iy1;y& zKoAEopLz{=Yz1ozY>1oU1rC6RnMUdx|YeHPLu0yu9UdKFz8`-lns)de-J->l=k ze-yRsB(?8rN7W+}3%D4vC)t`IxTiz;ZYZ$EA4YgaEVCd!2m`6+bEv~!{}SoQxmnx2 z2P1fro$)R5Pvn`J08Jw^h54}G~rF}|=rXpE9JSGEP z1m|5F3Is+yHu7S=U@DycfIcSP-vujxavwkB&d4qL!_m%O=eGGLJi+PK7y?`#==oH= zo*je=(HCF++5`Z^3S|@u$9jwg24P6I1b`K&X`i$Jpg~9=9`%MQ5TY@Xz(sr_jFg~b zyaZ00p!-qvE?LeyR{lPf&vcXbm-Hm~C^$A1LG?uVR8lu}As4Ux%q)&NEo`f3XpoBdwjc3ExcY=wSD{!NG3|TkC*fh`PkUJ=t=Qwsg zYUBZNEw^TZm~>QT9Vi9r2jiV-OEmjW%;s96j6RM$hvE(D2G;m9R zGPdtqWe+sgh9St0Wq~zMS4huD-6TA*F&b*tiC6EiElNKl72ki|NPhO3?s#(n#{Q!1 zg<~bKH2*7ANXT^~sbd`t6(m~5n_}C{^eK|pZGr(K^N>_;f;egJMbfbg^_o%yU+|-n zY|C@#4h4Y7)ZdycX6r?hQaaXS-&F;`*fiJTkpaD${dA-1Oagh}{%a=aNyj%Vp|Auv z!dh9N^V3|Et2*$3#cJEPi-Yegw&HJMvnn)2H^V3g$2dpXG z3C3bxIz>;AGdz}tec6N1qEMm!ryGB?t0tg=;(xmF=Z=d*;}JRlk{wHwd7byj3uy0@ zK!B0C%@hE6F?gNzaXS9dEFcv@eA8+Gb~l{!_INDHo~~^|p_dY1;Lo!#nH^H(?duhL zfg80L9{AKgPgOHR=#&0Lt*kdY5INg-=M*$2iWvSWaKp~KPqe3F+lvogwCw>OQwL%!NufI7<1Q-xUR2Cvz!9zG=)tKBiG&z>GW zbIKv&4gLxi6hc2~zzim29s<=quZ{`uAIFQko2W~iK?rivHe?sbR}jftj05UE^%S^q z!m5LSpB7<1DChax;%g%^b3u;}viF?Z4*@lgxX;NO7r7(Onxh}2PVW`QXxH(Ac?=%^ zJRaYA6n#eqPa5i2xh=ARmFGTchfQ_BwerWb{OQyiPRAlIwE-4{i>zTrOu{8| zX$DPDlOEu*K#GTd&-K6LFe!jl0B)RZG70icJmU?y;Kj3tc*xvSZO^^l=aIUmh7j*- zpoq`GMLWp@YW%?*lelle_{@hlXtYm?z*ayCO*Z*Q2AXvcIKe)X+`SlD;Wx1OHINa- z5q&8&#QRfseZcvTBNFsMIJw>Kmb5Z2aM!Etw ztpYU*Kl8!q3t#-Js#r%wFF*DNaLgIzOK|55Xk9HzWzgZp;1j94_VRCl@>Kv8R$e}l zUh6GO-DLz!KC)atn}VeCNrnbS)EG6bdS?K@v;;VWe`_wt0O9n_lO4Tpo)XA(l*HrN zF0(m$ghZzrz$AM>)^P~zDxxkFiY%cIY6tKE{AGFc_>GA#`>Nuda6k>r-4pm`Rut?Q z!54Smfp9&;@V-?hU+F&^IOHgx0aX)Rvy=4I{zF$2=x-{CiR2yPuX6B^DBzLA0Um@a z7|<$${jY-%)TAqqPGGMl6?+iAPTU_bp_iwQ`={Os_Q1c<0W-*DUTXqNkt3RX&Oc4v zgo$e8(|Up$64>g?{XluaEB ze0kQ}9LzHB=<2|UcfCNk(^Wn(Z4Sff?}u$M6u*EB-d*qZ7QF>iF~>vRR+oFV0ZA_h zwJng@5cE!rZjvntNE7i8eZV~dB!&V%_*aA3{G&Q=rqWXJdSNT|MAl+91+zUjyhAqQ^@YF7qulss*9_a>71UUw_Xo4l4y|NO+pr35kx@o2uh;Y&Cvc=QHfY>ajV1ABsCdLnCdbkJTg zUBi1%^B-q`bxzNKs5pJG{9^Flr%K^e3s6jK%>)w=<}VAMMS?%&gYEye8r?q>E8uGS zivqO@GOeE~paJ!Zwl0M#8a)u4eX=js^_%(N{X^PwRUokD4=kw`c}b0tc?UFCHGZ6M! zJ)k3mV1Ega1;&0910)s9Z1K_C8uOdNk7_cFG&1 z-$dOX4bXV(+3z?IAXvbzY!m$RI)B3XJ0a-6I|Es`P#_#PAIuiw;Iw~=p8!+-PgFcc z1MM?Q@c`)01;b#plMrSQG9b$2Sri1pfo>7!p6~&_0e`k6xHH~IVip2_dyjUmWSRnN zAn2GW0TWDw{lEY=`Qe@w-*)~-FQA$Uq9^jiNgeD1i)?A(Bh{~b@DCQit4y$ONpjo7 z-zq&3ROL$s@_>-f9FT!&HXko>ubBvHFX!YvO+JaIzg7m$;1moV~j^Ccp`xdQdf`Muw0!khLy`>`BA9(iv zh%+O(17Bm!c~FvwWIj1F2q3G|t7pZ=F*xlk8oLMt`mMlG2t=z0+=PBI5Vda z1*W>y1`ubL(U(sDMLRrA!Q`3G;!;x4R{WsFR%J6+zQb| zn&=wD0Dn8VOC&G{7hD4ajqTVj@qO1-cd7zBmB7D532s8TPyWokS8%rk|1!WmAqW6% zAHXwc{WAV*;lbMgRe`Z@xpRx*r^rCjcL+xdsG|8A1OqWo#y<OxJf`G-U`C; z1KC;y;3VQ`ZL!Qb)PwCe95UW|Ky(0=q{?$$Q1VJ#0FsbqL7j^4|8qzT_GXg$Id3fW z!C%SQgaX*X@y}3mt*Jo-`x=7|07ia2&)kmzC;$v1|F<>B^VW_x|Lb&Ip5QNF^%Bib zaHO`-J#TA>z#4gg=0ixd>Sl#RiC=;2Tzwha?hik#DLfbC8Eta)JI}->QqAi z<|(lcwlbx8fY+E)7nrK(wLBB^A<*<=Tx+nHC-Z6g^Qccc*aQQ#?C`>uOyf`dWbc2L zb3pRN2Ht6E=-Si*^>juch)vxdNZAGvL4HY!hiBnW0nqOrA zt9Zm!1)?i)7R}7(zWPag0PvQ+|6}S+z@cp4H(*1ELbA0Xgs~-UD$BGGS+YiDnIcIF zmB>20r7TH8k}{SNvQ;YCW~5M~h?FcDk|Z?N88c?)`L1XB{lD)!-s5iPGa`uu&a?5Lv4c`NkgU^KlFl;pv?at%?K( z52shAB*F?$seaFEtceO0Ac)$(OfiDJ!f-k^Exo!wUFyM@iA?phWJ!Pcm>`c!ORYn@rR)Tln7OHtKmuOT(mmXIICSwG|tWhPGG)gd@2S5?1Pf*UNw(nR5) zs=&R2%>vV#;nqblbP?**QfR8_Be-or9j+{-!O?}WRt#O3I*Sl3iS|Rfh)g4drhb~H z+>`~+PHWP4#Sl?_DbjfOPJUGMKGF>=1%vG$Q!r;YpxX@2>+rloKVe>uiWg6BWwxQY zMkhvJGm*iPXzYQAjA#sLz()cT=Fh{L5Z3e8ga(a8r|l=QvcMoFy`OoYk-Im^any>i zsVfi*P=*o_IuX}&C_0vy-l@^~jWq;8ov3?IV)v2>;#U-)>)MtYUD0@q*AYuukL_pb z%Yv~tFtnANn~3=QXK2!p<9Ya>NOBX|z?75otK$VU&~syUswP&jrD2gu(wr}7@q-;o zHoL&%93xR2d5*c~2!t6}YXX`E9^jB=krMVVI|!J7)y=FqiYk`~E`><(?N7mwZ(%n?LNv) zciVP4!Np%noha1)0YBd5$ps(2i>}q^QsG4 zK^0JVpx)e%!CS~qc^mQrzk=Z4!RKi~<3^15VChj&C`9NBLt_j)X$?hSDDzH~aqOwB z8RI)+O>RwpBoSJ&2skd!oDTi^9*9*{J)c@o^1HKW# zhX!o!Lp1jIvIKP^#7Ff7sUw$G3?;=ri}ZVA=K_c8eIspIdh6IuwEWQGe|u=xqH*f9 zW^Ic_PKwD5fW&?*8m|B(aF=O^$Ugwer!pVR4~xuMvA93C3>Suco0CJ4x?XE6K^o4A zf&lp*ww2D8^+HavV8m0)(3-v*9EebBJ4fviYxD3d0O~R^h82FYY&qloi=Oq%aaONLdNGuQ>FB1V*U>*0$sVL7EJXx>@&?rg zJ2du7O&`zSKqK)6Rl1BIX;EYrCm?$aLL1-XOE2Ils<}IoDMuGGt%-PsceYCBKx5T@mg^nQkzu(%okr+$lFsn578AsHdeFv=) zj3B_xE<)Ry0%)+9y zClI?-(;{eLE;Z7`)2HZj;@l>#+Uly-N(t;7;g|vM6(W7KS6_>wSo{;G`y@~x8sl)> z|2SjDHkEA4dI-^XWtq96G_cSf}(W{+$e6bR;;GXyWEx2;b2OpI1;;9`5q@MmifHPa;XTBA7`fH zZPPiGqr_;Z1#;Zhww!8*NSp zb;jqH3hyN()&q0YuhWa>M^>+8@|Yu9g46aQs&A)SDMNH@C&?b#}emH!6b zzW1Gy3@DOnT=Wo6B%zlLXMvTe4PlCC{o!SbWbOxw)k%C1*WK$bS8}zKQ`Xx-P+$Rtxk9HQ5DUVOu#jT)Kv6#+mL zit!XnAEnFtNsYS7#4XxK=UHZAAzUgoPQ*V$GTHq)UCq#7>$|+O;H)-BR?#fjM*9}U z-aJLH6n9dqLo}p~6dkj06d1utP9KLZT*tgNadsl+SrnZK;oVj1kHwPgQI-sr5_?AN zX2**d{Y?Po+LI;#fu~3=TFWlVSW@0xvlbr{9i5G&FCTSX9XEG%R#VXPK(O@9j+20- zqnjVS4WN4JNT}?zMy|2xEN6Pns6I4X)wHX`380i5bDxuS6?l)0NsU>!Wq?ROi(1KN z2xvBJO4f9?L{U^qqHGaoU2YjsGa=Xos^O8C9tdITDA2nncYsHNWm9(QPGRUhnJu!9 z7V12xcAi!(K)#Kg!1q~zuXXuH*$wfdNfswNLnTtA8?c0~f3sUq}> zJ^D{(GaY$exyI2Q0`+3hnLwAf6E&8>)s+G+u{Q>a8U`0iu3R`E!hCGHbp;0ED+_PM zR#u68TZp(O&aXq^Z~C57T#7hE$YR7*=zm|nge4e28|04(RHagg=?vzc)WN+h9SBNz zI-COvW*X2NBv5`_4>pb_$U*BRn)ns5p$`P*ahw%O^)Lf~>S=-s{KIkDJC0YbJF>KL zjGc7h7qT(xmh@(=3c9Ikmk`=MwT=}ux#y$hg8=lX7dX&-d#3|wl|rLLpivA1jZ-Dv zR4XVf>U8?NJ}e3$e*PHbrbGtUuhAdKEGq`G4T69Bl+00{$ z9*_hmE6`iy&@p6rcq`Qsc+z7$0tU+AHpE~E9FYUO)e86^0mGSyo#jLyHQ)vDR1Esb zI|Y1rG(J0m#Qy3?Lt%{$HB~Ok)%@Uu$)bsgz*`9`=T2$VzOMzgLpR8`9kC@5?D@9W z4dIL793dERLE~sdb{vmlTf%$~41u)=HNMx^yaBrL$U|NXG|ckM(M9BZJVm?Eq%OQv zv8uM>s4XkQ>@``(1&)gBWSy7XKZ2wbU#L4(=HOe0|E>1nhhkSu(N$J(B_`6u<&t6|4-DFF`rC!ze{FDk=c|@F+9!xjDR~ z*GLzlGHQ+(n4X~-o#42|Y()<9NiUOAG_fXi^ChwwsSQiHgY9FQf*<5Z;ZYYv7g7Xu zg8s457&sEMm8-_B&~BKMA~UW5xIICA$U1g*aY|ua8{i^W3<6k%GF%vwK8n}r+6TKR zC5Tw%>Oy8kU0}UgtpgadJ{EZ4mqbnNdC?`Agx(QvK_6Z;-x|y_%BGnu8HXkVwGXdq zp9pEm!r4qjWTE^fr8np=ZjCPw8>Iv}{2R?Vp5>TIf{ytdJ|DLu2{IE-4A2hr4Z2*B z7C{|ADJQh#-wu~Xk=~M3B?n(JVaFYJ5g*^)6RkZ8Jpj+doHVArSi>t4^t6^8L!j?E z1lw_p2f^Y1L>>CFNHO@LBCW*>(Kw;Lo|Wk=V##l1cjV5!LdxfB#E@}%oNB|pS$`l5 zJU4auqY1JZBGo8sX?3dS<3^yFwJjY?{d)usZiGOkdLoZ&tJ-i3+yJ`#wf27zH`#?ZtgN?X zyoc(XvQh#NP5eJvVg{hBe-(!*;Ax%Sp*Y1?LiReExy=$}| ze~89N*loW3KUp0`sQvpI{S#&vF7@KVcykx1_+`-P7@)=N1#@l?4{K0Ls9qgiT1p_w zjbB2ITw)Scxd&mbaH3b>R3KrgWJ}g%SV9FeHVUK=q=Wv7x+A4mEJ^xK(K7b8aQIoU z0xwdZRV+43+1zEQ1)#-UL;}5rEg%<7EX(Flb9N3y6*>k9hj7Ql1giImOd@ygkR;nd?mOksbo>=3W4yu(;saf3t=d^`#PBl*ZSQ z9jOwVUbhC3%+;m1fQ^Jiu(2Mvpx354ar!0h`&m2ozK_<9(|_z<2Lx#PF`Y=-<^4y!7#5v9QY3u-US|EDE1|p-P}M z2Q#n%G9)dxSote%brn0*X!y=u2X0r$9`ir>9P#{&Ye~`0B4)KV@ZEI+m4I(e$d_b- z8$9EMn?b4J%WAkr+qW=ya@Ul1sby3;WfiuAavtr%Ql^c>D4*2{)s_*>%pwOQYj$xG zZA~LQxZcq%%$oU$7X5;mh&`h?#Xiji=B`wR6AyX=8q^t{a51J3IsUi!Z9;~ns}m0* z1D^T{&F+;Vk*ItE_Tv@e;T5vvBILunn#g<2ihrxiHMu(N`)WS)D5(IogGrCKybAk9 zkexO+8|KAQv(5G#WLd{tTv|dgeFJmuljzKQUnst-c{Z-db@SS+Sp~sSUYz+lCpZ+@ z7;xwx-lK<7RUz^VyRbGX!IR5vYxiv8EhZz;}XR38*594YPaTv<9rhY0Qy^NdjU5rqncrwh&ecvKqV zGAOpFox3{o>8Kxy*>M%-%4f6EA&)Te-~310WC3UO6%1HixKK4pXl7E!?0E-s2M}L0 zVUGz6?t8xeCuJ{5!68}-Vx~ekysDtZ?h#sS+e-l0p4TSF=v=|6+_V(2bGT#Y0|t}N z8?Qj?3(c-N6dYQJ(N|4mFhx@T=0OmET4Nrzizz@($M(_OF#H-FkU9;kB|BDR6%{C^ zO6cY3!qLi5wnT|@8yD6l9AgtU58wI0{w1XP-46Wj7@{mYegoYE+|Ua!;)WUf-7OQw9upgpSj#kaLlg*NaO4hO}Vlo5UG-^>dFO-<*vA zeCDy0$znALsGS{u_ zD+b$EV8)_jxULEJJieI0D&OIi%A;Z3-a07q6i_4?J>H>Kg^3DigF3=LPH2&PYAC`+4ND zL$p4yEI{&3&>g>Nmf_S-_aZA$y$pVG_;H9M+FEods!E{k$YFk<^-%Trmk0t<15j!Z zH8z(^mmXI|WdaM79=bf5Rnh^dz?YR*m7wueXFLAy4WGybstZm$dGLg6V@T`KaZv%7 z$e2ka4wb18_LD#n1qk;B`EiuSQx>U*B9wBB^v`)U&BL!lD76qk?M#W6E#NzW1LP%T zA-)e>vxI6|3EO6eo z10~L1(mL~SIezY{lpUv`x%x=VCEO<-Ua!kv3u*#rGf*(wAA{cqYn2SMHnX7rVlh#c z-w=Z?Dso=6!2?cMKmUXg^oIau<5H|i%zyTVM!@NzJKU7&Ln!||)>Pn%CV0P8(!2x8 z^7k{P(WaTvr6h#xb5Zyhzvpkzot&aopijYq?!B)*pTaidrqW z0@as_{gCoUJN1gYQOq6g5m$7ncO=flvQ!KrI9zaqo2yH-=_LewdLG}>ii zC#$5UM^7R8n(mIz0(avc+cwbwU%03IMNhRH?T}AVzIc_DR-!H01f~+ua>MxUgQ)G~ zCkcNV(AXgYtNzR4MfdQ*f3^#PM^mIhb$Bw`IZ$3}FKYtIqQj`0qcNgg>ZwB6V18p3 zEO#}i)~W^D!y8#o50E_4X_)k>z#>sx55?NRbQg}%#1CqlAx2<3q;|jLpJFBkI0GA! z4hl?-#z2ta*6n`{dbrAK3E~Xt6SnwIJT4-psmeNz$~3(D9dcS@k;_g6;U8 zL-8c7*P=+m+1y8Z1+7EQy9-m$BU+q;tr4u(a5)r zALDS=B*@}hbIblOipzMqgfo zIz1&NeqI1Qt|JH<3ISQriT}Y_dSyw>b*;VWQJl1IuIYL(ep~jPRg`*Y=Q(+iY6GO zRh660UwxigWH}1v5d}S=w?+8E5Jl)6E~WAS{RPN?A74N;jY_zl@d#+eP7vm&7(}m& zu7zep#0b5M2!8ZN4v{RtQE-BsDbO5Pp!QB7fvViAe0#Yd_nAO$ctw8VAyWU!jWuBJ zF#CkHL^TH#Q|$FpLYJ&i6x?VN@Ar9iZQ?e7_4 zN9`H;(7`-TxgK=rJ#Um#>?iNH7Bm@!EC;o7FNU|lQKhT|(%Ci_AI5unXEsxyaHixK z)DW|-f@Im^pOhm*j~a0*rj)zDE3Ey3R|z6oPGBkjolzfdO6h(c9}JbvLZwjsee55* z56$;o_)LBOMn|+pbrT~fep%XcwkTcyX-K0^td%>JEHJH|pM1@_U*^)|Um{ezKze_* z*mRtkf(&IcLUagNavmqfP{u=qJ&ppIAbDgrAFueeM;JFzv;u;M+iUXMXZvAm z7tj>r*{Hwq&kY7M;rZ2BLnt1ScAWV*0*8el3aeJPkNj=o%Ot9n(Zx@Wo@JnN$AHFT zQjuKiJ|s?cst~ea7>9v=Q9~koIMTu^1YrXlWG%;zopV4TS;_QPx>aN7>V{P<$k|jS zJ61#t$WqaQFU9p6O{uX`XlW260L*30oCCb|%Lxss_i1;2a7@LosN3hz3^AVO&pRzU z=+UVMwE+KpN%Tg+%{imxS7e~|xX_rLP;s3tYM$uGTbJujSRRyCEcHiOuwEDxFoGy# zA5EQ+N|KePjVirZhMglWDGbNs1T6wCI9Ps<@DA~88a1)Oc;3(1pWmJnpMLX9<&=HKbEqS(~(nDj`CH88r;rdh}?HB+ZE+A6)=?=i8I40si3<@X$bPBMOTz+ z%oHQ&d|7hIDDrqp4JC?pCg?AE>49W z|2|K4(EBc?-bEek6z+u_oCxtbcz6WB_9RN5Hn><9CxhYUrsk*!9RziuC-M2w*LLjG z`kn3Eb9O0#<c%(~6*pIxUbdS=qh%*@#i$7Xi zojA3bv-BMsW=ccKE%nkNga2?X|EBZRvl13XF9u~bj_8~}A;j0J$wV~uO`ripXqf5H zz+8KHDL|-xHMT$02!@K*CqIu`;nDLq7Z}KzC;&hqc7y8N7Pi(1-6DowWYqbXSyz}d z0rmuH3+^%jJjf90tVv2#@U-g6erQ0LSRgzGM7aIS(>bo^iKw|(r$aw2lHcqg1M0Sn zI#QDsi!y+CB z*=*9hiQOiS$u&xAP(7jUC7!f#R3G#!CK_E@fVn~styB>PNwUrngCh?EFn$%AC~zZ4Ur=e*_L*ND0aYeG7CpBJ)GS1>HJ+tpu+eu z6v$|!2nERiQ*gL3%B&|XvSw$*eM>vnA&6K)hzK014twA|iNaUbcYgdt8B3UVq|!n4 z9AP?y$sM35pyFR(4!IE^oO6UfQotbS7*KN}Lk+Q(8(D#3#EdElxQg3J!V?0BwrF%U z_pXa-4ZQHHme9GVcWR^mU0}&X&$&rV&nk7~L@zVjEPMsOZkaosYKlr813?henei$5 zsd7n_(P$+E(S@C8EfCV!v#M}H%7sJF1OnnB2ei5q30=Ga5RS`_o4_OmK?<#eXQC?i z<6fDvW4t0)QHU)F_Zo#3bPKUC3y+!A0qW%7Uk_95Eukn*E`D+{|UnN#um(?^JtGy>o;zt^2Xip<%%quCJ7JJ7sF6b7Q< z7b1ubTTqONOCq4#pXG!tpO(*m#k)Ip37^MVffiPPS56?}L+Xtki-zyWyyR)Zwg-#_ z#Zy-rd>ERq&a$ zL)O5QaotHbv|yHE0Rds(1Yr%RctLW@r#1vjqprK5L`C|+n2&g>Pbo{+}S?5J$fq9g(t3XqhsGseVZvi{FYRE97H`mf*_y@ASe!HCxjeWk{1{hf+}a#v}b-lC|F(o$m;|J z(7cA|LRJj79ug`E%s6_TyOI3go2x43qFako5E@+OJe$P(>Vb}9O)4`m zWLfMSkmk^p(AoeXNN2WsJ#+wkw!(R60MUu1xWp>k|CX95^@~*6$ieh1y6beQP%Bjv zM=sfuU`C@2x9o}@2uvo-5*>IzmzqMS2J9d+yfG7`R5chtJ6#1485B=!9oqtW(plDj z=ZFsqxapwEszx*bZ;k$HhZ`z~n};j(K0R?mO{qVy;#}hKDTAd@em7nrRv8 z1o^X!;u=4{6J^B=Aw$fvE&Bd9-vb@-6?D#yumg&j-O=w}bWET^!=9o*fq_lbiNM|D zK-qCyv}kB$DoI5L(6VKrt^-vmuEemMKmo{!E4k8kX6B!P5&l8qj9) z5gw-Cpbdy|F`#Yp;SyG%M}zjB@m;^`2HN+0MQ#8f7NzV0Wn0Hp5@NTScPNwBeC12j z9sXCZ7_6;C%OOoPkuD%wsirXS2^c7XHXt~OE89Bda*+-Uc{M0+=VB^Vsbi&GJj%wd z1L@GGPasLCT=<48`}GVj1)-tD0ZyP&mYJ&~A0;_bL08Vk)Ry@+l!;m~j^RBc z+Cm^p`k>I#?jfTDPw`pvvI;{jWGj3eh5N`QziB=(l|oz((701_f~1SeSn7UyH#>x5 zdN89iz00qdbjDpbp-lKFMx$)r1WbyIF_u7&P`k3PM|klfbQS>s7>_Qb{tk>vv21{Z zM^}%QF49BZr?>i+0xjRpF>>eiB-2$9o;fvBmJ`wNE$J(MKjfBSwmr95bqb{$fw)o? z@44}ZnGg)b)xVUNiJtE^w36qzYWIou+}PwoP#o1)>08OI6Nj^DdxnyJL1Gk8s|7p? zb>M|wNnz)p=~{*gnYf_5#!z`7HT7^nc*b?X@l}ckaFy9{&8F^7+Wu}K%*1&X|3*fD~ zuQB*|F9^7K#ei=q3!%|j=6{KfuodVvpQUv|FmgsFtMwDCNZZmu!#Xwb96n1BnO+S_ zruV1tcvX%y%*X{Oj31^#55~BB1LgzZszw;pl7;Q5Ir~^ipk^eZg#ZzQ76OD@`B7)^ zf~5plGMJiNFovn}xQYIS4u$c!^gzK;HXdk`1(;ez6K~=F*&~6D??p9ifW+&T#|=#g zHbk2=#)3H7bp#YIe8|+SSf*yWYTY3v~HK(zxEtDwDl-StOc!wK{S8n2-4gng@A4rfxlVEi~OiHlw~f+ za&)t1CaPof)z9u3`d z^t=Z_v;cZu(4m0J0%pAJo>c})^Yq^M;Zq6+$}>>(-rs!)RBm_l!_LHrYDn41(!Bp2sQ6Wuf~b@GBB5-v+wcWv|fqk;XvGwsl2fH~O$`k3gJ%+#o;8$pNGOGHFl>H`^r7sFd&S7<`efq$bksCw8yQmP>+pock04*qC!0goF$tz6h2*h@ch4Y@b1 zT*oGqTi)PXitI}jkwtl;MupYQC?C3jn)%gE!VWEbdxRigR@m*>fIh$AIBv%VOr)Gc zT9CBpI+9c!Oj2qh=_u` z7tp)f>GY*=e1S3==@>J@sk?U_R5RfLDXWPt$Or*O6Vd5TBXkj45&mRiHn6L>|4k-B zSH|nWz-5(?F+pY!8ZsyX|yS}5i%LF2) zYJxUNq5p0tL$%@lESjVFX$%kfA96I5EohDwL8sPvFiv6Uz&i`4J;JOO4>=2(Z*+=? zcAV01j8yFyt%GV*Pz=Nk6R5dPfW@C2pbJuGX=q6SB0Q;1#f_+Nmk5v8@L7uF&nQ#& z6O1qv8jxU*fmG?Hp$~L!cuR$=yJC8%-LnLq!8$r`6E0-IEpyl~|w-CtM=~7mJ{SM#SMe z2M~M`M4fhyp#P!}e-4}{KP?PxHX&)=2$jHzqR-*r@;p(=t`JDUXIU{frC{b=7TbEm z0)sy&TT!{4KOz94<5ol;t-&bTEv?Hq#O*waYL-ne!Q|ks4(pZ#yw_Jw2CEq+k&?|f zBcLVBEHu5FXnbkFviH_o9f^tW(}h~c3cvOq4%-^CRo0fIyEnIFpjkAq{!e}>lZg-i z9-AcPabY2rm&E)_vpago-%Te<7oLfnT$L-Ed3IjYzy4e(M>AXtm&C-Sfn;&PK}gA4xK=J zmLwP8>FV~93r2Nak8(73&tH&a#jJJiw>jQju#Xxq}fp~2FQTq!sUtB$2bSSlEc`E(tYubG@plO&m_5BBDecyi9nfWtQ z1KoShd*^0fx^>?v3VrhD+<7~d7E;!RXNRr@ec!>DH@?t&ny_jCGO|5UzoRcCM5p!5sV9_ z{GQDIHTlGbmR!a1QSgjxZ`o40Dx5PL zT}2H_whfK13n?#d+B)#w*{Km%q}5nev^GV(YF0P7DcSY&#n|%3vgeJPaqV9vwB}5A z*(7-AIRF3t2_|a?|EW$p!#&GAoD#j_LUjc14B@V%*Ngon12x8PccqBz)8E?Ouz$r2 zbWZ5RCR$opqoo2TVQtSiZk#|=wTr_cI}?AYED;PGH{RZe+cwm98cfA5v3uTJ~y z;x28Gd-VCi3o(BgQ&A0LYuCoP2W!H&%I24!8h#kJh7i!6cN)=X>K#8C;Jv%^^0`8> z!zsVt*QRHMD2`34C>~q)6vxYX=%^#xu!t$K29f-gdjjj(wMT-QGMg{;R=J^F`#tq}L5Y z0rMZjb{mAcRWR4Eth*vse(z;H%j?Rqj@bOYH$n4KERRvTaRPfg`Ez8rGyMS~O?%M0 zR=(+@-{;UTRjUFuvhlbJCPh*&iLd)tBzJku)Wpx-$=h~l-+J@Hw%(5xO|2uZ7mu-z zcOO(#{9()F#ga11MDSZ>mB*Er-(qMU zNFb%Ooxhl&Q=1`|_B>9GJ{iFz zWv0fRJO`1`nHzdCFCPDXnPBzv(GM%yiAA$rS@(`s7Y?7f6OmOikdLv8yV%*a*LN)1 z@ScNW=H>|*LXCpHq|MQn-|85;1I>fUSg|YCy6?Ld%Mw@RhI)5f%{=?|41GvtZqKWs zE2n=`4U(*12GZIOW<0yg3v%Yrb0kCLBs)FJvklTJW`#vXedaV?`c($F++J2GDKA`q z5G!*b)T`@qNKIdJEm&jM)^%bI2Ypo6N?F(~hHaV^3)YFW_}`-|uOCRY{9vq@ zWFb;sCf#wjd+EBDL8*;v&);*+Wm}tADI26(OpP=p*3gHV zUw7Jj9w|Q*8vl7XXV9UyTJ7})8&XNL@ve32mP3t^pdrhJ1h9H>hF1@@X+AP zmv8;t+MylQIx;Nt=Dk>drkjjSotTG_;6tO@J)yxJc z?e>{~TZ(dLi%-2g+_PjeJv+Fy`fxYfUEA$YYN7wz4<^rT?7m2Jcc^vt{{F4)YEkm_ z*tlN--7;9duD0**tF1Ed#6sd42}zRFwMCnv`A;u;rrM4rCCFT;WCR91$D4ik zo7guFKWX(RAhfqIf~oxA$*|u?V%lB1gUqzwJF1)${&3KTToyd~AaU2t>5Ja4nW5aZ zH;GR&EAGmL`1A(<^nUhN;C|cN4+D>8+MgBoTZ=Lre*|CIvU~FDfeR;^KAzhwaj8_J zwa*$Jc_~v7aQX@FzEH$yh;i_KU90xIb+T7)fBAi3pUa6Uz1Y6Vnvl)5x*acFUMQiz z@RQ(D`SO?CoA&qDK9=}w+wJZ948yYN%{te5^F!~Y?jf=Ki!-qem#T(YAIO(ZwjB$< z>oeLl9MBvbd`WTvdBCRlNks{Fe;e?o&3k+yf7`Gw=~vK^{)t2@*4|CB#&Q>{Y>jtZ zj4x=h`Qp(X+Wy!jxIcQj5wzWdwlZVHd=lg>Tx?-7{S z3N%;$8V}m!r6hH%`M}lFn}RirH!?DO4YLeW)bF@B+^Kolyz*d^=7E6r*rVImni|Nj zx5gh@uFg%ce>X=ByU=khyFM|y_24awbJAHxwa2C1MXsBth}==>;9fjr9OZBMSEo_8 z>htvGI~R7Cs*P;vw-l_rH`@8+&R*a4O9j7+MeTFe`Pnsx9}7`mpPqTX?)teV>uo+o zH{J-n@jPBEKe9gI;q8{+M@Ye2jJKyJEpI)Hvm+FAB3nB&4kWDoJ>2`A88rLCg|yi%+->;U zWxJjS#d8nu4(r_8QWSi{@x@W!1yPw}f$V9rddCt&y+g)@ekm?r$&O?g*t2aL_aU+2 z{-DEy=_W@^$`RgqB6&QLl~>AWE6pfSq3b9xf-5#0zGcQfAlC8M)%F$k!K*+Sm#unr znPUDWMo+3~e?MOHJu8z~%9z?9d4AR5NanS%YckZw)6IticPVDqZVWWa!TxYwI^6oh zNbPD}gJDVHoWW+t$?PXnXLoLg;O`tCvl`*lNm5Ij<{|Onh;&7`d`(XV68BD7%WwvGqJjRoBxyZM=P*I8|ra#pJXt-kMi^$FemZzw6Uf;%MjHj+(imn{zL8&%KPP zxeX32+XEZNtg5Trl^;(33>efZXu2pq=3u%n`>r3{ z_^XrUuG_KRTee1C3^%&C>HgBU{>wS{@>^!L-KUbwMYxV}yNT~!m28nTWqfUM_}$X^ zJE`T)=})I}>McBO?!;3+6?ptE@X!vFpa0{~puZ`z^YpH>iQ%)jCYPfk_>c$Z+upq( zCb+YAM@WY4X$UI(Chwt~L_9T7p%68N({jOZzmo2ye;m7%8q)Oeeem`(UbfmPq2JZ^ z95UG5akJ|RcDTWl>LC5(7j@n{I#S%(6W8VRa%TFZ!tu}RBp$w8xiyMby7cJf&705f zQNQvZ5t?OGIree$rE;$AxbMmhe-yRrTv&gSm>D60Iz_vMl>z_C^V3-+Jl}%OAnqYc97?33!GZyhp7(+e8x`tW6J-Qm+^m>Q2j z`A4yycoD-ui>==07fdzUrXK~w9x3{% zQw-J4u@Wxt#^yvle!YdJQ{IKCEnO@v&=g6(4JSeM&Oq z(T!BfMo9}ho1PDUXU;9ne>mqx`HV9dxPLDz%j34<(a8rZYHZ`e4dhPwJI$#eFM76D z;A@NQoIA|&*O^sU9+tfEBW>{MhWxqRXc)Nwc1F@4l{;`|>=;*K|hiqkB%Ysbb2idw;_R6dg@t;m7)BQ=Qn& zwF}O?t_yF%S5vsbyvLmJBJJY+YQ$b$Y;`3=oqQbG8XU%B`s2RahQG*9) z^sK|?gxK@yxGMIKMQ7V_+ismhhM&eH=DD_?zaIEm9O|i<^Ji6v-Ii;Cg@+ry?6?+a zTNnoaQ{Z_h91}&3AydxpiMV3+<<0T>CV!hZ4<@rt?4=iM9vu7gH>za2|94w^&F=C@ z(HAyd$@5`qQH0jum$NDXKBfUjU*@kp-edgb>!{(+Z5gL@YG276{1Z{lA!E4>z5`h8 zV|UpDZATsU1SY-nkBL_Brc7P_q3*4w=Ia!9|2y>%Mf+XnlXCkRFV}+mKbd>1uRp9d z`*p<0Gu8E~h*#(9C-VhM<(JJ(CHj7Cwvc0n{S0gsS*s**_GfK{<@JM(Nv|UNp1<*^ z(0yV4wDDo?Ymefm_nij=;^g(;8h8Cr`k-SsI(20FbZ|w&`lw@@LX6kc>@W5-9GpUG>qty+zSRBrT6~|E|h2dC_gY$3mDpvAVC0q*e=DCg^7L zXgu`OUit0w+M>(Xt1b+L9?4nNplpr3zi(0@C}T_at$-s^;{6L!&2gWc6Ot>gS9R^w zTKQC{M%|QXzx)F2YERDDkH2Q%CmwPfBdn&h#wvCGtkhl0)y}Ew`Qm?}t*SFH?Sf;yyFIQn}qUv6bA1W#H5n%9vNakXw(mGJKVLfV`OsNwzdLflfx>pStYtx&SsBy9rDjJ> z>-)ml!s~;Vlbw6_ZBZZ6&a}O>UfhWKh;322F@<#^Ak(c?Yvq~Cd(su^!lN1w`0sf; zu?p9q5^aBDvEzDjb7VnXg3e#OF@kaX0*x#@#b(|@R@v6{|7oQG&KXn{O*&3QP zE9#n9*wHh4lx^u**VV12=4iO(?kYX%MFr;b!4=6X4BwypuKj9nMaNP>O| zc4D5Hc%-(2lge`NI7lDoh8NImx4saGw}%TkBl z+vAR?)^hdEb~B3|LR@*Hpax6h1dn9@T;=G~WVq%9>5=L)FBMvCP2Igo%+sw+R&qy$ zPmW%D@%i>A=jXG^YIV;dqDoUexty%MM_xb6I~uuhS)9b5hLgK8?Fl<4Et^K8jsO1C zS@@yT-p*9hC$H8dM))!J|5|eWvlPJjdsp-#&)@xFpibc~_|7y}fy7_U*hi`}7RkcWX}J&-KRThlV;W7IVV3nH(;BmN%XC zX=BFQPa|I)C66!F)SZr~cU0Owaa&_VM#7Ih)*`ty!h6QeeB83jx|FcBGv4`n!JE7* zyAnKB5h&D0W7?e$Z*?7SCY}! zmU>2cq5QwuQyV;Ow?4K!DDnO_`JC7nb)PbWvV~kl+C)jDT1H^*tov!sa!(o^ACkzUot@m^BI9wOzO?wm@i#_RT6fptE{s&j zy|w%P%D-@W+m{VHS1!1J{JOcvO4VPMyKP*<+C40vhXj!UpIBYyy z(_HL#be1*q@y{Jf^)?KvBjf3IMh`8@BdJqA8aBZX-1&NYpZ24o->8mfHVLJd~JQOCGuTs%%wCTlu(69Y@S=Q=>HUY4nPs z^?}jeAH#1B-*U{nrd%wacYWe*==}!?9xp!}i9Y$K#^EbPF*3O^uVCG$)DKCH6QsIb z`}HVm=g0aKdGLdmWygokc$l#Ume#q_XHtq(IHRRm%1=*kIsEI4Chk7z;m^X%wJ#-Y z*ra!#G|l1P2X?bbmPFa{G}S0avy7jtBD=(kzbj3(y3lvwjkUrNjz3?qwvUL^-Q0G6 zk7;C3PPXh&uVs#6>C2qwQ#iSso8pVQn-3U9bk6-{37NH zmz4_TkfNyEh;8MSO^$yY2O72v`hB*15YN=~=FW}|_$}^uRddzTDz$Lr`bAyi(#`E< zyv`Zp3GKt)6SGEYZ`=Fm2ivya4L{{+XE<)MHK$^$$*GcR?NeVVBlrE8EGI8X&njk2 z*u(tHSC{VpENVsKOKqgf706CbH>x!Hn2K&7!?AL4CJI zRruKJ1BQQTz8W33u7|wPIN*CHTXc1T%Qk~m>m?-qR^&9zSTD4HygT`Q{)9Bw{#a%E zxMYjj2&I>z0xn-l^R_GN2&Sth#7%^o=Xo)U>cMZQ*v+wD-X`!;KDC`f5W)Wr7da z&1Qv;YChNLsTlZnCtC;C)%!i_mC+WjoLkLmSATyiw=GP)IDOZ{%I&z%sqe9}zyG$B zWW_%8`Vw%Q?nN7ItB;=OZ${XHU zbyD^ND%|K#6Jm*+#ogiYKdz-Xb9`^L<7W#sGrlZ)!!u|9%w}3*{(Mr6?%9M>+%x5JZaf-h1yYGz9@^i9rPEgx-5Ggn)n$I)TtT zgx-4z0ylWhz2`o^zkW~Vne00|nP)e7cizv=PId!nG9`1@jgaqo+O_e){uc5HyU)W9xiEcm8R@Vtz-{?BvecN3V-E#BdoCiOp&< ztKq!f?8}0$Y*%zKwq)M;+)nzI%tl+a*_XCERu+E#VTAJK((qU20Bm-n?I1=(X+4>h ztyr7z877idSND}5WVbRdS8ixp^NFIA$ut1M}d^$J(Ygd8+*u%_kS1=WKy5B+L%$& zFogUdqpi-E+yR@oj%r}qM9%jsE6t@C8T`JAv)EDxY-jF}_i3OZ`Qlnp4C={4(OZz1 z1}$1Jg@bl+Yo+#zhfdmAxxZUu_>z>CqFcD7y)EG^bA7Q%|HOyQ=+I4!^aO#v>VK=hN|22R<$s5)cR-yWPDy zXc4M^w(hfj5b}Hx`_QzOZ~9UY|Y)Sga?M@u)texxwHcYBfhKX3K`KSG% z;st___ofXQN9(Ei$~ZEYE+)eE-XN*iibgs`zRaN`OAf$k^U>+Yl?Y(T9R(Iv>$oFu!;|F;r29wc^2T(zHfi; zQzWf3x*_I!bbpn;_@ms>efhGF(TO@YN_v;=mmIqymsG|Lj4#VcP!ow=cEsQuY7q(^ zC!=`mLVJ=6*fL97_`uCFtA20$9V6G1R+pbg2tV93wk@v}pTP0FJuc!uLH z{|mD7U|(jOhg3wx7)!b>EHE5p806}7wBbGW1ple6)TM+;r}+Q*>Q8NApJgw8nGwiO zgk=&3I3$W%GBzUR7$oN&A?FqrBvq3x*ZDU!wFWMDbyZgFlbxFp&6@5=%BGfhk5OyJ ztOP0+&zkZb31rV2K`*)1X%$QQw<5YlYMNc^Pjvij)7Ir}2Ed>Gp8`nfot~9T$W6((#JJe24w4+ZJ9x?_ z!t5>hKm;0;NpXWtpeE4BI-B`xw%_UjBmT1f-75ObT+@eXntJRzi#KV*@?`mn+qn<^ zfO@U!1*GoONnixOT)|EC;WpI=A=wAJo6oM&1c=;4sG(bt*89Z270$UHeu|b(yZb`@ z1p{=S9pF~2Gq8r#Y}F&=%rD9b_Fjk-&=EE`c@`B}LFz=ByHl@5uK~7w=sfIZPIe=6 zdPC+@lS!|E3tDJ&`yg+I&wn=wMcktg3JD2m3GjGso;9fyr0r~D5#H&GHt)1>_+05c z3A39t)^seYl))1KmB&RFh5Tq1_2n|J`Xc@h&GU zd?*mFSK8w-i;}vzdDtLZY)CeFjU>JB*GTg0_6rcS*0MpdCf{s|@+`W6*>FT(^S-pa z5Iq^aP{5R3I)s)0CDGA|P}+M80FNGiD=sUCUI8omwasnd6ax(m3Gc{Q_nZ=p)uDJr zx5a5LcVZ{DgNx>nsj@89hi>Ty>8~jG07`b3$4MD>JQ^fU_IL|$sSxjWhc+b7x(~?N zvxjABxWCS&?j?(IcATJf<}{sWb(YbpNnXe_B4}Xy2dErCg1(i8IWX8s+61 za-$6Gl;^!(Ka)8LnAi7s!a5(BLxLO-jQ4(mSE{cXugjF(uevNSjTc$l=j-DUolN$i zj+rDll*{sG!unstOP`JspEdcw1jCVUOxnl?e{7Z$b&z;l7aaVYS7z*-u= zX-&XTn`{IORmBu=oYfyls8KDqme%bPvsx27i8>NPKkgIT)W2~g77p(hI}{5Cu3%Q^ zd6!n*$pZTRN{Fv-W#CE&ya}K3Hr@Sih3VsMF;K+1Ib=Mj$%)ZB;PKp9 z&ti44ae0w(xxNnH*pcwK8`QhC6rI3Z>Od~)|~+kU8- zZnp=c<lFSnxp}AWkq0Qo@6DR*e52oEx_m0O7vias66W(S zexGRQUc^qP82h>sH(DgjmcG}5&sORe8y5=f7!|$-do^g_G&uQiIdn>!Gxx7Z)e1yD z>;{kk_Jj*q{j8|OHPMY6jhcm>EPs?|lf99ESF#X5+e84Pg<75Ozz7$92Th1ViY2JS9<-2u3qWv)>>&7|T z$y&ec15t9JTYjU5zG74^j*-(YAvsNywfp%$Mo|M;_wj#TEc;9yj@@dOo}{YjSZeyY zJ~t%(O~3Vl`73uZAP2);Ip)%}9&1*ih}{mG=hftaAq%Ik6~3dW6z=`(T9Wul8d@**D%Z^xOd{EUam z9p|W3*mn+X$M;FUO`XbIe=!>Nc_3Ul;_k3QS(0*%PzrxmMK*2RL-$vA_8FEvBwJ?= zUX-OK6a9(RroG*$5LLn#!&MKApj0)qll4I1K=q}wn|&pk1Ax7ScXq2*D@mR88kWP? z(7b74V{s#Ju-d?i!>Sx%$PK^WcWBa?1Kl_rw6jXkvOXGA;44WvcI`{hnvTpF9(-e< zM|->G3%EC@x%`Kzl_Vv`LeW*O8t&up`@VwOWPy&mQ@pzINOyr4A_bosU}Y)fIvw$$ zQYmo%{S~uH_GU8dmRhRg)^MtxA7y#ly5g zgdKEwu8i2?)60K~n3v2dsoJ_BzLL(XK$asM**m_Bern9gIcpYw*-BnPdi|2!3+|#_ zOH!_PRwD^&$|o4=lDW>{oWlonDNED~*zV0OXrOcmfi88C1kx`hFnG|&w$T_n*Qm6; zcOZd@9QIEf*vZ5Gtpc; z@IQU3I`aqTaB8~#q0{%rB3PyYm53&_r|pc@S|E#a({kb;thy~Q^}D{}eoNOqdp5&C zS7%@{lBtM{goMStO*byJY$&QsRALs|aB7f@3jazt6(hbh$~5$xFI18*z-LRPLAVZ! zD(LkDByX^e*dKtEMM@A(S}5THEK01`6qDx+5O)@VV{6X1uRXU6Z-_{U829z;D9;_B z7pH%5e3@aBw9)ShaB_|(h#J4BMF6vgt*dn>a{6sZ1LTVOZH{P5fLWA(rr+${i1Ad&azUwP$AFXSsL%`J^nryM|B>zIeTy1ADts9 zWhhlz2L+%1$T0+;+pKP7%>dW0newuVGn4yj*?%qxGS%`)^b{lcu5>wqGezH?)#-!@ zAyZIvYr1{$&+R5$^`o26IJBiU<|;{rdoPqbFYA!2t#eutkp&9A*JcrSfY8TfkzG=E_4 zg1v?M`X>h`7ZzAGqAp45NtsvS$t_)%J{m!HSzI{`=0*WwoO>NU^^m6g^)Z1^;t$z$ z2iltEh1{^qPcqDgP5a?)ySnjblea84v0{mrqaA1AULy=44K%^B1G9!v8PbTxtG6{M zfIQ=hiuMn!7mMAKnkz@Qk^uX@jQbtChc2Rz1lw+YC@qW?Si_&LF_hK}A4>MI2r>Wh zNi2(gG6P(02yEz)sybt*z3c?*OEhMgS+j#V>7lYqKOIFR`W+bPCh9HiPvT$Ydrvy` zv-SJ4t{Asi`>iXg;0pjNEec00miYpBm>}RvK2cxYmrx>553m~=r<*(c}nD}L=S4`-re<>nmsk4;jU;s&d zPoOxe1W{iO%t=c)_lrw7XIgg5cr;XKc=srhpxc>41Q%{$1<;a|bn=m+tlo%w0uENs zA4|dLORWOlTdaoa8cCLPFMG4Vvt4rUwc!b&pAEL{pxZ|SnC`4jZfK-GZmoT7 zsZXXmb<$05d$$_P#fVx+bmmISTcv~=?Oi|Sv?Y-mrK4`J{m@>=#vv(^Mx|V6X2Ku& z#I492%!F9OWAJA((QT~~-$CzN2-soC58WTE;;!q;#I+h91wp~qCDeS8@+l;dG-9H{ zboa>bN?WJhmur7>uZm}yLSJ#flqH}l=}GYexqhP-wL9>qB7M{O3&)9i(OW-cyw&R+ zPILl$Tjtg@8R7wwTAuxV^@ZKzH9r&le3K)L<_MGDn>+N}yJ>~gKHyI))lgf5x#8vV zU-s48=6|zPW%Nyu>#3PM?xwv~iskoVlJqtS#iCOvPf&j?14`oNq}V|!Hv-X z@CTv`#a6K?5;fZu)$g?(Y6TpvDA`y&KxKOT=CAYDZ?o1WUx(zTFcWol=(@j*|5w_w zMu*}T9^Vg6^55VT0PpkN$H^K_k87F}d!G;K#qF^OYvcftzudymHlIKJGe#=Q#MYCJ&Z-S0*+uX;ePT_iSl6yngO4$rzpP zXzsdoYY1R6{&a=+As4;7b$B948wgJvoORLpfqA^0y*Nk<_j$T$2LlfnWvph~qO$s_ zR=S$q@TnF;$mzXQvI3=_etY@!5=I-_75(wgU;^G^$y-6D#}`|zqhm4oYtO}_Th=E_ChrZjxEm3n@kUER^gQF%#I85r(!*24VJoCMdjPF9sD$e0%0vqqON1Zm1N3u5di$46@ zEL&&SiMQ&=&R6g2G`Z!CRl4}%O%erSW4CefFQKyGAp@@~?(R^h)x=D;?bbAi=7yQ+ zJ0w;L1W=6H);I@8I+C8Hy6Dm5wMwC~)V5(y4|CCN-|ZkZlT?$A2}V#tJTvT@uyZ=G z^C;w1-dOR@YMT77_|CiK2)~0R<%^D(V&!}lc9-XEcEPj}!TN|HR!~9QBcz<-_knRq z`^T|R8Gwv8Vd1Y0V419(o1fs)r1rDQKlf0WOo>(j!dcuJA=`eAUWzLdw7=ef=*&`E7UW{N{yCqTGhU*P7Ok?Y7@ zb*NOQlWF5%oa1wJh>-4!Hj_3v%V+vRss1;g2FUX!nWje*nekAogcE<;7uWuEtiq!c zw(*Yo(DP)1Vl#MCmV9$7Pt&4la9dF9W@>GwE3fhg=;EUq^ypcF-_}+*#cRY$jhpx+bmCx4Jo8(F0itJ(km*_nGtdtm zk=+nhm3{8T%pKq67%~rkb|%GH8)FtS79Tr2<3v8%0#Mu4?Y=Vj_sQx3iU*CWuM~l< z*;|Up+o0f1mzO53wX9)piP+BH4t%Nwl-n7Yxu+|+GD&mA59U@VOhI&^Tuh5l0Ty+z{s`jRdz&&*fJZ`n%+CcDLm$!NW9IiqJtszojy z-In4v7igA>Pv1Cmc)b!H3WsuBW`(RNUZH>6=~?SnaFoBVAMQ+c$TVo#8nLO-!;WX)#|C_(`(T*c9iMc;lnEJ7ON2$TKg|#?HZbh_QE|a1 zlgeK2uj!9!rXOb(bG>w=3g;f|OTJ)H<+%F%=F5RTzEfu^QoZ%EG|@TKgT)HdS8d;9 zIW{YGP}41|o!lSjl)xT)Y>E!MkkZwkGgFpdzNb+#c;Ghb2-XS^Bphr%p2>MbFh_dY zqF&Hp+sk)a-Al$(BEvXs1yLL87(2gfYD|dy*x9ytALgGbc;8`^ny@m~$y#30O6&8R z%2SXi?yfZ2dLJ#<@-FD5+0JuK((Njl#o=HURnXI#QdWH~1+7dSWU3NJY}aN5uOPBp z=b6%v78?U@pRfsw2a0D;t#xg_jn@MQ)^Tq(BT6=~MsD2S-aK0q>b|uOr$iYBq6#IY zi}d2^>QiP;ED@SRLQ`GD^e(z2TPg{oW2igA8v*%SkkIxI;fBmY>EYrT8Ab1>?I>X1 zGPtmBbd+;doqJ);t%Y^@YzHHSV$ITBTg+=^18?xu4P zvGW@CENR1;4|O6#--fADp~qcnm@^FsH{cnLI=`S&{m<4N$H#)(KXJ-~bpxrZS9-3g{TpOg6xs#aqF zlRm0;)YWywbGqO~7|A$fBUuyj0>$mJ`AVpe3UM!5JMS8=RPXRih*8z-6MG{gwMoKa zn_ZrpiaH_RwGvf49A`(Da3qrQJ!~BQ+P^Ox9h99-qvhZe_^g5K_B zedSY2=|7L6=tAkDUZ>{H`zI(Se&XZjtlX|kJq@KPxD=e-M15h&8C@$)SQ?sgT0BV5 zX83cH%*i|pCRRHIxnl>a0J*&kR?`(S8* ziC!d=`yM2RfPM8ybSsZMH=cLKyEy+gzCFqt$od+hp~;N;0xCN zNdRE+r3)gYfK;t-VN-Rz+8KaKtOJ7CZ*^{%&$H6BR$J(a>cUmbUk2I)T+@K6I zGF`o9G~f+5Lx>m2gurS^_zd_jo9ff^aFU9Ys%2a%V6s?~3OCZD0o%e8sKEUMT{r{L zA6s zk0E5nXEg>LT_o!)xjfz8x)IJGl)zMP*Ca+C8LdzO#=$O2N2$Y%j8~6BVc*_kpOC+m zxU)q=_;Q|*6RcdbauLQ{bbFSAD3wG(&?H=&3T%1Jy8pi}EMfHjcEPO&$pflD$7flw z(51_Prbu-bBKdvv74YQZJdXe?)VwZp42y5|2Vy0JKfD(fotx7`?$FZ3}!e7wZXM5#o`;C5WG>#0@05d@XSV3l9QyF?5vH*9I-HI2@8+Aw5Q(%$pZ zNbzN6q-P)_cexDqxO@Rupa1lsg~yVc7Gfb!OTrow@s$Vl=>YVmbAIfpwe}Xn`*!Av zjMRbOOOOXn15N`R902#32b5h_>oNQ3{GTU!va~AmT zW&2}8zuk2rzY}LjxSV-JZ+xS0H>qz+jqE(YLVU%+FAKA87#!HnUwT*Kpsws8cgey5 zS1#X`fg_ajPFTnQg_-EStMlH2c<3F9h-kI96b#7*ic+a5nVdNIXXAe8tjGLA_XnxW=Dx4 zJCf}29L5XSU2G!4(gx5XIhpZjoM%XW=i~vBr^r*}DRPn@$;mm>sRF97R0G{;E+aH} zc?30 z-_-Jk>k!r1Z;@qsI-6*7$EHdDOS`IuB+aaG-LSIsjj6SCWG{WS_3ZhVPuHF-S*U5+ zOS_6;t4r?CS!x-oqv8^l4AasT4X;YixI#wJD@DVJXf0 zHR}o)P|0~+r6Q8zNE%Xb<4mK5x+FNaW125@#d;YYe?w2de)439KMxw3xkDOqiPz$= zTIW>v=!mLgyLb($4$^JOz^9gf!jH8Df9#L9GdS+XCAZeJRvmhmnx<+vq^ZJm(!h{x zgkDO!`{5p^-7<=sJRDZ}G}GN!&Lb*LSS9SFcDgawXS9wb=*&; z!3@s0*>ajKhjlK_%O;&mH{&3D=5OSS_fL_(npjO7TV1|DSU-5#<($)xCzKYQFwPCS#4l;#zVm^d>dZ0OC|vB*s)5f7m7`(Dc$uN+xJRx;#9x$DtiBquV}{0g8!1+8PiiX8UZ{5_`1YDjuXB_Aq|5uJ^-?t&QeCwW ziJT6FcVJvwchNXlU<`E< zfDyo$6)=wF35*{_!B~p~u#4mzoLh(?!+HyY3@4 zmau<)HVC^;5Ss_Wu2aMUVS%vOB<#!?BdpKYgo)UvXM(T;IT0I2SeS?f!X{TO6NJ4y zD1;qNLD)){YhBB7c}1?srBYQcSM~J`_kg|`i`g&pf?1}R>*RV@l~5K3)Ejtxm8`Go zn}Y(`JK?KcRm#|9){VG1-X7edOuklS#%?u{wX2yeTdbLN1~DM)86fOic_M5zHDNth z7N4QUFob&33bn z$8Gk0=>gnw-nHGzB&#p&Sf)~UF)fnsq5!JT465JG6RN+9f9HJ!)Fpyy?BZ7CyYh;> zDi`rC{I4okigKkSSITm=AXkfWwIo;ZIzG8QsK>pJ^;zDK{;!=#FZo!X-LBw;%s|}5 z%L-ly)Jv`q*;^rN6(V0D391G1AK6zW`>O6fl1s6uZ{YvQVa`gFNC731dx>OUS`Aqa zoGVFDaqHn$q%tTM@P>Ys!kCmeo8tadydN5g-SvJ}ydP>*N-RAUs?hBU&9Fjq#NFZj z(&JTnyvmN#B1!LfD>OlpRV&fTm1wm}v|gpv4y)%?gyvUaZDWnAWb-w;U=+`+QM{Tb zqo}ovJ;kVNsQyFE(dJLpM8??2=UKFo{$1ZUZ;ERc68Dj4n>yMv_r<1V)>}2zXox%b z?0^2nGjSdtt*dpBeDrjoKjZ3-p7EfYJAT=yn(8vT#@XmnjXFAD8+deC>|>3iwqrKg z0q=8^bObq;V%VAzd@y(f*|jvojUS*)g_$?DLW3AvS5@BCT31nQ)ojvhxUQDG)j&rg zRt~$yd%qxB=Dz(vToITP1-rxe5EHGIaGFk8B$z+{M9Ov1njkq}OMHX$8 zaEv(aS~QMhG1SJOF#MBl0aGZj*nr3ZFq|a}U&|AQzdyxTVKa`yU+0a(|2A0jX@hd@ zduR?O)VfZnW%HH*u#0EbE?yrLyEvZ0F1{DFiyG$Hd~s1MEsEv18L)5iV%0`y`-h5b zrNmas17bOZ8P{?Y=ft@ZUdox|v$`%!)F77Lqp&AXidn%u-9ExG(yBTC9k+{QE z{K)*gb0FUTR19vUTES67u~3kUl>&|?qIdRp;`G-&a7yI;qJ|E*vS*1$9#i1#Ht~K3 z0LA{kO1D#CnvKcLmaZT6cM@bD;sQV$pq(uT_eKJ=6G0@LEXBEV?-aaV?#l7OB97rK zU8*Tf@qt*|Q!J&1cg%-9;BVU};B~U{#kFAagd#hb?kIPE4r(Z&SN>(osF^JT*BjME zMcjD)*uCOwqn}#Hs3CD*b@p()s+pE|54&iXj%c@NM7#* z9F6pX*QDRHIjeV$^$eGI((k6|8PqWdC-4xol?Gzhmurfqaf6Em1JmAvr@!{<%hK;h zHYa`fa~1U=EHy3FAXlj)Bb?PQ8&+pEH0czbTnbzker~7S?P<3Epi097M@)NiiT9>N zG5e!-3M?^L;x}W7XLE0f?{|g8{M?SEHufCyE{am6N`4%xghbY`OuO$QH4XLE`l*n4K!8#i_JUIKdsA>#jMbLwg$ zO%P-|*img1$pqHi9?~>Z3|$o8(OTFCGA*q>*NNHh-w`!E4)qkM$QMVnm6$j#-B`Xf5&_e60y{F?4e zgUur&@)O+HeM@P&&+YnzEaJtV02UvJFP?q9b#l0js^^0s6!&goC&74d4>^^3H#qLb z=^=pu0pyN5%Nm)_@oy?8P3G^vo}1b(`5$!;MBUbR$Y%DP!GPeiiC_^Bd<+DadLo$3 z_!1On?!uaI40G_V_XyK+F!$=+fwRmk!N*L1%*wJ!StjE?isVhu4u)0uoof}s&lD|3 zCS?4ZJ;I;g2;LGOm~ zJtxLJ+*LoDCh!B!1iCcskovg84&K#WxrnI)o7j&{bdUE+-Q6a-oseYN=D;R`P0WW) zya_h3?=XfH}ZC zGccbAn5TvLh6nS~$D9HcCMgCE)xOTbln)J5bxEnjcj({D>j2&47JCfFp zEaJx6O-*&8mSj$xOJzHZJlKx#5Mf_}8*`%~x^ev&?~IJ(+ViPDvEvDc_$MJo2k1eE zp$FU8I(;`4+!hpTfqFmO5dTm_=uw8A4+l<7ZR4D2RgUmPV6WGpb$McfRMLI?p;y~E zO@LhmyLxhV^_Wx$m)WOo{o~hEl323Pu0+1XX-jp~R4g0OY!<25MNQqY6zgz)S21jL zf$p7+el3oDORT7`&n1a4iM3>rwRI-si+mInsYQyy_L1b4EE_7br);QjPWEokyqs+-i7~F-?z}d8!Tb3fb@* z_Wda~Wz#R^y=W;K_TuJ?i(-k)4>6fL2j2H8SQS=qxy3?3E>;S-{OGV_6DO&^o9)RT z@9Unl%+#N$qhtGMA0P4(_xh5DC)Ll(>=RQYzI!<_MdE8$ycEZIc^Ow`idVhxW%mE1 zyq7~C&x#x|!Aaa<%w0n}epV-OZ^a2-*gNj5@{wl~0_QUD3w8Hn@5Do0e2xDbq=jqL zIUBJkDIAyk$IsK_p(gVp7nun5l9AygNL^qB5e3r1CW2_jmm81dG89wgaSa&_XHVz| z&3uV5M|Cvjulv(c_gjX$zy6RDpQs~8Q8inL%+3UdYo<;r6`7prtoR5HIPtC#y!yXh zF8%~t5OL5J6s2XUxXic9QLF|cE&soc8ni5`6#meNBuU9JdaH=8s$sB+vh%`>s-jo{v%J za7eKtRjxpfkI_76*}t?yd5zM%-VVu+c)!1Ihtgr$5m)|oAjd_(k#@|WgQkUSo1AHn zjXF9If`QSa+@DXQT$a!I*FrykeU&jKMEiI~=NPDx<}+R(+xfg@^f#*!o_ziLw#TR6(ODpOpi!Xw99sVaT|aH2 zybhnpF&z0Lf1D%7FB}K}6as)^Ktb^jyzFU%;clN`@COI&baya>PxRp!1v6!iL_75u z%E4|z8~>e}T2??UacWrwwWPY}anA9w>GRq{M?ROB+;cB#N}ZkGORxNED6f4j?uW0d zjC=bIIw&Sf)5BjPF*b!eB>_p7)=O1t{}@Y zEn8HKy11`chH5n6>Ie84;AeoJ0Re~rU;r>g{s0URfIt9p>S}=iBzFPG<%9qv=6%f& zd3f94U_x=fE1E-{5Vwq^SYnvx zFXP-Yar`CHtV!}kE+iRfpZkK%m0-j?;II&$#W5E}4yf5axxY)LyDa(Kle*) zzmA+ev(9!;uC*LfGZlZwRVKHCQ{#%`YD~Z*Pbj{sA<|uuF{r>TWE8R$4FrGEA1{{qVqrDw%OA4 z!}P8O3*+biSrFd&NBsNmg78?4?!WgTuFGw_{!eet3!13yDMkbLam=SLb`@1abz0|P zAu_e#ON|gmFc1-f>IY?5NH{y8xD<_T|E09Quv}E`a-IBU> zoz!-+yGM0mh#XOjK9mPfxGG38X1)5p<{hyw_a1nn# zq}y-n^Oo}vt+U@E%k=7Otj!&pBJD5jsv43sv&J>U%EGs%*3yx^@b%V{r(Zo@d$eGo zrfDziDu%5txLs$VWvGsdQ&=!eOII|!DLvs58Ah)Z4S!F%`{EsJf*h9|RY&;8xxgr9 zIM!;`71E*7*SEl!(d7#DdkT;)@&?jCxnMte?Esl8Mhh-;?tpuQ7}Fy+^~q$^FDQ$ClM z1EZRvX|_~HO~tZVTDN0|f&_b+qHPfi$ zb}|hnIHP9EX|^2JxHvAGG%o$A?3k8E3BEnw3Dv?Ta&UFo!GL)T-0ra#zU$>WsD%z~L`h+x-TafnukiVVY0LyJ0kP_k#IM{y(88#mbovn_(H>cnC}jg zSilr%*HVZcMk%HmcwDF)4P*Uf(ndAXPXeMO)xt2LPlA|@ll=rrT(-_>>W-yYujgC| zyUCCH$eiqAj(S;8do@$nk>RAZwPPu6XG;R?Flm#7UP?LT1sX^&7?6T0PM56Bmae}( zBpt$ZJbso<`LRDzZRe0#WVnuo;_KMQco(w(@7z#}Wqvvg;!VzShYQ=sW^L~)*0fcO`j)S*f*`0s?m_@ zs)dN>^jb(C_h&4{sGB;OT7~g2$agCjRe0Kj5>k%U^d(kyv^HP*e*R6!xb~>8Lse#G>5AR zt$Eyhyu;g_HB1p5G|BvctUnPOxg8zHJm&5t)b9O+$=id3KJ|G**b^bsS{q>02}VOj zh7lWbYY`Z+neJkaX1d1%#u=}${RPHQBLNrzjCld$aFM~dw$4Uf5*XJD2gbE^7mfV| z#!w>x7y*oV0pm!K!1z%VjJ1dZJ5R>o?9Bv1ZWM)(gFYdtPfeHE`)3k)jrXqIMic2D zfD^!(7jTXi8=N6OE*+ekg##z^x%(8Hp;iNM3INVLf^)3c;0*bB>EPTd95|Uz-lyOU zwHkm^0C46Joa6lh&Y=w8{3O*?mzT>Oz4b4O#?G^zw?4B?3f_MJm7*@Y`|UPi1f+Qe z>a?xuO$`B5Pa#w%iVf8eQ#*R{UltCk0aN?YotGl+JYy>F)&o=ls(FO!WU-;@JBtLX z9iaLrg@Y>f@?EUL%s-+C>zqeymUe=TG`mlI-jV}a@;(g2g zb9H>D#Q^Vz9wIFu77&{!#GXB6hz$svGK2loQ-N4Q*uI;^CLxv*b`1~hS=dXT-1KS=@~j_-2hwyF7t)Ui~WMjk)upVmt-<~akon{{-JMd zdK1#EL|Xnu(P+6$CZtPrLOQce769B|xE^M<%VoS-Ccn$edN5ht>KD5HCOlbP3MQ*w zb9=wpZr1R)%-%OWfJ@F#ZMSmC>hn96snlIei{!m1fa+6&>UWET>gUPNypMpoOi+!d zxK;VKydtm4CAQMAl``@T4b?G``NkkN4VME`w*H$k#MvT`I@?-fb1PQ;J%G-@Ns zk9(F!jS`OF$6b#4am=of~6+R0%GITjn>IRJ+9gyG9Y!ti$|=qqd{arm2}arj^R zYdx)B&V3Ke!h%}I1+{!$5&*h*YIX5Szv$v<23`Chs*4)t*<5K}EYFKeNh@IA_JgVo zdSwrA9Vugi!La6H+}(eU?0@hd0{ip#eJ&*I8~69I%thjL*Rp~h;=2TER->gO!x3K` zyb$d@v!&I=9V9AZZBMb3nu9FymHVQ0DJX8LNdMeH=?1tydbk|mGX1(8)Z1^^_7UqU zag>bVF=8tX#Hz5SXc{*HhS*hO-hBdFp+&;Tis6JW(_RE|F_4;;YB=tD?nA?mB2xI+J`i$X_6 z^1uO?_6%|I5)z!*CJt3D)LrN(hyK1wr=c*#`s8Ly*I)NG2y*XHvV?QxF9Ebq4YY*> zXkSf%b}ER32P^N|$O%Q@j^Uv*yB1)${g|P!~;KTnpCYD6)eU zw586s)}?s~|GZ_?%od*NS*VUDiyKcLx)%}H=!X_EYDnByojtK;YIqvz-WGvpqK;^{ znoZLpXP|dpyLF%%iY6)!J&(OzdOnY1K;nxBk&8KA$l`0WCDs%}Y}xoIfyBKp)*e0G zdLcTd=(H?DG0H$>&&2e;Jc^F$D^_tdaAX*KGD6!r>2WJ;gU)u^#7evR!|xKEeJn$+wb z(lk>HT{^L&weTFsw6ywc9J9(>!feC?7^C^;igm>+%1o>r=~0xqD1I@sy)2jXhH2J! zUL$hlgSfw^ItWLq>n54ur^U3yb%ylJ^pX;+oE38A>@4<`c3Vb`6cLo=^eD@RMOT&z z#j2|;-qk<>EqB=O(P`huip#+_bY~W99vYFK;==A*O4Gf& z+b3iRfBXet@t*kX$v0cahs$X7Tnk)r?^Xxmj0blbP^v%*MT8&0C=D4^{Y`s|w*e&z2(#GXBLL;g_@o?-B?k z!VgW?aYD;Dp*YwrV(!8Y=mqFSUi9LZpchBbi>1tZv0D_qU`=~u_u*8^&j0l4jHJm< zHqV3$y>ukWTL#Gk$t!^5&4T1*mApGt^2*&cZ(eLFbqN`D{CieRx?ihtIwkNLCxI?a zV^$x>bnv$B+C`)eG_e;=bdPrn-B}aeMo3e(S6Acl1EWXO4FKjr2(w~t;mU1+yJfk zV`#-o&0?Od#mpk26-7i? zEnN-d16NC+AGm7zMHfB`u0Rhd0&C=uB;Yau%mL=Pf%zQ3JS)sMJeZe{m*zUq9B2+S z&sI>Nd1sp61e*6cHFsaDcw8_y0OkO5fO)op0?a$Z{8NB=&r|bbrMU?-2bu%TvlSF* z-kIjNfaY0gz7kqB_fN3a=9b8tA;|`&cd2qS6T+KCK{#u;t6fjG&au<2@uzM_FDLC6 zxVJANpFc7(eK zd*j=P>lM)-SB~(^$VjYR@A?yCcQ_>92{GJ9H#!X5+s5kjd@{H!C{cmB-`tRVQ$*-i zhORdUPEKy)m}yoHaYtac$Dnn%V}fMTz5StE*}0kkT?Jh|K3zQ`6~bxuShxQ1%PI*h zS!h=xZ``z{I%+DGjc7FU)a;z5?pTWTdTv)SZ1pDHI}?3d9DA2oNnf8$Ghr5M=_YII z%*Z$SC~8uRB!%^n#FlOwO0%nNC~?mAlhi!O%jI}B;^raicuo>xUk?S~%}W_FLwPGN z>%9dG!gWb8mchgn7qbRj>^T@m(jUy|_;ePh#0dMgP0Jb4gCf|f~OoQJA>TV9b@izX;}1YB^5)jL6HW3&3+5%V;TPFVs24uX-tUz6V(8&skwXSJjw_70b7)78>Nu{g zIK~ruM_pAu^lCydxeVroy8BXhGDDqzga7NN4_Byh8!;~_?3eq;&(PzcBJ(EamS%1f?k`8(Z5i(V`hCuP ztd1N-)odZMIujhOnL5c-WN{{*@geMR;$7IC6#mzX#b00xJPuldlC&(9miclyiq$}* z@T^a*9^567mlI5sslYzup52RR6U}sB0KeQAr6afFdX-9wm$o>AQ zO(Xg_^c^}Ld4X1V|8yvEAruzd{hq}6Uv%FkTA^nWDs(VZu_CQpfgT^BanQ8?&<@2l zOyhbtWIyD6ziEfUVcQ|s{!L)VdBBl!OrwLQg>0LQw1-9=9SA|k=#uV_Cy_3T=gb?S zm%pCUm=vOIJT1iAmgVC-&BtKMCz1*J83{hUOf!vNpf%0Q$`zN}6(nR_D@IX%B$nW{%96A2LfdD`u z04Vwt6#u~6o-`P4_Xq~RbI?Y2J41M&4<=MFtIVNjqaLAh@HC-~|4yu0R-jsvs$~_b zCDTcdamS0M$8!&{c+NAsr=Hi8IXb_UUi;@z-uSin+wggnQE%U0$IhJ@rid$-oYY|H z{*F6w{WtAoUkD}`G!2+wzy#y8PcXpq5C9AS1^@$i9^iR^=K-FF?|Dq5cplTXsy8(R z-iLP_CK&=uGGLMc-Uom|05EWW00!_r!23AyY60(~aNfsYs`t@qB5PMOTees;>+IGX z@IJiXFv$>Lk^z$pArsfY`w##O00sa9cpu<>fcF93hwpuiqyN-uQN(0UZ z%rOL*W565(oDTql0AL9H0T{sf0O#Yxs|B2o!Z{zqDbB}5WLc(Vi;7Vf_Z7=fjRu_k zfO!VYGhm(p4u}9?05C-U01V)OfCF;k)dCJk;T(_)DGo@&^P0i)@P5MtLx2eeOfZB@ zOasqD05AX;01V)Hfad|8N8vpW*Di>LJ&2flM02PSl0HKjJ_*e8Kcn1d?C76Ju_nkH zxsYU_eeMl57lR&ikNbU}`~86X{Wnl@Rsq4?s>0?v!FE49rt}J;@qo6sUj`12YX*-M_DGYf%lYUW--MqNH*Bp z&ZgPUhNU$3)Ee7=A=tl(Ub!#o;bLhyK+*3?=$vKPMIdh+zE$7_!k zEYvjZ1-HHy2(WDq34_6Kth774Bg%id(q>E7UuTB^n_$oV6K=kL#NYoW2oKe_$Dy&> zo?OxzRWm~?$qqRj^6nK+lOO`LRB|A!J z*=5PfW+{cjV46deFu)kVNaAj?Q7WkLcd&{?7yVbz{^4HhCx%t(N zjm>2bH(h^u$8daWIqW*iEyoHhlEbnecz)Bi0{t5)j|u$1u*q*Z49oVfS$bU$tOh10 zM-rio;B>25GiZOxPwNB|(Tza2u|ewQIwtNAVW#T3_Zxrt-hj?*;E`$ip0tu&M9TUmv}vEKED(PSl+ zOL;O8G7a1I^%`y(p3n1=#b3=4*TX)f%Ag#@AmcYrndJz?cPI!)nvx~vA_*J;uu^0; z5}}<;Ex@S4!+y&Si1t-7rJB`X)fkU16TXmIo`^UG85*oI<4pPUDB+e#0thY4YiGJn zjkJ^NaJrdtTS2oG@Wv%+`LuD_sZn*k2qfh8d{NNCRU8m?`N@Df-cD=xL_6CxUuyTz z6JJjC#9K7WkoZ`qJlXEE7aosFooJy$8!@Et@J{iOB3AfWg%LALs(?M5#_kLvTXo0v z6cR6pZ70VXr>0DacfEPmP3INboaFs>Zhw@!W?xPfr-;6LNPb z6aF&v9nYY2m_{+nA>+c5&@j_q%04z}KS>ZprG*KKJ_;_Iq2Uyiq+%Vht*U2udkZ0h zEz09QWsw~la4$K59!C$ysc%|-u+JiLsz}F@bsSSj7qNs|q+y;Z{Jcm4S7{6Gul$GjV0J=0 zNF&9SmJ?WkjcXstv8bu4TSR>(_7z=Y&c}vl?&?h=*cDo*EZ5gov>6)Mwj6`Is~38BWb@P_s^irg6Djg)m7>Hmt}wqv;b|gI|Q^`E^$5{i%DB;yF$< z_E9?-Lmvyrp9ser!ttl=4rA_Ex}-P5tokZvCdor$H|sgAxO(p>#^D)7Sc*?sb1k$x zv*;o($Nq@(U7n@T?wxt^tWxfF=(v4BFi1B z8op&}p-aws=!fkzCdiQau|k=jD2&hzMPK|>5%)k)?z1)kTPI*EjXJQchZb-MY$2w_ zmT!2bG=2f?0PO(nh8^vY0_`Sp&@M)`$j?^z&f{^fP4(VE;o^9@!*s^SePiLveA0c} z4D5xlu1i`)t1J!-@RHw@QbNGxlPckiMF_j6wpJR$0%Mo9wpQ=nEt4;1Ay+i%uflES zux{bWN~2OP1O5U26$Jk#pKttoO^JWeXcjP#Pw7%DEXs|8f#NZ5#G}IG@i1ZW2Lcvn zU|0fU4bT|SxR_`>^?al8D;YFiBWS#&si64ks6z2^)x9|0C)0Q2h69_g3D}%J;X<5_ z)Qn3SyaA;Fr3-`7)6X|bUr3>}nYNnQU|!O~YA<#&rmu|(f|qhyH)~8Q#irtCHN>ms zhz7!Vj2P69Wef)i{N@P^^sTKmIckOVGkS47LoPh3C@M|p1EBz+6oyb{Mwd`ZJrK&7 z6rm`eHXuBrqL9x=g+jO!FvnCfw#yIr1HEH*=D}jUqW1z3+hrVW?Z~D5}6Mb!wuN~_Vu4x}?x4!xInu5)~7&SJFfhPN0`f!lRTkQj=Fedfl zzB4B^`NQ^;X+t>(q!%sO8)T`DU1Hbfe5=v4arDAJ8$wt(nT@$BN+3%Kdefut2TSkT z@Uj(yBvB3r*28*hq(%B4nc8LIacMm@bvdEh@w`_gr#q?<7#SG(Kp1)M`DWymUdDYq z=oc0he0+Tv_!#x!62Sx?Oz^=39|9g5CLTNVeDl~+FFa=BfRLE4;IJE`#$hn62jC0f z`?TK2J)8r+2&G1HG2h4S1zwk<=UwOvxh6qZdb0%6FPDDNXUE9Tqe`bI$-X*ZgiXyQ zO!3Ea!b(i#+wu2OO>p5LQ| zkiy1y<@HtKqKbj2LowG1SIhx0AiTF7XAG>^rH;Ug2hWN}Mx7N`Ip|YfOgSJPZZao? zkmAL~CHB0iz>8nE0qX$k0P98s>yC~()}7;)qlk5YbAWSzbEArLNP%F^6HMV)A%Wt2&E=V*1^!>;tv7rw-KG7Ann2>eiDQ)=;^hmf_=&|tMJ~qGfd^QCfC@uE z$AEwij(}E@=^oo?Htjt=>$4ut`dCfsYAq^ffVekx>lu4f1MoRuHVU8`p!&(7`Zz%K z!9n$j^kd`|d7*ud$G1lTkHzQ3(Xe3h@yI1eUP)V71WOv=xiIj20^s@J;Q4qKo>l1l z$AHd&&VbH<&KY!m3DEiA&^i4MrkUJ0HmZDMR={bKR^GbhJn7K#8 zg7BH00%+B;FUeQs$#|dy1e8!jN;nCWaB!4xO7U7gT}bNN%}oUZ{K=>=0Jq!uQ>;C% zBr_xw@TT}`ekEMZg|5{Seq6Y(3E=*0zs?l0$nJ3^_!J-m-@z8|s5>Us8Re)`D+ zCtlk4j#H1e*0|#|=-wI%^!?cY(3hr}G$t>bq}=)B>6Eg#bJpQ9D`UA4?wT@iDCY%x z;dJ!es#e|8ux}bo+!w~f)01(=0PveSuS;*V-Be`MFh z?YeoRR$-bTu^MczU!WMEn8HxZDWI6APcds9jQ%B!glQkrNhrg%>70{eS5)i8-v#0U z;sN48Ks<#f9@Q;{*K&vlp%ju7^OnLy48vuowGt1i`P5It0IQ%`x4Y<eHhj2-6u9FM>Z2u$r|VV~1`ZJ}WWtO+}ixU*~d_QvM+^&8vQZrqlv-myo-=Wa`Z6Aul~LCBQD zX9Dasbkk@eRFkij!o6s*96al|Uc<0S$3|#JzBp+bo<~Tao{2>>vYc?_?Y0#anxtFR zt|@ANDcM8x(LKIzsIM8E?ler<5ZA)R5}dkb1Oyvv_>s275)*S73)PvpV%Kf&GOYK6XwhOP6xk?c})8R>k`SW#WnD8S@o^Tv+_bGAF~<(kwsR zL)LFKo30n&nvUZB^hZM362cUB@l`ZN)9?elBK3@tuIut>Fn!dbqiBQjTZIoh; zf$p4qbKgT@^{$q$x*qXIiO~nRm-40r^1KYiHVl8M-ZME(5c1~818dE4VwTEVDSw%x zPB2%&Ts;VL^-VBW3uLaI%%IU4-LYLTRS}!I-R2BdhRAqT5fpV&Sg5)hf(5g6GtWhI8@cG8(&1*T62A**2v*Uo}-cs<* zQ*r!zuhBl*2}}ruf-)w=&pMhA@<^8*{7$U~HU-!e1+gjK0-K^hHpNmN((G7|aE(IE z#x@zFxQ@MTg>CV07;Fp1w7qavd_Ec0pDU9!MJI3nOajDV)Xo;cz}dTx?0ZzjUfh+E z+5?R%6qTWIvn!3O2A53d9h(vO9QeE-d|m-QFA$%f&4ZjK_Ux{7{%BO`e1cXV_0Hyk zGfZPXWiszQ_a61|3*ho}=jxfujjmj-7+5lucWOjna$xd;F!^a<@&YmWavtEceEezn zZd5lm|M{r0`3zS9>YdTwP2iZve#)%gUkQ5D$)5wWr#o8D%x-mM_MCwxvwOG31cnEO zF9^f`1Q@0!UgfJ1A3CmFg**zZ^wFMhu^3l}FFkL|Iniys@Xbj=dK@eg43(Tg2TZ zM<}*QlA6?T)9`%$3M&sja(iR*`c?hbwQs)EKil|PQ0p)lIyd^%i@8v#dRBcmpsUNR zUARbp00~S(&ETl>v zG(~Hbs^@nekC<6RZJ7PK|If^3dMjZF(pE!0qtjDmoL$+pe znimWdFi;9&pqv2%r9cMCLT8BSG<)+`qiCjx;RTt!IV+>Pk$9+~yPCME_fTwm{3TC{ zCo>yO)qHkq6U9bHDxa}?NkIy4(R|y7Qc^ntkZ*H^e*1MVJn=31gMG8IcyC~x1q>a9 z&N7D1uX{9f@+WTw*!Ex|fr(TQ6KMfVq^D#eP4-|SrRQ)e*`1A5#?fCF(KzDj{_M17 z8qS$OBbB(nq**mgFmjKawQK@6zTd){5iT}hIrSy2+6uH94zL-}H3I2Ufz2l7dnR8w z&2})>eEeMtJ7$Et9;(QRHqKmX z7tUNW0u_l4UlsSSPj9f9LzF1trl-CZ_)OFxE?fWtdTt145eTS21a!q0H`c5qTU+rB ztwI`N0mA#`^g(n5HT_KysR<2$3y!j_&$wEKg%7k0AEX)=SRor1Sm7D4!n?o<1!9Gj zv|D1_ajKO*cf$PJA~Hb?v8OeEH}puTm+}Pkz*}?7;0M)VVTNM@GZ+=EQUx*qGAITa zoCPu{5E)cdE<(3Cs=q5D{G$ON{bX2welk?Pz$w`mAgB*+03iQBk^c$%yO?L6x{a@& zv}k1A!#g^?4eIO3`vo+avrO!WZB;$P+gsQ%9N$`Gp>Kq25^hMD@|U$}q%f)VkY=Ji zgsH&!wT706GvOuei)g!V?Mu4ZH;ejm=6>WVK~b&33-FrqdNf|S%qz-!noCI{7g7Rd zIvI^)cNlRolY08?VWk?Pjp8Eli#>^NWhRfJ*lWGSzOk_#KX10pW3KcPGmf^f$m1>b z63@l~iRAM*%aO%F8=QDPyWyQ(`sLCusyp)YsFKm-Dz`6a#8kE(ZnCUNtc#=#q6~P% zbKDRSBX*1Qx>dtYV39t*!1ImTm?p%9Hn>TnE>d=n`}Io=Wp0UW#F`_?-8Py{dyf}l zeJQ%JLo->-7U)E}IV!2aa6EglqHaesDZ5b(k5(FyxESY@qU~w_3fH%fMBe8%B5Ull zMnt=(9*yohPJ<5b{P9Z@ zgo_Ykhaho|)FGY`RUXT1GBHYHxv5ktV@Z)6g-spDnhdPKmN%FzUuijEcVO6;vArXs7=s(xN4?!Q#m!0_sr*7g4~ zC1`m}4eSzqI*}fSmgfnYJ5$F|s$B9p$yD!>CNN5@XjJA!lsJ}??06bQZ^ix? ziN)KL()0geafRzi;VqwzK}mWnM|zeFKOKM9GHf9N`TM?|KL0^F537xY1b<9lPi+k^ zhR+L`BOxx4`yEa5zggG`rp7si8pj27YD}dF#WNUT8Z7VMw}rGOSX##g`BL=zeOrh} zWJ{s^<3vvKQd0GpPaZw-uhUH}QPLf{no2kO1JSm%C;>p$5B>} z@tjYp5bQIVeEKO@8bk>Y=uR}-CB~g1oqijC*UfdNKIbj$2cL&<(ue0MPW}8-JA$I$ zGEe<`h8Ohs2jRFVIPyFBx`Z6Rmw*6(0s&AADNy{gEPK$vaH&sVh&u;s^sqCC1ASbf zV6Mzkx>27%ImAq8lfMH~%VkiDN-ZCNT6&t8o(ZC4`kWumq;r(Z-HcqKo|B7P>F;A- z=y9yYlz%i8h5bfO^HA0BEtActMKb>&-KF}+w%Y9h1B2xO1_l@y&%1#Eo(BS80AK)M z0M7$F5AZy|^N2l<<9VKk>3Rj1A~iBZF2$Z()U`4;6ujrRnR#y4y6t8j- zUJ@b|EhE4s4s!`w7QT$%JP)jUMswFPdH4%S_*MKMTtZArr4`U65u{Y;Qhq*;Q$NbX z8#vf?Ydm;%qZPQeYs3L3xLlRQCIu(O)>jspTFSX<8QnTVR{*tuT0kwJ7ElYQ1=KPG zYUyZ-^Z6HU51(GX?b@vd_LslD_RY<&ZftBWd${TP%c0VisbA$w)_W*fxB#%j7h dMa_8F*K6Sl&$*pNNTatr{vYZ$fU;6~0RVW9J{kZ3 literal 5964 zcmV-S7qjReiwFP!000001MOYiciTpGABp;wY%8%HCvlu0%x)~j3iM^UvEzIwv6H%W z+?>ST?nX{+kQ`B{L4XE8+3G{iMqMv`ki0hd|wODzqY}WCf0! zHA!pNde<5ck(FcmxZ&wG8BozEpKPP3$4|8j*xRP`pwz5XDV6I@$FzM~Rdgb&Pv{=T zkM!LqVq>!wnIKgj7qxwY>+V*VYqHZcjp`$#j-?iwiS@0l!ih-ldc$b4lFFq#7YkJl z%kuOZZW^w~^OD71&k)yx{-erZE{s9OZI&|ULh#KfNzldT^nIvG)!n}4>$F7lfa%@gB zQ%=iowtU{WBrT6NF1s`;jvE4m+@3EBTDXCIqAo8UP-ogn?VfF?yXGtH96j;XL{Gd+ zvkVB2b;@(?9(&=Lu+*^@Ilz7)$WZiU8q0LF&PZtB>L?9~xH<)O=cg5b3Y8lsgqVx2GVLl;uhdIJshQ8|> zlnRq5X4+(2m=YSM`pcY$tF)iQh@#TM1VtYOkIm3<3QAJ3PFiNgHQa-xfWemKai6fn zPWQQ&B^!mXrM@neZgCG=mUDh*bG@NGaa>C^`h$oYQpEE4oy!{yjYVgXSF|r3r&c+@ z+E-3sJ|DHr(^aR@z_y>&&wSSiI=TwnCuo0Aj1Y#AVWcsIz?dF4Z#G@tXf+xKheRe3 znfs5UC!*AEo1TBjB66xo#*%d$QAiiDm|CP^o+|vJNCG!#3m&fg3w$u!0Ujig;(E*W zP2a+`kL6g@Ow~=IzAE+?u*QoA#YF7t96 zjyT`rSqkmmnI|tv1?NgzQ561tp`CO&=V5zqYv8*8u2atjs1GpkzQ zlCvKAQ9FqVGGu2T{ z6|Jn5m-_~I@pnQg0pRjUm0-pqfZg*uYmH%nv8y{f>)(GrNB%GixvWY5%G_oS>K0tA zHOg~yfPa901;M|`oAUDP4+%MR{=0S3Ks8cuJT&9wsdQP{8683`=0F z0U84u7ZZ)AjyD>=mO|qVg2pSF3W{%xDiohlJ&WUgGWkSqII#JqfX&$xF2w0b%(x`M z8&Dchx-cj`eY{b6D}mD0q}9v@^NJQ!d%2S_eREV0yp++pX=7R`HWjVa5bw@~G!VpN z#Gqc5F&rfD`y&|WJ3AY4)H3U5^yX%YTzFJbRGQESLIFZ4457@7E}@ii5X!{_p(s}y z5FSxc$QPqRA>0X=XDS)n<3IR<-Z3ln!-=VaYD%DrFyu)p#7Tv?sSqm_GE_4`{}B?6 z7Ea5jr{r-u$jT8!65JvQc9`RjStp+MPX{>>t!X<~zmLP+w5XL1D)_8b)p2d?YE{F- zKwrm)zGja%eO<{#UpwT_uK5(#w2!pA-`u;YV6!hrjm;vUNv}&E4l;RLe#9%aE5I|W}|80@I`+%gs^Zi8*x>bK$;Ttrc2)smfp4DWh(|r zq6`kK2lduSi}XG+wQI!V(sDKRTuim&S+7V=cT^)VGBEN$7x!Mm@MhFu?~Cd@#X>fX9Z3#}I#5@Iu-5E6wgK0egUjX0d^*-*2 z4DdxLF_Me-|y{KHJ_+B)>M++f^jql0( zt3*W=15t-!ZWOMVePBR%Z#&8uSg}hTffWbOiYG^%71ufFQ(jCsATDk)CxnpVmE{$- zUR2=4uiJoifOUX%BZ76OMjh+k=a!?0b%1k#bAWTBigQSTbBh@`HyJ@#=y_*PI?MiY z+A$T=LtVf7imT(#!obNq_IgI09OW zr+X};*|ZM$tj}gJ>ti;ltF^400pi}&-52al^}*+W*(iW&fa;?|^%;Qb!9n%e?xiIj27T|es@O&l>&nk5Ob3kW6XFz8_ z=M*}>0_Z$AbWXm5S&bhY8x=lF8US_%YX5vxP@8wESG<-_HGDAWEZ;7ww zmxJA0=w2%h_q}{B9h^N)K3&MD+wA;u4|MC9n5Y(ww5F5|O>Sn~lia z+~4VgxnGFM7T&pdBb^i%zeiKXE`58N`E70!fPbNMRxe$e*UTUODh_u-$L@{?i&Rr&0VbUJ#1YazsU)jfxu80crHc z*uSe|!hQ)OHRC^DF>0D=`^^@d#eR$+_`;||@S8X7s#7!V`cedN%K;b%KLs>?&<0!s zTmxJiK3qczTzfME*JgU0(-6#}{!DVrL}Q{*lN~d8fcelMd_FbV5vWvJz1|gpX(I~f zoIY#|4J%+x(1D2DpQ`R({OlKZZ)%v50_dO^<8a*YjL^ z$UbLHmAzqrr?%dfx)U!$u_@>q_35n1t{5J}nzMyE9K`xnhKhjffb0fAc5eaM6^QK4 zr4VL=p7$&e9iRB2gje|Kdx>;6I28p-W(w^@xI=e*dR7gAXhk`cLA1BBi8dStgk+C; z&^hoc@ayyBR}J{JK>Yd>6|m3^ES?yyt$mdBMw~IsWGmL6#fh#bXuX9zvWWQI7Un1b%D5gB@1bG&8N6Vp=SF58Kbz4-3JQJu8b;YPX_hp%4AK^iM%hyKpaGU&g|Vo z_BmC7qplR!9%x*ls1%J?yVAI7aLIJuu^EBSfzJ!V=VjpY0`d8!EXZkM*Xl~=wNa(> z30i%WpUnkln8ti@u6UQ+bLycET%PP)xw+iv%H@iIB~y8)Mg%4YCNBt+zXMEOASPeU z0-TnIKMUSi=*H%|qsrzpTm>jUqrVr!F^~P6S-rOs+36Ja|6`*pw@VP5yhTP0#*v#EgVTvVx{rpUI=$G%daMiIKmv)vuDIM$wh0ap;!|!^rAL1e1!HPI^%Y(H6)!0)v^fOcwP%@M)2OYY1db@O3T-3*vD0$Tn3w$HJg|p z3VHn>kv`PT=2S zYI&D#q+66&QKfgX5kjv4$%WmuTuw7?8TSu0n741f%Z zK?awA3<^XBWtEH2ZH{Wci13g4fb^3={rSaE`2y!U^tV$Sys1WH7>hR;l~UI;$ochingcyE7*cN6#0PLh^(=b z8WHUtc3Sa$J2|-;jQ#|;P&vAnrvZbFE$S)^Dj?RrL4ByL&>8( z2srGtQI8%*Y$wDN-w580r^d#mXXMYYe54A^c=Q>#W79QWg5wa~pJ(@l>dGP~xd<_K z2oh&VE%1z}@>ph*u~8byO(jwpQxtj1!gk%?Ln#Y8l9=>O-{NLhiV@Z6v zhJC}dJe2U(;@kA;J}FefSxXnZwA->tP>KBf-!PTPcZ&^2R=#!pvc4r(%QxIQrWOCc zQ~_Ep(}{emr0aSZ99X1hX%JJ)DHNK$=a`Z%uzT;KaAKpx3b{Z&FQeGuoMgYJQTX!Z zk4%ndId1N<6zHA*VRu!MQ>I5psU$s?Aw5e5sE!}E3`>YW{{5<*y#7JD{&kxr^rP@C z+)td2D~2x$nIj=Ck^2oz^S@cxS*Fl=g+j*##cE8s2t{)oK^iRY-?oLcCRkc$1o=|< z{j0VRkI0q+`Dd}5_G z%XSD)f6sjRprbKB`9b*oYxaB4i1H8OKvv+$Z{+(Da{N{T0ssmGKry61@jF>|(7tV?13V7|zyQDizyO{Hcpl(+faei;9%r&VkE-L^*ww0rhr#mz0|N{UFfhRL zKmZH?42gdL4B&Zy=P_`#fafuCp2tFl=aJr$3LKB{8te-M_667%C>NxG#s$iSXW(@p00saC00!_n!0Q07W8}S# zKrT*(zkDxkNgyQn0TXQIc?BuZgvRHa$E4;|KR{6yM#>vY^(K9R0Jm9Dp?>(8X? zRCAn9?qhY=HL8zHyZ){3xIOM?CD(&)caW~f3`=Z*3D4FoUf^DL- zrTsO1Q(x1suC1-}{VPt^@V@UjmiNHhGaGy#zt?y~UOo~x*l>VHJHZ8L0eP%N9$0sc z=AK#Q;V;GEH}HP2^O%%M%cpxMNU6{r06iR~eu{@Tu)pWjc<}6Y%Xcithyu=XxeAF* z%Dt&?>7=@$uI4gzHL_KnKT7uit$m(_YAvEnntmW)vjS$^faiT%))d+LaIcK+*pKtl6kne;p}%!X}0RPZma2c u6`X1so|lq(tDBedIjia66g5K}IlUHa&6~NCtdK^&JpLbtH9)!JZvg-=5TMHd diff --git a/tests/unitizer/substr.R b/tests/unitizer/substr.R index f4e89391..8fcbc418 100644 --- a/tests/unitizer/substr.R +++ b/tests/unitizer/substr.R @@ -1,3 +1,19 @@ +## Copyright (C) 2021 Brodie Gaslam +## +## This file is part of "fansi - ANSI Control Sequence Aware String Functions" +## +## This program is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 2 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## Go to for a copy of the license. + library(fansi) unitizer_sect("Simple", { diff --git a/tests/unitizer/substr.unitizer/data.rds b/tests/unitizer/substr.unitizer/data.rds index 476bb1b044a58a17dc4fde4bfa9a93dd4582259c..a3e182eadcb249db52034ee2e05cfdfad1e0546a 100644 GIT binary patch literal 10324 zcmYMabxa-1^S6CCxVsfUJ-E9Ur?@-CIk*&er?|TmFIL=3ad&rjcXxPue}7N%?v?Bx zlg(x`lg-S2X2~KE0RJ1%XFk?$tCAU{?up_m_~VP8bc+OaXNZ@6t-`cq%12-^uINbL zTWIEU{B<|e(3d?t2ZbY`)j7Xn^9*DDcq-+CjQ(7Q&T^9eW6+cvoDR= zODkMc@ba4Tsl(zZ0g%S*5*VSzn$Ga1eu(BBS9IS9*sJFqx2Q(sN73zk-rZo8ASC23 zrr9X~+lUitQVnhFOjMs8rbwfi2XC4{8h)pg)eKVWo&JeA{*$rdiUT=K>i!bXGl24n zLKKs;9!$pPtLa4S`x;+F^nSGnx4y;O9D{ng9rEF{9b&8N%5W9_S7au9&qcMYh2!`2 zjMgnS=U5jVSI$%mov+zj$Hz=$RjX*b{nG&R$xFfwM#B>RVxvGN$wlvYR{mX;-7%a7 zY8h!+NOGYfL%~|_`1Bgl!}-S2A5ZI{e#Q~)(~ z1OpQsL9bcHMnm(Q(i3Hs>%F@JM=UC!?JL)^ys7!5?0IdWh~Le>12|RKM#^`X@PC$Q z&(9Q@3E>iL4EFcvHc4)yccmE3S%{4H%Jcl@Hg@&07joU{*x8@bTXj}T6j19b_%fv& zsNq+h*oEgN2Wh@{N@n@HTo@jqhMNKqXSMewtKmKdJ1Fs6>iP>wq~>nA$x!3denxTIe7l( z=9zPdL=4O`?`D3u{zKy;9~P&HE^>IYT6PBPGc2I;t zG3TF-*PLC&f+5nw!-9AH6=#=)&gh37P36MU<6dul#p`XJ7h_KHRhH{Ft~BX^IA z6wT%%&Vq1?^#UtzwG91MZOBK(<=AfZOWA+o?id=Vl z+3X%Suo0%{ZJBlZOcorz`ze9Hb|I|naV?7rmjNn|pg z_SJ_PpaWWS&H%%GI?6D6{VGb8Wv*&y_|L|%-}qk7h>rDdJYz@~^h~mGOTq>}@X^sH z^P4g;8}3dERM?r*Zs!ZGnL#wwikDs?Qd{taJ`0M&5lT038X)%uFSd5J)6 z2vm(bH&CLo+*yMJ$uk@81$-TpRfob4J^O13eivqU6wOhASbg`~=RxfR@`DB=vGGI{ zUc~ENMD7WR?}?_QO4v&5{3RZzGzDhrff);-sGJ6SB}1W|*TLBvQ3b`+eA>JKDJUre zw7B7Z)tF*HX}&n=)@w|$cMi~;k}cbD{pxu-jXP|d|L;po5Qn2uQvfcJpJU$1ovY8xNxmA70aan&&IMjO=%+ov7YMexU>E@y+SX92sY5(J_ST;*2r z&+JFGUh8vJt*G<(R{z~(^^!9M|6_rmImnOaXxa8#6N;>bQz+D#a$rTTjXaKB!!%Cx zi12C?Gwk=SZt(f@^|B|VtzN$}X`a4NMU{mY*2m7-lOnvWvAtHmG9|P9?PY`qCA=$+ z07E?{{J6Iod#;6ehgNg$0GYHNJB1cQtJn`H#f-pltxO$aFVMVAY(!dNW{C4Glmk9J zw=kuf(ZDYpdse2u(ODxnde5zGO>#ZbWz@^Tqr_rkE>Fk#S|?=s(M zMD{a#LPj-dKvmdMCoLV^inULbJb&<$QcPU64AD1cMo?skgun2U`(X*Ue~mMsBJWsc zAN*LY4tNb^BfoH&WK!h$2+y5XMLL~0-h|v^uC;(Q9EH7vUs8kaYp3c}X)UT~F#QKF zES6!B=0}dIrtktSKVgl&KjHf?-DZo}5#}%rL|nSOx9b3Xv=BWzP)B|I9li*k{LF0t ziJZ*PS_rlmb3Ft|FwG7G^}mY3zB~%Uz8K3@GuL%>I6|1)e9N4|J~dC0{Jr@Vn7YkO zHWCSQjR#=ozrG)>9$8tzS^h2UF|tqnf}J)rRoQU!gQ^@?6~&Ccu5{!G>2V%esnZen zTXb@L_i$gx^I{}s-@kZg=_cV)#yMXd1$DP46Ec zx{|eNWa`npu+#T;%)++-)4O!(DihO!-G!ksFp!17SIBC0z5IpUqgJz4CDj6 zCBg+>mrh>@PM{Kmid&*N=CID*EG%OpWpCbTd>XWArZo?Ox#P4CzFN0eL$srpD}{^= z^enj;M|SPMYvM(ebb6vGjaki0C3v<8_h{{!i2zUB(4ponGeq)YUVf)lk1POBj9 zrTfg@DrT7!yEmJ84hGs5F>wjk#%8=Ia_Hs{4s!+UkS@;ggKVVtcgDft40wzlDe>%*D17dP8^tY zu5v;UMYU(n?>tBD*ZYliiGKa zDUPbZ{sLA3#3||{lYd|dzpDeD9-XSG2V)-q*Yu==ngqkx)H|xFEtKoVzLgqIYGcZ6 zB<7R2x0~xdL|CCaE1{d;O@EUe^;Yf~8R|c7qwFAOpUAo1N6pN`Ofp0)FXft!zIs^Do4Y+_Md&D%ojd`02g>sgT%{Fq{u0zET*n;F%^6S!S z9T{Z65MW3xxzS>ecbO;E3FagqK_bco)G*Yr0ajA1RIWD{>@Y6nwT;;gNsd0to&2!GDQb=( zzB&>2>w`lA;HgavMk>QKE*3E*R%^e={OuLyVi;USJ5b4stFKz|OJ6;FPIFh`2(e9= zI8@UqkO&(4R9Vt6u#3Gbvu7N}z}$ik0u1y6;=hW*`=kEDR?7dZ!U(=`A${|P%L_tR z7e+9P_%0;;=^r{w6!P)H%L}UHwrs~XlC6VbPCV7V%R`%`Jck=%uzOR?ZJk5(I`_vE+0;iPOE-VYqqu# z1cen$ZRjVmx>{{HFkgcaNl5Zg z8wJY@2d>>26$ERILC9W>Bx!}c?sMO4{qM`gysG);BU*(@SQ#eAk%f%+U}qHFiD;nn zq4Uk*rZ%9&Cs6aN5zGy^yColgJ9r$)ek zHtOfse3*$Qzy#F)uv~=gyjk6RlJG!(=Gx@_KTy5!F9o>W^%EYN4tqilu**9=pj`YS zQ2GRbZ(1QoH

xYX*Tmi8YB&Ys)hc?3=3|Y zVC3Kzda--aW^#kOMFK7xvZZn4N-y@=Ca4*x8TOzfS^uNvu3NSs7sMj&|4jeUR*hxo ziO2fJSgNpaD8xzlJF_R~xVN6<`UrSjP}4XZec#`&4u4c+tsCu1@?S!qW3*X7^qir? zGgk20uTXmN3=eg_{-*rpq8BJFHfIC;aDDClv!lZ(;efTppCNB|{Jcfx)@lzPCus5D zCl#>NaaCm>WUr)|z#=TQZfq-~;SVo6oGHje3C?!w9+u*G+4(iazl^s}SYaK4X+3Q6 z^Od-5iS5!&O4->d(x3zTiI)(=ltBziq?9pp7ST>Thc=_*P2G5enXdw@uUxP1zBc)H z^G@W9xeVIM+0Na{#LnDG!%oMlFV%8rO<~%2X^PDTxY$3(L3`u(nxBv%-d)G_L98b- zakQSd>i`NpWqz}4SY$3!7oVlug@02O|A{RH5Mls1dm!cAnz7xnU7%v2fme}JzC+@^ zYbSkoqP2VKpBqR*Z>oON0_~O;fOnIKSu=qDBJ~~^-v%7aCNjl0)ccZl4@=Jff1v8Z znNEOe{lMfc(YiNX&*Lb2Z$40mMY$4cIR;FizeXHFm3UJ)YYc`E5#W1AlEfwYrw8KY zPPCK!lS~wM^wcJ!5(c!C9(N}g1J1=lIL`lS{Q(lo_#Puh3EB!Y=#<(`R z3yYo<3*|A|>?~q}Ds#JwB>Gw<`NNPo$5Nsj-iDxzc-s`?JS1<#DWk$E`P!DU?`jpM zW)x};324O_8kEPPzk+_O_;F$5IJ%;(HPi&1nWqsRrB@FbO= zbywpV`vsFUFVLx~&4I2&utyQZ^V%&2RHI`A0YSJcUa zMjb2n4Qiz>@T|=Lj9o^dT2KBQPtAy)I03L-ID3GcVKf;YFplS-34R}DMjtfb#TnST zCH9WewO!w(v zCd;V^PL82qa|4e^{)Dx-%@dCoW9$%oV7iW=fwzRNgQwD@vw(F z_jKxJ1f(pa{I-5E#L1pTw@Y&=vrTXfA(9eXINuO|5NZ!4e)S;Abcu3xb|Y#SD=up2 z*$^S;az6Z%V8?aoB%a$Qm2Yyp8`Ribk&X(@Z4oV?{k26S6HpqyjK(Wl;kQ>%)^xt% z9{3Hpc~#x9iIw+kA-Z7y$Fy%R4Wmi_2)Ho2S=H&-mgw^-2065bplG=#qLz!~5Mo*T zMZGR#=4IZ;c=`-}iwwc7X6<0^FjUF)?CEC>?~(DDs4DJmLIdCPI)NX^gWH1%eGu|U zLP~1Wnx#HiZ0ZQCel6{)@^UWaB=*JI?MR9G`6}Ie^I9poRl2@O#xmUy2>)Q`GJBLx zqur7|#uePL_<{YIbqL#|&1M}GDl{s3QpiF;hIkl=>^OtYk) zEZrnWfgH)|RbEIn2K0#V!Hm+XS6(Iak3i17gz|#p33Ozq%jaLCHOsx*wd^Ln0v;6c z`NE)jg02iUSQP~Oq4Z7YUSMwmh4B+04Dv4)HQur^3}vHhmuQ+9Y%-;eT+#+7r_3l6 z1?6zf4X`nJ4m3vAX7HYx|@CZpKNM!m9tOB0aYt&qwg-kIAwc*c<)D$FWp{@7W?`*)K2Vr09Yv^+wX74n@|6g>_SfjeY{ zn~%;wJGMP_Irvyvrq;+KA20kirQ{7VO`~(zswxm&oj%X9UqEGUbZC{KZSxhteZ8!V3#R{?VVG&%Vcn*eQ>RWlf|TtM1+=JJ`(o z2P79GRgP~vvHa_)q)q=#LMQG9o~<)i?YEB}122+;j?;5izyBp?6>UFC-)j!uqmqn* z>0|<$%Gc`8LzggZt@*)Rx4Qy+tQ?H=UfZx21HJ$9)LWBs z28Uq3>F&hoB;T?MuHW*dzUAz=jIkKUuBVM&`l_334VZS`>jPVA4t^d`tT=A7Ykc{2 zLpt5Y3e+p|L2aAcSEJF8H0eWi{N4&VDUw~tOwvZ@K()vaTi_rIDjI4l(moE+RNkf< zRLA>;`q1vzIRuh@%a@TeqxDj%u}HAo-};tuh^HiRUYb9P zuWs`#`Fr2RegHk%VZsMX32ldlchfDmPYYT%X7Ly9hnAx^3G|n$>({TxY|aAtoC`T# zZ@S%Av9CKF`v*Hsls|7ozwN#yoyDCH{oL2;la-Jvqb}ACVQ@HTZt^_emi$nNfD%Co zAmDRmb;j;hI`5m*_pMtXQkb-IX!q8B4&1pQfnpTrl>U|DW2!9e+8#SP0%X4MD8m-f zYSq$C)YSy3?KMQl70Njd&!0$$7tbf$*GKB4h+!NM-s4rIfFFyZk0Kkv646Xv6}(_j z{#%Fc;&`IQ%X$DxT_`46-qyQImxZ4g&wHjxs1!yHlJl=OYc*fI3&@bk62!42Bj_U+8b47 zW%cay&D|5wa<@^JCLah9d~PypUb(FbclpamVk-q-8rMN$-#^6%fPC&(RY@ANzx`#C zK!Bmi9XdlUJnLUF6j;&>n@{zSZe%9$B9@4xUxdl zJA7_5vv%P&$P#Z$wE)~9|E1B`Q_;Kq(?m*!DTzh$MejFWFd9M@147mcxw9j)^ROUD ztqJXChnE^mti>PG9Qh*WiG(DXdcAFBq88^hSh>GEq?^Phv z@%6|+*f?=dA}Lvf&wjg6MVpj4DCb<6B2fi1)Sj4-$Vb7t}GztTx{4lAe-zv!?mRD$$Io zQ}X+kvNEK&XW1x+VYtS=SDR{LCdrd-6kvs0uTsUrbENaOIs)^GU1;+6qx%?8#L z0h~z)duR9D*V@JHs=uIp=)S{fibpMe~mHZ-1 z*G!#EUD@UpJwBTLuejZaV~uRuO187hqqnHDou_>t6EYBnB3QrwTP>9q{Nr8vU&Wz0 z-?Tp|pU6e9Iys~oZq>4zEl`h1XzRVw=#G!gC-&v7$} zi71z#PW1$nX8I?sw*VC}=Q~ximU!yDX@cLEpK@$3G@5c)gmc#?Sc5Qw;4;%|67s}6 z3T!^*$2iaKcL}^9aAzm4v#y_lLHPihB^EIjnlKx0CLgAYrr|mai(CldeoH5d*dPo1 z`Qvk{wkZK@8q7by1#;Jdh6!872|Y)T&ze0$;9j^V2v&lJA(ml6Iol93AQ6Qk5dkI; zhTK?A1!7tYpZI!WWRg%9!a2gY9WRqjvnNoHl;jEP3FSFN*Cqh;91?89>BID_xG#Mw z)wTDw!lKh=%AXS~-Q6&amvLXBI+$$0(h)6k0Q^&!Gs?NIMJbB~E`rrTN+H0cc+TNR z9GcG$Ny_p{a2HF*k$msAc%@>z0M(xv#_jNVkpdoM_Kw3C^q4=<4CA8M2AP3DyV)Y= zVLm#7YzPJ@Y+7rcNb%@;+d7TJT^&SRj=UssBWl@;dnatJtN{l82DQV?IZz$D*#@Mf zbRF)xG=p0E8|XwM{>acc&^R+DIxqIG+k!9kw%^}5v-HcC-Bk;bm3Xb7XE<3OeUow= z)-3+7i^t75Gll;;$!0=)yAE>vSM2}I^iG)e2#p5kxJ@=Th{a9xM}wxv%wM|~U`!#F z)yd1u*E3briUwfTVZHIH_?tq(am}Zv3wFn--IvzSqr;R>3u|t~zv6@bR`}FJx;vCN z%BI@XvPN&GUHp-9o8aGtSwQHL;(YZ9LKzLHJ!>el6EVbb2dy z-LP=J=E$y*Zze#^t4EhFV@R!zW%RG5P&n8)^IAQkKC=6J?p#yP@DsSL0tZNRMUQ9l zplw!2ulaXG)!Ezi*jTny1dRB!$BW!0%(=MjQe}%Rk(acKbe^3BT7#<5 zOsxfK%`tYOPof7xJp|?kPWt5TB>rV+)FH0FR3lKUiaoYFh%m(hv*tv_P@+Oyo|%_% zS2k)@f^&=t9dTo_BEi?PAq$h_tzh@2L=AW)ryMDSZXuU<78~C!KCtu(i5%V=U z{*g?)4N<$=yhd9KJbGA$O#$w_uyG9KN(A%Zmdf>S&e-!7eOKo8-m=T_>E-8Rz8q`< zg7WPphHpEZ?UnS3Pd>$KR!iVh{`ch+pS6JE+9gUqW4(l58uQ@_R{0jj<)lM(b@Qs( z7k6<7@8`p+zSQwbgRK z%~hXhuk;6%*f4lrW^vVuQVBqYlB}a0cI_*6y1s6U|9yloK1`}L^8Q8#N3MT-QX5^? zwyxmvtxSSh8;r$mgNX0h#&9k?R8`HmEh_Go7!!7u^b))-@;%cr79V_Gzj)WZhL@r@ zy8*Yf&e>+WLcr>zs0)%9syJ93972dNKxpxK$V?dTF^C_a=!0Sk<{UX zr(byA2$7X7-f*MHUjw$ud)`$pZIl;-$H<1=A2vgIyT^yCb83bpGc95d%ncI!Hea?o zYKD2Y3`3lpiCm4esCb0Va`1mMk?wKCPEXs|{H3i?xF(tk+1xl4UmPLp<;RnTh$rls zz;QLL+ETKbV)mwecUjncTkPuG^s-I-!Mz?UA++9ESws|rMfi@SxKKegre=CepMJ$E zN(i=yB7QeuPBtuIKMjA7RnjQ4YW~EWTDGK{mh$>R={VWwQ}9@Pxc=uh&E+(w(CuN& zAtWQi+u%n2CdKdEwvQ-`^rlX7$6Fn7;DYLPX9sCzI;F4-L7QNX`wizX{o^brxlf>o zzrKeV&kIa>5AMRi^;@4u*#cfaIZ!{pP}gjX0wUrz6$=jfD3YWeqrN*y{7LD3`JA!; zaosci440Kc;H<{Na2;LtctHKi@#^*A@KwrsRq;ff;yvx*VSr?d56dm8?}IH0p9n3Y z@+LTkT`25}KKIc&j?5y<{htd(I0u95@!M1xp`7+})vAwx%O=03g!*$XI3=awA4m-c-ol_pEH1>nxBXxIj@)x^4c;iG z$X*6TV*NnG9W>%k_S-=WUGYK@Ik6N2WCQ*He^IF1L0YBP2lrJG=pLP%P7DsTj%jTZ z46GRL9M5zOmSho$QWKRXA zlEM!RIhtp->TN$9YQiyhqYqjrfrmS@k;`JyHzOO+rr-IX9$6gTyP&X+e?8CfG|(Fj z)*tFWywNUsI}ZRkpWm;gx)0L+u5o?ynVOWpwVGP5k=-2Vzi$0K+hE072&y;J{?l4C=t-@Mmly?f5`=#=LMw8>~Kj7%~Pv zIaBA!|Gza~=gEItpAhg>?Knp)OhN3$FNIq-$T@H@K9O@IWmlsLVEjKf2w+?acR~|- zq6haOCvIhC_BK{w(ruA%uznErw5PrcHpX6Ded(aSe~4C__$B7{T~odld*$vO_lM8n z#e+$QP}ti$%l(Vhsaw9~m?U?+pP}_#@!w{bjRu?63A6pwAiL;9hJpH=#d5h0l2Zq9_2uIyCofK z-Kv|*s^G1KEB3aSEO$EFRJ&4a*}}Z$jG&;|iOWkW*QN?M^z7DUSH_;{K>s=c{pfG< zYznm%DR|y>a)lWX_Yo9%s8OI9RGq(eCxam#3vwD|mD$m8-X#;)In^kmk1^pHm21lR z`X9HC@%}koSuQ*6aV+*_ESIdTG*xyyKAbY}sayuVUj)(J|1|Bj=qAa1zTpA- literal 10036 zcmZviWl$YFvw%6cYjJmq7K%F*FH$J(?heJ};O_2Ppt!s1!J)VxiaQ+KZ{PR(?)`Q1 z%|v|HGeIq5im$COpBw{7ZJ zv+3~ev>7Ke@G@WAY!<7hp@au;Luso|%l__Iq3Mt{r_VB__vVx3rl-I67T)h}$e7%c zRfJIT@mVC7LnAW);UbG=i1YQ`#$i!H+B?-eau2E)^Sec=7{&5^D@CI;Vsl_GmlW^xz_FQm+x5H&nYL@eMf$l_#;pB0LM)t z(uE}A`jWfP`|^OJ!1JZU0r$w}p7x)_np~CE zm4xbPA`Q{zqyppj_M85W?$@hlX2d+q7M@=}llo@-$k{9T)xke%v|^=BvZQ`7;!H5Y z#u?J(u&RDAYfAyYQ>)AZe#-u^2KB=gEMwPDG4mB4Ltns*M!6~e$L>T2rzpJLW zw@+j*6@uC-ggVt?B-;tbhw%n8#c=FN7Uam2^_3zK3n&cGE~X6;Rvi84Au8Im>c_21 zrB{}ZStsx_lk(k}W~8i<$Kj+l6l%?RMX9zTM(Zr(>VzPT(-Yf?DW`axyU?ckAQU>P0<%_fZOeqj(lK zB%yy;=SVuT7o7JMcH+Y?=w_!6Z912lTih%<*gH1HYeO|eKRL{!-Mh4UvZmxJ`TCxZ zn4?ILZoc+P;&h!0)wwq|M%$g03kq#>lgGJ-S@r8@wwu``qZTogWbJm(m{>0VHYg$0 z{rO5G@gW0u_~VmI`YA73Y5oVM#pnVJ+sREG!Ay(J9RZ{`msv_c(0 zXanLdaT<}gdgI*IE^%xNv$0Ly;nA^bRbHf7_A1g&b}_fAg#2-H@F}iNQ-kLOYi`dcSh+7gy$BAB_zDm_&K_HmNCn&e%K_B%ir^l&`qFQ>wGA73iN|L|C% z+^N4Mz1VZEppkYhh*)M;pA)s-8ND!;bE@T}*F=)aF7a*~PFA0np-paJX&<EA zteYm>aydr{E=}4sm8_-n>w3#^SZ3F9HJC5_V#TR5PUv$zIyWLD$ z55uQ1!Vz!EQ5G$Tso8_??A0kpc3jMA$jLS4PF?5Vl@^HTSROw0c zqk0&uDiNyIjO;uT8Ym+6P#rP9hHk}pbdDl;bs0U7o&~)!hz?#|e~BOzNt79jqb0r0 z++7V2-DEq585{CahTR*+{#IS(ruu~9Tc^WH_~sSb-qM*+RI0Y5X^1;U4SE0h2GHj0 z&{Ec!7Gj-m2$a1LW_@FXXn|#o%tF+Fq#uskte`4ktPy}*9=${&*uWpnxV5ZU6O72= zLt$79&Ogm+%h?Y3sAFYK5d;nh+~CV(qcA{7pbWCzY~FHEn__$eh1k@|Kxj5Sp)>aG zD7JlW6qxR#U_M>Gxz{%r2t$#%R$wMiC>qz+ZrNyQZ+&p?R%}rzJ-?O^lng+|03&{E z|9dPg)UQGb`|Z=I(wA^(i;o<6&YM@mztefbrv%!)`^1R&%2rp?yu+0mG!^jM1eS+6 zBTe)j6V7wpK}b4Vn@%EQd$XKWd3I~6OlxmGsNAC>cW#n)nVYB4n5x=(Nl^Ebu;7xb zes%XcJ&g)mQv9lQ0v?}`l%aPnDd$U!Qr(V-ic}*c-)iz1GTLR8iA9O+)UQ8gTTusn zpH-mnndSf3S5`VCb0ZTEsTdWhGR(szeV;jyD#cG+J|V6k9&)ZbU+d`z97raRj{qo} zrI*EG2q?K%Lp&k_d~`d-m1;d z15NGj8=8Zatt7J{)nAMw*_9Iv|ENOKIeQ+)1xkF-@fQ2l=yQ*&Cfx&p9^n^T%1z+x zuFjvYug-_#N~y;D)Lbp9+NDMG(}RcPCn6Kn01nXcNUYULl$WqSCy7FrGET1kku&ng z7cLH;*zGD?M@pvN4g!F_3XZVKsmAaKm=X91=!h)(01K=|4OT-!tl3x2fN}zl8K9xl zf_!Y2;~yC%chR7&^y2Q#Wx2O-=Lge}^%o&)Tfnl}`(>BwX90+jTszAn|569gs8qfRS&0zT23G;OifWEBkIQu*rk`?<3W*L8XJMY{Mp+ zyZcH9%Ojcy@h@;2cE#0rhlkQ%Ty%9cFD;J7Z*_Bp`RN4%Cg4SgP}=Oq%hm2)2%jO= zUG`dZ{(&8h>C$}M&Ok=>F7d?q3O=G?swEd}&7LI$%~C7)6#jh;xd`;h9(HLP+Ifp} zrwx%Gu{nQkGj~#ssrq%8#Vh~Z+?<$`5SSowDB@q2UkRrcaZ@dc2cq+1f zMty(H7!w!5K6a79JjPN6QM2HGdIKf?c}Fwy%yWQa-Nkx`E&Xyvk)7+;NmY!Ag)cS_ z=4?>7~g-)2J zrKmp*p~nEk{|BpO9VpNk1(cR9{s5gOAH&?}{IPg~c!U2p-DKcRkrBXZQ=3{~TTBZ4 zRD5r#6#E7+hcPdOYnX;MXA0^)b%&d%KDTUEr&ZU~ydjHEHoUPI2%MEu$9z;>W)6`A zngVwlMIn4ZQ!~tXA1$D15LmjbsLSB(Sm^G_|7o~jy%1sPPbMb%(iSmZ>plxld(dM- zfdyQ@#mm87L^-!>`~quG98FZjOH2%w&Fck4$*5aYoItI{fEi%B@+}>u4pW_JT zk={f^iTbfiP=-EKjOUPMrF(n!;e^G>cQiPvk4weT~a8e-tOE>^) zuqA-vw+yC*4wCW5?b*?>T6S1}8kuyha9Fcoa>%TwIdg{Pa4%vnqLoST^W>t>0u8Qa82j!}+=(s(@WIr1g# z4opG0O#8bILfoNfYtnA@fhU{Dx1_zUy*KlQPaK9`=AXJihI)ZVKmIoT3tJ^rdajhb zzef2S*OQWD=<)t#K0o`J@M9z3c2?71Ps-c-Iy1<1uBl49A=0L-KCB$CxdOJ!3I~N< z$zz{I`PnNX%oU=d+`SwJml#{V0{eFM5aBe^L=^d_G5ErodvyMGKxE_ojml|QbAQs~ zGTCb7$0WslYhmXy#^mbnfVhP76U()93#|oI>cx*EyfJ)#T}1Fjg80!scaI+r#Dy`x zT{8f>T$z}=jG9(Kn zGC}QXMpUqS{^^zf8h#e8@B}xinku}SGqU;-R@&=&_4}Cj+Oi*Gg8rg%qP|=xfdar3 z!PI{Uqz`R6jarXV%bNG*g#<$X7sUZ}sFk_!(>z3w{m!uXrIdLn{cprKv4dRctYxDwPI^fI@@+`-181;?O9ScF@u0o<@`SG8 z1anv2v-)n#hSX*MImjNpSfw9Hb~<3m69%q}4w)$7+c&;|zz?)kXwPt9@$d97JTX^( zm0+QuM+Lc9ro$jw3G__07OS0*b@e2Nc9q$ej^A|Qf6u-VF%4z=@j_$$BACIpNb_;? zk!}*q)H$EP{?D28j7IX6vlHqrQ%wAlN&_r}fNKpCE{)5GY^ z28PChON&ejXQTTG%az@Z;F75%MGg7+NW9LG;;FR9VX)Gdf>4Jq;{MHhs-i+GP^CHSeCotmxU`#Vb>NGUw!3HbAoAr z9v>G%vdsxxKjt+ktm8)XKn4JhOukMe=KHe)C3aLcHYf?muF`U|QllK!T_Mw_NI zeUaHaTcY@)_*Ml`Uq$g75gLU!d{V#U zj+lZ&=tb#8vDyy#0S?ikh3ovZ0$^KrKkGWl)Y;I&)L`>$NIoI9A(n7G*KSrup=kYG>Xq4RlW?8(`)3qfjI_VuAet0|N2$f7lr z)AhBFyD5#=eNddtpAN^a!yi--> z_^1Q7bhVMaA05D9xIjHvo)(~HkrG{d9H!VXTZ=^gG@Z?-S62}%)+0w9#2A)8_T42; z>y|~}D^vF-x`xl=Po-;YR*ERXk8R9n>`1v=_YsN-(&0ZsS>T(%qaT@-)NR3oOg&aFZ?9&Eu405ljhjO0)r zVCY{wxZ#HmL~*I7bjy0!%C&Aar7g)|70uvSminJJ^WSM&PjBc$x7}Gae?1o zOref~xa=uvpr52u=%Y*JLfyk^2D@=?WxR|&1(tRUIERBz1?eK?b00!DTsW=dAOs6@ zyfP8X_%SwFb1}VRo3wh-ELmmWHu0spp@%a#x*qR=N`IzId7Pr4GD06|jIfCy52^sF zpg7{2FuZt%8izQ8dm?^IRrT%mY++BflseKU2Vu>ZUG3>Q&-6A-%~JT2d7yHDGD3gZ z5>WZ?WPdu|3tIX$nxWR8+mj)6r;6T}Sd^NBYn*93X!`RyMYtDEIu*qatJP3_6cNAi zs(SHhTkmzT_6o*B87v8Kfp$R;=Bt5mnPMa~nwm7-XT~l5+R{-x)dM|`^j}s0KQ^I` zv;Ufw(^70B!5U^G5gB4!6D9FxO{Dd?x71U$?)Hpy$)8#h!<4a-w2eeZz&R7%&ZBw! zH{{N_HGbFGlv1`8P5&F4<`eoU4$CT&MIIK?^SZntxnu-r-}T(ny%Gk*TKi+0wn?<5 zYy67ECbxCd*{N?uOea;+{il`We$OJkX~|J2+UPhg(*?*7G4AH7GP`QCf!^vs+ztC|P?8g(HnHj0tpA0MBt-gXe)Y<`9#!cSaa znLOh5^xWkliL{vXM00}}{nkHLgKHrC2VOV(1Cn$N530{xbCsbB9rH^%^26v?L!QOY zo`k;@fO!p1lsR!nr0W&4xW}aKiq3FlfxmL-LZ6Kv7!) z&=9KHMc4+JiQo~R6NWR|k!MP9gQ`!hgJpAt4Se|=ebUjnENE5SC}BX?I$h#Ntv{n? z;idTJo6NCsT7sgQ<6V9HkQ&xq8TytDU9vrfs@aRkz4I9doDp;71CW7n%7ma?Gv*aweH@>0dpT4*S4{@ zwP5VKXEdt*joP-YH6da`M~z-psnt*S|&}{B>4zjQW+u0B#H1t|1MtH>5Z%f26w|{^A)XQm?>HvMhkyW zyagrmlsUg{+llme2vbjs6W^#63LY0i2bY9X7&5^w_bfo`2-Vs(kjElnp9uLx`lij@(~EFv+wf9TnkalryKZCB3tv zH|oZfe%5FTE-s2jFhrWcFczd06A?TX7inZAk+u9b1Coe$_nA);6y0(&43_4-5I zf4t&)>2gqyB;HfeTdwL|`&`Ye4E_EoMh>`i`Xbm~Bs2o+VK;F{KVXi=Wm^$o_s3_U zHmc%OtsiS8pQLxj7{2ttM+fV>*^yA@MexNe>R8^syH)qmRelT_bP`vwfFcfeBcC{@ z3%MoTHD?2JK?c8nii5Q7b=>a>uFuzp!uE!tO2O7Z)qhY?V8j5bawsuQ|5?)?$xe3| zO_yAM^s2B@|M`LHQ6W zKQ5Umdvv4|MI4@mzL1%IUR9Yj2!*~4uvNc*xskgDam=2hmrS!$^QTJBQL@LF#~7Co z5}{oM^lWBagw5*xR2bJS)Fg^p3>QY97s)h-yWm})}iW4e4ec7g^fgRO7G@z!64guS;M91n;#H?4QaRNO_KQZOPJU7^aE-+}ZLR_q^Zbu`?DRYuF%I z5KWaSM2I4(fD)(uTdNYa(Ys)bDYhZ_?}GLeV>p_Gxgwz>g;8Wgv*d)gGu7Hd6VMHz zUi%uRQ<|oK!SH#F;^c^imj8!D6}m^jr%^|CS%3KMw>?J=q&hLTjNlJs>9FZERq_y~ zUYai;8t4EDKsZ5CGGPWuFU`C4a{6wx(WFz9M{y#p9N#npZGm2ZK2ZO+99vv~K8F&U zr&FkYg&=!g>%uBd(zj7LvMN#;+IRjK)&3K1uDELa84iw^FOK66H>ypkxQu*zp7fPi z0URIlqZ^fnaq^=lzDu?J^$Y0u{dxU)tT@DAkLIo8k zi}~Ra&|ITBYmm$x$BR9TQv~sdD^WuVYC=-GV!>PJ#BCF>yBs;RZjU9=dh%d=a9Sf| z{GgXD;~-7icMsoT4L~^l(qUvm=x78q1{(9rSKLpr?XUc_3%YhVx-niD)?xGoq!cZF z@}-C0y1#U(CPwQrwz=EvPc`R%DkRr7jSdpl6j%IvvARdGsqkOaX6#<0uhzLCK~`E* zrQ06^4IWZ~mCR^&C3jz6ZdMlO(qy8Iv#w8eeYSzuW`1wd(InJ+!WW1Y&a#g`?gN83 zoxe3TvE5_V#4flVF=g4x7xC`H;UArQhGiQPKllw^`K@s;j5QlL*e3d)o<**53Nayy z{aoPEFS`#S4Uug_U!~QyA6A)=(QR6ME02;7 zqPb7eHKg_%Qen=+RqrtVWykHF-flG+%9XekxobJS`l^D%Z!T=fvFKNqxNAcD@nDwm zB+(8To2|=T!RhCjq`^aEY-&#dA1mtv3TS+f|D#>X8gngyJ@aleONIK%z^19cXOn&l zbCUbuZ>l5S%K9?n1tuEVuFN7MW@n*8*{Ipyzd3gQ`?^}pG>@-dUD@!(udlpy3wm@r zVtjme!?s%8Np(^=CsYcUr+T~nD$VmanlC z|NAnzi{Hhh`@#0Uw)XIriR`EzbCjZ-N`CcuFDq*!;R8~5@%3E>7->CbwO;E-7WZAE zb&~kP42gB=daBthp7A6--81?%rsXu^B3k0+NelITQpOHN%y(9}x+#vh{vg6sOR~BX zY(q&FNd-1OmQ^L^OxLFr?$Yton8CAZVepML^yS>#*Fv;u*{L-2Q}+sS^xues2%0v; z+rP!I7O@R=p{d4c4tMji(MKY*7LPAo5<>0isl8U}g(immeHl!^c_fx}EusqhC>qEYFObLi6 z&kC+w$Rz2ZELGH0Et(;vdTQ5o94b1SU=!ahPqUJ*n?nW#7#6grf3C_aHmb%q`_TW| zOymab)r$R%8#Gu{z(w%|rWB5MgSe_CX#`Y;QtT5w_5~aEI&Y54|77+}4wGxyJ#`u3 zDfADI>nCk;%uD&J7xL4Xu_B1?f}?Wu@!a!wHJ0(5C<{CAqzB!^g$vv1~F&tdc0Z%@HP6z)tBhB1-XTe)z?%rq*T1 zJ?tL}|Cq|BP^I{`38}iN_CFUI%1R=;{wllUqlZ)qp?ldeL0;QP{aJyi6??4XhkP^f zem6a4tayx0`W!VxCL1m!36>Z#;N<$!3iNsN5P5not=saizo5Ty+1BA@n<|m$w+NZQ z-PXpwu;840-wVsRLh}+go>A_r1@Tn>$;-Q(yS#pz^QEkE5~<<|c`(_$C%-^hN@z7< ze$z1OT%P!LlcMxM>k@I8;}&KAy&#x$2k7I^AMWGHPv5Q5{^*)A(ui%hqxG}N&XZ5^ zd5=KhA?ic_dluq*`$vrr7D)VMB`pkMoot1_&cOkX#+eX#2z-{rxJkkcPSe+XJ%;2SSO*2fP2< zF#!V#=7ALKj=IkLSLAH5CxYFh=TdgTPQco4qME>3s5ls)7{Cxy_^(PQ;0U{8!(ZV_ zHsTXF;`D#XBCsd07b*Y%4I_vF2Lu2qApk?DX&Aw{fGjw{xPogzMOqKC(hK!$>$zb> z0ktZ?R2Vc73@5xLs-y4+D0rw)5CRa8jo~N^Z;$6F96I&Ln*sJAsj=iLUReYG0JcIo z0scUDqW_=j8ko-5zp6W93$FRiu{&eA*JuI}{=C8$6aZ(S3JP3(0G9VR1+xcW!9WfgfFKMF!uldZ&Vp8HW}z; ze02q}SB~jMF~K>CL|}oT7_TC&nu{O8t$p;OcyHmHTNjBJc^}7Egoyn1@MW}E<9G5T z25x&w8AN!0G4PlhYc~5S;~^gM J%`r68{{XVDSsDNU diff --git a/tests/unitizer/wrap.unitizer/data.rds b/tests/unitizer/wrap.unitizer/data.rds index 2f6d90073ba8fbcd9f772a3f584fb8914291a61f..762ae05d93162f89e58aad462865d94ea5dc9f72 100644 GIT binary patch literal 26616 zcmY(p1CS=q6E^scjUC&zZQHhOdj~tVZQHhO+dH;>`}==)7k3@el^Ge;l@-}l)!EOJ z_>qu+|6L$g-7sl5;(qumk>vFRcsxBK*LNCOq+_~93~QcOMnJ$rNT7mod%^&Too!%X zFLN(*tO21QAcdl$Xdu=}McO-7b$G1lQ_3xxm`m`ob&>Zhtk`|WGq1S{i?3Qk&vifAZU5kFK5Z-qgRMLX|aGXO#fby(au9_~S9xQrgfm4pT2`ZcD z&JsrZnPI$WHF(C}cq!j>{l3~z@qlDuF^*O_($MhtUhzZRz*(Os>jv0Ci4=kp5fxf`@F&y+(=WG}V*PRyf@GB+>f;Gh=`fV&oln|oDLGi|vw)zI$U056l-y#YMN{i= zTWTDLp7l*UVXzS$Flw8{P^x>}EtgbFUG5MzXa_m0+BHBBx?8eCpgs;}$;{L=#H!WmFikRdH=CEn1mJq@9Ryo20z+t=`h z{IfpUvE#TQ8w*p^p8K?TD7V)qs|5_6Ceeldy7S8tb8(HL?y=3VhkgsUr2Z-a=AuMK z#!w-$oC^=#N&;K#eX^-|NrL~5H9`XVBkcLtT7Br4Z$XmKu$PGPs?7RUmT|W$AI~F* z!R5SyIE-3RxkZMe2Bc{~)~3ZELo-)HW<~Jr57Po{6c@Xq?#|Zs_c?m6S(8?T-RKk6 zW>U5twbJs3#0B&__p*mw5v8DidElP@dI#1iWwuV1c;RL1kr)s3=bh@{Ckqd*F z3r)hvd{EY8L+>ZWG7TQj(OEUi9V)=Eh=mX5nNo+U=$THUJ0|lUsyrIC>M=!`>1{}* z}}H zFy3BT+o7qf=Y?8Yql`$OpDb0VL06b@op-AGYd>3nfU3eCXSZe{ykcvDU1m&qO6ORe z!)v`xb|<+lYAq#8_M(b2pn?rI+~iOKZM7-`X1KP&z{rvxPB%*ws!J?9YN2OGEJGHR zak&T2G8!S}loVeWtGLOs!cxqN(BY2ba#Pt*yn=Yfp65NP^dbek-AOO@@|^dvV4><{ zu{T_K9H7cjKy@cKz4F&0``$vhdQ;W~4;8(`P&#EKS+i&b6;{Ejfek%($1_VS=a}4M zCAR~XQ$71=4Pi9QgU-NAI_*(6@qp9)c)H4BG_rDdb4l(m;@c!AYVmHj*I$L1>VgLX zahXzNVA&wI=n=514wx~wpElynhRU4?oQC4LmEjhTJTwKs4jPBgB+iV;VTd`KL|Ppx zRfyAXLd_Vz(KX9f<~DKwQ4rE>98xN%)Tclc(k`-!9E_1}^XNtEW?Q+{s}PnY*hp&1UI@9AY1UF z1cD1c3-MIvKL3Gs5womyiZAbh6v!neXtr1ZD#zUp-;s$o0q+*J57VEy>^7?0K{9Uu zKSFWe+Z$k>zp!!PdU!RwnA^twa?O%MH@tT?`L%bZpan!jJ7%rG(;ZtLUI%1&;5HpL z_iGzQQhr!Q#AnvD+stLG!nrtxcBvTbPjZPZ7FGqTsdCLeghWex#cDDHB#42Iy{MqO z{@JOlX05eU_R`NaXOpFig6zun`U2eg(rj;!)78jvrwRD-bs87b%IY`@rJqbrh1Vbv z+buvnX)sGZ8=a&Zy=~yI zQ-e=F1U1(x1>=;z0p+apV$r7_ zy=`WP*t0&y^Qq<`>TyeBrXtRGm7v${Y&b@{pxq#_kK3ipH&z$c<VZgZC`Uk6^OW}2sFkVHO25m~mp?^vpa>Yk;JV-+0daiw;HS13wnv8>`ue($sr1B7k^2@*NHlxZS%(UUN>Lo!#%@E)rexX8Hhr?7~;6% z@)-s@UCWW}78^T>rLTcmVfRd6Uwi~N`1j1Rz3T74LI-K`pLSxlh}PPtzD>upPOOR7 zGH-7$uZ`tEK;>fXD(T$hd|O_sJCGWF^!y}*7*u8O`-T7Ni94z-{+eZzZnWU$4Xl4l zCGVV@t3=bZ&mF|pkr1trp}UyNbt7L2nY|@LEtl{TAX$*K6od*N+r8`)M^(-VKuvt| z!_o992i&xU%F92*1c&;UBX}0_r!^XY1z-l4&COsg&LjwM0){_O>Z9lnXC5bdFF=P-+>Et-Z6DcNM!B{o!P#vAG}4RP1P#uCc0 zbyMtHwmsXqz4Fz)1c9L6WMV=5O+g;oRr7fFBO(Mw{0&hI+7->vF2)2Y4_}MX{Uu$jxnwimf$I;Zf_??K0Wr{v%Bko$R5CVd(Y0(*O;xE$Ra>l^tD$QZu4jT8 ze6^>vg)A)#8YiCT~UReoa343pSp0^8ClB= z&JTn^gJbh2;vz9(QbuWn-f1t6jDf6?u6FpUGt7*RcU}?W(GBis)3Fn~2* z4YlS(&&j(qGCeNzHeeFmhVs>5RS!U&%jy?q!Xh?E`;{pA(F>sHhDtb^D2?0s z7$>h3>DU#7=TVibpG@`ov`?#;T_S%Np^CP$jkES85XuQv{rY zEJIY#KUK&hmG#Vyl=To}-jf6?mSV8r-Hoid>5E&@Jo_B%@FWabM7bChril-qpFZ|r zhhCXJl=;KViHCAt44Q~L`mi-|yGzuBWgp)%_lE2XJ7jx8ul|iF;p{sBP9et4drNnO znAUfMo5{#uhPh~{*ks&mUn3Gs;$nKt2;{OA7H4W$PC4MAP1XvdwVOB#Sx;bP*D60I zk&@SU?zxCCB`geg8H_w1L2S1Vy0j7R9sYdp!zA%^GBk~*G} zp}G<6Aw4CU^Do)qO+$c_ykvRVqww6zyi#CWXOL8$&AYZ9aRNFTp#{nm`xauX!R`(p>AY`Ji6)GVq$QU`IxCFP>O>Dm zoyG2@4q*p>-5>O67j}J@8-W`J%iX^p4LFdRfJpq~W5>-eRKu|uOx+*_-~@Go93gue z5ktbjMlrUDDbB$GZ@#mDI%Krxi2-xuX{jE%!vu14!6FsGx`_#7Y0wP>DZ0ZjcMGzq z*|@J_c-dn<5**v`Qkid^7R+g1D=6WTfI-*pIi4Y*P5Rc1We;}}6c~9B%0+Vude2X+KE{WM zn&PT-#W3;}&x%ajz7#bWW`7@3nd!BbCdy2R>YEm3vWKC|BzQPZl9raLt4s4Xq8@j~ zQ5@32u$Be{2Jp&-^5%ef(**FQv<%{%l=IR(na5!w=xu`I@vvYf18@Kw00+RH0a0K7 z0|1@`0I}faAH?p_kdw&zR2Z`%W|PTx45VbD!mLGGXt!5sM~Uxhl1a6u&87XUa-c70 z(wCnjw%2#=YlF7TGN^Pe(K7Bg;(GwqJ`Afg>0)lzz$&b= zCF)e*cG8o#8lMLW_~PM&zgJe#VJjvzFztq=m>h2NYfF{=0sSQH(g5iM@g_sujwNNu zeEluL5>X}+7FV=$U>1J7xa?bxkWGSZg*7g=^?kFfiJ_{TT78WxmJD~M)Fy-Nq^IlL zISW?AaTmZ-pG`H3YcVwqB6Gwy*u(@?DCDa;eYrSAc?SF6BDofXKL7NS?Wv_o@is0j zw@Q(n3g1@Q8ojwV_Z@Ch*{sGfhntBbiFRdQlPYzS9~>?`OAD#yu*4|YP;k{0mLm#y zk>L|QWN%v8@-Z}PZd!sy?f6UbWhSm{+B0N7R#LuzgdEPn&hLVT?rFHQ!LWA2c`_pV zlym->Q@U@NP{q_;8S}@r_%79SazITgzqs8_15G`nQuZxJMznBa+TX+iSbknkWzb-u zF2l}X;e0>EXV`lDf<<&)sKTyUb@7T{@6En#7WJ#g3XAIuE$dM}(Zr$HT6PPHwyA`I z%PO-%PkFPU#I~TrNq;`7C6NT(c6jnjws4$%qPS#BYjDBI?s(fuE1R`S(V=zps`mT} zKKBPVVXninPS3&xD`RT%Qne~f)5^|ud4u=6U8%D)&BtF|RTjp5!M*!lZ$Tnjqj8>s zUG})g5d0ktPYW9Vh;@A{io|#B8nL}5%^k=;48p)mMBUI>{Lnz36N=n~l}zV?4oteuXu$n*HZ zF^@&R$=DQuL|-bRLZ!{&jM+8SgI4Zj$@{n)!plV~F;T8J8#E6Sx)rVM#!9{z@sHp{ z$xck~{^68r^~UFnTw7mn0R@xRT66GSgsZHk%z4_@FLhW)iTaPIj@9KYZGHMGDzbNT zLE{S0VmcbLi)$wzIN@Mc#~@6dAsUDY-XdKai{QPX@ZQGf}L2o#MK z8W76TvIL@oezJ_{pVaO9UsvKNxyWxq{oUTOf9*%ghlHG5c#>WYwyK=PGzHnUaf(h_ z*5N_CTh?13ZVl)4O3<%xJ3XpVDs55vqZ5bVB$E)aV1iT5UYGe2@l z9%5p>h-N@g>&Ni@&iU(1L|t+_nvKgnfvTb>bPT3KL)^6I!yh!)@ZgJ?j6R-iwEU*& zdQHRmgRWRUF~FfXF}YY-JiH01+Fr(S)$m}7nVgdK!I6V)ye>IA-6eE=XuvUkuY^^K z)F&jL7wq?orU?{HYeN#ocdB_#rYMUy<@9s<-T#4obHbz;NY+O$BIC97_5}9ZC*-?k zes?m#endb2PW|=-{<|xZAN{QHpXDI(-@QAMEBaZ!C!ZeD`-dOw-6y%^f$-ZWAmvc@ zJ#&aVmVea(lg@NQ^-6;QcW859ye5H=mi(K7m^H5#)nJh6DQ3B zN~Vj23b~g*AUqeLYTjA@m5jRLy1n$&4oh}$>{wCp5zX5fCyIYpN&FP%=H(Rx?}eM` z)X1n*s4zMFSvqz6vf7T?jI7YEa%O}stK+u&8Len+tb4gHmZBJr@Vb(LrEZhVrj)r9b_B_fuwp1 zD5*D#g1iXzDJZv8pl(*;+HNUh_Pasklq1U;%Y9Eqm1Ta+gq#=0K^J6!&na5e@Gj&h z&rv@tdwgYneE&o|JkEpCsZXf)W7AX?w+<4G$R|QM%UG7*!LP6xIpU_yY%4Ex!ufdj zaTC&xOO<6{4Hm{a3p|5(&^n0?NsULPD5aia@;=e?wgVy-B%Mdexj)S&w%ZKauig=H z^DG2~@dU(6>`d>m-o(WH1SkT9**EHd7y!-{2Zt9_Up(mEzfl|>omA+Jo4ZKf^FSTW zIu{{RHFO^u%UT3z!-A{GG^3(dP)sr-F00mC5%DI$Hxw@1oFT)W!iY!AvwP?Js&1e% z2Bl%HBRqwLO_bzo;$J}AfDCyt%PI1z{1jKb`6kZ!ZbkZ}n{Y*8(LSbYG-%$^(DNE` zuVMgGfV3+P25zW68DImlD-s58!Vrd9I(qufO>{%wE((8xmj&2$m&7no+fYsU4A4cXZD%`Z1tLt9*C2#%@{v0L{P-$-fvmgLjBMna`F@*oyb%|J3d zqC~~xpzt?6seQ14m|K?2Z2&U`U}lQqV6gM?Xan!6Xak|vwj?rSj;u|!|1%N-HuXpv zza(_ji3=W^8$m!r_hk;R0cFRPjA54#w5tnTtZReNq?L8WRjxvuc>D6em3HfnkOojI zs`B8*%ipIL`dOH!8*%O`U&-&Dwk@e>?uccc9<-eB{X^XHm&a=6c@F>h=o3owS z6~q^h)TSL4$pTcQNj>X{@r+}>OvDkt4p${6oJQ5+tlS*px2!6;n37w{Sx~!c(kh(M z7JP*-n#LuDhX-86j!Xztlv$&pU{NlwPSMcKp+XyuZZX5 ziZXE*#&%sFxL~^H^DAP&Me$^Qb$``*1F}barCnqGI;#r-{4y~< z)v(+@-54WwvDD0M=~72AXj9$czu>{giFwHCSPR#tL+$>qD43u&<)t!O2+jpsE(9Js zt_JR2AoCRfSv%XVHzWtQ=l#{D&7s|%G4_a3w8kFXc%X2X9>sFvi!BK!m%=IcX+erM zNkkALVX{z|%gYlSl?ajohSLh4&x;*k!C;3Q`Pd$U$Gme{FWe!J-*hcA}X`Oa>4$|=>NE5-MA*@CjaeY$#;|OKkz#<8Ia4QZ)jz+CDu`{>{)VlcG`Ujor45%o_;8$+iTLpewynTwqVKN&W0 zEg{Ouyv+4nk>&K$*=kqdoCHrMOM4N#oZ6E#*)i z<(bJHix%zvQOIdWK(IPTJCj_^sF+{)kAo9xX~SS_NLHo}DtW4lz+(lNoZUR-w#0}u zJbCM%#0yrvgb6fqce5th`b!nJ)A_R`3$Nxj|HKRPKW>$hSgY)S!E}!hWv~!ppuusr zLC1Z!uzd*^QD{Rh<9fWf`T%O-0jid?05Ww^VgnHM5OMyQ1MrM3s3i#OHXbQDe_D@R z8v|1nojiYV4d6sfHiiPZ%t9N3JUMEA^UXnUF%~SRBsdZ*IH(GN^*)P#ezy{oJLYc# zt_(p6_kr=SPwk^dR>9T)bpZzRO8wwy0dNw1;7tACaxYmoWse5n*^b8GsbQv=(=z>@ zEP<@ERlmFCCRiKR15*`xFY@$B-w;B*ETkUFW<}>^KvN}u`BS=>LL)SK2E|X|c!(I1 zAVU-$L+upxOO(Lzq%b6Cg4j&?$@2s?aeEJ+V>ccFoPG8LiQo}zPJr5@;I8Brt- zGTTisb7)FJLVT@xltCG#YNHz&xy#yS{6dnk4TO6HO)dL4=l$(+;8@dl86~Lro|Kdw zFD&Z!M;a*@X-%*R7RI(aO4(E+CjtZQq`7O7oi4yK9b?hS>{1rydMnG4aD&ZCi>*aq zFdzg3jy(p;&U1@(s}c5_(~2(eO<+181B8|R+3NbTt+IX92Tc|Qmmgsm#Q+bL+EYY) z(DR=31}^;J2%8-jtOL=7@O0qvLP#YW#3OP@Z+;uqc zGiH@(FpSUL_0dN|)+k72OcQ1ZJ!1+z8QsQt$7^(o8nvm$k6nL(AH@?u_reUK1JzBV zi(L=K(0x_;%VWl8hD(m1h4b6sirDms&Uyyke){D4i`vOdm^ z`AL^K64Ze-eJE%w?wcp2iYTRrAGiZ-;FEmN6FOtQx=~dxiR78N5CZAkQmJlG?-Xr( zhbcF4lafuk)b>}$R)=Zl#(?_C6uHEbSC)L-AGnXHl;c|g=WG0oe9oD;OZa(^;}Ay% z_+zC968=a!{qbTs-To0eqtEGv3CmP;YcnFiA zwccD%ffyLHJhHsSq%*1=GG@uIS2R65&^e<+cV*J5zgt|b&&><|ztFTxLMpcB<#M*j|&<(0}8%%0O^AC3@RC6qd%w(nR2e=Do|Qdu$s6_M?4Emn zZ%ut83pK``E()hJf7CuReS~d%X$&BQ^ok$%-P-r=_kxDt!~UkK#bo(heLwz~xe7GJ zwsk6HYn7M{p-XuU%E2UiB|Z#AtZacwYt(<Tz6V?!q~YW{qB#}r);$=qs{uTzV}7dZjCOf&}2)nHDO16?5WvNmyvE} zkFSqW<7)QC8aEweu^EOkNV5`NHl3zMlWpmkb0RwU<2V$ul973GUt+3X)wFYIQBhUM zZjzW~D6;S!m-JN)2lB)1uH0QZQ;6W`Pd5y0-rY2J4^5?w)&i*!whA{Xq@H=tyRJ(* zk&4?*yUO6tQbk4-7&UP!Q|yXsJEoD;v8*QBDk}la9#^odE-OqvKx$gWnw=`XiV|$| zE$bFzKbg^jY1ecdtft#uYazBNdm&p`UMMZw-W+0`>@IELx^jEEkR4oIv2(pRV{XtXM8wSRb8ATjXnwngIk7y z7PlW(YG@R2SW|9$kIS3jTE38Q@lt>8{tgDdB{rIbEhkQwlIOlhyL=sNFbZ~y==w`aT8))t^@42u zXGak{M*w#5&6Yd8_oO7~uY>ft+z$a}%aON9-5x=;#JO};23jS#ez4~j8V4bjD9m9P=hr)amtW1{3kQle{WjhE&J4;3~C?yia* zcdnDnh?>faqmXvWi#GQPjylI!AI6*f{}dMSx_;t7#9QM?-F)QUkQgVUl3ZJSAxEtYKy;zMBv>T z%4W4`G|8r@b!QN4T2f0)db3@x%Exa08)CD8e=?695d~&kkcq22ddQgIR=?&HataYa zS8M4ZaA>r`YKk1&vcbz^lLg_Jh#3i* zULP3&x|PLOV*|u2fI!vC3jJ)`DYs;09ZDCaxfSYffgZewX$$6)VP^Z#3}}I>w$u!Vit|IWWE54A17inxyoK)4`vt^;1>l@SXlXw(9e^;1!*X8!TX1zaeoBG z#biL4BF7+e#}Oey$!KLJf5Fm|``AKJ=;q?SL{ygE;CCL|8Fykz6Ya&Y}<`f(ZlQ zWP>d`2j+ygf06;`m>U02;X#K=;J&xI0B0 zU!;eCG&fBne-;50B$pw+=&02s-?`Yen6N{)QZnE-N5{gUV0&dk$NX_lKaz4R*zN2k z7i(#pcI=aVsbgon{@0_ywx}`~LL_PuBz7R>h($Wz`qH$8!!}+IRfY$8@WT)ZbauQ0 zNp$=%Qe8*g7@lj%+U@J#=zCk%#hNF5m{2OY7i1lV7Ejys$dgT@^=WgM!dL#!c zcU@|CWe0Z)_gOPy|AwR%EO>^s_miqmNX!k2U)Gjz>R`;+;%1nC8+d1}u{^DVvaqP+ zy|fND$|C=^UxL3@*l&LnKfEqE^YiQM+R-8kIABJF5>58x2EyW1a$rOd!1CK>V=d<9jnauysgtWk) zvPB9jai7X40o60QefZ-Q4EI~C6#(ldbH@}?tnHW_RII((>vD15M!(%rx8l&!Ke~b* z)W|9Qb{bPgo3=9>ud7}+lnlW0!`WX8 zq#4}GHfw1E`>=5J(LQ%%$63{Je*3ESAdzSm&3{*XIs zyDg9|*f2x{y>rCPc^h?4qs(gcIsUGj+!K*B_~jF4)Wf|+x1in0JXZI8KtOk3OQOJL zbYhFQ^H%e=^bGaB$aJ&mq#7DeQR<5W7FTS0bq>fC_=YU-6`S0~Rkh=)U2S{qzLR-l z2R1pU6n*T(GLM?~Q(&OxnP-C`Ja4Gh3fox3(AY|NebS4fj3++{<}W{O_39Qf`#>qs zWJoH;X(~mevLS0msyogMd{6TrKW+0}0|?=7cg9EWKin7zq>(HQy{UxTOJQaQ-7G@U z$lIX-BSbfsbN(Qg{$ua{EO)E%1A)B%YN&Fhff2w%fOleWc%$ErHKTx4wA)M0BUsfl zCy(#xI5V6P12bo=?rbd2-0<#NrOap4s9R6&rg1iP>T6|T3^Nhe$o^FF+aLpP{^?^Q ztdoVbK_=?|zm@;TCPCH$CE3`jO0?f&jLeBW#x1S#VU#Hs6|6Q@a;N)KGH)drXKtUt zrITYSn3J~arF{&M^JLNvH4*qw_2&V0(cpKXU;i%PY1mWkiwAivmC$73xP9#SOz$Iq zH)z>;e6kV0hffEei+C*YZcah`T1W7d>^7T0Qa`2aZ8Jnx6hi5zwzr*b$9 zPwMD5MhUNa342!zws%xQM-KfV+ zKOCl@W#)oVBu|GB>)9|o=nlUjHrf@Sq^e!I&`~KOgn5N08d}JEl(rP3b8I&T(h76R z|9a&pZW*7T4(MV;p7k=Icd$Pq~i<{SrS z<5M3SU1~@k`Qw!36if8V9@XKLAS4rel(iNn+8+j-YlaWDj&Bu$9BW2DZi-wl<(qV3 zB$`v3@jN??kYVH=m;DP#C2mEIA}`9*T||D@+G1u=&SbnFwj-$fqG-@#{=~qH@wpTu zyfXO%KZ45afBkFmN)S{FyeKYDVlY`4cdkKw%aHC6NL@k@ROicxBHRliD{)+k$;&N7 zevv*jA*jxV5uIP<HB>J+(!WlOdbG(V=Y*OX8ms<^);w7L_?sa&QMiJ z9J59q{$!bo7!^6cM3=nDjMn&6Xh$ixOdildjxik(=ig%VEHb{~;>c+pLQHpj+O|C& zj<3>8cM^V2KWEaDpH5t}{J*i3frTKeLkan>?N+`9C{mb^NyR7TaDtW z2kmB{lUr{jZ|RTm%t#db{=!HJNic;Pk0u{Wr4kM%zQ9lv>_f!)u48K@G3H(QRE7V7cQo6!qP1GkRL zz}0x{TyC_Ht0CHRKl%krb)*G_DO19wm;W z)vRwB08$iE>1z%P{%;yxZCbPpx}gdPHP3^DHDWp5me-qgb>*;sou_0SHe~OOH6xCd z{j?hjf)l)4$h1TpoeB#)0y1dBtV8~l9*Iy#6yioen?MQ!Z_Q6)T#D%&_u1L>ZnyDW zyB$&%K;dToQu>`${~FIgWfq^CmMzL!_^*r-;z*ZOoAa2!TER8%TwvK$c6l4aUG;@U z&_1i8)0BMP70H5m&Ma@bp=8=lE|87-ZbJsb7JNen*fz!0mJF(C{eyAi5-elaMAq;f zUUY+qp_npj;m9|;3xxT6+w@B!(0brPVtz13ek+rnMDP~~aY*7$Q`s`ZiA3#KVR4Rf zfv`~6p4Tb}othyCNWDD-?};ayfZ$9zlq+?j@Z<0MRAUTSGhS~Mc!R;`!4L!h8^9(G zz*cmUA-Hxc<+L_;_{bej$3+kqsP9sztNbmQ0tyRe{ru$53ZcUy@LSdtd}j)5FFMqY zqOITk2u6UiVSJpCB}h9v$B|2;Ag_Q}GCNS2@bS9}y~g@Iodr)vEs4~Q+N5yU>{ zWIr0hA!}l97oS@X3&6ok1pzSs0GdGu>;d}X0ek;V-5>dG9wo6#-_YRi=m^-3>zWHf;_sI2$ZnWn>p+#`~q%4duD+TE}#p2*cNDM?AtOun3=NJgQG2ssyYD z5%&zep+VX{H|t9vlJAlm(mQKT`~d(638?ysq#i8K0v?B4AKH7+ixyYZ($A;c#L)lB zZI_;8CEv?$8-u7AlbGoC*#~0boiVf%{J4-3?HDK|cVYRx(ry+K9+~$~#BDvNsm4;! z5486YLmk5YLm57A%?A-)ex*w<%!;0eXSS-A8Ftft`Mj>{m7)S?o6_S2@7uTz+Kgj? z!zVmO?vp&Pnk)`6eHL37I`&jt6J+Y|+>1+!aO2vadK7odQNVWa_1ADwp3tFVR8oMNe~*kd;}*q%U5LI=Q3V_=y`P9qPjhhOJHS@pi88@tFTI`VfJh}9VCy_ z->+?R>1nJkc-d#haJpWW)ADmMf*O%w?T9%8ZP12fQQ3%e1Fw+#cu~I*8~Pz34AG)= z5vlr5LG$6FxDW&TB!KrpqL2~c`#b>spRg}KLTw-)2Dy7)Ay-gI<_~xd)Kox&AR)1}ga)tI7=EY>JO&<63_e~pm_xS(XQ4;ZB0ryPdrxVk1&54Z01n>) zM=z6p2gvfER9r+Zg2#E{M{WN(pnPfnxkcw`0wHwI^-yh~FZ2O7!s z5HER3FNEq)_j>Pvr(6GBpx)6{#9MFoPe1Hi?mc&?Tkrq;-9!R?<{Tn~2(|mIy#GwJ z^|{$s^B*{V01XvBQ7(a1Nm~Y*&vu+Zc)dmeF@ttW0>w!}#l6u1m;fdu0H*)8%NPwr zz!dG~*+#3)=-zh2#{koB$IH5@d_W2(N*_~bhXJMoPv9YAag4b8Iso@%=3Otu_Rb z62Ri_mWI1Dn1=;owHE}c(g;&#CgpE+J(7p@KPoIo*NY-xM3quOaqO+QxgEzfc1w#Q zRXsJ5R{bskpVq6<=daG0PP<2q5|_Foej)3i#YASBPa5>f+~Q1HO7%O}&o~szqyD+D zaAKPub)!&dk)Go}VDV0huW@6bw*x)BJi;NoGu0fu8W;!c!ZeHOuO*G1^2{xM98SmLJ-YepPXrLAKb; zIy1P(K{BqI@0<=3+JN!>lv^au#>_Q9GQroJWo)GmC3ZPrpZzq$k0S&MWvMK9EU=0jsi}2zn6o35?{o8P>c^VW#Ct9 zrn8v(BB>KX<8^2cUm#$Sw?%{Hb0Kl*xEmqkpa{e z66%N-=14jaU3QVu7IaVpSQxUlplITCjK}YPwvd^_#7~dLaq^946furof?+u4;bB~I zVsd;0f&C~~oh^rJ?cjp-0^th=(dpUqX;Om>iVe;naJTv$cx{E;IT^jd{d=T~+budxSd&p%Y_FhvR`;?YHwX zx)_({y?Md|{*s*Qe=PHTSyQ@1wyT?Qz`p{J=c8dT`g|Ub#`mI%e&61n+!BAT&MuLJ z-;uu5N+X7hb$}|$49k;p{Blb(5i+-L)4mAQZlb{K?^Z@vW4!I=m7T9$Rhq}7vM;e} zcFBywoqxpSby!Exatk`>#apyotV}-D!CGwyuxzbhps?N-m=iTrSXuCyJ5$wRq=Kwz zcAlwy+N0Mh+hX~5ie3LpBn7Ua|I_@pn0=-RoPGjcgB`~W+F+79Kcov8cwpPX1m1V? z*$Jk3nnQU!MwV1C#F%w1wr-&F_|b!6*6(`^jQL0Q^GT$?ico-b&fG-+?07qF5N+)a zb4=(>qehI3eW+FFkwFFD_l$knyyxI;&L55^TzhhT+5X)BxxC(r8qF?reI*mf_yHoA z-WJQaRT{_hC8AO=fAWvI0EB`*FoSVclarz`Q` zyv1m;efmrY3Gh>OQm}VXdx`i;^!AQ)H;G#@zsTHwKl>Uip90Yp!K7AOAj9pO$ym@W%?kQx7x>WVVRTr z20|7)Gxgzr{%^_si;BPCx&ShL2Y2d=P?2R;0LUC;c%CrW98eyJz^H~EGbEQB1pF0b zUd$i!sGntArz@L_F0AlDGoF}-van2S?!Q|vh6(IROrWVdsQtxr+O>A1z5vnLyc(Di z34j_lqV0Q(A z8e^Ig#s_6^sB8mkmC^E13vh@94_rJ6gUE{!?7Vc}P4WEwN1h;HW*6bayxY-Z21b2m zAu8jeHwn}X9+omUT#lnHD77ofx!}(oB;iP53sPP}^=Ah+su7%oMg8`T2 zvt(P}hWJEHqt@9@iv|`GBM>EE5D;4^eh(}z?sK196Tpc~rC2*w3%8F7@iyQ2C7pUa3f=B{2^nv7^pCB=sOHyfgN zQtEycH~{-Fg!?d5#m4NQGoG#5-VJBT1m-}9P0WhTQ$l=qMw9j}B6vKZN%@cE}_dAv_^?h*QjoL_nF(d=XPr_(A1&S^r~&-H5P z?Jit5u+_$mXOq0#B6$u%HOBMH+j2N4+{eeiSpNT;YBGe5G@etX`#kdm2;CS2XgWy; zNnijLK7a%Y5cdnj|9*-YjBfl&AMkfg;su_Aa?t(VQK>iWX~4 zlM~rhEddDKN#(m)k%NjKeGUj`p!fyBnIckB`f{Bb`YTa%mw%lbEdO_d#yRo-#P$CX zXT-r348d0Tlr+%F8kfYuq=wM{g6|-fHjvJzq=8maw?!Iklegdfqc^lT2_AjII|YVm z-&eU-TH3lcyr>Q9;nf}W{_u!4oU>yjndFxHPoT@&*KhsaC(hX^SXmC zaR}DGht|g}x}9tdhR<}^M;{KRNByAuRBF2=y-`q;|MjT+s`S({hl@h@nVvR4|D^nS zEU};3JwX4W?~zw4psy^XzbT*}&;#rnY&~E-ae6T*d1@_OziW$J$D691>bh0D764p8 zncLeksLU5$0;!=|GgZ*hKIFZ`>jWPbj9OvOq}cr*p5I^C+!l3260P|1}s zc7>~@k+jv;4aGh8dH^t$#rg!q?#Wi-2#>ihxqu8W>lB&mET14jiQ&Cut+NoOvgbcO z@+&cXMa2gtXq@DSONw@i^$BuCg=Bt=UYX*EipoCrPO2Q$!RXa_5*vTgF6>y1uAdMrwS4Q2g50{E&l=R$iJ-X#8>5oy(I*gUof2K zUs{nbDR9z)aMKXru=DWp90fG9Uyi6Iiy&3%rv{9;C_+pIgNRH(CLrU0+s_&lR=xqp z2o@t+!+NJtwvX-nfRm6=_WRPFcnKyp8e)3!e>L`&QE>&$pYY5ugFAx+cMBdo!JS|Mf;)lW!96gz z2Dd;65;P%rfS`lBCBYpAcX!y~dEWQGd-l_QnW;YKp1$4HzpkpTuB!V57wZ+;4er^3 z9OR|ylKvDmm1>y%>C%NyfWMhzb}&ZjOc$fOh3;YZ~xw{y`w0f?qnnghq6>ON*)I)uSYat@0dbzYyP4awr#4RECE`pUM9O!@cPRnfhO6SlHDsBGCKrc z8Z&PzZ>EjBjoxHWj1nD327NDDL8S(Wz8-W=U`^b1^YG(OxLE%pRv~5HG0VqI@gqrX zV$?Xmvq-tM-Jk@#*YwO*`m(VZgSE)Swrp(iQEZU{G`0WRDJFf}oe+R@auZRT5=4Jy zc{fz zdzLfuuZJO}&57R*%pM744!BBg58bo>ScZ@n9l)dkVO#Qa;;5KFD2P>7nfAQESWBKR zjxiTM{@8|rW%Fc9`;8>^!(SIVys||tS5gpdAx4@w0}C{b0~`b8LL>)UEwQY z_enM02P}03TYn^i%kNU%O&>lIUN6_%bljCc>lN4g?YY^x`}}a>_svN5;GzGrykAJs z^;_S2@|J*XlQyY}rFlX|AMIZUdII~nI-k8}!--XRH3se}>=v9FCr+GJzgm75FvKM5 zR%E{AoU=){$-D~*(V6QKslclCd)MvYZlE`s*ThoRv=v%&moVy^bKqI++*R{4&gz>0 zq#s=uo#Nycv)ZnjIZLq@V|A5YtKBYXOT$OCbA=;xFqhwZ51(~iT+?4_8?WgHlsl`) zyfHp73G?7z8gz@KiuU#|SA(ci;g*0YpIY*~T*y=dk6Ar*CqH29Jw!SQ7q zw=!c~^&QHa<;3xnrIqM&yzR?l1YI63kTMjHrQ10nzR3+=J$a86=bGD67NZ%(ySMHr zjvM6=un25sU=sHKQ~nG=b($~G?SpWCr9YP-#OY4G(ERXV1%zBzR7*;+S{%d)`+Ru( z#}?%l(ROl6c>7J{-W}WVis}t+u>|AMfP${zALz3{Zh~CT^khDHGkIgStC?762cAYO zBj2qtNiNnh%s6iAc7<_xXlJPZ}=@K(yC^CBO1YKHLNPfC(tH>KKyQ zwY%PclY-W>KzY~#0sxW(CKQ8n)sT#a-F=*! zZ)TkPwP9oyVevkfb`y$t?segD4itgKQ8tc^3~$azff4g=sMd>~1Q~#q$2E>z zuTnJS4anuBu`Z*R(!OIE8YhBk2WD4SN{8LD*miwW`eHGUfFzSB`+>)F3)EW34;(ScCIe#!%vj=D}vAALa-0EK_3FKmnoh|wxAcup2M{MP1K(Esj?0G z*gcM}ExB7BXbm%6r<*FN%%`{a^|oDZ)D55IbkA?AizXAl*T1X_+ptqD^o(!*9nUq4 z2fNW5Sla$TBU#w%NSn)0I8i6mU&e8qWASF7uVaZHBI1`QGKW?+-{5}E{#~F-=lje^ z9sUd;HpdIF*7pNXgDBV9E_b61S$-v#S#mf*s)Hv<3xofI!6k5M@t?>PSpE|lz~$g7(@vfp`z*}5 z)9`~}iMJI*{La*GuYa#%^~pt%x`Ku-)q5bPRV4oNKe*@vwH2{LeDI>iszDd*xYI=NCQn~fB#9PFqehe+Id~k@F{J8JhXh_lf zOw`0lf|V2JEMXX<(L8kVsFufcv@(+6wo>5|=zaJJbhMo*w1rQ@dxo@%sD-f!esoH9 zwK9KtjBt^PSLu>K94xLzE^}0ia=t73)>O`aNUvX!OrytI?MW)aLXimZ=EyjKVfC1t zE}%Q0eKUVUpYOWWuDAtdU*%Dii+8|F{=B^K=o9mxE+}8#?V%>SZ zj^iv`=jjRj{;9Xw_el#8KEaQSy?JC5j%3#E!kAF~wxF})gC?+0rK;a8TIGV~;=<#U zpNA=9w#w2Vm_dibQ^Qx&IJN^)FSfX7zWZZ^EKyN;!IvtUlud5Z=#r{4Gj|xyVafjd?ZuT^&Xij=mn`?X7c*@_7f_G} z#cPe~QQ2Kq7e70b|K^5ReviL@5#Mn8{?Fxu{@o||sKb8Vb+8O@wdeb(WgaosVBja^ z;5qvj{mTmPc_S7UsJk5(F+!z5(p5yEtLmUUfHW|ao(bUhr+iJGRfnuHk^%atMUD~1 z5B?(2A+wNrEO-1IH!dB}%_4uS9<6aVFjgtX-vy{cambOJevkpo0gI}&j^4U&dOIPSq`&O-_6hG%1wOlhH-e*3Ncn|!PSnYby$*n=q zOhD59)it#!Qs&W^{07JOp1mdDlS!Le#ZqqRM=h9-oeXzP8Y(%{&cR;x9L%#F{)10|+WwHzY_VAHZ!9sYUAFAzW zn(|udH^2xB!Iwuiz$Rb>_@x+J_9PCM?+OoCm$Oq}dWSy8>279#Z#}*y;kgN5qgD`2 z%6DBvb$>9-s|BrGyyWvFy53Lt83XsbyFZK}^y%ug{;#sl1)|-c<-^~%P#M2L-m5LN zRM29fSj@ar#QlsZBCC=|@i>S$f)t;N_#86ZHjrS+-BxG{1rY3z!a1a=jQThpyrr$% zcT=drmM|R%7s!Z_$_Nn=6aydyawQQuh$ETknwV@czq~L0Cp-4820J;i;(+#w4-Bi9%-mrYVj6Ew%NFDlO8y@2*IuISDr+;(8f^K(&UgH-0~ z0ENu}j6ckAPTVy!skR=Vis5k^WP@4Z(ZO#8R>kIr*eHwI4CJ6@f}Tiavsxdr}ct8cOcX(x5;)0e6@SEva z>1qR_=if8;Ee;l#2|ki~cl`u0(*0`*Wn6K>OTs5RF;7a!H4Xv;Fci@+u4*JfuqP6O z^()cpFI~fNlz7h6U8@4(0v@k9FJ)REJJN3HmI7S{?-LH&YS#n$E=?C* zC5*=(vF2Oz^)AHc8-4EY2hlr)HXWv@OC&UMP@WPsAUB~43x=%Fd5dd7vRy7!C&Oq) zW{x>kh9un<1vd~Cxu7B&)Wc~bDyo1kN;m7~X9LapF+@fF?HUJ zaKNb#F2?b6%8ft%bUr;fug6N)SzMFNfcPG(<+zp(uNyTb4}LQ$ZB*o%c4yVoqF~-0 zLUG45BhO1C<@+R&_{H{Wpb%?`tl?8oI)GaVjr-bVnF;% zfD?cW8K7n2@j)6y1rToc5Ws>p`-AFaKae{tWk~xAHUsC(<+v!W;nEvF-4pyrn#uw_ zzKD6-sMkUjO4R@G5HCEYxD|JNx^6$B7Ye3#E`JsN>9M&q3%Z`N%NW6X%|zP$eSPB) z_a86JBvcfZU~;EH?@J)@hPOip)dJMTNY#a43CaNQ0xgmVbN?d|k`-9JSw*&_UP&E4 zz6%Ob6yxEI>IAGpDFn3~3RF{@B(2$0osX{Ujs*vZ-B@)ya$KE6QK^;1nX$Zh;U=(_ zP+OdcmR8JZtV&X|iWIZNC!@hnj0SGfx@rAXOKY`>O;?U<p>}h zkw+jz+#n5%D@KV6#90=GyTI1if{LH^6Q#rq3TktWYXr5pj{1Mn3VoGNYqrMD+?RQg-#2I!0-{sr2}6hO#lfLR91j3iQYl765Psc`g7mR(q+^ixG<1+HZwJFhNj8Dk!2D77Ty@ zF_Q=tpO!*1Va8-^CB??$N@wyjTI*vIwl)pZD%r!Cu^EG9r##^qt{JPpFk5(@e^N%? z7eXo^b{9CZKLbDc!_#^q7ne!$aCI(S5K`rl->uH;oSpo;yAqIYO3gG-{BW859wC~fQu7rzf zX<5QmP#2DArUweDiG^*=n#hJOS*&^T|DwV=0AbH4Fi%x;c_htY9R=V&>a!lPtk?(h zyE`Fzm^Ca|P-bhQ?-hsiVFXTE9s_8W<ilO{Ij{V~W|z6H0G; zThyxPvP5TSH}37Hz@vhjNMoK{ z9Mtq55i8R;rCYwxFdu?Zuw%4>5ZD=ag5Ajsv&cS}Zv7_U6zXH381uBHh2O$1{{~$K zk{pRIe}vz%wYNRtbuo|*74!cSq-8aMf#Gx#L5H2fw>6RkdMGy;oZIiD4A`XO$v-t@ z2Wf_88Y;3mo##X8#0ag47iOV)kjiNH%IF*vu`G^dpT|Gy@3JE9)fj#JSMY3H1N&Tp zRE}c2ZpvI8xi)9Bji}d^C*)k)i)7j}XL*!NsdLo<6X?I16YTE##Y@5~j2iLdf+(In zp~W3PIR_01KX9ayGVJC_rK^06X~(_N-Bamp$F3oers{DmS`(r9vr;#B#i)=!5ZmAp zb%YoCvb$y-W z!!Pop(@xEPxhlKg*G(wr#LJXjLQ>7k})lFgf=^?ld>}Ns9&pY}`VzcLP9nIiH z7Ua39j*sRti3J$|T1WT6ph}B6q8hHtI)-aGma~`?o_TTv5aU*H($Z23STJp;7D+m6 z!e>asg?k}kjIuQ4*J?%e43_Bi)32Tj;0D;(25hu};gm2Dz-bC#;t6^gqf8x;!!mT| zYxhZ)-wZzN>;3I>c?KwP8%R+hY_N@|uyzdMnI&a`Z^gE6nWB>6@Q|CiE1Ru9dECCK z_q3q0R_H@!*!3KrQIsO9lnG-gidxH!)LSID+oi8?I3Jp#8obB8;GrsT!kB}4OP5H6 zy;?CDy$pt6(w!JM=NF;W0UYS499BkA3;|Ch)7FzldWXf$1VNJn>U#@gy_4DjI{Dag z2!kYF{8+cJe=4c@V8He(VL_WS^f8^_PwZ`Uoe1*C^nEZZj0>)(Or(g6J8S;r>a_2~ znKBpv$u{i}6;+?N+bFV>EJ84}IV+%sqM@s2Ogf_1xm%*glw!z;DVx=m>*FtCp1jFLC7u-2`!YA{S7azSv1KxfA z_39Y!d&38Z{5o@U!;hx@$om5Zso)#|;xeMBj+7~WNIx0p4q5PwGJ_$-puah5`x(A; zb-A!dEYT2;7=H6g9yKE)d!S&D(5o_B$jH$fPvWCYlwxJH;v3>+ZFnh6t1#5^$y@bh zM;3%%MVqUoP@`5HcVpr800RP1lt*CT7PRTtCFfy#>k+r++*p!Eum%-Wm+P1(0^ouS zV97y>t*F=Y@9?F7j!sqa&X-wh&#bv|wa9vL9Ng9oZcZKy}rE%TxD*DDpBy zAAaiezj!G@)JWRC-7ISw*Zf)OOC24hmB6Ps9fiiA@f35RX9et6>(p!}G<7O6eHaO% zG-}aOJ4)6BNpT9K?RbAzVVl6wc+62ek*lj$w<$j_@03zyxiSWPgILLbXz22c)Ic+b z>TN3(_&tVGhKEJc=9?qH+aVtM_1d17&_bN8b*;T~&dXn%kB*#|R-D@DLT>zo6pIgA zo^=qdUGFpVhZZ;?w-#XslbV)Sa_=^&25p3NI!Cl|HS4whJYP14(`S@-ZwRg46wb3| zhH>?+rY$~Cu4YZfv@%j-Mvn?hZKfxFL!I-jdALGxB~9(Yt$I7j;BCsRTPy@MNoM3R z2%JO2$Qq;RAAYPT-c4EBYQb)-X^7DL;a&PMtxALI7by{A-6UrfdHS?}aF<g^{pqC{ySyetb6q^!*kwYfU*?TDiM`qK@^pMtT(3?Z>Il>m@URK@S}bX z0!8?OANo%u)%t6Eb%(cY?exLRuVfRPNg4|o zzccF)b+cm~rSc5N_gDY7Tp5p&e0E))CGVWwYnQKS%A8%H*?)0rnCzWuH3yZnCn&&Y z!b={p7>VOu&RxiQWk;BtTPy+B-a&yKx11K3CXOq;mx@4+;c0j@@cn}8QW@u4OXZen z*CfV7@tu-ieu;W{APEN6O06P)S*jEx0sS@d5P`bN%_>DkrdSjVMV%?3V;dKvY7S)+ zFpFQ8Psk`Ui#>a}-JG9*z7GugY$8@?u!I89!2J5Ugki3>cj3?Hd1VuI(f($#f&l;7 z@{q9KuTSQM1JziHM_s?gFty8*VtEhY^ikK$od&UAeF_+Ti<>3?m&aKu=Btfqbd)4< zHEqw}IGJ!q(pJdoA8$J5sfqPm$a4_BN2ybjno*%O4=l4DOOr| zml@rmOhmm0X*G)s2kW`Xac7lr<>p`IL#1PHxg9=Ag%y`#- zQ`%XIW7e}sgfrl$6Ov-oQ*kjpNDsu* zwW;`mA9|vxJoCIVZ08kh%cU^bWs3bGg74}ioLZ;qyPvi5dMSUe06r(rU73y6kADo@1r;=(Qq{g(; z36Es4@oMgAL8gXezI{^_i90|FH7|M4fQXqD?pQ;jrwK;j%3r%>+DC_d!zNC-#fpb@_J$fDC{d(&f=96 z?=5@xeAaW-N2@7*-1OFGt4#{>@)_iGJ~MkeL0f-n^U35I{*}tznoqb3VYrz)a@_Rm zWlOtX34s(4$h{YO@iM{sFR8IG~z8c z#y@LZaQxUriDG~%QbYcVQ{{N}J(5(aa>N+q-o@sj)_6w`?H;{b`uI?_hoj9m(+Pp! znBeDkMT~XQ-R&#zhG#N}Y>aDOiZ&;`QmzjtUT>Zb9N~R)Gw^#lFnjIWS(aOyM_l|L z&dqK~K9SbW#N(-NH-qid^$vC_Mi#c0IWV;dj`O=SHA$k3s|D$A{99(V{-M!%gJU1B=`kLoY4KwH zE^-a4FWv0#^pV1fyyPp6XF@`wXPatYhmPwcyjFrW+dZ%G1MdTATYo0M?HR80laYH)q);cc7W2ZuwujiP-PF1r z=xm4nJ5L_8oI`-z*9{)1OpFdpuQM;x7q3o1b zSSK?$Fifz@h`MD zV-9=&E#HE0B~;+t@1Z)kBsUr)wc=-NrwK)8e|na-1ozgI*w(OsS)J%~m0_Fm1~66W|fBZZ`PCfeanX--_^bguH+@khpg z1D6DaxcfbSvYk-6#l5A`Na%6cWG!c?q1;TYzgc(m>W>pDw(^)oh-vT22$f8HVCKl% zUC~UFWdr-XDxzyh7~#w1lA~m_D(fdKXeLytG$%X%r3(3lE#swiR%w`8aSc)K=JIX{ z_+>BM-Mz^6=AL2+tCf-=%-LkZ{A7o-I@x6*1gPd}jG+?m{;9fS6_QW6`AxV&8N+}6 zL7Ownd?fXUNpkZ)u@bZ8n2mK3VOz|6gs-f~+XI3>4B%qliSc4wvF?>$BBW>64M}_* z?O~tTo+HbOBa7veWBEu^CcPjqs^&de-|v6&)A+yl``2 zi$YAYTm9DyBb6_Tx_(vmaK*+`msD(4Q?7f&`&!S#h>p&Z;P1Tsac5$dvYx{Gi$v15 zm+tC|gv~E@d&p*dy#k~1+ZrpG>Y2Q<*XkwOAK_@?`nRE?mojOZ3}z!qAQl$yQM|vK zMpJlbA_Kv-Rz!1=85(#sv3-*HpQ+BLnGe!&u$bY zzNG%w`Sh!AK+J1<8r5B1t~(PU%GuS`l}f+tqnxW1>6k5)bK&w=&KaW5Omung{AjPK zzA3bhIx4hsWOwE$-rt?4_SQlj*48v@9rZ=x#$ETKuECg661Vs266=`kx@Clzjkgcf zG?##bGq03*-uQ_P_n^P%6-yiU_}QIQn^0`o1po3~d<#$AXapxM5x}iv&qtn8njgGKx3aQ5^oE z@NBkM*;X26Gsk_=|I=OQgCs9tA23^m{1nJ6uV?L=2KK)23D*o4rg5E}Yt~mrz&{jxRN7cZ zA3(%g) zZsgCNO`jVt|GTytDPav>6C|Oq6DTH}DAL9RWtp zOlJB2V%(|;f8cbADuk`Fn;3u%AOrBgd|(zwogo%SPmDVSY&mECh| zEc3;ncP(*~D!;~SgJ6J>1i*X12mtiI=LQ0SpXLUBw};-xzzasKWSZ|pN3lghv}g$b z|5qTVC&>%`zuvHRO}4??!aVhKnJjpO`-BOA3E=QQm_WZnat(=#r%5(5Ff?~!Y_eGX z9>*%GHnHh??MWKx9by*rBd;8+Uj>MQDIR_y#tGn=Zel>ZDVq z>;Bj8LQd1+rP#tMwqi%L#Q)Z6_^UdHxHX(#w3aQsXR=$P@55Q&Yb-Nl&unVbC?O%i z9K^!v_8~{ul7yy$BiKpU!z{wWggc}Ys`XR`tFw?_QxTdVZ+eUjd=yx3HP9+^W~VZo zpfCMrWmpI0KDXQpcwLnxpS>Vn`=<(LIH83izQ);JSddGY%hTNaYqXW94#%3|`z=gb z5`3&kNEgTgSOwFQsQ|*gY3mx@} zsq(U!pPQA9&EJ>=n)necy(Fop-$W2Fm_|MDFsf_|{JX!!LTph-j`NS8)CwGDdi zC6)8dBJ9F#J!d^fVQ90}R&vsg7X}UPQIqaGQeyAeb%NYaxU$1uGw4%4O62qkZE)+N G0sa?JpcN7T literal 25614 zcmZ6y1CVFE6D~Zq?U^0hwy|UE*tTukwr$(CZSHt}W8?1ozjdp=`qHP;eNI(6I7wCd z$rHjTD4_o((CZ%PY`ihg^|h!ZbtEG9DD9rHLt3F5l%RpxhAwq~paw7@BvN-Mpoy1V z5Moa=PczN4a{|{F{f6X6QN08kKIyxHq0T4g4c}P5SX7F4s`rtI6iPW_3I~+a#w5-# zBZ=8xgb^p49$A$)l{XhRl^MAk8DcM2ZO8d$otHP2fDb>tKWcs^nu^IjlL1tp0AI0; z&7bT-y!Eg-St`h6l2`ZFUQ?bh@KZ0(j+9l{Z(~SCY%hq7>E#{)s;YAthseXJKl&!+8t~0L06O_$eftra88)`>m^6*Q-q? z#~*3j&Vm%UDuOQf6&6A*@wOT+GyZPJqrZ@VI$Z%HEBq<0rh?2^-_c8Mv(D0+3(hc> ztkzAco$wMr!LB--SI+Ak>E{}fW6z0|Eu3!$Ubti^_x3G|@?wUGCC^Ls`egiWS}}N9DM|9rR`iw?UPM!@a6O?{0KKr{+3Y zhBrUZz}H?2+VivE8t%DOgsg74StWv;!G(6mS?W)UQ6s;iBkQ%Ug;7%9#$zmA|DWBl zwr8eQ*R@aWqMXvARX~L-oog5Y^p=)-h>=iN+NNb#Dy#0K*^r>i3S+jC$Ypu!(0wGN zpDs%G@e`pU#F8%@udPW8*EK8vp4j^rx7^8jtv=B~;!0aVbp@2pQ7dDQ|$}HulygZNp=`fiKZ6erdyvk~D7X zZxsWT$a8W6Oivjc^7pCcq7^9tXtKz1bOfYxl6j-J_ys5)zQt5R{uN5@O~;df8QZQNw&LuAldH3m!v>yf zqJ~2oJj!7H0bwy@+~$bEynV6vtYZWOwQq@ydDfl7g;qo_!_npi)lli?>$0*(?AhC65GUF7j6mykSGi#1=~nUn+9`=+Z32-u7(Z8F$hskhGj6g_n4OeN8cy74CN z7SX6@M8lT{hS7&oc*9b1#)4IuVgVr~rl%yA>cfla0tJqx`gpT;b44b-Bi*tKt8-er z>RgVKcGhe0O`%IoZQ=trg2ClXsVNVqGQ7)0YbawYyG=AX>q3ggvBugsGt*2JesBzQ zRjucCz+ZJmsaWd!W2TGs)y{&JQ=w6R=%lU~kr$$*u^pk49(Ijn zEIe zrv4%GU+t$vBLQAAly?6NdV?B3RdRnvmFY?Bj)$SSJ%uEI<&kVc5s=Ig_yc#{8~M)kAFl&JBY!|bro^}NhhI{ zyc9Wc?@OdcTc`0#$7(;$#XZQN@KOsM=!#Zl&FUR^ai=5)?j~q3FxHyZ()`X^m#H)x zZs;n}Q=b=sjfRejnyg=|vvSJ}tX++6pT`M(hLB5FYeaPnJhNCNLsC`ehI2Rq?=boa zW4I@B3~E_{z?+#x<o9lOExFKX35svnmkXXchX%R)@lMM`f_#Ts>v7D3%_1cO1opg@s%ffL@`^dbMl~ko zh_pC81XhH?h|>WtoaN>s^A5)AdEGUbWjfyhqmOY&e%I-D*jbiL1`jG5z)Fz>-BcB}aAiC@MjScjZr>tTlQneIAsjred}8Xb zMEnSd(XQddeUE^*WbJQcLE78MzcosdJJ5SR*)rrDQ0%lx{P{%AI=;U2an~B%j%tXG z`zZUDe5jz*b9_2#{k7#r!8<;Y>fhT%=?QVjRAEon3i9U!R5tmWx0-t>3$9Sc^VxP6r%(z_H|v=m5I4JZjH5z;hM(~MGozmqaMXLt*;ry5)YZ@d+5Vgr`& z;{=mH9Bg;k)s1|3b|7c_Bu2;;5w65EO;}pE=(Nm_t>Mb_(GyvPuvFi15fRy?-|GJ- zL<1}g1Ly%@e!|29gd1YJ7}CuWflLWh2!6(GT;35!w>WbL9HINSL=CWPOkolra6<=5 zV#$aTpKxKj1%;4@5FR=3hrW)B5g$Aic$%l-ALv~6dsrm)(gj{R$djFF5TQ5Wuc|;r zz(qo|X1cUAAPt|%qO^n_;aGI38vklalGsVW zx>WP86^b^Cs?FP_an?CK^VF4FYa5kWQyQ$L5q97ZKr#T;0o4gopUqHL1v7lZj!@5? zMbe2nS#xGIWtQDp>XO@Wfp+oZg>zZ^P;~QYUgpa)y2ypRfVj)0yYOY7Tka7E0n&a5 z)gAFmvXpSqwlRq9b*)qoZC#~YY|%M3TVj{Kl=TkvnxWomDGx855N4bqW$HeS=USM^ z|2jez>H?akiQu57e_ct}s7l@PMK@iwOmS_zVzGj~UbvD4Q5UFC@3Z9Q9{-9+{)iO3 z@e32ZA)H}cjVd`<(1$w#d5J@a`LJl-ae@Y_i^rT0Uyb)8i+!6!Qki`Yi?&w1SJ6gC z9vOmQ>u@E=gKb82yTf*6s;#^KwfbZ4&49X~cknFSg3}uJ0=u@(L*ER$WVOO0lrG8B zfTWFMpu71x1VYM<`#n1YNgLBeL3 zPVANZ;=lxIg)y}aT&Zn5Gdyy+CF7g?)nx9gV%h$ZYp~RNIG*Iomo;DaX=;$LGq~<* zkSh%41NF{`YukEC_O75v43(?Lu|7}WyhK9 zR@*j-NE1}UR7Yed)`S?n!&B>_R+ZXj7=r^{X3DlIl(1&;8KuNd@1Zv<^N6S_M205( zVhpLnE}WBK*hl0rjF?EbO?{_ta=5A4kwyE?zCE|)VCb3QOfrWpMZ-DC`mQMe91YOo zFn@l_Q9-OU15qdoyb7nzlApv}n}il1_ueQyexE)o8fSE2Z9z zdQNZDM(APSoc-I8U}NI_09pYb$86lZYWB4OP2+EW2dL3slv&d>xMKO%@uC~NsUAm+ z)G-oPjQkkUV-bvagt%1)uVeuSXFJL13+`@c;v`#SoQACYqZK>lY;EfZ&5Ujb(2l=K zZ9tWomS+@soGN7hxGd9ZTZU!wq?s1nzkKjYsf2@I+hK;9{#u(i0CJ^@&|k{c!76GU z7LgE2lDOAKFcQCw?H$#yv#URpzp_c9^Qyd!BVx8UH%7)&?;*?* za~X1MhEURJ%)9gF9oXArXj09RV%2bt#ngk(obO6RUHNG!^YMC)v4Jcjc5;Gx^~p9#%1rB0z4g*P4uN~eRN1K;k_b@M z8mnw}kFqt;>Y_)2%~g_a=;vl?({Y{hP`XPV=M^95*|(p~UC7O1 zn5q7gy44`O)>FK9j?+1r_G+`z>Y{15NW42C-#sEGlhy<7%6zC* zouRo?R^(*s3Z6Dx!_wE~>7DPpQ?;*b!`q+3c_`d%5i#&ymt8Vu-KI#b$M+g9H#TA(m?e6ilWnDt}dp&Oz)254H>VI9gjmpM9Xc$ zHGP%57na^fNVLw>tkI;&#Dk;7;^-zA9IQ8|J6aL8pE-e)wnnw?Lr+1B9>UzW~}SpONeII z(n7n$)_!lVv6Ebtn%nB2_4m7}j-7e2RHl0{G0kE_s$^lE%~|VFs(qYeL|~VDg!Bt* zYT{ne%1)vQN5ZPAOHh;!NyCcx&?=t9!?EkUW9s!6Lg-qIds(?-&frwQB;htd#!hfQ z@bKO%j&ffG^dsuQYw^5QhTKWBrC%Dok{g*@wkO_&Z9Ry{2|RfKZ)S%HW|{ zQuXxy+EBI-9`kQYgNVF(LMZ^FQfBNf$V6IY392)Yjuy< z7y<5}C#l(`?qlKgk7_c5WTW2QtgZzst5Hu?N3H2?fzc3v?ovn;?!&GktAeXIjQXuK(ibIQc6SQ>-X-T(M_GX5 zmout2k|%$63i{b0TBoBZjIO6DjQ&ILO?w~@?^ntCY4S<6aB0PwBY%5Z)r<$2-y_`x z|Ll;PvggvH?#1|XHx*^>0G%?I2%w=k{y1b_`78ZLMN3>d%G?B*t}eeM(=D;$Ra10? zfuU#wN3%MAgc-WMIoeWMH_-&;>57@VOSn<9HUYqSjKUA7cqLP~%Rg)?I6M^`p~*i? zQLK0kqEh+vHjc^t>F3Z;beZ#ux=CGWtQJO25tDCdBNuvmaJ#_r+5aN=2^19N6Du{z?e%`ZS4y2*XXZK4a_e)Ayh zhZ9J!YDgHEOn{H|V0-or^Ln(&0QYMzRu6x*YGxbH_Psz3pOqzfwC7oQ6cH^nB8;E- z?L1Od398;~R&P#FF9}Sm zAUO^NFC+dV?#GM*Ck%{p?b`>!3BtMQ!s&^=FA2=~&qu7T^rQ)GYMK~fGDuo4MO6Fn zg=V(c6L_T%-f{D|p>=cZueDVbyP4jgTlLoY(p`Hk9>MCd9#iju4_tUtA3GI%UEN!? zX)OriBu~p6Ucy@>sLKsev4BR1l4?Ye$qT+)(S5SbSm8lKzZ#0D62b=%?yZ#@D18Y1 z)=Pa?n0^^xMrBvjY28$;X)78Un(t>Zbpi%xq$}N2`69ZyKO@aQRU*sSpvt`1D+v7;* zdeQ-scXw+}IQD9tXhg_F3$-K*7J|g!@sbmfRTEd>qSp}+#Cu-G2vH(?S=u|&aGzoD zBHd-^|1`8v*Jc7x08oG{e!y>kK^UU=#w;im>63N_&%lN;9{XuN zAW@$$k>9asu7rIdAQy7J3I6Nxa}9Ur>D zY*3c=Z7cgA^D=c{Jg7Bb%AF%Av=#k19X99+e)-?7A0|d75%0>$T<+&mimoys^=ZKLvKRuC@BjEHP2_Sw*bVn{ydpB`sZGk zqY`R=!53eebW(dsf9g9vf4it?#q6Z{+2?2rd5)d8Dh>@E#20lzwN+_lKkH>^xUsca zk+c-JIhV=(jbPn|d8PLFG9D7n+;!Ph1wD{kA6S_1D#r0Fvg$0qBo@&b!zP+}LS0kP zvdN^r-yJPaEiDruuB%(#;&fSFok;t5E!!Ne@LOHMH`Z)l>4Gojo4@M3@dWG$>I^At zxlGAtfi2?a9FOSUQF>fcc!4kM`6d-tyXwH7yJBKa)V10YYhA8uO0(c*)_4JgJMFM{ z5U?xS)!S#oyRo5GT!!>xLabKBaCb^;JI6^+gxh28;%ap=`I&vd3eIT|FEqziI*WB2 zlGL9%D_0!OJll$rtI7+wGG%L9>4K8Q z$*xP1W+2UZ+_p;AV+07UXCD7HVfy*~i1fTQBaMojf#7y6ft%Z|*1iO&oQ=GXOE*cH z0M1C_y4-a}_0HtM#8H#Xtm@75_FHI#Ml%Xq%^dc2=Lz#!+U?GFtKL3SkoxVsLiebX zX6@1vKUbYQFP%b&O`C-myw2TNC6N!90$Q+5+K_gxuJN&}h`@uQgD6!F!x(xZO&w%m72<`9n>$<*LSw_qw9v__B}dn3!D$|rLwJ!#WnPmmD? zOB%=L6A1|g%Eg2I0YhmfPso=aWX0luAN|-FM!>#v-bflCn%i_J_H@|$2P9K0osAW^ z9MB5*VC=>hwz2LwH-H?qMN5}gTddl>t^qAN+0FjjEb+X-ro0*6hH4#{WUhW|unJhK zZU*IQfTt~)w8R&xvhge90MIb&^zeE~gNTG4bE}D$he9@%f~4@%SqmO`UW^) zD}5K0RzYa^1~77t)&6j9n*dEv5f@G1+?X*OtOavQ1uLQzb4f*TOZezfjN3%5=ieMS zUi!SN{pQvI{Ww_G(UX@Tt3c|Y3xy_wIO-r)g1}Zpn5+F6y$|>;{Ha22i?l&gqD|4J zrTZW_1DR&4eY?abI2+ajRp#?9^LFu{ZsL5bB_6E%h32bZYLdwPN@o^Sypw<7#hIOu zuwY0sII(JSkYsS8jW>zvQN)?8kYup0oX643Eqi0)9oHXi_ZKpu2D}F(P2t3?i2Qwk zo`sstGt?D3X&VsH$b=a-v=u!$!T<2beQ;|0{@r$3-Yow%m(S1)E9KwK04#|@FXon1{lJiy3KU>Uf+@+>BGm0Kap5(JjTzJU7(msb9B#`kkEjH(^5!2=<7 zu3U6gjYD&Pq@75a+E2g8Oxq04JezFjL0_QWJ$7Ha-3?c1GFP73gj%O*fBIJiHlbB& zrLhAZ1%VV#vRx|Ko+gR@Kv)0uG@=9SAs`);3DVH^aAdnf3e(9hRFxIk`I8q7)n81d z79ANM9&E~YsdJad{tO1k1C zmkkKN($$L%#W!b%+H}cw@fl`_>+of}@R`6vO!q?usT%$0Q#>(YFckxA5bMVQa{f#6 zK1R$c+3kCrvRT&ZXn#2b;zz+~n8vY|f0YkeR}8@>)gp+*Y5X~4(jpu-diLRIA`rxY zzz(7X(@3X_+YpPO^`>_tXo}aMmu%NB$&}i3?1EP(ZM3Xj_0%@obo4ZX53}FEBGl8~z@*mO=d8tI5Lp4A3D}uOa1%FB zJ_Xxyc+otL72tFNQMJ4Z6Ut(@^r=$y=Ljgw75-p(lF+qKq_1QVV1E2B&svo7FM)hx zH)}&pLyiV(e0iZnp`{_G6=ltX9lzDat5N!LMi8S1XN_j=itQ>z_lb~BJUq{@tPZ5j z68!7xvBhT^vU$DXBc0=@7XK&|=S#A9OcxN-NuygJcU*KTE9E3EDK;QU_Y%q%guWm? zGIkSY?o?k1t_fUQNsul-?`Ab9)T(@w$(@iyEFxN^EPv)df2bfVf4{DLR$i!N-2NLL9Or?s>L14UH2`>Uz1e6lt2hje)Fe*jtKaU_+g{{dyye2}<)`d@ubpj=2x4!M=Gs-PBr_to))}n3Ni3z4OICK#6F@ny75c z+A>xeWKYc|=QzKOr`2UoZ%X67DCrf}_fxaQN7?RZ`#&H_z00Q6dB`E*g1D`uAWr7% zKR!)YNHu)(fB2Ckeb#^Q5zy3XR%Zo{P=k466s!#cu^g6!HO_U12fdxL2S%cI95G{St5`dxJz=BAL)pRoZPV2(rhDTn!%R8RRQ zwTOEY2|$GlTzu-1aPhAs8|T*5-T?ML+sXeyML)UmXtu;N-E~{3QaEYJ4ZHUQ1UhT1 zjc*(qT)jm&qpF{!HMGsR|A;;H+`gLsAR<(q{}3YWszN>CfB29@+Bu!|%8cBa7;fu| zxSi%sX+V=ZXcT@~x}cQ$CgDCFi!_FNLvMFwnY~K8*fYv(tIa+i_l&N}iv9EJ zaf^BuRjs`sft%eyPZXn9;Qt~)w>u6I@!js{qZYjPy%JSjWK(i*+srp#np!LH#q2oj z8$Y|K5JExftuI?o%s=z;kTVB77M@>0#_Otpgn_`IX4DFXCQI(>TyONhcRl^k3#!AQ ze#&T*TKoirx+f=1*RoYsto7Z@-0in7f2?5^+N*mfY#WtIuiZ0PU;fa3aEtL$XT9=w z7wo-opYmi{T;LuD_mpI|yIpYByTo}n019YgLQSjP*w$8}Mf(`)vTeM4uIVm;Z=N`j z2-Z2%_CDdWXSLWd-gCnT6vD=UY&EQV3)<+mBiVa>msZ$SmW0=qJvq3FsbQmXlNasH zMmZ|NZ|8^F+Ph+1QY}#qp7`03@OyTMO?>5BF3(JRS}HbgPQ@NuOAkXE7HVp34)4+> zyR>b+L>`T1RMy~m^BtIQLt8^6w7v)k*mc8nYuX;!-!n^baS{^Ple*Q(_V1zwxA6M@ zq}*?~e&(j41W-p^Talj!69{4QiOmZFEVSCUNxk&=ybU$r8SGZ+a{}oXp~V-C zbIM}75A!DD`{HohdrRK&!C47+`FcNGFQ*!N;!3z5rFyUID#~&-zWk{8LDb% zNC~bej#@5u^gK8t`d6*U;fQlmjX$#JuyeWa;Dg1gno?VvYWm(Ja>%+{V@RKAQr1CF z+=1p}sp(VoupL;lY$iJ@D{xc{+Wwsgzd-tiKX!|7hs zH)a%l12o$gWeYU%qjB1w)sV9IEF6?NV_y|P-&c}{ICg7`6}g!Zlf&ZQG*mHfpFidm zNNmJ{-`OfZcVTci)@4UjtDOIf94*fuZHN5C7(NUVF)V99HBmezxSCY_$Z1R1MV$oAERIPy&e3VC6RUk=7C&K37?Cxoe#xT0h;5&Uvfn=4EX`tEgt6<}hU%&G zr7S;Fon!rKk!Rg3&ka(JT;WKN+hwSE^ zGg-ZpLhTlA-{(HY00jqtg68=e5++SKfLKz|W*hV99L!n6_^0>Cz zZ%akQ7QY^xM)U^#lkKsC5)Zqs@P5`9tUp;g!S(Bne#bM>?j-&}NVSdeJ6}za((80_ z=sC9uifdsAZQ_#nxKdu}H(kPO(mtKT%G_|)I)Hwpu1v-}U7%9Yg~4?D8n{j$HsZ?8 z%@I>$lYwrB)YoN&qVf!dSlCDzA^X7_T!jNBMoJGkqh{RijHJQv@6(sBHOK#<9x?{=?Z7JqzqWd z8V6IT7k~_BL$V@TC6}u1;X60H#(r=jUYVY|q+3CNUnfY69`Odpt*Oe1<&ZF*?|{F* zXJ|T~V>oOI-E`>J1|NV7WN-@vY!<`zI?1foWaRDL?Ouqb!nNZ%r9VWP7fH!sE^zbR z2Ml$?{wx>{>Lb(T2jV3hmy@BZ6Bs65?pXN2IIn)3fsbP!j*p~4sPO#hP^?}Lfc-g+vbfbZM}u-bKC7Cpn>K`* z*SYSrwVc)Vsa2qSA6>|nfb!+GI&n%l;Sn3otIXzWQ}1GllgC*98wqNo3AGj6&;CpM z%ODGBogAzcI>1I)KMM)`{~7=9n`48lWNJ?h4D<`W*7%m-u2vy;e9QTWy16ua4B(9; zW|caS_am!F;*wwt6`EtLj`P(OkMwaTqDi zjW0cauy0rLSz8dNacGs9Fha@w{?(N)`LV+C6UnND5~M<>Zx;$7O$DzgPoVe;7g=daJZr1KOXWEiSph?Qa&x|aaWD5=HTKS$<>OY# zjf(L7Hx8XetvZRv8>!J_zO(CSM@^Z@A{E{(|2m+AK<3kJn2hP=xwPy=wqS=EyRX}5 zp3bkLweC||n_?o9GyB7jqBpKyz)XY(eG1>Jw-m$!1BH@-?GROSN4Kt$oosg6f=D!Kl7Fl$Sm~} zIfkCTLAl+s-Ui{dX>Im(?Z<=$R`KZpTqA0Hl#s z8TMeLcI%}EBLZNiNK@ZXS%gfNmV8wwl1HDAYtQLsW(yHlAc&=>v)rrO<~wUDUg8U~ zaCWe_9(X)>RLx@oFaU#1JVK*H%O)wH1^nM;Zo6qvPardPjd?rJAxu4>x3uzcW*+K! z>tAMOjh=W@EPNrX`z)--(_#b{CSQHwv!eu;Ifz`RxOZi~$pOwigk}P`a=%VRQ}f`M{?{yKK(!6$XBO?z#;ti$$3Fh;)TBKx!&$Boa1C7{0&@CVY7JIhfM zdHfua%n_%WyZ)lTGE1=PCVIP)WDCmecQ5-`>5f*_n%(^e%hxSsG|#Fyg?q6SjvN2c z@kF@ReRMk(Buq4CpQ(NoFsSjU>IXeEC}kwGMyn(3l|iWq++jwc*)+o3#G#pF0%9Y87IoTE}54)4A&&D=92*HatvNM(ax|H$r>Q($rLL+rkt2?9W^E*RqVS5ke8N z5J6ODS9E7a3e#l{)$>Sn$A%-OT3IkNfECmtmBYf-ib1johG9k~-jrwtE#A~4%`{Rl z(}y&{lws-fc@@p{Orh8ftduoGIkUSi$xWZUr>mNf%3j6;kBaZ=V^HAD5hoHW6H5+! zsZeeym!zjKJoQ5^;s)tg;iV4ZTlF9Wgy9|n+)_4q7P*!r!fr}f#xGfxOTH<9E312@)MvR@_{FwbBns89XhczMvr zH5J=iQ~E#-;2nkb0kdV0t6`w{B>3?+Fd|4I3E=UGe_rBA?qg`5o?;mD-;|R;Sf}Nk z=5aTyqYI>Nmyiq%2yd5w292Q&dO@H-p^E;Qr|BZW$Zr;;P)UpO4@F6VY}4{2LzzJY z@b!1ugxwwyV_87<-IM!!d0x6WK-vGo?|y87eQ$IiNFWK|{{QOpPr6-5UaHnJV0D{nHSDSl&5dc2HD|1I> zmTZ}*r|{>y zgPM-p?@H9*S5w|$WW2)Tc2!8d&ym*=(Bc{NlQfj4;kGuNN~4aNPsh(qUjV%*_mnR$ z%+W?>>W(Tr975!M)s}&u{CLKYP2;&w5>*oDze^W}jX^FCM!J_)d9PojXGi}rfXkmz zJ1|gHtMNASpI;9fwrn-aj`#9w1a-quH;#^hF}xASvmSA5Vf~(B#g5}ZKDU09M14=k zC_Wj)g8w_8LxTKb#rmZme3goP&&DX+52e@-_217CmmHj;<`7o$)bR6Gf@v%KkZD!4$_1guGkL;Y6!$g z;-AkyH zJMb$T$e0;~c@Lfll&A=3{J-T8uMrVAZL@ay4}FtA*l~q4%&?Qio5G8zpH6_9!aE;e z-q#0%G$Kz0p1-@QnKFTkl3=49|KmRyFgYf4k_VCknnELZvcV+>l#<2&zXw$DEiVs^ zS^%l5DIo+XVZ*NkGLuFlkkt<(y$2<%00)%qmJMWu7pyV^MPWt zq;^hVr1&nHW*&_K$M|)KrHf6;_A@xc+d?TtmD!xytlHG6Rmua~53^=lb!ulw45HQ$ zisvToQsvV6z5sYY@OK(S{5+|xdzwapQH}1yEMW%pZ~ms$(LPVijEG402(Pr$UzXtR z=a%sfrO879@}QXTXQ9wb@R5QX8FV42f7n?eGg70nZOe={=wlmt zPj;YpRAQLsbaYDGT=1OK7=Ks|nZKZIwXg!v#e4{cMHADNchA8Y_8&E$5a22Bkc8%o zJ3;h`AznUnQaUU@uZXu-jgmD`Zd$7vlMWx=&!02|-?&^V z1*e$+Cn(1+BT?WBvrx|bvAxoPV4t1^0F=l+EH@G=&;{vbWar02F~Y&#@29#YW%(TL z5oB!sIS<#|``T=7bopIjq;VHnlLOoQbY0CPL@*9LU)~$t@Hf2YZ## z*BadRu*jZsv@1_wSL&Bq);NYm<1aj7`-C`PHD5rE`1zDBm9AM%bg@1=cyOSV;Y(Bbn2a$-LoK*2gRXc)}vbvV`PxWzLwA&dg_V~v&=|5SH_Vw~VTgaJK;U$yYSvT#2a93r0v z$?M3h7?&;M<&(AT3kmij3S%oq)UJgxz&F=TvHy;fa2b_0ta!RAeD$*H8rqOs*6$ED z*1$RPcPW2uKK+T;E-wVMG<} zpNxqTI6>i?5i=ZwD@aVb`Tv~gI9^A)d`Ax(un2ACwQ0*OGkq%!8=%lB-W1P z+qqC<2BUnxISbW~1gnRsr^c0g1tjRF6pDfgv*+AOC_`Q386+EVux9N^Z0A{O8^<-- zX{t`$hdmnB$ofI>gg!7)`xuIXsDTGy2K9rq+}6bj(#5k5>5g#tqo8jz`6`+n&M*$G zP$D-c@|&{}u$I5uqX$uiMC2*CFOzHaSjy>Ko9Bm1iNOU|~xg+$eenEJI-X9EaV_~eu@FO?rrjM=l# z&V_f6X43|n%8f+TrVW_{qEZQ=QrW^g8&MjEM3Lpg-23I#fTtCp4kiEasRxzDq|}aC z8-b>QazGC>Q1mr06HdCva(>=&!XvyzqI+-2V;Mc4SocWpfuV!ZADJ{4Nn954%Ro#_ zk$lMF&PK2541UJ)@HojfswAXX&%mM~ZOc$<|15ks91P=?^PQBz-g!K!?g?(XLLtOc z%-04|HzAzk*uB}rqKmLt4RlVd+Q+Q@kSuUihl20_ldT>LH8Cp#?WPhL&FA}EK;bxl z?xwbi2IU%-a{jwZb7m7k^D7c{KS=5%$iT<>u{XTO7cYw8uL_PQL1wa^ryohcu+FQ>L-s_DdOjM?9+Yg8T&~>0Qtgh}pu@CW;U}J?xY>=$e(`uzCq- zy>VKS=3t=+HIDVxrWM@o2WyinJi_x|NpEro&QYfJ%8#v zC|8!yS&RTpJ8?e|3@8&1NC^zcSPH0ooL6~25$^|tQC{NRtX~RSfF(RB@o95`=X`(M zqFj-OCdy*EuplReMaql}+n!0{#4dVJ@$DoWZXYTwS71^R!-}rKtd90kK2_w$_y;Zc zd&1Gg|9{Hm|0)}QG>i}`T7>w)M8=R3U?p{o(t2J&7_$(nYcN%Z>Mo}PNybnfp~UK_j3D~S`~!Je{fD0 z#n*H4Z>)XzdW275)m~5XZ=;6Ld{1KM4Nw_A6Wec7?ukP5VljJBy1m(uz=F_v8{H+& z5F#$CJtiqu(15EZS2ULA*_Ue%JiRPQ?(ad%Ok83h8e2M7SQ|_Q zFI#u5J0#g~%NyHOL@#yLwi35mx-$FZ-7KJ{vUe^-eDAGgj_@1}DX8Y$O%wG#1Aj)t zqX*ZM24=`O64*HzH%OT?%wFj)K-+!rYh7^x~b0~*fqfm5Lcz-uE_Hd%68j1{j3H48`|cQP=&mYegB5}Q6JUO3{u)L(hcVWa;Z)=ECnqG zEuY%F3Z)6)7K?xi{hYPc&X4YBr_9E&+RHrCwK2^GY&+k?>V3v zt2jGLd~%{1`X~NT37ye>tr8PmTOH9as;9SZ;#zbMJdI0v=C?d8 z#;pXFn*zf!z0!|I%3T_Om4qo8 z$W(%UjT8d4^ZF0!*a|MKoIG^U#R3Zaid9V;d}QfCq9mzJ(^9>Gyq=rMR*Q5hR+U+Q zaw`bq$b(TgC!C5%lYS%dU4pu-qLhyZJ)dAw4rKo!$?xP5T!(<~53Sd6iriQlxuZ6r z2d$c*(Clk;L+Pe(-YyE=Mlcz=`3P&UT=)g?(mN;Lv}!VJf-H$j2j}i8*sniOYgG{W z^m`+YI}|*TU$cbUuDiq?8;$C1N6prT%n4z^MVqIjd?6mmw&!gnc7pX9DTO37T`Pg4 z76}(}B+M$0&qCNd(sh_2!vM`g#b=J|SB-YOQO@dHzT389hH(xq!{zkClPi7|dCt~U zxj=gXVeAfW?eiSY5OJY@cY1Qm(co+Fwb}27Q}hZ1;~2Xq4Q6;XzFc8g*c_!$PzFUA zh;9`r35>G}Yh};HM7v2;K?aY7XubfiLV)|5AB1hBU@EFzlg=WPUa{?` zLAqD`)$#q)_oK>|0c68fX_-~IBMP#la16H_+-KlIRfI(TD#r-8M@?jZt)bZ~8R$FR}{5i#@RWTnS_r6sb=e&@ez4wyq z`h!H)t7l1KG1Z&Z)>QMn{E$1;YGycQZ**;{Xq^Y5%gwzQsF~?kehg41GNNYO39|+f zBUf!J_uGb^70)qw$aHd}r|aL(vQN-M?NGguy@#5En!A(OG@H=PWr(G464E z86VD_Q@w`t6`>^heJ;C>wv8WUVfC*4D@=8@fBnMKH5BlmmevDazmyF7*R<`8I$d9T z1C76V|1drWJ8sXS&!EhV;MhQYrB&dJM&`^JiJuV8$XiR#JdM|erVZgSTzGSb%O;fu zdCRkh7nd!sZ&Ld>)~G1}aez4d$iaSqZUQ(w%sKV&&4~gJr}2eem)CR_<~CZSN)g19 zkD72bgURmiw;~4E`XipiT613H1a>dpnEh6mviA7hnHJ*n$CI@A z(g-wgk*)~5x?$aamO*6V06HSU9xlP1RpW$XA%AlF z%VL8~i%N9)59e1%OwZhPN(B`wI#yPbuW^x8^!?T)Cu;l=rxi&CK`Of~S#hR^c8Cnmh>y7j;>D^8Unr zc4@S|2f}*7fs;X)wG98)i_7v3$Mxq~wR4QQw6y0^Kt4=+m3PsWV{yz2m}7R0>ayFz zLFDqSK;Fu?0wD8BdZOjUK0Q(Z8k{kV4+v4ld`L{e3b1<(FF9Bn|4RUH#40wFlAZ$h0B z+h#sU3hba)zkbs-Dz3YA*)=NtAo3;ZeGEG!rm&0LR9vAA0KVKH!35hEpgKr&g4_Jt zF2`2<;Md=9#F=SY=b{sOR-k0fd?(OTr;!zqpzMhyHL8_=8~V#(yhYUJbo^qR!Ih`G zaA&s%am;1hW61Vz$_3Bf50!VV-e93y7qqc$U{H2 z{u1c4c#bMZZZ=*`ScfL}d5J+sP|*98S%_oqeRmLr;}IYMF{y;L9w;|bBr+T;6xG{B-Vh#W{8!p?RijHP}VPW+d3 zl^|5}TTlQgGO1NyI1ELd7mni_c1MIUd)azltlPM@Y3Yb-C|<)d%y^(Xjv{5Ei55}h zn^W_&GY8J}j$QzF#P7LRT?0?&9U|)7s`RlSxR6ZT8)!oJDgsK=$qv^MMz8m-N4q9D z)xXm2K#EtZ16}EENPFp>6bA>R zM&(bwhg_Y<=u{bd)wvuEMcuwj)&WIo+ZU8Tq2TW&uZs#NdcKSRiQ0j=bZrl#kBw6(9{U#WX)1dI9`?os51KVIl%*0&(il=X~%y0!o=N z#1ubwEn@>cJtkmt?SVpTSR9i3#hWh*f}u*|qLgARr@<{S$t05ZyP>CCUEW7xqug2J zGb`2Km@O`1&`P9zet~6DMKo1T*B+4W=e{hi;w!SDkCu|}p5o08fDzsra0p7on%%*> zB3!iqdxM|8N<(9S+sJUNP&^Ut6$=vy3JF)l|J;9ny6wOBQ%YHRlSew^bB|?sRDG!p zzPWbok3hD6LvHH12GT)TP%Z3fA_*;7)(AIV6K)f3Q$2CBDth!ABsfDD5fHdSEF2YL zcm-vptH49Z(9@z;cBd++y+=3i;rdfp%HHX*J2j-7>t%;zd6knFOKdP9gjs0!wgpE! zz~2Vn^{z9Iu`;iCZ_se-D>qI0&FKCF{&cF*5` zhGe7kp}`r$aQ@Hlcs0^9W{_33J%cWz|J^;=^CwEFrkR09Ian#1H0!Y$MCeuH7~J^< z1G33Fk_iT=2gHrHpEadd5l}M19X*5L;vd}=)9KnMuLo=fV{pm7@N4X?w8a9v?S}_E zRy7?=r#ErDQ1yG|-|pXDC$kE|-A0f}NQ7|3_$J6f9{}fXy2?`zru1pt$&|!~2%eW{ z4ECgcDWPF~Hb0LTkLN1IvlV#K9}fSY3b21BKX_F?S(kP} zcdc&_`;U~(1kB%PbDR*n!Ks1%r(&N`#*pT+ZntCi`PcQkainNuI94cX2qzNp)o2YT z9k%!gwe0cBFr$MlIG(wO8Sfl5tn>gbe!u74ya6)p!41Mxb!#j?hTpZ#cL8l8OQA`T zpjL)DcW)!0G@U_gh=gIXSo^ZZw~elM`w!oNaj*m$;(Km8=Pv^oj~3tTMV5&epO;(D zCrN)e9{wkih>WP1-dip9l^#H-^MLVjTM&aV1(81bO|wjQZ+Gv)`ersd7aE)~3^s(p zTJ9_`v6|CXxMpXgXFfgq?NCJddC-j6;8}j!3ThW{W&8fHthh`EUPbJm)uzW>x3BHJ z2W@kbs1IllV`x4wqzPd-Zf~qz5R$i6tI{S)#a>a)3LPixkiCG7i3eWVIi_f99Yify z{ZKFX#yBj{NMI>S{$9bwSg=nv|H@J5Y_)vd zSEun1YjJ6W0c0*fVu1LNz-sgqe4hm1I&i%Xc(#TDMu#(wF@cy95UPMFzHY2Beh(Vu zZGh{M#2$CB2ttoCcmJzL83;YfSldV6+W3+<#>BBy|%@OGj8$2FgY-J#mfBsvEe24hx zyX&01<(T*jP?o@6gq=hlSYY8wSro#dIMj-)hM1e$+R>v#k;(cCx_;&FN8mF5vO1aB zE-WovIGKb)2)WX@F8{KT!wEiw3FE6*Uis^H3X-*>N%PyzI(Z>F_d)f_>*JQ-HO?>{ zLcWT}v>L&>#))qw`h|2R73P>k+?791a{`Rpmau1SbY)JHtD{#*yV8QbV4A;Vyzdp~ zBcLP5;;GCeT+IglL54GoaSmzNGAA?|bgablZ<}^D|C9$lgLX*}Wc{^!h**N&udU+s zpj7e+l4sG_?C?AeJXP;8sS0!z%E3~@xEDNWODzMN_guVf8xcWWS^M}3B+k>^O*=0U zw|&%S?QL5?Ofr74(%F*A##R)*lYfL;PA6c@hzGUS6zk~|4{A3FK$C&lx*cu_0aSBt zjXe%i852}*@l);Y^Xi3XEDpd)fDmvWq0#$|X#OXt>vrqMm>b6+^mbf0nS{{)gsY7s z*QzewA^LiZiwS1$26HgtjQzUkAGUrie`NOnbz3 z!E?#N6@!sYh{ExBV+}tDa8}y0FED&i7Vt%)7&&Dt=*K7p2*)dc_8^0b+391XexGhfBab7G$As^> ziQL^upnqLjf2b1+GpKEdA|ez}EzLC@a~4P&X|k^F$Msp!KCTo^TK1L>xcUT0 z%f`{XldNUG9mpfHbX>ZrZMMUYQ&33kWon3u|CAEI`7QmKuQZ&m^h3n(FbboiSz(ou zN@9O<=?a;4fy>ehn8(7ElHG^I#fTBC$QL2)FlNk7b|rPv!aEjA#S0EHrE5X`qqs$) zWWCo)$Kt7^Lxnf*!vFsBV$t3sN>_{1HB6kR(hPl36Mfjc_=kp;E(qT8;0+<^lX#4u zkX>E<>R+pPweK6{x(ZAMsV{=(n03jRM>|dnxC^`YKI_G<~7f3 z#}~c)Umf+oqbmrrE5n1|5_i-jqT?{BI)L>P~oI-_-6<6=o-o^n0ar<{g&vU?w3(lawzGmvt$(1n;|Xb(7RgAaXVbg#4CCn<1*JJhOWG~Iv2D$Cs}a}7XeZ9rGj{IFuvR2i&b z)VOJ#{rzL|4ZL@pZPUAn1XW&cv{L%)##0m1lXxcKF=K&2ak7@l-guMz2vqM8`~j}I z>C3p6KZKvNxM>6b_1YJYymA zR3&TG%d$|bz1Z+7{KhIfr|}aN+hSH|OVX0VV(@Q`*Us0QFfW$F0%pkyTdH|g=BSN~^e9R}Zf6vRJ!){A!3<76B;p z6x$~Z8e25QM&(xN{mZF1R58}HgjSK6TbM~+Mj%8O{5P&_&t_1G>z+ZLsg7@i6`hJh zjqv>vTIyU2_@z&v4gRLg_?1cnYxs?K|BYVVx?A|WN0PjY0K)Fe)>3E2vg3$z0&bo; zw}7T+M}@!+O0f@Ho53t#MFuVwE}~Ai=EOT}4$vFlpH~=9QKaGrv6Z}j;%sFdB-mM0 zXEOPPVkH3ra?HfmsyWzy;y<#m=+oz!kMMd2dq741xl$6F@LY8Ls<&?={NpWEO7B3` z9{KXUoKgmn53}~8e7lr&^ki@FbqkAFfCCE>mW5uhfST4Ritz2G=X6_TTJ%R3XS|~Z zwU2y{JpHm`*}MXE2aSJ-_dja=9{8b}dqFhqN^SJ=A=vUix#6W*eaU-jS)!k$#QiSJ zQSr}SYIn`yYG=jx! z@_)Qdmw%Bb+#2-SZ!ceyg>7N`Wu}Fzh80ibek?G6X{y|1XZ9 zq7!G{&gyq}NuNX`VeQ1rsddr!c{qvA9%o|1`8a8pIp32M4}M;1yhue_+Zebz(tQ4D z4O!y)$l7UofR_b+8^U@0bfqS3RX5d{6lGoaGqhA$O?y16Dx)fCeD39*t&3vv_hFk- z{mx|nPfq{IB?`K$yucdaE5=f+TPhSwve)(0B1;ZnCl%5hixKGrdt)|Mj5?5fdy^Kz zvb9H60{v5}iE4C9&SgaMZVXI{On7@Od)oIb`Qc{KVNq~sTSDK7L|0X7ID)Q9zdg6N zA!?~2a1MsPb1Py9TCVop$ zLAuo^%R*U@eDy%-ON+@3ELjSUs#1w?=<@sZuLu-aGuB^n1;5QTAVo34LArHUbGKwn>b6?s+ro$)o z+T5Xl;6HnwGXCNgsH+u;fIi)~cgS+@ILnRsI=k^3E)c#ycm#Vbj(>S*2s z2*vivC9`!=X$!r}!1ANP?{x21yuZl`E~sdIR*Cqd>t7u!!7xwBwR;`Q-wC93T!l7J zDO+A+k;FCs71BJq`)gq0XOvTC9uZN?}1`lR?yo{#9h{ z(56CO#(KW{_yb19_y*0(^oQ44p!)1DbNZ?nK?ORZ=R@V%*hQPP}0xY(kj=JkPyZF1J=fRZQf1W-kh+*-s^B?Vc* z4?1-Z3-1%4*1e62n_Jew${H#5hc>}d$xsO@T8{P2Vt3O_Y~A=BS& zZxA0%#E9r+0y6UDg>>+L(HG9OoY3JrWuP9E2>rv3SC6TU99YjyrNt+IiN1lSppi;M zavuvaD|?}>i_VDG+G<-}*!=tR>0E1(Tc;y0*^`5u^T!p3!~r?ljh)t6)}U|+@i@*q zXcU)+fe8ruF#e=Pa$_yqoRab{$Dr)zP=kAi!R$Aif?b%zhk#!y)GWSV{7SVh)Vzih zvssI+hb7+V(fVZ-R$j4q9$R$vwx43*UZUX29s0%kf-3IB+kDf5%|4w>3tMAt4}o%Z z6d3Uj@Cfs2CN$$G6t#NT&eXXw?LM}71-ZlkF$8OrcpK!XhHIQ8Be1&Zh+vR_eqMdhp_anZ&se&eE z(g~8_%@mZA9k^i?>!h&5nS{qO?e{A>#tXykL9Jo@LDEr%?qhSI=!w3eb2U0yvtnye zw7u8GmvE`|4L1SfoIBxcU%vof`a1bk&v^QQx1yW)vMt+Z=p-0e1SI$5B%0%Yd!qGu zGHBI#P%;BoU8?xckbSaq{6CqU#H`NH3gGqqI6gk^R4c(<;e0j0nP(}AJ{o`M(Whtt zN(IutQZBfpz;>H%O4DE?UoK?+y%lF%t(}p!OP}gJ1acENSBFrS<dz*Z#PpZQfZmlUC$?Bm^UP1UOh2!SnPOXguQG5DKq4@B*)+ zWj|rqf+GaEHj21)b7mHAWrJQBp8lV{0&KyANbn1S-`&stCIDuX$k-ZTYzjtVs~-|fys}yE zDHzjRmt=Lm8KLo`Sjzzy0gC{B6qG=u0RKni-vCRD6hGy03auRwM5@4r-_Gh#t!f68i_0y!M3RC6@RTd|9^HJ3r@cQ zz%g|&KbXH80Q{W;Hd%*C^MHX!Xan=*R$E06XUH4;U0vuIQBf@;(@u&OWW8(*#a#~OR&R)S*{$;8rwc(^=_4bb0Sm2~A4T)4Ql; z{KMehWMa0NoNu(%5%Iy4B8|@XhWJvu;D4v6d|X*t?VyXt&yd@rnziK5T{>o6#66C| zQFZ0P4Zo#b Date: Fri, 18 Jun 2021 06:49:46 -0400 Subject: [PATCH 20/20] update notes --- DEVNOTES.md | 43 +++++++++++++++++++++++++++---------------- 1 file changed, 27 insertions(+), 16 deletions(-) diff --git a/DEVNOTES.md b/DEVNOTES.md index e4953c37..05cc71cc 100644 --- a/DEVNOTES.md +++ b/DEVNOTES.md @@ -9,13 +9,6 @@ These are internal developer notes. > substr_ctl("", 2, 4, carry = "\033[33m") [1] "\033[33m\033[0m" -* It's possible we messed up and `sgr_to_html` had carry semantics whereas other - stuff did not. - -* Check whether anything other than `substr_ctl` uses `state_at_pos` and thus - the assumptions about carry being handled externally might be incorrect. -* Rationalize type checking on entry into C code given that state init already - checks many of them. * Move the interrupt to be `_read_next` based with an unsigned counter? With maybe the SGR reads contributing more to the counter? What about writes? Is there a more universal way to check for interrupts? Main issue is that it's @@ -27,18 +20,10 @@ These are internal developer notes. from general utilities. * Delete unused code (e.g. FANSI_color_size, digits_in_int, etc.). * How to deal with wraps of `"hello \033[33;44m world"`. Notice extra space. -* Once we add isolate, make sure that trailing sequences are not omitted if the - end is not isolated. * Change `unhandled_ctl` to point out specific problem sequence. * Check double warnings in all functions doing the two pass reading. -* How do we currently handle styles across elements? - * We don't. `strwrap` carries the style within one single character - vector, it's just that in the output the result might span a few - elements. - * This needs to be properly documented. Will also simplify - implementation of normalize. -* Bunch of docs don't have @return tags, oddly. +* Bunch of docs don't have @return tags, oddly (fixed some). * Make sure we check we're not using `intmax_t` or `uintmax_t` in a tight loop anywhere. * Cleanup limits structure, is it really needed now we have a better view of @@ -49,6 +34,32 @@ These are internal developer notes. ## Done +* How do we currently handle styles across elements? + * We don't. `strwrap` carries the style within one single character + vector, it's just that in the output the result might span a few + elements. + * This needs to be properly documented. Will also simplify + implementation of normalize. + +* Rationalize type checking on entry into C code given that state init already + checks many of them. + +Kinda, still a bit of a mess because functions all have slightly different +signatures. + +* Check whether anything other than `substr_ctl` uses `state_at_pos` and thus + the assumptions about carry being handled externally might be incorrect. + +* Once we add isolate, make sure that trailing sequences are not omitted if the + end is not isolated? + +This doesn't make sense now to me. Maybe if the beginning is not isolated? + +* It's possible we messed up and `sgr_to_html` had carry semantics whereas other + stuff did not. + +Yes, we did. We're now using a different default value for `carry` for it. + * Are we checking byte encoding on e.g. pre/pad, etc.? * Write docs about behavior of bleeding.