;toolset1b, more tools for operations on a single window, this is spillover
 ;from toolset1
 ;============================================================================
subr hairs_hack
 ;wait for a button down and up
 !kb=0
 while (!kb eq 0) {
 xquery
 }
 while (!kb eq 1) {
 xquery
 }
 endsubr
 ;=====================================================================
subr bit_tog_cb
 value = 0
 for i=1,16 do {
  pow = 16-i
  if xmtogglegetstate($bittoy_rbox(i)) eq 1 then value = value + 2^pow
 }
 value = rfix(value)
 xmtextfieldsetstring, $text1, sprintf('%d', value)
 xmtextfieldsetstring, $text2, sprintf('%#x', value)
 endsubr
 ;=====================================================================
subr setbits, z
 ;assumes z is a 16 bit unsigned integer stored as a 32 bit value
 xq = z and 0xffff
 for i=16,1,-1 do {
  if xq%2 then state = 1 else state = 0
  xmtogglesetstate, $bittoy_rbox(i), state, 0
  xq = xq/2
 }
 xmtextfieldsetstring, $text1, sprintf('%d', z)
 xmtextfieldsetstring, $text2, sprintf('%#x', z)
 endsubr
 ;=====================================================================
subr decimal_cb
 s = $textfield_value
 xq = fix(s)
 if xq lt 0 or xq gt 65535 then {
  errormess,'value in Bit Toy\nis out of range'
  setbits, 0
  return
 }
 setbits, xq
 endsubr
 ;=====================================================================
subr hex_cb
 s = $textfield_value
 xq = atol(s, 16)
 if xq lt 0 or xq gt 65535 then {
  errormess,'value in Bit Toy\nis out of range'
  setbits, 0
  return
 }
 setbits, xq
 endsubr
 ;=============================================================================== 
func bittoy_widget(dum)
 if defined($bittoywidget) ne 1 then {
 b1= xmtoplevel_board(0,0,'Bit Toy',5,5)
 $bittoywidget = b1
 ff = xmform(b1,0,0)
 l1 = xmlabel(ff,'decimal',$f4)
 xmalignment, l1, 0
 l2 = xmlabel(ff,'hex',$f4)
 xmalignment, l2, 0
 t1 = xmtextfield(ff,'0',10,'decimal_cb',$f3,'white')
 t2 = xmtextfield(ff,'0',10,'hex_cb',$f3,'white')
 xmsize, t1, 140, 0
 xmsize, t2, 140, 0
 $text1 = t1
 $text2 = t2
 s1='bit 15'  s2='bit 14'  s3='bit 13'  s4='bit 12'  s5='bit 11'
 s6='bit 10'  s7='bit 9'  s8='bit 8'
 s9='bit 7'  s10='bit 6'  s11='bit 5'  s12='bit 4'
 s13='bit 3'  s14='bit 2'  s15='bit 1'  s16='bit 0'
 $bittoy_rbox = xmcheckbox(ff, 'bit_tog_cb', $f8, '', s1,s2,s3,s4, s5,s6,s7,s8, s9,s10,s11,s12, s13,s14,s15,s16, 2)
 for i=1,num_elem($bittoy_rbox)-1 do xmselectcolor,$bittoy_rbox(i),'red'
 formvstack, l1,t1,l2,t2,$bittoy_rbox(0)
 }
 return, $bittoywidget
 endfunc
 ;=============================================================================== 
func labeled_text_box(parent, label1, label2, space, ix, iy, nx, cb, nchar)
 xmposition, xmlabel(parent,label1,$f4), ix, iy+5
 tq = xmtextfield(parent,'',nchar, cb, $f3,'white')
 xmposition, tq, ix+space, iy, nx, 35
 if num_elem(label2) ge 1 then
   xmposition, xmlabel(parent, label2, $f4), ix+space+nx+10, iy+5
 return, tq
 endfunc
 ;=============================================================================== 
subr sdisk_deletelast_cb
 $sdisk_npoints -= 1
 endsubr
 ;===============================================================================
subr sdisk_deleteall_cb
 $sdisk_npoints = 0
 endsubr
 ;===============================================================================
subr sdisk_fit_circle, win
 if $sdisk_npoints lt 2 then return
 ;we should have 3 or more points in $sdisk_pts
 xx = $sdisk_pts(0, 0:$sdisk_npoints)
 yy = $sdisk_pts(1, 0:$sdisk_npoints)
 w = zero(fltarr(num_elem(xx))) + 1.0
 circle_fit_lsq, xx, yy, w, $sdisk_xc, $sdisk_yc, $sdisk_r
 ;drawing it requires converting to view coordinates
 x1 = $sdisk_xc-$sdisk_r
 y1 = $sdisk_yc-$sdisk_r
 r2 = 2*$sdisk_r
 x2 = x1 + r2
 y2 = y1 + r2
 convertforview, x1, y1, win
 convertforview, x2, y2, win
 r2 = .5*(x2-x1+y2-y1)
 xdrawarc, x1, y1, r2, r2, 0., 360., win

 ;load in the text widgets, these values are in pixels
 fq = '%6.1f'
 xmtextsetstring, $sdisktext2, sprintf(fq, $sdisk_r)
 ;convert the xc, yc to center of image on sun
 nx = $view_nx(win)
 ny = $view_ny(win)
 if $view_order(win) ge 4 then { switch, nx, ny }
 $sdisk_xc = .5*(nx-1) - $sdisk_xc
 $sdisk_yc = .5*(ny-1) - $sdisk_yc
 xmtextsetstring, $sdisktext4, sprintf(fq, $sdisk_xc)
 xmtextsetstring, $sdisktext5, sprintf(fq, $sdisk_yc)

 endsubr
 ;===============================================================================
subr sdisk_mark, win
 ;called by the callback when $view_cb_case(win) = 6
 if !button eq 0 then return
 ;compare this position with all the events (if any)
 ;if the right button (# 3), just cancel and reset
 if !button eq 3 then  { sdisk_mark_cb  return }
 ;for 1 or 2 do the select
 x = !ix
 y = !iy
 mark, x, y, win
 convertfordata, x, y, win
 nmax = dimen($sdisk_pts,1)
 if $sdisk_npoints ge nmax then {
  erromess,'buffer overflow in sdisk_mark\ntoo many points selected\nlimit = ',nmax
  sdisk_mark_cb
  return }

 $sdisk_pts(0, $sdisk_npoints) = x
 $sdisk_pts(1, $sdisk_npoints) = y
 sdisk_fit_circle, win
 $sdisk_npoints += 1

 sq = sprintf('waiting for\npoint %d', $sdisk_npoints+1
 change_button_label, $sdisk_mark_but, sq, 'red'

 endsubr
 ;=============================================================================== 
subr sdisk_mark_cb
 ;interactively mark points on a limb
 ;pressing this button either starts or ends a session of marking
 ;needs to know the button and text widgets
 zeroifundefined, sdisk_mark_in_progress
 if sdisk_mark_in_progress then {
   ;this means we are ending a session, assume w1 is defined
   $view_cb_case(w1) = 0
   sdisk_mark_in_progress = 0
   sq = 'select\ncircumferential \npoints'
   change_button_label, $sdisk_mark_but, sq, 'gray'
   if $sdisk_npoints lt 3 then {
      errormess, 'Not enough points to\nfit a circle' }
   xport, w1
   pencolor, 'black'
   return
   }

 w1 = fix(xmtextfieldgetstring ($sdisktext1)
 if bad_window(w1) then return
 sdisk_mark_in_progress = 1
 $sdisk_npoints = 0
 $sdisk_pts = fltarr(2, 100)
 sq = 'waiting for\npoint 1'
 change_button_label, $sdisk_mark_but, sq, 'red'
 $view_cb_case(w1) = 6
 xport, w1
 pencolor, 'red'

 endsubr
 ;=============================================================================== 
func sdisk_widget(iq)
 ;given an image, find the solar limb
 if defined($sdiskwidget) eq 1 then xtmanage, $sdiskwidget else {
  compile_file, getenv('ANA_WLIB') + '/sdiskwidgettool.ana'
 }
 return, $sdiskwidget
 endfunc
 ;=============================================================================== 
func special_chars(code)
 ;convert any defined strings for special keys
 s = 0
 ;test with f1 keycode
 if code eq 0xff91 then s = 'TRACE'
 return, s
 endfunc
 ;=============================================================================== 
subr drawer, win
 ;called by the callback when $view_cb_case(win) = 7
 if !keycode then {
   ;test for keyboard characters (shift, f keys, etc have 0xff00 set)
   hex, !keysym
   if (!keysym and 0xff00) eq 0xff00) then {
    s = special_chars(!keysym)
    if isscalar(s) then return
   } else {
    s = smap(byte(!keysym))
   }
   ;display what we have
   xinvertlabel, s, $label_ix, $label_iy
   $label_ix += xlabelwidth(s)
   $current_label += s
  }
 if !BUTTON then {
  ;cease if a mouse button down
  $view_cb_case(win) = 0
  }
 endsubr
 ;=============================================================================== 
subr draw_label, win
 xwindow,win
 $view_cb_case(win) = 5		;does a wait until a click
 xtloop, 1
 !motif = 1
 $view_cb_case(win) = 7
 ;get position and null the current label
 $current_label = ''
 $label_ix = !ix
 $label_iy = !iy
 endsubr
 ;=============================================================================== 
subr xfonth, size
 legals = [8,10,11,12,14,17,18,20,24,25,34]
 if min(abs(size - legals)) ne 0 then {
   ty,'WARNING - using closest font size to', size
   size = legals( !lastminloc)
   ty,' which is', size  }
 xfont,'-adobe-helvetica-bold-r-normal--'+sprintf('%0.2d', size)+'*'
 endsubr
 ;=============================================================================== 
