############################################################# # TraumaVision v2018.0 # # Written by CN Stephan, 2018 # ############################################################# ## Instructions: ## Save your desired homonculus as a .png under the file name "TraumaHomonculus.png" in your working directory. ## Save the TraumaVision_logo.gif file to your html folder for R under programs. ## Run TraumaVision and select your working directory, enter the case number then start plotting the trauma by left clicking the mouse button on the homonculus image. ## Close the locator once all trauma for the first case are entered and repeat for the next case until or cases are complete. ## To plot the trauma, click the button "Plot All Cases" and your plot will be automatically saved out at 1200 dpi (publication quality). ## Click "exit" to close TraumaVision. ## Conduct any cropping of the trauma plot in other third party imaging software. ## Import libraries required.packages <- c("tcltk", "jpeg", "png") new.packages <- required.packages[!(required.packages %in% installed.packages()[,"Package"])] if(length(new.packages)) install.packages(new.packages) library(tcltk) library(jpeg) library(png) ## Display Logo Window R.base.dir <- system.file() setwd(paste(R.base.dir,"/../../doc/html",sep="")) image <- as.numeric(file.access(paste(R.base.dir,"/../../doc/html/TraumaVision_logo.gif",sep=""), mode=0)) if (image==-1) { tkmessageBox(title="TraumaVision", message="You are missing the TraumaVision logo. \n\nTo use TraumaVision you must save the TraumaVision logo to the following path: \n\nC:/Program Files/R/R-[version]/doc/html. \n\n See CRANIOFACIALidentification.com for more information.",icon="warning") q() } if (image==0) { tt <- tktoplevel() tkwm.title(tt, "TraumaVision") tkwm.geometry(tt,"600x280+150+50") image1<-tclVar() tcl("image","create","photo",image1,file="TraumaVision_logo.gif") imgAsLabel<-tklabel(tt,image=image1,bg="white") tkpack(imgAsLabel) tkconfigure(tt,cursor="watch") Sys.sleep (10) tkconfigure(tt,cursor="arrow") tkdestroy(tt) ## Terms of use tkmessageBox(title="TraumaVision", message="By using this program you agree to CRANIOFACIALidentification.com's 'Terms of Use'. \n\nNO WARRANTIES OR GUARANTEES OF ANY KIND are provided with TraumaVision. You use TraumaVision completely, and entirely, at your own risk. \n\nSee www.CRANIOFACIALidentification.com for further details. \n",icon="info",type="ok") ## Set working directory directory <- tclvalue(tkchooseDirectory(title="Select the WORKING DIRECTORY where you saved the trauma homonculus and where you want the new data files written to.")) setwd(directory) name <- "filenameNotSpecified" img <- readPNG("TraumaHomonculus.png") # Function to load image ld <- function() { plot(1:150, type='n') rasterImage(img, 1, 1, 144, 97, interpolate=FALSE) } # Function for recording points enter <- function () { ld() data <- locator(type='p',pch=21,col=rgb(0,0,0,alpha=0.6), bg = rgb(0,0,0,alpha=0.6)) data <- as.data.frame(data) write.csv(data,file = paste(name,".csv",sep="")) graphics.off() trauma() } # Function for Plotting All Cases plotALL <- function () { files <<- list.files(pattern="*.csv") allfiles <- lapply(files, function(i)read.csv(i, header=TRUE)[,2:3]) dev.new() jpeg(filename = "TRAUMAplot.jpg", width = 20, height = 17, units = "cm", res = 1200) par(mar=c(5,5,1,1)+0.1) ld() x <- unlist(as.vector(sapply(allfiles, function(x) x[[1]]))) y <- unlist(as.vector(sapply(allfiles, function(x) x[[2]]))) points(x, y, pch=21,col=rgb(0,0,0,alpha=0), bg = rgb(0,0,0,alpha=0.33), cex = 0.6) dev.off() graphics.off() } # Procedure trauma <- function () { dlg<-tktoplevel() tkwm.title(dlg,"Trauma Vision") tkwm.geometry(dlg,"320x100+30+30") A <- tclVar() entry.A <- tkentry(dlg,width="20",textvariable=A) tkgrid(tklabel(dlg,text="")) tkgrid(tklabel(dlg,text="Specify the case number:"),entry.A, columnspan=4, sticky="e") tkgrid(tklabel(dlg,text="")) OnOK <- function () { name <<- tclvalue(A) tkdestroy(dlg) enter() } plotALL <- function () { tkdestroy(dlg) files <<- list.files(pattern="*.csv") all_files <<- lapply(files, read.delim) ld() points(all_files) } OK.but<-tkbutton(dlg,text=" Enter Case ", command=OnOK) tkgrid(OK.but, row=4, column=1, sticky="e") button1<-tkbutton(dlg,text=" Exit ", command=function() {tkdestroy(dlg)}) tkgrid(button1, row=4, column=4, sticky="e") button2<-tkbutton(dlg,text=" Plot All Cases ", command=function () { files <<- list.files(pattern="*.csv") allfiles <- lapply(files, function(i)read.csv(i, header=TRUE)[,2:3]) dev.new() jpeg(filename = "TRAUMAplot.jpg", width = 20, height = 17, units = "cm", res = 1200) par(mar=c(5,5,1,1)+0.1) ld() x <- unlist(as.vector(sapply(allfiles, function(x) x[[1]]))) y <- unlist(as.vector(sapply(allfiles, function(x) x[[2]]))) points(x, y, pch=21,col=rgb(0,0,0,alpha=0), bg = rgb(0,0,0,alpha=0.33), cex = 0.6) dev.off() graphics.off() }) tkgrid(button2, row=4,column=3, sticky="e") } trauma() }