What is the proper way to do that:
- display a jpeg image, scaled to fit to window, but with preserving of aspect ratio.
- resize image when window is resized.
?
...Possible there is a way to know original image size before drawing?
...Or there is an another way...
To display a scaled image - see //http://alh.net/newlisp/wiki/index.cgi?page=Slideshow for my attempt.
To know original size before drawing - not possible I think with newLISP-GS. I used a MacOS X utility. You may have to find a platform-specific command.
Resize window... Ah. I cheated and just read the canvas size each time...
Thanks much!
Very nice, btw :-)
I planning something similar.
Under linux ImageMagick should give the image info, but currently I looking for a cross-platform, easy distributable solution.
Lutz suggested something too //http://www.alh.net/newlisp/phpbb/viewtopic.php?t=1808. Too hard for me though. :-)
Quote from: "Dmi"
The following seems working for me. But beware: it reads a file byte by byte with 'read-char', so it may be slow, or it may be broken with unicode version of newlisp, or it may be broken on platforms with signed char. But again: it seems working for me ;-) (newLISP 9.2.5 (not 9.2.6!), Windows 98)
;; http://dev.w3.org/cvsweb/Amaya/libjpeg/rdjpgcom.c?rev=1.2
;; The following code assumes that read-char function returns
;; one unsigned byte (not signed byte, not unicode character)
(context 'jpeg-dimensions)
(define (return x) x)
(define (read_1_byte , c)
(setq c (read-char handle))
(unless c (throw "read_1_byte: EOF"))
(return c))
(define (read_2_bytes , c1 c2)
(setq c1 (read-char handle))
(unless c1 (throw "read_2_bytes: EOF"))
(setq c2 (read-char handle))
(unless c2 (throw "read_2_bytes: EOF"))
(return (+ (<< c1 8) c2)))
(define (sof? byte)
(and (= (& byte 0xF0) 0xC0) (not (member byte '(0xC4 0xC8 0xCC)))))
(define (first_marker)
(unless (= (read_2_bytes) 0xFFD8) (throw "first_marker: not a JPEG")))
(define (next_marker , c)
(setq c (read_1_byte))
(unless (= c 0xFF) (throw "next_marker: garbage"))
(while (= c 0xFF) (setq c (read_1_byte)))
(return c))
(define (skip_variable , len)
(setq len (read_2_bytes))
(unless (>= len 2) (throw "skip_variable: bad length"))
(dotimes (i (- len 2)) (read_1_byte)))
(define (process_sof marker , len precision height width components)
(setq len (read_2_bytes))
(setq precision (read_1_byte))
(setq height (read_2_bytes))
(setq width (read_2_bytes))
(setq components (read_1_byte))
(unless (= len (+ 8 (* components 3))) (throw "process_sof: bogus length"))
(return (list width height)))
(define (scan_jpeg_header , marker)
(catch
(begin
(first_marker)
(while (setq marker (next_marker))
(if (sof? marker)
(throw (process_sof marker))
(skip_variable)))
(throw "scan_jpeg_header: no frames"))))
(define (jpeg-dimensions:jpeg-dimensions file , handle result)
(setq handle (open file "read"))
(setq result (scan_jpeg_header))
(close handle)
(return result))
(context MAIN)
(println (jpeg-dimensions (main-args 2)))
(exit)
BTW, Dmi, are we the only two newLISP devotees from Russia? Can we form a Russian newLISP User Group? Even for Komsomol primary cell back in USSR we must have at least three members! ;-)
Hi, Cyril!
Thanks - the code works great!
There is Alex around here. Possible, he'll join us?
I have //http://en.feautec.pp.ru/ for my postings, but it is mostly english-oriented.
And I have //http://en.feautec.pp.ru/store/fun-of-newlisp.html for adveritising newLISP in Russia :-)
I think that russian resource is a good idea.
Hey Cyril, that code works perfectly on MacOS X too - thanks!
((and (ends-with _filename "jpg") (= ostype "OSX"))
(map set '(_image-width _image-height) (jpeg-dimensions _filename)))