REBOL [ Title: "XPM parser" Date: 26-Mar-2002 Version: 0.1.0 File: %xpm.r Author: "oldes" Purpose: "Convert XPM image file to rebol image! datatype" Email: %oliva--david--seznam--cz library: [ level: 'intermediate platform: 'all type: 'tool domain: [GUI graphics file-handling] tested-under: none support: none license: none see-also: none ] ] xpm-to-img: func[ "Converts XPM image file to rebol image! datatype. Returns block with image and transparent color." xpm-f [file! url!] "XPM file" /local xpm size colors chars-on-color pallete none-col img i tmp row col-to-bin c b bin-incr ][ xpm-f: read xpm-f replace/all xpm-f "^^" "\" xpm: make block! 100 parse xpm-f [ thru "static char *" thru "= {" some [ thru {"} copy tmp to {"} 1 skip (append xpm tmp) ] to end ] xpm/1: load xpm/1 size: to-pair reduce [xpm/1/1 xpm/1/2] colors: xpm/1/3 chars-on-color: xpm/1/4 pallete: make hash! colors * 2 xpm: next xpm col-to-bin: func [hex [string!] ][ if all [hex/1 = #"#" 7 = length? hex][ head reverse load rejoin ["#{" next hex "}"] ] ] loop colors [ parse/all (first xpm) [ copy c chars-on-color skip thru "c " copy b to end ( repend pallete [c col-to-bin b] ) ] xpm: next xpm ] bin-incr: func[b][ load rejoin ["#{" skip to-hex (1 + to-integer b) 2 "}"] ] none-col: #{000000} while [found? find pallete none-col][none-col: bin-incr none-col] for i 2 (length? pallete) 2 [ if none? pallete/:i [poke pallete i none-col]] img: make binary! 3 * size/x * size/y while [ not tail? xpm][ row: xpm/1 while [not tail? row][ c: copy/part row chars-on-color if none? select pallete c [probe c] ;error! append img select pallete c row: skip row chars-on-color ] xpm: next xpm ] reduce [make image! reduce [size img] none-col] ]