Hi!
(First of all, I repeat that I'm a newbie here. I say this not just to
excuse my poor lisp ;), but to ask you to tell me if I should not post
code of more than n lines in this newsgroup, where "n" would be a
number you consider appropiate. Thank you!)
I am trying to read FITS images. FITS is "the" file format in the
astronomical community (you can see more details here:
http://heasarc.gsfc.nasa.gov/docs/heasarc/fits_overview.html). Simply
put, it consists in two clearly separated parts
1) a header, in ascii "human-readable" format, with key/value pairs,
one per line
2) the data.
I post my code below; all I can say, is that:
a) it works
b) it's *slow* (which in a sense contradicts (a) ;))
c) I don't like it, specially the function "leer-cabecera". I don't
know why (if I knew, I would already changed it... ;)), but it
certainly doesn't look good.
d) But above all...: I did my first macro!!!! A little one... but, hey!
I did it! ;)
You can try it, if you like, with this image:
http://www.cnba.uba.ar/~llopez/M6-TOTAL-final.fts
------------------------------------------------------------------
;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; X11 routines
(require :clx)
;;(unuse-package :XLIB)
(defparameter *dpy* nil)
(defparameter *win* nil)
(defparameter *gctxt* nil)
(defparameter *window-width* 500)
(defparameter *window-height* 500)
(defun get-environment-variable (string)
#-clisp (cdr (assoc string ext:*environment-list* :test #'string=))
#+clisp (ext:getenv string))
(defun parse-display-variable (s)
(let* ((colon (position #\: s))
(dot (position #\. s :start colon))
(host-name (if (zerop colon) "localhost" (subseq s 0 colon)))
(display-number (parse-integer s :start (1+ colon) :end dot)))
(values host-name display-number)))
(defun open-window ()
(multiple-value-bind (host display)
(parse-display-variable (get-environment-variable "DISPLAY"))
(let* ((dpy (xlib:open-display host :display display))
(screen (xlib:display-default-screen dpy))
(black (xlib:screen-black-pixel screen))
(white (xlib:screen-white-pixel screen))
(win (xlib:create-window :parent (xlib:screen-root screen)
:background white
:x 0 :y 0 :width *window-width*
:height *window-height*))
(gcontext (xlib:create-gcontext :drawable win
:background white
:foreground black)))
(xlib:map-window win)
(xlib:display-force-output dpy)
(setf *dpy* dpy
*win* win
*gctxt* gcontext)
win)))
(defun rgb (r g b)
(xlib:make-color :red r :green g :blue b))
(defun set-color (color)
(setf (xlib:GCONTEXT-FOREGROUND *gctxt*) color))
(defun set-color-rgb (r g b)
(setf (xlib:GCONTEXT-FOREGROUND *gctxt*)
(xlib:make-color :red r :green g :blue b)))
(defun draw-point (x y)
(xlib:draw-point *win* *gctxt* x y)
(xlib:display-force-output *dpy*))
(defun clear-window ()
(xlib:clear-area *win* :width *window-width* :height *window-height*)
(xlib:display-force-output *dpy*))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Code for reading and displaying FITS images
(defclass imagen-fits ()
((cabecera :initarg :cabecera
:accessor cabecera)
(data :initarg :data
:accessor data)))
(defun iniciar-imagen-fits (cabecera)
(let ((naxis (gethash "EJES" cabecera))
(bzero (gethash "BZERO" cabecera)))
(make-instance 'imagen-fits
:cabecera cabecera
:data (make-array (coerce naxis 'list)
:initial-element bzero))))
(defmacro trim-spaces-subseq (cadena inicio fin)
`(string-trim " " (subseq ,cadena ,inicio ,fin)))
(defun leer-cabecera (archivo)
"Reads the header of the FITS file.
TODO: -check if EXTEND or END keywords are present. If not -> bad,
bad file...
-If EXTEND -> read another 36 lines."
(let ((línea-vector (make-array 80 :element-type 'character))
(tabla (make-hash-table :test 'equal))
ejes
(fin nil)
(extend nil))
(dotimes (i 36)
(read-sequence línea-vector archivo)
(let* ((línea (format nil "~{~a~}" (coerce línea-vector
'list)))
(llave (trim-spaces-subseq línea 0 8))
(valor (trim-spaces-subseq línea 9 30)))
(unless (or (find #\' valor) (zerop (length valor)))
(setf valor (read-from-string valor)))
(cond
((zerop (length llave))) ; Nothing in the line...
((string= llave "END")
(setf fin t)) ; This is good!
((string= llave "EXTEND")
(setf extend t)) ; Then I should read 36 more lines...
((string= llave "NAXIS")
(setf ejes (make-array valor :initial-element 0))
(setf (gethash "EJES" tabla) ejes)
(setf (gethash llave tabla) valor))
((string= llave "NAXIS" :end1 5)
(let ((eje (read-from-string (subseq llave 5))))
(setf (aref ejes (1- eje)) valor)))
(t
(setf (gethash llave tabla) valor)))))
tabla))
(defmethod leer-data-en-imagen ((imagen imagen-fits) archivo)
"Reads the pixels data.
TODO: be able to read n-dimensional data."
(let* ((data (data imagen))
(ancho (array-dimension data 0))
(alto (array-dimension data 1))
(bscale (gethash "BSCALE" (cabecera imagen)))
(bitpix (gethash "BITPIX" (cabecera imagen))))
(dotimes (j alto)
(dotimes (i ancho)
(let ((aux 0))
(loop for k downfrom (- bitpix 8) to 0 by 8 do
(setf (ldb (byte 8 k) aux) (read-byte archivo)))
(incf (aref data i j) (* aux bscale)))))))
(defun set-intensidad (valor)
(let ((color 0))
(loop for k to 16 by 8 do
(setf (ldb (byte 8 k) color) valor))
(set-color color)))
(defmethod dibujar ((imagen imagen-fits))
(open-window)
(let* ((data (data imagen))
(ancho (array-dimension data 0))
(alto (array-dimension data 1))
(bits (expt 2 (gethash "BITPIX" (cabecera imagen)))))
(dotimes (j alto)
(dotimes (i ancho)
(let ((intensidad-por-color (round (* (aref data i j) 256 (/ bits)))))
(set-intensidad intensidad-por-color)
(draw-point i j))))))
(defun probar (nombre)
(with-open-file (archivo nombre :element-type '(unsigned-byte 8))
(let ((imagen (iniciar-imagen-fits (leer-cabecera archivo))))
(leer-data-en-imagen imagen archivo)
(dibujar imagen))))
---------------------------------------------------------------
LuisGLopez wrote
> b) it's *slow* (which in a sense contradicts (a) ;))
Yup, slow. That has been my experience of writing images pixel by pixel
with code such as
(defun draw-point (x y)
(xlib:draw-point *win* *gctxt* x y)
(xlib:display-force-output *dpy*))
(I guess that forcing the output after every pixel ruins the
buffering and costs you a factor of mumble (10?) on
performance, but I guess it will still be too slow.)
I couldn't get the CLX image functions to work. :xy-format
was too slow and :z-format was broken. So I resorted to
put-raw-image.
CL-USER> (defparameter image (make-array 2048 :element-type '(unsigned-byte 8)))
IMAGE
CL-USER> (map-into image (lambda() (random 256)))
#(252 118 126 225 157 84 134 175 24 25 ...)
CL-USER> (xlib:put-raw-image *window* *grackon* image :depth 15
:x 0 :y 0 :width 32 :height 32
:format :z-pixmap)
CL-USER> (xlib:display-force-output *display*)
and a block of coloured speckles appears.
This code depends on magic numbers specific to the display
hardware. If you want to write portable code like this you
have to understand the meaning of unit and pad in
CL-USER> (xlib:display-bitmap-format *display*)
#<XLIB:BITMAP-FORMAT unit 32 pad 32 LSB first>
and other things beside. For example, you will notice that I
have 32 x 32 = 1024 pixels. So why is my array 2048?
Use cl:describe on the display object and learn
PIXMAP-FORMATS: (#<XLIB:PIXMAP-FORMAT depth 1 bits-per-pixel 1 scanline-pad 32>
#<XLIB:PIXMAP-FORMAT depth 4 bits-per-pixel 8 scanline-pad 32>
#<XLIB:PIXMAP-FORMAT depth 8 bits-per-pixel 8 scanline-pad 32>
#<XLIB:PIXMAP-FORMAT
depth 15 bits-per-pixel 16 scanline-pad 32>
#<XLIB:PIXMAP-FORMAT
depth 16 bits-per-pixel 16 scanline-pad 32>
So my depth 15 window expects 16 bits not 15 and that is two
eight bit bytes. Also it expects data padded to 32bit
dollops. My image is an even number of pixels wide so I'm
OK. A real gotcha lurking in the display structure is
MAX-REQUEST-LENGTH: 65535
The put-raw-image in the Xlib that comes with C is specified
to break up images for you to stay within the
max-request-length. CLX's put-raw-image doesn't, so you get
it working with little test images, then try to do something
useful, and bang! it breaks, and you find that there is more
work to do. I became disheartened and gave up on images at
that point (mostly because of poor health making everything
an uphill struggle).
That is a great pity because put-raw-image is very fast. I
wrote some animation code that used put-raw-image to write a
sequence of small images to the screen and was getting an
acceptable frame rate on a 166MHz Pentium. So still pictures
should snap onto the screen without visible delay. But it
assumes a 24 truecolor display, and I'm running on 16 bits
today (to get 1600x1200) so I cannot check the code before I
post. If you want to see it, ask, and I will check it and
add some comments.
Returning to the code you posted I'm puzzled by these lines:
From leer-cabecera
(let ((l=EDnea-vector (make-array 80 :element-type 'character))
(read-sequence l=EDnea-vector archivo)
(let* ((l=EDnea (format nil "~{~a~}" (coerce l=EDnea-vector 'list)))
and from probar
(with-open-file (archivo nombre :element-type '(unsigned-byte 8))
I expected the read-sequence to fail because the source is a
stream of type (unsigned-byte 8) and the destination is of
element type character.
The entry for read-sequence in the Streams Dictionary in the
HyperSpec says:
Might signal an error of type type-error if an element
read from the stream is not a member of the element
type of the sequence.
which is what CMUCL does
#<Stream for file "test.dat"> is not a character input stream.
[Condition of type SIMPLE-TYPE-ERROR]
So I expected to see something like
CL-USER> (defparameter byte-buffer (make-array 5 :element-type '(unsigned-byte 8)))
BYTE-BUFFER
CL-USER> (with-open-file (s "test.dat"
:element-type '(unsigned-byte 8))
(read-sequence byte-buffer s))
3
CL-USER> byte-buffer
#(97 98 99 0 0)
CL-USER> (setf char-buffer (map 'string (function code-char) (subseq byte-buffer 0 3)))
"abc"
where we can use the built-in code-char on ASCII
implementations and will need a custom routine on computers
that use a different character encoding.
That is clunky, and clisp looks good here, permitting
read-sequence in this case. But what is
(format nil "~{~a~}" (coerce l=EDnea-vector 'list))
doing? Why not use copy-seq? Indeed, why bother at all? The
string is fed to subseq and subseq always allocates a new
sequence for a result; it never shares storage with an old
sequence.
Alan Crowe
Edinburgh
Scotland
Hi Alan!!!
First of all, thank you *so* much for your reply, and I'm sorry to hear
about your bad health; I deeply hope you get better!!!
I'll try to figure out how to do the put-draw-image stuff; All I did up
to now with graphics was (ab)using of the code I borrowed from the
c.l.l, and have a lot to learn still.
Alan Crowe ha escrito:
> I expected the read-sequence to fail because the source is a
> stream of type (unsigned-byte 8) and the destination is of
> element type character.
Well, it was a problem for me; I knew that the header was ascii, and
the data in binary format. So... I just tried :) And I don't know why,
but it did! I forgot to mention I'm using CMUCL.
Anyway, now that I'm certain that that isn't the right thing, I'll
change it according to your advices.
> But what is
>
> (format nil "~{~a~}" (coerce l=EDnea-vector 'list))
>
I think it was all my fault; I misundestood a post I read here
(http://groups.google.com.ar/group/comp.lang.lisp/browse_thread/thread/a259de6e2fa25f70?hl=es)
I'll try to explain myself. Maybe I should say that instead of
"coding", I was "exploring". When I manage to get the sequence read, I
checked it and saw that it looked like a vector of characters, but I
wanted a string, so I remembered having read something about converting
vectors to strings, and just copied it. Yes, I see now that it was very
naive...
Thank you!!!
Luis.
"LuisGLopez" <············@gmail.com> writes:
> Hi!
>
> (First of all, I repeat that I'm a newbie here. I say this not just to
> excuse my poor lisp ;), but to ask you to tell me if I should not post
> code of more than n lines in this newsgroup, where "n" would be a
> number you consider appropiate. Thank you!)
>
> I am trying to read FITS images. FITS is "the" file format in the
> astronomical community (you can see more details here:
> http://heasarc.gsfc.nasa.gov/docs/heasarc/fits_overview.html). Simply
> put, it consists in two clearly separated parts
> 1) a header, in ascii "human-readable" format, with key/value pairs,
> one per line
> 2) the data.
>
> I post my code below; all I can say, is that:
> a) it works
> b) it's *slow* (which in a sense contradicts (a) ;))
> c) I don't like it, specially the function "leer-cabecera". I don't
> know why (if I knew, I would already changed it... ;)), but it
> certainly doesn't look good.
> d) But above all...: I did my first macro!!!! A little one... but, hey!
> I did it! ;)
>
> You can try it, if you like, with this image:
> http://www.cnba.uba.ar/~llopez/M6-TOTAL-final.fts
A mixed ascii and binary file.
[99]> (probar "M6-TOTAL-final.fts")
*** - READ-CHAR on
#<INPUT BUFFERED FILE-STREAM (UNSIGNED-BYTE 8) #P"M6-TOTAL-final.fts">
is illegal
The following restarts are available:
ABORT :R1 ABORT
On most CL implementations, you cannot use character I/O on binary files.
In clisp you can easily go between with the functions:
EXT:CONVERT-STRING-TO-BYTES and EXT:CONVERT-STRING-FROM-BYTES
The problems comes frorm l�nea-vector being a string that you
READ-SEQUENCE from a '(UNSIGNED-BYTE 8) stream. You must match the
element types!
(let ((l�nea-vector (make-array 80 :element-type '(unsigned-byte 8)))
...)
Then:
> (format nil "~{~a~}" (coerce l�nea-vector 'list))
won't work anymore.
[97]> (setf l�nea-vector (ext:convert-string-to-bytes "Luis!" charset:ascii))
#(76 117 105 115 33)
[98]> (format nil "~{~a~}" (coerce l�nea-vector 'list))
"7611710511533"
Try instead:
#+clisp (ext:convert-string-from-bytes l�nea-vector charset:ascii)
#-clisp (map 'string (function code-char) l�nea-vector)
There is no justification for a macro here:
(defmacro trim-spaces-subseq (cadena inicio fin)
`(string-trim " " (subseq ,cadena ,inicio ,fin)))
it is called in slow I/O code so you don't need the speedup guarantee
of a macro vs. an inline function.
(declaim (inline trim-spaces-subseq))
(defun trim-spaces-subseq (cadena inicio fin)
(string-trim " " (subseq cadena inicio fin)))
(STRING= LLAVE "NAXIS" :END1 5) gives an error when (< (length LLAVE) 5)
use:
(STRING= LLAVE "NAXIS" :END1 (min (length llave) 5))
or:
(and (<= 5 (length LLAVE)) (STRING= LLAVE "NAXIS" :END1 5))
or write of fetch a prefix-p function:
(com.informatimago.common-lisp.string:prefix-p llave "NAXIS")
It's too slow to display-force-output for each point! Do it only once
at the end of the loops.
(defmethod dibujar ((imagen imagen-fits))
(open-window)
(let* ((data (data imagen))
(ancho (array-dimension data 0))
(alto (array-dimension data 1))
(bits (expt 2 (gethash "BITPIX" (cabecera imagen)))))
(dotimes (j alto)
(dotimes (i ancho)
(let ((intensidad-por-color (round (* (aref data i j) 256 (/ bits)))))
(set-intensidad intensidad-por-color)
(xlib:draw-point *win* *gctxt* i j))))
(xlib:display-force-output *dpy*)))
To make it faster, you could store the pixels into a X pixmap, then it
can be displayed in whole.
See XLIB:CREATE-PIXMAP, XCreatePixmap(3x), etc
(it's normal X programming).
--
__Pascal Bourguignon__ http://www.informatimago.com/
This is a signature virus. Add me to your signature and help me to live
Once again, thank you Pascal!!! You are *so* great...!
Pascal Bourguignon ha escrito:
> The problems comes frorm línea-vector being a string that you
> READ-SEQUENCE from a '(UNSIGNED-BYTE 8) stream. You must match the
> element types!
>
> (let ((línea-vector (make-array 80 :element-type '(unsigned-byte 8)))
> ...)
As I said before, in CMUCL it works; although, I will change it, of
course.
>
> Try instead:
>
> #+clisp (ext:convert-string-from-bytes línea-vector charset:ascii)
> #-clisp (map 'string (function code-char) línea-vector)
I'll do it :-)
> There is no justification for a macro here:
>
> (defmacro trim-spaces-subseq (cadena inicio fin)
> `(string-trim " " (subseq ,cadena ,inicio ,fin)))
Oh, please! That surely I *won't* change! I'll never erase my *very*
*first* macro! And to think that I was waiting a loud applause from all
c.l.l... :)
Being serious: do you think that it would make my program to run worse?
I confess that I still don't get macros fully...
>
> (STRING= LLAVE "NAXIS" :END1 5) gives an error when (< (length LLAVE) 5)
> use:
> (STRING= LLAVE "NAXIS" :END1 (min (length llave) 5))
> or:
> (and (<= 5 (length LLAVE)) (STRING= LLAVE "NAXIS" :END1 5))
Ouch! That was *obvious*. I'll change that.
> It's too slow to display-force-output for each point! Do it only once
> at the end of the loops.
> To make it faster, you could store the pixels into a X pixmap, then it
> can be displayed in whole.
> See XLIB:CREATE-PIXMAP, XCreatePixmap(3x), etc
> (it's normal X programming).
As I told Alan, I'll try :-)
Thank you!!!!!
"LuisGLopez" <············@gmail.com> writes:
>> There is no justification for a macro here:
>>
>> (defmacro trim-spaces-subseq (cadena inicio fin)
>> `(string-trim " " (subseq ,cadena ,inicio ,fin)))
>
> Oh, please! That surely I *won't* change! I'll never erase my *very*
> *first* macro! And to think that I was waiting a loud applause from all
> c.l.l... :)
> Being serious: do you think that it would make my program to run worse?
> I confess that I still don't get macros fully...
Well, there's a big difference between macros and functions: you
cannot (easily) call macros at run time. This shows when you try to
apply a macro:
With a function:
[16]> (let ((strings '( " Luis "" G "" Lopez ")))
(mapcar (function string-trim)
(make-list (length strings) :initial-element " ")
strings))
("Luis" "G" "Lopez")
With a macro:
[17]> (defmacro trim-spaces-subseq (cadena inicio fin)
`(string-trim " " (subseq ,cadena ,inicio ,fin)))
TRIM-SPACES-SUBSEQ
[18]> (let ((strings '( " Luis "" G "" Lopez ")))
(mapcar 'trim-spaces-subseq
strings
(make-list (length strings) :initial-element 3)
(make-list (length strings) :initial-element nil)))
*** - FUNCALL: TRIM-SPACES-SUBSEQ is a macro, not a function
The following restarts are available:
ABORT :R1 ABORT
With a function:
[20]> (defun trim-spaces-subseq (cadena inicio fin)
(string-trim " " (subseq cadena inicio fin)))
TRIM-SPACES-SUBSEQ
[21]> (let ((strings '( " Luis "" G "" Lopez ")))
(mapcar (function trim-spaces-subseq)
strings
(make-list (length strings) :initial-element 3)
(make-list (length strings) :initial-element nil)))
("is" "" "Lopez")
[22]>
--
__Pascal Bourguignon__ http://www.informatimago.com/
Litter box not here.
You must have moved it again.
I'll poop in the sink.
On 9229 day of my life ············@gmail.com wrote:
> d) But above all...: I did my first macro!!!! A little one... but, hey!
> I did it! ;)
>
> ------------------------------------------------------------------
> (defmacro trim-spaces-subseq (cadena inicio fin)
> `(string-trim " " (subseq ,cadena ,inicio ,fin)))
I'm sorry to disappoint you, but you'd better use inline function
instead of that macro:
(declare (inline trim-spaces-subseq))
(defun trim-spaces-subseq (cadena inico fin)
(string-trim " " (subseq cadena inico fin))
--
Ivan Boldyrev
Violets are red, Roses are blue. //
I'm schizophrenic, And so am I.
Hi!
I'm trying to implement the put-raw-image thing, but even if I try the
example from Alan, I can only see a white window:
(defun alan ()
(open-window)
(let ((image (make-array 2048 :element-type '(unsigned-byte 8))))
(map-into image (lambda() (random 256)))
(xlib:put-raw-image *win* *gctxt* image :depth 15
:x 0 :y 0 :width 32 :height 32
:format :z-pixmap)
(print (xlib:display-bitmap-format *dpy*))
(describe *dpy*)
(xlib:display-force-output *dpy*)))
No errors, but no colorful pixels :-/ I even get the same print-out
that Alan posted above.
"LuisGLopez" <············@gmail.com> writes:
> Hi!
>
> I'm trying to implement the put-raw-image thing, but even if I try the
> example from Alan, I can only see a white window:
>
> (defun alan ()
> (open-window)
> (let ((image (make-array 2048 :element-type '(unsigned-byte 8))))
> (map-into image (lambda() (random 256)))
> (xlib:put-raw-image *win* *gctxt* image :depth 15
> :x 0 :y 0 :width 32 :height 32
> :format :z-pixmap)
> (print (xlib:display-bitmap-format *dpy*))
> (describe *dpy*)
> (xlib:display-force-output *dpy*)))
>
> No errors, but no colorful pixels :-/ I even get the same print-out
> that Alan posted above.
Yep, in clisp mit clx, there's no put-raw-image :-(
and unfortunately, XLIB:PUT-IMAGE doesn't seem to work either :-((
--
"I have challenged the entire quality assurance team to a Bat-Leth
contest. They will not concern us again."
LuisGLopez:
> No errors, but no colorful pixels :-/ I even get the same print-out
> that Alan posted above.
That is strange. When I try programming CLX I get lots and
lots of errors :-)
Asynchronous LENGTH-ERROR in request 324 (last request was 325) Code 72.0 [PutImage]
Asynchronous MATCH-ERROR in request 326 (last request was 327) Code 72.0 [PutImage]
Try definitely wrong width or depth to make sure that you
error messages are appearing. If you are using SLIME you
could check the *inferior-lisp* window, or just use emacs's
inferior-lisp-mode until you are sure where the error
messages are going.
I've been checking the error reporting.
If I use CMUCL 18d with emacs's inferior-lisp-mode as the
front end, I get my XLIB error messages.
If I use CMUCL 19a, whether with SLIME or
inferior-lisp-mode, I don't get XLIB error messages.
Where have they gone?
It cost me a lot of fiddling to get it to start working.
I'm still trying to work out the 'right way'
I've been opening displays on two machines (inder and
cawtech) and comparing everything I can find
(describe (xlib:colormap-visual-info
(xlib:screen-default-colormap (get 'screen 'inder))))
tells red-mask 167116800 ie 11111111000000000000000
On inder, at depth 24, it is 32 bits-per-pixel,
while on cawtech, at the same depth, it is 24
bits-per-pixel.
One technique I used to get started was to use
xlib:put-raw-image to put a single pixel and then use xmag
to look at the window to see if it appeared. With height=1
and width=1 there is less to go wrong.
I'm surprised that your window has a depth of 15. I thought
modern machines would all be 24bit true colour. Are you sure
that 15 bits is not just one among many Pixmap options, and
that your window is actually 24bits.
(xlib:screen-root-depth screen) => 24 on cawtech today
while
(xlib:screen-root-depth screen) => 15 on inder.
Alan Crowe
Edinburgh
Scotland
Hi!
I checked the depth, and you are right: it's 24 here.
Anyway, I tried to look for error messages running CMUCL in the console
(I normally use slime+emacs), but I got nothing... :-/
Hi!
Browsing the CLX reference manual, I came accross this:
'xlib:pointer-position'. So, the next step was *so* obvious... ;)
I don't dare to paste the full code here; you can check it here, if you
like to: http://www.cnba.uba.ar/~llopez/leer-fits.lisp
The new functions:
(defun draw-square (x y size)
(xlib:draw-rectangle *win* *gctxt* (round x) (round y) size size
'fill))
(defun dibujar-zoom (x y radio-zoom tamaño-pixel imagen)
(let* ((data (data imagen))
(ancho (array-dimension data 0))
(alto (array-dimension data 1))
(bits (expt 2 (gethash "BITPIX" (cabecera imagen)))))
(when (and (>= x 0) (>= y 0)
(< x ancho) (< y alto))
(loop for j from (- y radio-zoom) to (+ y radio-zoom) do
(loop for i from (- x radio-zoom) to (+ x radio-zoom) do
(set-intensidad (if (and (>= i 0) (>= j 0)
(< i ancho) (< j alto))
(round (* (aref data i j) 256 (/ bits)))
0))
(draw-square (+ (* (- i x (- radio-zoom)) tamaño-pixel) ancho)
(* (- j y (- radio-zoom)) tamaño-pixel)
tamaño-pixel)))
(xlib:display-force-output *dpy*))))
(defun probar (nombre)
(with-open-file (archivo nombre :element-type '(unsigned-byte 8))
(let* ((imagen (iniciar-imagen-fits (leer-cabecera archivo))))
(leer-data-en-imagen imagen archivo)
(dibujar imagen)
(dotimes (i 200000)
(multiple-value-bind (x y)
(xlib:pointer-position *win*)
(dibujar-zoom x y 10 10 imagen))))))
"LuisGLopez" <············@gmail.com> writes:
> Browsing the CLX reference manual, I came accross this:
> 'xlib:pointer-position'. So, the next step was *so* obvious... ;)
>
> I don't dare to paste the full code here; you can check it here, if you
> like to: http://www.cnba.uba.ar/~llopez/leer-fits.lisp
Nice. Try it with:
(defun set-intensidad (valor)
(let ((color 0))
(loop for k to 16 by 8 do
(setf (ldb (byte 8 k) color) (- 256 valor)))
(set-color color)))
--
__Pascal Bourguignon__ http://www.informatimago.com/
There is no worse tyranny than to force a man to pay for what he does not
want merely because you think it would be good for him. -- Robert Heinlein
WOW!!!!
Lovely false-color!!! A lot more contrast!!! But what I was expecting
was a 'negative' image... I still don't get why the colors...
(understand me; it's 9:35 am here... ;)).
Of course, I'm planning to be able to change intensity and contrast of
the image. It would be great to be able to change intensity moving the
mouse pointer up and down while holding a mouse button, and contrast
moving left to right and viceversa, again, with button hold.
"LuisGLopez" <············@gmail.com> writes:
> WOW!!!!
>
> Lovely false-color!!! A lot more contrast!!! But what I was expecting
> was a 'negative' image... I still don't get why the colors...
> (understand me; it's 9:35 am here... ;)).
Well, here it did make the image negative gray-levels.
> Of course, I'm planning to be able to change intensity and contrast of
> the image. It would be great to be able to change intensity moving the
> mouse pointer up and down while holding a mouse button, and contrast
> moving left to right and viceversa, again, with button hold.
--
"By filing this bug report you have challenged the honor of my
family. Prepare to die!"
Um... I don't understand what happened. When I copy-pasted your
function at work, I got a beautiful false-color scheme... now I try it
at home, and get the expected negative image (?). Same CMUCL+ slime
here and at work.
Well, I suppose that strange things happens... :) I'll check tomorrow
at work what did I do "wrong" ;)
"LuisGLopez" <············@gmail.com> writes:
> Um... I don't understand what happened. When I copy-pasted your
> function at work, I got a beautiful false-color scheme... now I try it
> at home, and get the expected negative image (?). Same CMUCL+ slime
> here and at work.
> Well, I suppose that strange things happens... :) I'll check tomorrow
> at work what did I do "wrong" ;)
Probably at work your X server isn't configured to use truecolor but
a color map.
--
__Pascal Bourguignon__ http://www.informatimago.com/