World: r3wp

REBOL []

parse-async: func [
        file rules
        /local port buffer offset getf seek meta & && result
][
        port: open/seek/binary  file
        buffer: clear #{}
        offset: 1
        getf: func [len][
                offset: offset - length? buffer
                clear buffer 
                append buffer copy/part at port offset len 
                offset: offset + len 
        ]
        seek: [(offset: offset + 1)]
        ..: func [blk] [change/part & compose/deep blk && ]
        parse rules meta: [
                some [

                        &: binary! &&: (.. [buffer: (to-paren reduce ['getf length? &/1]) 
                        (&/1)]) :& 3 skip 
                        | &: 'skip &&: (.. [seek]) :& skip
                        | &: 'get word! integer! &&:

                                (.. [buffer: (to-paren compose/deep [getf (&/3) set [(&/2)] to integer! 
                                as-binary cp buffer]) to end]) :& 4 skip

                        | &: string! &&: (.. [(as-binary &/1)]) :& 
                        | 'end 'skip 
                        | into meta
                        | skip
                ]
        ]
        result: parse/all buffer rules
        close port
        result
 ]
 
if parse-async %15.jpg [
        #{FFD8}   ; jpeg Header
        [
                 #{FFE0}                        ;JFIF header

                        get len 2               ;get data length  for the current header 
                        (2 bytes)

                         "JFIF"                 ;yeah it's a JFIF (confirmation)

                        (len: len - 6) len skip ;skip data (len) times
                        some [

                                 #{FFC0}        ;good ! i found the length properties

                                        2 skip  ; skip length of this header

                                        skip    ; filler ??? always = #{08}
                                        get height 2
                                        get width 2
                                        break   ; finished

                                | #{FF} skip    ;skip this header
                                        get len 2 
                                        (len: len - 2) len skip
                                | 

                                        [end skip]     ;error format
                        ]

                | #{FFE1}                       ;EXIF header

                        get len 2               ;get length of a header
                                                ;... to do
                        [end skip]
        ]
        to end
][
   ?? height
   ?? width
]        
halt

perhaps it's not clear, but this parser do not load all the file 
in memory but  only the needed part to retrieve the width and the 
height.

you can probe the contain of the 'buffer'  variable to have a proof

the concept of async parsing could be extended at any type of serie

Cool Steeve!

yeah i'm a cool guy

>> c: make object! [ a: "test" ]
>> save/all c make binary! 1024

** Script Error: save expected where argument of type: file url binary
** Near: save/all c make binary! 1024

oops

wrong way round

why not mold/all ?

good point

get-JPG-size: func[
	"Returns size on JPG image or none on invalid files"
	jpgfile [file! url!] "File to examine"
	/local stream byte1 byte2][
	stream: open/read/binary/direct jpgfile
	;seek to jpg start
	until [
		all [
			255 = first stream
			216 = first stream
		]
	]
	while[any[byte1: first stream]] [
		if 255 = byte1 [
			either 192 = byte2: first stream [
				copy/part stream 3
				height: to-integer copy/part stream 2
				width:  to-integer copy/part stream 2
				close stream
				return as-pair width height
			][
				copy/part stream ((to integer! copy/part stream 2) - 2)
			]
		]
	]
	close stream
	none
]

89 files with total size 158728227B done in 0:00:00.094

(instead of 'byte1 and 'byte2 there can be used just 'byte)

but it's not working on non jpeg files:-/ I should first better test 
it

get-JPG-size: func[
	"Returns size of JPG image or none on invalid files"
	jpgfile [file! url!] "File to examine"
	/local stream byte
][
	stream: open/read/binary/direct jpgfile
	;seek to jpg image start
	until [
		any [
			all [
				255 = first stream
				216 = byte: first stream
			]
			none? byte
		]
	]

 unless byte [close stream return none] ;no Start Of Image marker 
 found

	while[any[byte: first stream]] [
		if 255 = byte [
			either 192 = byte: first stream [
				copy/part stream 3
				height: to-integer copy/part stream 2
				width:  to-integer copy/part stream 2
				close stream
				return as-pair width height
			][
				copy/part stream ((to integer! copy/part stream 2) - 2)
			]
		]
	]
	close stream
	none
]

which is not correct as well. As it would throw an error if the martker 
192 is not found... I should rather use open/seek instead of /direct

here is correct version using the /seek method... sorry for so many 
posts:

get-JPG-size: func[
	"Returns size of JPG image or none on invalid files"
	jpgfile [file! url!] "File to examine"
	/local stream bytes height width
][
	stream: open/read/binary/seek jpgfile
	;seek to jpg image start
	while [#{FFD8} <> copy/part stream 2][
		if tail? stream: skip stream 2 [
			;no Start Of Image marker found
			close stream return none
		]
	]
	stream: skip stream 2
	while[not tail? stream][
		bytes:  copy/part stream 2
		stream: skip stream 2
		if 255 = bytes/1 [
			either 192 = bytes/2 [
				stream: skip stream 3
				height: to-integer copy/part stream 2
				width:  to-integer copy/part skip stream 2 2
				close stream
				return as-pair width height
			][
				stream: skip stream ((to integer! copy/part stream 2) - 2)
			]
		]
	]
	close stream
	none
]

A few extra posts is no problem when you end up with a nice, useful, 
working func. :-)

that is fast! thank you Oldes 8)

How do you get Rebol from popping up 'public' folders everywhere 
(windows)?

I don't understand this question... byt maybe try to look at 'secure

terry, I posted a bug report on this once. I don't think you can 
stop it.

I'm not sure wether it works as advertised (esp. in all versions), 
but theoretically there's an option:
--noinstall (-i) Do not install (Link, View)
(to know about options: use 'usage)

On thnking about it, I think if you use --noinstall, that's when 
'public folders are created everywhere. If you install it, you can 
define the place where the public folder is to be created, and that's 
used then.

At least that's how it worked the last time for me.

I thought the newer releases stopped doing that. There were a number 
of builds that did it though. Very annoying.

it has never done it for me, but it has always done it for others. 
so, it's not clear yet how/when that happens. afaik the code does 
a make-dir view-root/public so in theory it should always be in view-root 
not in the cd.

I thought it only did it when you invoked the viewtop

... or any of the *-thru funcs

Yes very annoying, I use the following func to clean things up:

delete-public: func [dir [file!]] [
	foreach file read dir [
		if #"/" = last file [
			attempt [delete-public dir/:file]
		]
		if find [%public/ %Thumbs.db] file [
			attempt [delete dir/:file]
			print dir/:file
		]
	]
]

delete-public %/c/

Just thinking aloud (I would have to reboot into windows to test 
it, and I dont't waht to ;-) 
It it possible to set view-root in rebol.r or user.r ?

(You have to try, 'cause handling of these files differs between 
versions, too)

In the above func on a Mac you could replace %Thumbs.db with %.DS_Store 
;)

When it comes to decrypting, is it easier to hack an encrypted string 
if you know part of the string?

Ie:  If you knew that a stirng always started with   keys: [name 
"     could you decrypt it easier?

just thinking that if you encrypt an object, it probably starts the 
same for all.

I need to sort some French words but REBOL's SORT puts accented characters 
on the end (sorts just by ASCII). Has anybody got some enhanced SORT 
for French?

terry: it depends a lot on the crypt algorithm used and the length 
of the key. it surely helps to know any part of the plain text. however, 
just compression would reduce that a lot (since the result depends 
on the whole string); also good algorithms are usually smart enough 
to resist a simple attack like this.

Sorting: you may be able to adapt this hungarian code:

http://www.rebol.org/cgi-bin/cgiwrap/rebol/ml-display-thread.r?m=rmlMWWJ

thanks Sunanda

a: make object [
  b: make block! []
  c: b
]

same? a/b a/c
== true ; OK

d: make a []

same? d/b d/c
== false ; how do I get this to be TRUE?

apparently I need to do it in the spec block, though i had hoped 
this could be done inside the object to encapsulate that entirely. 
cleaner code.

if your just looking for evaluating the value then use equal? instead.

Henrik: this may not be what you want, but it works:
    d: make a [c: b]

(your problem is, that cloning does not use much "intelligence", 
in the case of d: make a [], the cloning code just copies both a/b 
and a/c and therefore it is obvious, that two copies aren't the same 
block

ladislav, yes, that's what I had to come up with.

paul, d/b and d/c must be the same block, so equal? is not enough.

Is there any script for LZW decompression?

Oldes. These might help? http://www.rebol.org/cgi-bin/cgiwrap/rebol/view-script.r?script=gunzip.r

http://www.rebol.org/cgi-bin/cgiwrap/rebol/view-script.r?script=rebzip.r