Display image

[Dmi]

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

[cormullion]

To display a scaled image - see http://alh.net/newlisp/wiki/index.cgi?page=Slideshow">//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...

[Dmi]

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.

[cormullion]

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

[Cyril]

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 Expand

;; 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! ;-)

[Dmi]

Hi, Cyril!



Thanks - the code works great!



There is Alex around here. Possible, he'll join us?



I have http://en.feautec.pp.ru/">//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">//http://en.feautec.pp.ru/store/fun-of-newlisp.html for adveritising newLISP in Russia :-)



I think that russian resource is a good idea.

[cormullion]

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

Code Select Expand

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