fits-image-data-RGBA32-false   xtlang

(bind-func fits-image-data-RGBA32-false
  (lambda (f:fitsfile* transparency:i8)
    (let ((status:i32* (salloc))
    (err:i8* (salloc 40))
    (dims:i32* (salloc))
    (x:i64* (salloc))
    (y:i64* (salloc))
    (z:i64* (salloc))
    (datamax:double* (salloc))
    (datamin:double* (salloc))
    (nfound:i32* (salloc))
    (xx:i64* (salloc))
    (i:i64 0)
    (comment:i8* (salloc 256))
    (hdu:i32* (salloc)))
      (pset! status 0 0)
      (printf "-------------------\n")
      (ffgky f TINT "NAXIS" (bitcast dims i8*) comment status)
      (printf "%s:\t\t%d\n" comment (pref dims 0) (pref status 0))
      (ffgky f TLONG "NAXIS1" (bitcast x i8*) comment status)
      (printf "%s:\t\t%lld\n" comment (pref x 0) (pref status 0))
      (ffgky f TLONG "NAXIS2" (bitcast y i8*) comment status)
      (printf "%s:\t\t%lld\n" comment (pref y 0) (pref status 0))
      (if (> (pref dims 0) 2)
    (begin (ffgky f TLONG "NAXIS3" (bitcast z i8*) comment status)
     (printf "%s:\t\t%lld\n" comment (pref z 0) (pref status 0))))
      (ffgky f TDOUBLE "DATAMAX" (bitcast datamax i8*) comment status)
      (printf "%s:\t%f\n" comment (pref datamax 0) (pref status 0))
      (ffgky f TDOUBLE "DATAMIN" (bitcast datamin i8*) comment status)
      (printf "%s:\t%f\n" comment (pref datamin 0) (pref status 0))
      (printf "\n")
      (let ((naxis (pref dims 0))
      (nullval:float* (salloc))
      (anynull:i32* (salloc))
      (dmax (dtof (pref datamax 0)))
      (size (* (pref x 0) (pref y 0) (if (> naxis 2) (pref z 0) 1)))
      (data:float* (halloc (* 4 size)))
      (data2:i8* (halloc (* 4 size))))
  ;; grab data from file (converts internal format to TFLOAT)
  (printf "ok here\n")
  (ffgpv f TFLOAT 1 size (bitcast nullval i8*) (bitcast data i8*) anynull status)
  (printf "and here\n")
  (dotimes (i size)
    (let ((v (ftoi8 (* 255.0 (/ (pref data i) dmax))))
    (v2 (ftoi8 (* 255.0 (/ (* .2 (pref data i)) dmax)))))
      (cond ((< v 50)
       (pset! data2 (* i 4) v))
      ((< v 100)
       (pset! data2 (* i 4) v2)
       (pset! data2 (+ 1 (* i 4)) v))
      ((< v 200)
       (pset! data2 (+ 1 (* i 4)) v2)
       (pset! data2 (+ 2 (* i 4)) v))
      (else (pset! data2 (+ 2 (* i 4)) v)))
      (pset! data2 (+ 3 (* i 4)) transparency)))
  (ffgerr (pref status 0) err)
  (printf "read %lld points  error:%s\n" size err)
  (free data)
  data2))))