#' Import character from google drive
#'
#' @description Provided a regex or fileID this will import the character from your google drive so it can be used in utility functions. Will ask for
#' googledrive authentication on first load. If you are using Rstudio server, you can authenticate using another machine and move the generated
#' .httr-oauth file to your working directory.
#'
#' @param regex A regular expression that matches the file name. If there are multiple matches, the most recently edited file will the chosen
#' @param fileID A googledrive file ID.
#' @param file path to file
#' @param output if provided, the file will be saved here. if not, a temporary file will be used
#' @param overwrite If TRUE the new file will overwrite the old one. Not important if output isn't provided as the file will be deleted eventually
#' @param ... Variables to pass to googledrive::drive_find (if regex is given) or googledrive::drive_get (if fileID is given).
#' @return The output is a nested list extracted from the original XML file, edited to make certain fields more computer readable.
#'
#' @export
#'
importCharacter = function(regex=NULL, fileID = NULL,file = NULL, output=NULL,overwrite=TRUE,clean = TRUE,...){
if(is.null(regex) & is.null(fileID) & is.null(file)){
error('Either regex, fileID or file should be provided')
}
if(is.null(file)){
if(!is.null(regex) & !is.null(fileID)){
error('Either regex OR fileID should be provided, not both of them at once.')
} else if(is.null(fileID)){
character = googledrive::drive_find(pattern = regex,verbose=FALSE,...)[1,]
} else if(is.null(regex)){
character = googledrive::drive_get(fileID,verbose=FALSE,...)
}
download_link <- character$drive_resource[[1]]$webContentLink
if(is.null(output)){
output = tempfile()
}
res = httr::GET(download_link,
httr::write_disk(output,overwrite = TRUE),
googledrive:::drive_token())
} else{
output = file
}
char = paste(readLines(output,encoding = 'UTF-8'),collapse = '\n')
return(processCharacter(char,clean = clean))
}
processCharacter = function(char,clean = TRUE){
char %<>% stringr::str_replace_all('&','and') %>% XML::xmlParse() %>% (XML::xmlToList)
# simple statistics -----
char$proficiencyBonus %<>% as.integer
char$armorBonus %<>% as.integer
char$shieldBonus %<>% as.integer
char$miscArmorBonus %<>% as.integer
char$maxDex %<>% as.integer
char$miscSpellDCBonus %<>% as.integer
char$miscSpellAttackBonus %<>% as.integer
char$castingStatCode %<>% as.integer
char$baseSpeed %<>% as.integer
char$speedMiscMod %<>% as.integer
char$currentHealth %<>% as.integer
char$currentTempHP %<>% as.integer
char$unarmoredDefense %<>% ogbox::replaceElement(dictionary = c('0' = '',
'1'='Str',
'2' = 'Dex',
'3' = 'Con',
'4' = 'Int',
'5' = 'Wis',
'6' = 'Cha')) %$% newVector
# ability score -------------
abilityScoresData = char$abilityScores %>% strsplit('⊠|(â\u008a.)|(\u{22a0})') %>% {.[[1]]}
abilityScores = abilityScoresData[1:6] %>% as.integer()
names(abilityScores) = c('Str','Dex','Con','Int','Wis','Cha')
miscSaveBonus = abilityScoresData[13:18] %>% as.integer()
names(miscSaveBonus) = names(abilityScores)
statToSave = abilityScoresData[19] %>%
ogbox::replaceElement(dictionary = c('0' = '',
'1'='Str',
'2' = 'Dex',
'3' = 'Con',
'4' = 'Int',
'5' = 'Wis',
'6' = 'Cha')) %$% newVector
abilityMods = stat2mod(abilityScores)
proficiency = abilityScoresData[7:12]
if(proficiency[1] %in% c('true','false')){
proficiency = proficiency %>% ogbox::replaceElement(c('true'=TRUE,'false'=FALSE)) %$% newVector %>% as.logical()
} else if(proficiency[1] %in% c('1','0')){
proficiency = proficiency %>% as.integer() %>% as.logical()
}
names(proficiency) = c('Str','Dex','Con','Int','Wis','Cha')
char$initMiscMod %<>% as.integer()
char$abilityScores = abilityScores
char$abilityProf = proficiency
char$miscSaveBonus = miscSaveBonus
char$statToSave = statToSave
char$maxHealth %<>% as.integer()
char$abilityMods = abilityMods
# process skills ---------
skillNames = c('Athletics',
'Acrobatics',
'Sleight of Hand',
'Stealth',
'Arcana',
'History',
'Investigation',
'Nature',
'Religion',
'Animal Handling',
'Insight',
'Medicine',
'Perception',
'Survival',
'Deception',
'Intimidation',
'Performance',
'Persuasion')
skillAttributes = c('Str',
rep('Dex',3),
rep('Int',5),
rep('Wis',5),
rep('Cha',4))
names(skillAttributes) = skillNames
char$skillAttributes = skillAttributes
# char$skillNames = skillNames
skillData = char$skillInfo %>% strsplit('⊠|(â\u008a.)|(\u{22a0})') %>% {.[[1]]} %>% trimws()
skillProf = skillData[1:18] %>% logicConvert
profToInit = (skillData[19] %>% logicConvert())
doubleProfToInit = (skillData[57] %>% logicConvert()) & (skillData[19] %>% logicConvert())
halfProfToInit = (skillData[76] %>% logicConvert())
halfProfToInitRoundUp = (skillData[76] %>% logicConvert()) & (skillData[95] %>% logicConvert())
char$profToInit = c(profToInit = profToInit,
doubleProfToInit = doubleProfToInit,
halfProfToInit = halfProfToInit,
halfProfToInitRoundUp = halfProfToInitRoundUp)
names(skillProf) = skillNames
skillMiscMod = skillData[20:37] %>% as.integer()
names(skillMiscMod)= skillNames
skillDoubleProf = skillData[39:56] %>% logicConvert
names(skillDoubleProf) = skillNames
# true for everything, ignore if also proficient
skillHalfProf = skillData[58:75] %>% logicConvert
names(skillHalfProf) = skillNames
skillHalfProfRoundUp = skillData[77:94] %>% logicConvert
names(skillHalfProfRoundUp) = skillNames
char$skillProf = skillProf
char$skillMiscMod = skillMiscMod
char$skillDoubleProf = skillDoubleProf
char$skillHalfProf = skillHalfProf
char$skillHalfProfRoundUp = skillHalfProfRoundUp
# weapon lists ---------------
weapons = char$weaponList %>% strsplit('⊠|(â\u008a.)|(\u{22a0})') %>% .[[1]]
weapons = weapons[-1]
suppressWarnings(
{splitPoints = weapons %>% ogbox::replaceElement(c('true'=1,
'false' = 0)) %$%
newVector %>% as.integer %>% is.na %>% which()
})
splitPoints = splitPoints[-(which(diff(splitPoints)==1)+1)]
weapons %<>% splitAt(splitPoints)
weapons %<>% lapply(function(x){
name = x[1]
range = x[2]
dice = sapply(seq(length(12:length(x))/2),function(i){
out = paste0(x[12+(i-1)*2],'d',x[13+(i-1)*2])
})
proficient = x[9] %>%
logicConvert
miscInfo = x[[3]] %>% strsplit('') %>% .[[1]]
hands = miscInfo[2] %>% as.integer()
type = miscInfo[1] %>%
ogbox::replaceElement(dictionary = c('2'='ranged','1' = 'melee')) %$% newVector
damageType = miscInfo[4] %>%
ogbox::replaceElement(
dictionary = c('0'='Bludgeoning',
'1' = 'Piercing',
'2' = 'Slashing',
'3' = 'Acid',
'4' = 'Cold',
'5' = 'Fire',
'6' = 'Force',
'7' = 'Lightning',
'8' = 'Necrotic',
'9' = 'Poison',
'10' = 'Psychic',
'11' = 'Radiant',
'12' = 'Thunder')) %$%
newVector
# attack and damage bonuses --------------
miscDamageBonus = x[8] %>% as.integer()
magicDamageBonus = x[7] %>% as.integer()
miscAttackBonus = x[5] %>% as.integer
magicAttackBonus = x[6] %>% as.integer
attackStat = x[4] %>%
ogbox::replaceElement(dictionary = c('0'='Str',
'1' = 'Dex',
'2' = 'Con',
'3' = 'Int',
'4' = 'Wis',
'5' = 'Cha')) %$% newVector
return(list(name = name,
range = range,
dice= dice,
hands = hands,
attackStat =attackStat,
proficient = proficient,
type = type,
damageType = damageType,
miscDamageBonus = miscDamageBonus,
magicDamageBonus = magicDamageBonus,
miscAttackBonus = miscAttackBonus,
magicAttackBonus = magicAttackBonus))
})
names(weapons) = weapons %>% purrr::map_chr('name')
char$weapons = weapons
classData = char$classData %>% strsplit('⊟|(\u{229f})') %>% {.[[1]]}
tryCatch({
char$classInfo = classData[[1]] %>% strsplit('⊠|\u{22a0}') %>% {.[[1]]} %>%
strsplit('⊡|\u{22A1}') %>% as.data.frame() %>% t %>%
{rownames(.) =NULL
if(ncol(.)==4){
. = cbind(.,matrix('0'))
colnames(.) = c('Class','Archetype','Level','Caster Type','ArtificerFlag')
} else if(ncol(.) ==5){
colnames(.) = c('Class','Archetype','Level','Caster Type','ArtificerFlag')
}
.}
},
error = function(e){
char$classInfo = NULL
})
# char$classInfo = classData[[1]] %>% strsplit('⊠|\u{22a0}') %>% {.[[1]]} %>%
# strsplit('⊡|\u{22A1}') %>% as.data.frame() %>% t %>%
# {rownames(.) =NULL
# colnames(.) = c('Class','Archetype','Level','Caster Type')
# .}
whereStart = classData %>% grep(pattern = '^[0-9]',x = .) %>% {.[[1]]}
char$statToInit = classData[whereStart+3] %>% ogbox::replaceElement(dictionary = c('0' = '',
'1'='Str',
'2' = 'Dex',
'3' = 'Con',
'4' = 'Int',
'5' = 'Wis',
'6' = 'Cha')) %$% newVector
weaponAttackMods = classData[whereStart] %>% strsplit('⊠|\u{22a0}') %>% {.[[1]]} %>% as.integer()
allAttack = weaponAttackMods[1]
allOneHandedAttack = weaponAttackMods[4]
allTwoHandedAttack = weaponAttackMods[7]
oneHandMeleeAttack = weaponAttackMods[5]
twoHandMeleeAttack = weaponAttackMods[8]
allMeleeAttack = weaponAttackMods[2]
oneHandRangedAttack = weaponAttackMods[6]
twoHandRangedAttack = weaponAttackMods[9]
allRangedAttack = weaponAttackMods[3]
char$weaponAttackMods = c('all' = allAttack,
'allOneHand' = allOneHandedAttack,
'allTwoHand' = allTwoHandedAttack,
'oneHandMelee' = oneHandMeleeAttack,
'twoHandMelee' = twoHandMeleeAttack,
'allMelee' = allMeleeAttack,
'oneHandRanged' = oneHandRangedAttack,
'twoHandRanged' = twoHandRangedAttack,
'allRanged' = allRangedAttack)
weaponDamageMods = classData[whereStart + 1] %>% strsplit('⊠|\u{22a0}') %>% {.[[1]]} %>% as.integer()
allDamage = weaponDamageMods[1]
allOneHandedDamage = weaponDamageMods[4]
allTwoHandedDamage = weaponDamageMods[7]
oneHandMeleeDamage = weaponDamageMods[5]
twoHandMeleeDamage = weaponDamageMods[8]
allMeleeDamage = weaponDamageMods[2]
oneHandRangedDamage = weaponDamageMods[6]
twoHandRangedDamage = weaponDamageMods[9]
allRangedDamage = weaponDamageMods[3]
char$weaponDamageMods = c('all' = allDamage,
'allOneHand' = allOneHandedDamage,
'allTwoHand' = allTwoHandedDamage,
'oneHandMelee' = oneHandMeleeDamage,
'twoHandMelee' = twoHandMeleeDamage,
'allMelee' = allMeleeDamage,
'oneHandRanged' = oneHandRangedDamage,
'twoHandRanged' = twoHandRangedDamage,
'allRanged' = allRangedDamage)
# class resources ---------------
resources = classData[3] %>% strsplit('⊠|\u{22a0}') %>% {.[[1]]} %>% sapply(function(x){
resData = x %>%strsplit('⊡|\u{22A1}') %>% {.[[1]]}
c('name' = resData[1],
'shortName' = resData[2],
'remainingUse' = resData[4] %>% as.integer(),
'maxUse' = resData[3] %>% as.integer(),
'dice' = resData[5] %>% as.integer(),
'ResourceDisplay' = {
out= 'unkown'
if(resData[5]>0){
out = (paste0(resData[3],'d',resData[5]))
} else if(resData[3]>0){
out = (resData[3])
} else{
out = ('')
}
out
},
'Reset' = {
out = 'unkown'
if(resData[10]==1){
out = 'static'
}else if(resData[9] == 303){
out = 'never'
}else{
out=
switch(resData[6] %>% as.integer,
"short rest",
'long rest')
}
if(is.null(out)){
out = 'unkown'
}
out
},
'RecoverPerShortRest' = resData[7],
'RecoverPerLongRest' = resData[8])
}) %>% t
# this is to prevent the character reader from crashing when the character has no
# resources. this is may not be the best solution as you wrote this when you
# were drunk. revisit later.
if(length(resources) == 0){
resources = data.frame(remainingUse = character(0),
maxUse = integer(0),
dice= integer(0),
RecoverPerShortRest = integer(0),
RecoverPerLongRest = integer(0))
} else{
resources %<>%as.data.frame(stringsAsFactors = FALSE) %>% dplyr::mutate(remainingUse = as.integer(remainingUse),
maxUse = as.integer(maxUse),
dice = as.integer(dice),
RecoverPerShortRest = as.integer(RecoverPerShortRest),
RecoverPerLongRest = as.integer(RecoverPerLongRest))
}
rownames(resources) = NULL
char$resources = resources
# feats -------
char$feats = classData[4] %>% strsplit('⊠|\u{22a0}') %>% {.[[1]]}
# classChoices
char$classChoices = classData[5] %>% strsplit('⊠|\u{22a0}') %>% {.[[1]]}
names(char$classChoices) = char$classChoices %>% sapply(function(x){
x %>% strsplit('⊡|\u{22A1}') %>% {.[[1]][1]}
})
char$classChoices = char$classChoices %>% lapply(function(x){
x %>% strsplit('⊡|\u{22A1}') %>% {.[[1]][-1]}
})
# character notes --------------
notes = char$noteList %>% strsplit('⊠|\u{22a0}') %>% {.[[1]]}
char$Features = notes[1]
char$ArmorProficiencies = notes[2]
char$WeaponProficiencies = notes[3]
char$ToolProficiencies =notes[4]
char$LanguagesKnown = notes[5]
char$Equipment = notes[6]
char$notes = notes[7]
char$Class = notes[8]
char$Race = notes[9]
char$Background = notes[10]
char$Alignment= notes[11]
char$personality = list()
char$personality$traits = notes[12]
char$personality$ideals = notes[13]
char$personality$bonds = notes[14]
char$personality$flaws = notes[15]
char$Name = notes[16]
char$ClassField = notes[17]
char$currency = list(CP = notes[18],
SP = notes[19],
EP = notes[20],
GP = notes[21],
PP = notes[22])
hitDice= char$hitDiceList %>% strsplit('⊠|\u{22a0}') %>% {.[[1]][-1]}
diceCount = length(hitDice)/3
char$hitDice = 1:diceCount %>% sapply(function(i){
paste0(hitDice[(i-1)*3+1],'d',hitDice[(i-1)*3+2])
})
char$hitDiceRemain = 1:diceCount %>% sapply(function(i){
paste0(hitDice[(i-1)*3+3],'d',hitDice[(i-1)*3+2])
})
# spells --------
spellData = char$spellList %>% strsplit('⊠|\u{22a0}') %>% {.[[1]]}
slots= spellData[2] %>% strsplit('⊡|\u{22A1}') %>% {.[[1]]} %>% as.integer()
names(slots) = c('Cantrip',1:9)
char$spellSlots = slots
spells = spellData[9] %>%strsplit('⊡|\u{22A1}') %>% {.[[1]]} %>% sapply(function(x){
spell = x %>% strsplit('⊟|(\u{229f})') %>% {.[[1]]}
level = spell[1] %>% as.integer()
name = spell[2]
prepared = spell[8] %>% logicConvert()
return(c('level' = level,
'name' = name,
'prepared' = prepared))
}) %>% t
rownames(spells)= NULL
spells %<>% as.data.frame(stringsAsFactors=FALSE) %>% dplyr::mutate(level = level %>%as.character%>% as.integer, prepared = prepared %>% as.logical)
if(all(is.na(spells[1,]))){
spells = NULL
}
char$spells = spells
if(clean){
useless_fields = c('version',
'raceCode',
'subraceCode',
'backgroundCode',
'pagePosition0',
'pagePosition1',
'pagePosition2',
'pagePosition3',
'pagePosition4',
'featCode',
'classData',
'multiclassFeatures',
'weaponList',
'skillInfo',
'spellList',
'noteList',
'hitDiceList',
'classResource')
char = char[!names(char) %in% useless_fields]
}
return(char)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.