newlispfanclub.alh.net

Posted: **Wed Nov 21, 2007 11:10 pm**

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...

Posted: **Wed Nov 21, 2007 11:18 pm**

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...

Posted: **Wed Nov 21, 2007 11:41 pm**

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.

Posted: **Thu Nov 22, 2007 12:00 am**

Lutz suggested something too http://www.alh.net/newlisp/phpbb/viewtopic.php?t=1808. Too hard for me though. :-)

Posted: **Fri Nov 23, 2007 2:28 pm**

Dmi wrote:Under linux ImageMagick should give the image info, but currently I looking for a cross-platform, easy distributable solution.

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)

Code: Select all

;; This is an (almost) direct translation of C source found at:
;; 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! ;-)

Posted: **Sat Nov 24, 2007 11:09 am**

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.

Posted: **Wed Nov 28, 2007 3:12 pm**

Hey Cyril, that code works perfectly on MacOS X too - thanks!

Code: Select all

(cond
   ((and (ends-with _filename "jpg") (= ostype "OSX"))
       (map set '(_image-width _image-height) (jpeg-dimensions _filename)))

newlispfanclub.alh.net

Display image

Display image