jbr.tcl/fits.tcl at main · jbroll/jbr.tcl · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
proc fitscard { name type value { comment {} } } {

  if { [catch {
      switch [lindex $type 0] {
       i {}
       s {  set value "'[format %[lindex $type 1]s $value]'" }
       r {	set value [format %[expr { [llength $type] == 1 ? ".5" : ".[lindex $type 1]" }]f $value]	}
       l {  set value [expr {$value ? "T" : "F"}] 		}
      }
  } reply] } {
	puts "fitscard : $name : $type : $value : $reply"
  }

  binary format {A8A2A32A3A35} $name "= " $value " / " $comment
}

proc fits { bitpix dims bins zero data cards { ncards 0 } } {
	set fits {}

	append fits [fitscard SIMPLE %s T]
	append fits [fitscard BITPIX %d $bitpix]
	append fits [fitscard NAXIS  %d [llength $dims]]

	set d 1
	foreach dim $dims {
	    append fits [fitscard NAXIS$d %d [lindex $dims $d-1]]
	    incr d
	}
	append fits [fitscard BZERO  %f [expr {$bitpix == 16 ? 32768 : 0}]]
	append fits [fitscard BSCALE %f     1]

	set x    [lindex $zero 0]
	set y    [lindex $zero 1]
	set xbin [lindex $bins 0]
	set ybin [lindex $bins 1]


	set m11 [expr {1.0/[lindex $bins 0]}]
	set m12 0
	set m21 0
	set m22 [expr {1.0/[lindex $bins 1]}]

        append fits [fitscard LTM1_1 %f $m11]
        append fits [fitscard LTM1_2 %f $m12]
        append fits [fitscard LTM2_1 %f $m21]
        append fits [fitscard LTM2_2 %f $m22]

	append fits [fitscard LTV1  %f [expr {1.0 - (($x) + ($xbin-1)/2.0) *$m11}]]
	append fits [fitscard LTV2  %f [expr {1.0 - (($y) + ($ybin-1)/2.0) *$m22}]]

	append fits [fitscard HEADTIME  %.3f [expr {[clock milliseconds]/1000.0}]]

	foreach { name type value comment } $cards {
	    if { [catch {
		if { [string index $value 0] eq ":" } {
		    set value [set $value]
		}
	    } reply] } {
		puts $reply
		set value -1
	    }
	    append fits [fitscard $name $type $value $comment]
	}


        set pcards [expr {max(0, ($ncards-1) - [string length $fits]/80)*80}]

	append fits [binary format A$pcards { }]
        append fits [binary format A80 END]

	set padd [expr {(2880-([string length $fits])%2880)%2880}]
	append fits [binary format A$padd { }]


	append fits $data

	set padd [expr {(2880-[string length $fits]%2880)%2880}]
	append fits [binary format A$padd "\000"]

	set fits
}

proc fits-padding { size } { binary format A[expr {(2880-$size%2880)%2880}] "\000" }