#########################################################################
##                                                                     ##
##  I N T E R S T E L L A R   C O N S O L E  Date Time GUI             ##
##            Copyright (C) 2025- Misato Observatory, Wakayama, Japan  ##
##                                                                     ##
##  This software is available under the GPL (General Public License)  ##
##                                                                     ##
##       Tcl/Tk References: http://www.nct9.ne.jp/m_hiroi/tcl_tk_doc/  ##
##                                                                     ##
#########################################################################


####################################################################
##                                                                ##
##                   L O C A L  S E T T I N G S                   ##
##                                                                ##
####################################################################

#
# Mode
#
set flag_dome_mode 0
for {set i 0} {$i < $argc} {incr i} {
  if { [lindex $argv $i] eq "-dome" } {
    set flag_dome_mode 1
  }
}

#
# サーバURL, ディレクトリ
#
source local-config.tcl

#
# 開始時刻設定ファイル
#
set config_list_start_time "list_start-time.txt"

#
# スケジューリング デフォルト値
#

# 月明かり/光害を制御
set flag_light_moon_pollution 1

# 朝薄明で太陽系ON
set flag_astronomical_dawn 1

# ユーザ時刻送信時に今日の日付を送信
set flag_send_today_with_users_time 1

#
#  フォントの設定
#
if { $flag_dome_mode == 0 } {
  # Navigation Mode
  # デフォルト
  option add *font {"MS Gothic" 12}
  set font_small {"MS Gothic" 10}
  # ラベルフレーム
  set font_labelframe {"MS Gothic" 10}
  # +-ボタン
  set font_pmbtn {"MS Gothic" 12}
  # スケジューリング
  set font_scheduling {"MS Gothic" 10}
  # 内部情報
  set font_internal {"MS Gothic" 10}
} else {
  # Dome Mode
  # デフォルト
  option add *font {"MS Gothic" 20}
  set font_small {"MS Gothic" 16}
  # ラベルフレーム
  set font_labelframe {"MS Gothic" 12}
  # +-ボタン
  set font_pmbtn {"MS Gothic" 13}
  # スケジューリング
  set font_scheduling {"MS Gothic" 16}
  # 内部情報
  set font_internal {"MS Gothic" 10}
}

#
# 各ウィジェットのカラーを設定
#
option add *background "#000000"
option add *foreground "#ff5050"
option add *activeBackground "#c08000"
option add *Button.background "#383838"
option add *Button.foreground "#ff6060"
option add *Button.padX "1"
option add *Button.padY "1"
option add *Entry.background "#303030"
option add *Entry.foreground "#ffe000"
option add *Entry.insertForeground "#000000"
option add *Entry.insertBackground "#00ff00"
option add *Entry.disabledBackground "#000000"
option add *Entry.disabledForeground "#ff6060"

# +-ボタンの色
set date_button_background "#383868"
set time_button_background "#304830"

#
# PC情報の色設定
#
set pcinfo_foreground "#00e000"

#
# Do not change: Set stellarium_script_dir from localConfig.ssc
#
if { [catch {open "localConfig.ssc" r} fid] } {
  tk_messageBox -type ok -icon info -title "ERROR" -message "Cannot open localConfig.ssc."
  exit
} else {
  set stellarium_script_dir "interstellar-console"
  while { [gets $fid line] >= 0 } {
    set status [regexp -- {^[ ]*var[ ]+([A-Za-z0-9_]+)[ ]*[=][ ]*["]([^"]+)["]} $line match s0 s1]
    if { $status == 1 && $s0 eq "stellarium_script_dir" } {
      set stellarium_script_dir $s1
    }
  }
  close $fid
}

#
# サーバURL (1)  サーバ側に保存されているスクリプト(staticなコード)
#                を実行する時に利用
# 
set stellarium_run_url "$stellarium_url/api/scripts/run"

#
# サーバURL (2)  クライアントで生成したスクリプト(dynamicなコード)
#                を送信する時に利用
# 
#   注意：direct を使う場合、実行できるのは１行のみらしい。
#         複数行のコードを送信すると、Stellariumがクラッシュする
set stellarium_direct_url "$stellarium_url/api/scripts/direct"

#
# サーバURL (3)  情報取得用
# 
set stellarium_status_url "$stellarium_url/api/main/status"


####################################################################
##                                                                ##
##                       P R O C E D U R E S                      ##
##                                                                ##
####################################################################

#
# 閏年かどうか
#
proc is_leapyear { year } {

  if { [catch "clock scan 2/29/$year"] } {
    return 0
  } else {
    return 1
  }

}

#
# 汎用：サーバ上の指定されたスクリプト(foo.ssc)を実行 (可変引数)
#
proc exec_ssc_on_server { args } {

  global stellarium_run_url stellarium_script_dir
  global buffer_internal_info

  foreach script_file $args {

    set ret [exec -ignorestderr curl -s -d id=$stellarium_script_dir/$script_file $stellarium_run_url]
    set buffer_internal_info "$script_file"
    if { $ret ne "ok" } {
      #tk_messageBox -type ok -icon info -title "ERROR" -message "ERROR in $script_file: $ret"
      set buffer_internal_info "$script_file / ERROR: $ret"
    }

  }

}

#
# 汎用：stellarium スクリプトn行 を送信 (可変引数)
#
#  【注意】
#    ・args[n] に空白を入れたい場合は [~] を、["] を入れたい場合は ['] とする。
#      例： "Ursa Major" は 'Ursa~Major' とする
#    ・送信できるのは、関数の羅列だけである。
#      Stellariumがクラッシュするため、for()文などの制御構文を送ってはならない。
#
proc send_ssc_lines { args } {

  global stellarium_direct_url
  global buffer_internal_info
  # Set debug=1 to write code to $code_file
  set debug 0
  set code_file "tmp.txt"

  foreach code1line $args {

    # replace [~] with [ ], and ['] with ["]
    set code_p0 [regsub -all {~} $code1line { }]
    set code_p1 [regsub -all {'} $code_p0 {"}]
    set buffer_codefield "$code_p1"

    set buffer_internal_info $buffer_codefield

    if { $debug == 0 } {
      set f [open "| curl -s -d @- $stellarium_direct_url" w]
        puts -nonewline $f "code="
        puts -nonewline $f "$buffer_codefield"
        puts $f ";"
      catch {close $f} std_err
    } else {
      set f [open $code_file w]
        puts -nonewline $f "code="
        puts -nonewline $f "$buffer_codefield"
        puts $f ";"
      catch {close $f} std_err
      set ret [exec -ignorestderr curl -s -d @$code_file $stellarium_direct_url]
    }

  }

}


#
# 設定された時刻を送信
#
proc send_ssc_ldatetime {} {

  global buffer_ldate_label
  global buffer_ltime_label
  global flag_during_input_ldatetime
  global flag_needs_update_datetime_info

  if { $flag_during_input_ldatetime != 0 } {

    global buffer_internal_info

    set buffer_ldate_label [regsub -all {[/]} $buffer_ldate_label {-}]
    set buffer_ldate_label [regsub -all {[^-0-9]} $buffer_ldate_label {}]
    set date_str_in $buffer_ldate_label

    set buffer_ltime_label [regsub -all {[-]} $buffer_ltime_label {:}]
    set buffer_ltime_label [regsub -all {[^:0-9]} $buffer_ltime_label {}]
    set time_str_in $buffer_ltime_label

    set s [format "core.setDate(\"%sT%s\",\"local\")" $date_str_in $time_str_in]

    send_ssc_lines $s

    #set buffer_internal_info $s

    # To non-input mode
    .e_ldate configure -state disable
    .e_ltime configure -state disable
    set flag_during_input_ldatetime 0

    # Force an update
    # (not requied)
    ##set flag_needs_update_datetime_info 1

  }

}

# Info Server から太陽・月情報をGETし、連想配列を作る
proc get_sunmoon_info {} {

  global iscserv_url
  global asarr_sunmoon_info

  set filename "_tmp_SunMoonTime.isc.txt"

  if { [catch {open "| curl -s $iscserv_url/$filename" r} fh] } {
    tk_messageBox -type ok -icon info -title "ERROR" -message "ERROR: cannot GET $iscserv_url/$filename"
  } else {
    set flg_get 0
    while { [gets $fh txt_line] >= 0 } {
      set lst [split [string trim $txt_line] ","]
      if { [llength $lst] == 2 } {
        set k [string trim [lindex $lst 0]]
        set v [string trim [lindex $lst 1]]
        set asarr_sunmoon_info($k) $v
        set flg_get 1
      }
    }
    catch {close $fh} std_err
    if { $flg_get == 0 } {
      tk_messageBox -type ok -icon info -title "ERROR" -message "ERROR: cannot GET $iscserv_url/$filename"
    }
  }

}

# Info Server から太陽・惑星情報をGETし、連想配列を作る
proc get_sunplanets_info {} {

  global iscserv_url
  global asarr_sunplanets_info

  set filename "_tmp_SunPlanetsTime.isc.txt"

  if { [catch {open "| curl -s $iscserv_url/$filename" r} fh] } {
    tk_messageBox -type ok -icon info -title "ERROR" -message "ERROR: cannot GET $iscserv_url/$filename"
  } else {
    set flg_get 0
    while { [gets $fh txt_line] >= 0 } {
      set lst [split [string trim $txt_line] ","]
      if { [llength $lst] == 2 } {
        set k [string trim [lindex $lst 0]]
        set v [string trim [lindex $lst 1]]
        set asarr_sunplanets_info($k) $v
        set flg_get 1
      }
    }
    catch {close $fh} std_err
    if { $flg_get == 0 } {
      tk_messageBox -type ok -icon info -title "ERROR" -message "ERROR: cannot GET $iscserv_url/$filename"
    }
  }

}

# Info Server から月情報をGETし、連想配列を作る
proc get_moon_info {} {

  global iscserv_url
  global asarr_moon_info

  set filename "_tmp_MoonTime.isc.txt"

  if { [catch {open "| curl -s $iscserv_url/$filename" r} fh] } {
    tk_messageBox -type ok -icon info -title "ERROR" -message "ERROR: cannot GET $iscserv_url/$filename"
  } else {
    set flg_get 0
    while { [gets $fh txt_line] >= 0 } {
      set lst [split [string trim $txt_line] ","]
      if { [llength $lst] == 2 } {
        set k [string trim [lindex $lst 0]]
        set v [string trim [lindex $lst 1]]
        set asarr_moon_info($k) $v
        set flg_get 1
      }
    }
    catch {close $fh} std_err
    if { $flg_get == 0 } {
      tk_messageBox -type ok -icon info -title "ERROR" -message "ERROR: cannot GET $iscserv_url/$filename"
    }
  }

}

#
# オフセット値から日付時刻文字列を生成し
# buffer_ldate_label, buffer_ltime_label へ入れる
#
proc set_ldatetime_by_ymds { off_year off_month off_day off_sec } {

  global buffer_ldate_label
  global buffer_ltime_label

  global flag_during_input_ldatetime
  global flag_immediate_input

  # To input mode
  .e_ldate configure -state normal
  .e_ltime configure -state normal
  set flag_during_input_ldatetime 1

  # filtering
  set date_str_in [regsub {^[^-0-9]+} $buffer_ldate_label {}]
  set time_str_in [regsub {^[^0-9]+} $buffer_ltime_label {}]

  # Ignore Year <= 0000
  if { [string match "-*" $buffer_ldate_label] } {
    set date_str_in "0001-01-01"
  }
  if { [string match "0000*" $buffer_ldate_label] } {
    set date_str_in "0001-01-01"
  }

  # "0000-01-01" -> "0-1-1"
  set date_str [regsub -all {0*(\d+)} $date_str_in {\1}]
  set time_str [regsub -all {0*(\d+)} $time_str_in {\1}]

  # split
  set date_list [split $date_str "-"]
  set date_y [lindex $date_list 0]
  set date_m [lindex $date_list 1]
  set date_d [lindex $date_list 2]
  set time_list [split $time_str ":"]
  set time_h [lindex $time_list 0]
  set time_m [lindex $time_list 1]
  set time_s [lindex $time_list 2]

  # Fix year < 100 problem ...
  # i.e. [clock scan {0099-01-01 -1 year}] returns wrong value ...
  if { $date_y < 101 } {
    set date_y [expr $date_y + 101]
    set off_year [expr $off_year - 101]
    # overwrite...
    set date_str_in [format "%04d-%02d-%02d" $date_y $date_m $date_d]
  }

  if { $off_sec != 0 } {

    set tm_s_raw [expr $time_s + $off_sec]

    set time_s [expr $tm_s_raw % 60]
    if { 0 <= $tm_s_raw } {
      set tm_m_raw [expr $time_m + ($tm_s_raw / 60)]
    } else {
      set tm_m_raw [expr $time_m + (($tm_s_raw - 1) / 60)]
    }

    set time_m [expr $tm_m_raw % 60]
    if { 0 <= $tm_m_raw } {
      set tm_h_raw [expr $time_h + ($tm_m_raw / 60)]
    } else {
      set tm_h_raw [expr $time_h + (($tm_m_raw - 1) / 60)]
    }

    set time_h [expr $tm_h_raw % 24]
    if { 0 <= $tm_h_raw } {
      set tm_d_raw [expr 0 + ($tm_h_raw / 24)]
    } else {
      set tm_d_raw [expr 0 + (($tm_h_raw - 1) / 24)]
    }

    set off_day [expr $off_day + $tm_d_raw]

    # SET!!
    set buffer_ltime_label [format "%02d:%02d:%02d" $time_h $time_m $time_s]

  }

  if { $off_day != 0 || $off_month != 0 || $off_year != 0 } {

    # initial value
    set date_str_in_updated $date_str_in

    if { $off_day != 0 } {
      set lst [list $date_str_in $off_day "day"]
      set date_raw [clock scan $lst]
      set date_str_in_updated [clock format $date_raw -format {%Y-%m-%d}]
    }

    if { $off_month != 0 } {
      set lst [list $date_str_in_updated $off_month "month"]
      set date_raw [clock scan $lst]
      set date_str_in_updated [clock format $date_raw -format {%Y-%m-%d}]
    }

    set date_str [regsub -all {0*(\d+)} $date_str_in_updated {\1}]
    set date_list [split $date_str "-"]
    set date_y [lindex $date_list 0]
    set date_m [lindex $date_list 1]
    set date_d [lindex $date_list 2]

    # do not handle BC
    if { $date_y + $off_year < 1 } {
      set off_year [expr 1 - $date_y]
    }
    if { 9999 < $date_y + $off_year } {
      set off_year [expr 9999 - $date_y]
    }

    # Fix year < 1900 problem ...
    set flag_force_simple_yearcalc 1

    # Fix year < 100 problem ...
    if { $flag_force_simple_yearcalc == 0 && 100 <= $date_y + $off_year } {
      set lst [list $date_str_in_updated $off_year "year"]
      set date_raw [clock scan $lst]
      set result_str [clock format $date_raw -format {%Y-%m-%d}]
    } else {
      set status [regexp -- {([-]*[0-9]+)[-]([0-9]+[-][0-9]+)} $date_str_in_updated match s_yyyy s_mmdd]
      if { $status == 1 } {
        # "0012" -> "12"
        set s_yyyy [regsub -all {0*(\d+)} $s_yyyy {\1}]
        set s_yyyy [expr $s_yyyy + $off_year]
      }
      set result_str [format "%04d-%s" $s_yyyy $s_mmdd]
    }
    # SET!!
    set buffer_ldate_label $result_str

  }

  if { $flag_immediate_input != 0 } {
    send_ssc_ldatetime
  }

}

#
# ローカル日付時刻への入力Enable/Disableの切り替え
#
proc setup_ldatetime_field { args } {

  global flag_during_input_ldatetime
  global buffer_internal_info

  foreach flg $args {
    set flag_during_input_ldatetime $flg
  }

  if { $flag_during_input_ldatetime == 0 } {
    .e_ldate configure -state disable
    .e_ltime configure -state disable
  } else {
    .e_ldate configure -state normal
    .e_ltime configure -state normal
  }

  #set buffer_internal_info $flag_during_input_ldatetime

}

#
# PC時刻をセット
#
proc set_pcdatetime {} {

  global buffer_ldate_label
  global buffer_ltime_label
  global flag_immediate_input

  # To input mode
  setup_ldatetime_field 1

  #### Current date time ####

  set pc_time_raw [clock seconds]
  set buffer_ldate_label [clock format $pc_time_raw -format {%Y-%m-%d}]
  set buffer_ltime_label [clock format $pc_time_raw -format {%H:%M:%S}]

  if { $flag_immediate_input != 0 } {
    send_ssc_ldatetime
  }

}

#
# ユーザ時刻をセット
#
proc set_start_time { arg_ltime } {

  global buffer_ldate_label
  global buffer_ltime_label
  global flag_send_today_with_users_time

  # To input mode
  setup_ldatetime_field 1

  #### Current date time ####

  set pc_time_raw [clock seconds]
  if { $flag_send_today_with_users_time != 0 } {
    set buffer_ldate_label [clock format $pc_time_raw -format {%Y-%m-%d}]
  }
  if { $arg_ltime eq "-" } {
    set buffer_ltime_label [clock format $pc_time_raw -format {%H:%M:%S}]
  } else {
    set buffer_ltime_label [format "%s:00" $arg_ltime]
  }

  send_ssc_ldatetime

}

#
# スケジューリング用proc
#
proc do_scheduling {} {

  global current_ltime
  global buffer_nightend
  global buffer_sunrise
  global buffer_sunset
  global flag_light_moon_pollution
  global flag_astronomical_dawn
  global buffer_internal_info

  # いずれかのスケジューリング設定があれば実行
  if { $flag_light_moon_pollution != 0 || $flag_astronomical_dawn != 0 } {

    # "00:01:01" -> "0:01:01"
    set ltime_str [regsub -all {0*(\d+)} $current_ltime {\1}]
    set nightend_str [regsub -all {0*(\d+)} $buffer_nightend {\1}]
    set sunrise_str [regsub -all {0*(\d+)} $buffer_sunrise {\1}]
    set sunset_str [regsub -all {0*(\d+)} $buffer_sunset {\1}]

    # split
    set ltime_list [split $ltime_str ":"]
    set nightend_list [split $nightend_str ":"]
    set sunrise_list [split $sunrise_str ":"]
    set sunset_list [split $sunset_str ":"]

    if { [llength $ltime_list] == 3 && [llength $nightend_list] == 2 && [llength $sunrise_list] == 2 && [llength $sunset_list] == 2 } {

      set ltime_h [lindex $ltime_list 0]
      set ltime_m [lindex $ltime_list 1]
      set ltime_s [lindex $ltime_list 2]
      set nightend_h [lindex $nightend_list 0]
      set nightend_m [lindex $nightend_list 1]
      set sunrise_h [lindex $sunrise_list 0]
      set sunrise_m [lindex $sunrise_list 1]
      set sunset_h [lindex $sunset_list 0]
      set sunset_m [lindex $sunset_list 1]

      #set buffer_internal_info [format "debug '%s' '%s' '%s'" $ltime_h $ltime_m $ltime_s]

      set ltime [expr ($ltime_h * 3600) + ($ltime_m * 60) + $ltime_s]
      set nightend [expr ($nightend_h * 3600) + ($nightend_m * 60)]
      set sunrise [expr ($sunrise_h * 3600) + ($sunrise_m * 60)]
      set sunset [expr ($sunset_h * 3600) + ($sunset_m * 60)]

      #set buffer_internal_info [format "debug '%s' '%s' '%s'" $ltime $nightend $sunrise]

      # 月明かり/光害を制御
      if { $flag_light_moon_pollution != 0 } {
        if { $sunset < $ltime || $ltime < $sunrise } {
          exec_ssc_on_server updateLightMoonPollution.ssc
        }
      }

      # 薄明中に太陽系ON
      if { $flag_astronomical_dawn != 0 } {
        if { $nightend <= $ltime && $ltime <= $sunrise } {
          exec_ssc_on_server setSolarSystem.ssc
        }
      }

    }

  }

}


#
# 日付/時刻 薄明時刻など 表示用 無限ループ
#
proc show_date_time_info {} {

  global stellarium_status_url
  global current_ldate
  global current_ltime
  global buffer_ldate_label
  global buffer_ltime_label
  global buffer_date_label
  global buffer_time_label
  global buffer_alt_label
  global buffer_lon_label
  global buffer_lat_label
  global buffer_sunrise
  global buffer_sunset
  global buffer_night
  global buffer_nightend
  global buffer_moonrise
  global buffer_moonset
  global buffer_moonage

  global buffer_mercuryrise
  global buffer_mercuryset
  global buffer_mercurytransit
  global buffer_venusrise
  global buffer_venusset
  global buffer_venustransit
  global buffer_marsrise
  global buffer_marsset
  global buffer_marstransit
  global buffer_jupiterrise
  global buffer_jupiterset
  global buffer_jupitertransit
  global buffer_saturnrise
  global buffer_saturnset
  global buffer_saturntransit
  global buffer_uranusrise
  global buffer_uranusset
  global buffer_uranustransit
  global buffer_neptunerise
  global buffer_neptuneset
  global buffer_neptunetransit

  global flag_during_input_ldatetime
  global flag_needs_update_datetime_info
  global counter_for_delayed_computing

  global asarr_sunmoon_info
  global asarr_sunplanets_info
  global asarr_moon_info

  global buffer_pcdate_label
  global buffer_pctime_label

  global buffer_internal_info

  # flag to use suncalc (JavaScript)
  set flg_use_suncalc 0

  # Set debug=1 to write code to $code_file
  set debug 0
  set code_file "tmp_calc_sun.txt"

  #### Current date time ####

  set pc_time_raw [clock seconds]
  set buffer_pcdate_label [clock format $pc_time_raw -format {%Y-%m-%d}]
  set buffer_pctime_label [clock format $pc_time_raw -format {%H:%M:%S}]

  #### Planetarium date time ####

  set diff_sec 0

  if { 1 } {

    if { [catch {set line [exec -ignorestderr curl -s -G $stellarium_status_url]} result] } {
      exit
    }

    set flg_date_changed 0
    set flg_hour_changed 0
    set flg_time_changed 0
    set flg_site_changed 0

    set status [regexp -- {.*["]local["]:["]([^"T]+)T([^".]+)} $line match s_ldate s_ltime]
    if { $status == 1 } {
      if { $s_ltime ne $current_ltime } {
        scan $current_ltime "%d:%d:%d" hh0 mm0 ss0
        set v0sec [expr $ss0 + 60 * $mm0 + 3600 * $hh0]
        scan $s_ltime "%d:%d:%d" hh1 mm1 ss1
        set v1sec [expr $ss1 + 60 * $mm1 + 3600 * $hh1]
        #
        #set v $current_ltime
        #set v0sec [clock scan $v]
        #set v $s_ltime
        #set v1sec [clock scan $v]
        #
        set diff_sec [expr abs($v1sec - $v0sec)]
        #
        if { $hh0 != $hh1 } {
          set flg_hour_changed 1
        }
        #
        set current_ltime $s_ltime
        set flg_time_changed 1
      }
      if { $s_ldate ne $current_ldate } {
        set current_ldate $s_ldate
        set flg_date_changed 1
      }
    }
    set status [regexp -- {.*["]utc["]:["]([^"T]+)T([^".]+)} $line match s_date s_time]
    if { $status == 1 } {
      set buffer_date_label $s_date
      set buffer_time_label $s_time
    }
    set status [regexp -- {.*["]altitude["]:([^,]+).*["]latitude["]:([^,]+).*["]longitude["]:([^,]+)} $line match s_alt0 s_lat0 s_lon0]
    if { $status == 1 } {
      set s_alt [format "%.0fm" $s_alt0]
      set s_lon [format "%+.4f" $s_lon0]
      set s_lat [format "%+.4f" $s_lat0]
      if { $s_alt != $buffer_alt_label || $s_lon != $buffer_lon_label || $s_lat != $buffer_lat_label } {
        set buffer_alt_label $s_alt
        set buffer_lon_label $s_lon
        set buffer_lat_label $s_lat
        set flg_site_changed 1
      }
    }

    # for delayed processing
    #  103->102 : compute moon info only
    #    3->2   : compute sun+planets/moon info and update additional grid lines, etc.
    if { $flg_hour_changed != 0 } {
      # avoid transition of 3 -> 103, etc.
      if { 0 < $counter_for_delayed_computing && $counter_for_delayed_computing < 100 } {
        set counter_for_delayed_computing 3
      } else {
        set counter_for_delayed_computing 103
      }
    }
    if { $flg_date_changed != 0 || $flg_site_changed != 0 || $flag_needs_update_datetime_info != 0 } {
      set counter_for_delayed_computing 3
    }

    # Compute Sun/Moon set,rise, etc. and update additional grid lines, etc.
    #
    if { $counter_for_delayed_computing == 2 } {

      if { $flg_use_suncalc == 0 } {
        exec_ssc_on_server getSunPlanetsTime.ssc getMoonTime.ssc
      }
      exec_ssc_on_server updateEclipticDateLabels.ssc updateSunDiurnalMotion.ssc updateEarthOrbit.ssc updateEarthOrbitLabels.ssc

    } elseif { $counter_for_delayed_computing == 102 } {

      if { $flg_use_suncalc == 0 } {
        exec_ssc_on_server getMoonTime.ssc
      }

    }

    if { $counter_for_delayed_computing == 1 || $counter_for_delayed_computing == 101 } {

      set year_valid 0

      if { $flg_use_suncalc == 0 } {

        if { $counter_for_delayed_computing == 1 } {
          get_sunplanets_info
          set l_sunrise $asarr_sunplanets_info(SunRise)
          set l_sunset $asarr_sunplanets_info(SunSet)
          set l_nightend $asarr_sunplanets_info(AstronomicalDawn)
          set l_night $asarr_sunplanets_info(AstronomicalDusk)
          set l_mercuryrise $asarr_sunplanets_info(MercuryRise)
          set l_mercuryset $asarr_sunplanets_info(MercurySet)
          set l_mercurytransit $asarr_sunplanets_info(MercuryTransit)
          set l_venusrise $asarr_sunplanets_info(VenusRise)
          set l_venusset $asarr_sunplanets_info(VenusSet)
          set l_venustransit $asarr_sunplanets_info(VenusTransit)
          set l_marsrise $asarr_sunplanets_info(MarsRise)
          set l_marsset $asarr_sunplanets_info(MarsSet)
          set l_marstransit $asarr_sunplanets_info(MarsTransit)
          set l_jupiterrise $asarr_sunplanets_info(JupiterRise)
          set l_jupiterset $asarr_sunplanets_info(JupiterSet)
          set l_jupitertransit $asarr_sunplanets_info(JupiterTransit)
          set l_saturnrise $asarr_sunplanets_info(SaturnRise)
          set l_saturnset $asarr_sunplanets_info(SaturnSet)
          set l_saturntransit $asarr_sunplanets_info(SaturnTransit)
          set l_uranusrise $asarr_sunplanets_info(UranusRise)
          set l_uranusset $asarr_sunplanets_info(UranusSet)
          set l_uranustransit $asarr_sunplanets_info(UranusTransit)
          set l_neptunerise $asarr_sunplanets_info(NeptuneRise)
          set l_neptuneset $asarr_sunplanets_info(NeptuneSet)
          set l_neptunetransit $asarr_sunplanets_info(NeptuneTransit)
        }

        get_moon_info
        set l_moonrise $asarr_moon_info(MoonRise)
        set l_moonset $asarr_moon_info(MoonSet)
        set l_moonage $asarr_moon_info(MoonAge)

        set year_valid 1

      } else {

        # こちらのコードでは calc_sun_3.js を cscript で実行して天文薄明を取得
        # ただし、計算範囲に制限あり

        set status [regexp -- {^([-+]*)([0-9]+)} $current_ldate match ss_year_pm ss_year_val]
        if { $status == 1 } {
          set ss_year_val [regsub -all {0*(\d+)} $ss_year_val {\1}]
          if { $ss_year_pm ne "-" && 1900 <= $ss_year_val && $ss_year_val <= 2150 } {
            set year_valid 1
          }
        }

        #set buffer_internal_info [format "debug '%s' '%s'" $ss_year_pm $ss_year_val]

        if { $year_valid == 1 } {

          set ss_date [regsub -all {[-]} $current_ldate {/}]
          set ss_alt  [regsub -all {m} $buffer_alt_label {}]

          set f [open "| cscript //Nologo calc_sun_3.js $ss_date $buffer_lon_label $buffer_lat_label $ss_alt" r]
          gets $f l_date_ymd
          gets $f l_sunrise
          gets $f l_sunset
          gets $f l_nightend
          gets $f l_night
          gets $f l_moonrise
          gets $f l_moonset
          catch {close $f} std_err
          set l_moonage "-"

          if { $l_date_ymd ne $current_ldate } {
            set year_valid 0
          }

          set buffer_internal_info [format "suncalc3: '%s'" $l_date_ymd]

        }

      }

      if { $year_valid == 1 } {

        if { $counter_for_delayed_computing == 1 } {

          set status [regexp -- {([^:]+):([^:]+)} $l_sunrise match h0 m0]
          if { $status == 1 } {
            set buffer_sunrise [format "%02d:%02d" $h0 $m0]
          }
          set status [regexp -- {([^:]+):([^:]+)} $l_sunset match h0 m0]
          if { $status == 1 } {
            set buffer_sunset [format "%02d:%02d" $h0 $m0]
          }
          set status [regexp -- {([^:]+):([^:]+)} $l_nightend match h0 m0]
          if { $status == 1 } {
            set buffer_nightend [format "%02d:%02d" $h0 $m0]
          }
          set status [regexp -- {([^:]+):([^:]+)} $l_night match h0 m0]
          if { $status == 1 } {
            set buffer_night [format "%02d:%02d" $h0 $m0]
          }
          set status [regexp -- {([^:]+):([^:]+)} $l_mercuryrise match h0 m0]
          if { $status == 1 } {
            set buffer_mercuryrise [format "%02d:%02d" $h0 $m0]
          }
          set status [regexp -- {([^:]+):([^:]+)} $l_mercuryset match h0 m0]
          if { $status == 1 } {
            set buffer_mercuryset [format "%02d:%02d" $h0 $m0]
          }
          set status [regexp -- {([^:]+):([^:]+)} $l_mercurytransit match h0 m0]
          if { $status == 1 } {
            set buffer_mercurytransit [format "%02d:%02d" $h0 $m0]
          }
          set status [regexp -- {([^:]+):([^:]+)} $l_venusrise match h0 m0]
          if { $status == 1 } {
            set buffer_venusrise [format "%02d:%02d" $h0 $m0]
          }
          set status [regexp -- {([^:]+):([^:]+)} $l_venusset match h0 m0]
          if { $status == 1 } {
            set buffer_venusset [format "%02d:%02d" $h0 $m0]
          }
          set status [regexp -- {([^:]+):([^:]+)} $l_venustransit match h0 m0]
          if { $status == 1 } {
            set buffer_venustransit [format "%02d:%02d" $h0 $m0]
          }
          set status [regexp -- {([^:]+):([^:]+)} $l_marsrise match h0 m0]
          if { $status == 1 } {
            set buffer_marsrise [format "%02d:%02d" $h0 $m0]
          }
          set status [regexp -- {([^:]+):([^:]+)} $l_marsset match h0 m0]
          if { $status == 1 } {
            set buffer_marsset [format "%02d:%02d" $h0 $m0]
          }
          set status [regexp -- {([^:]+):([^:]+)} $l_marstransit match h0 m0]
          if { $status == 1 } {
            set buffer_marstransit [format "%02d:%02d" $h0 $m0]
          }
          set status [regexp -- {([^:]+):([^:]+)} $l_jupiterrise match h0 m0]
          if { $status == 1 } {
            set buffer_jupiterrise [format "%02d:%02d" $h0 $m0]
          }
          set status [regexp -- {([^:]+):([^:]+)} $l_jupiterset match h0 m0]
          if { $status == 1 } {
            set buffer_jupiterset [format "%02d:%02d" $h0 $m0]
          }
          set status [regexp -- {([^:]+):([^:]+)} $l_jupitertransit match h0 m0]
          if { $status == 1 } {
            set buffer_jupitertransit [format "%02d:%02d" $h0 $m0]
          }
          set status [regexp -- {([^:]+):([^:]+)} $l_saturnrise match h0 m0]
          if { $status == 1 } {
            set buffer_saturnrise [format "%02d:%02d" $h0 $m0]
          }
          set status [regexp -- {([^:]+):([^:]+)} $l_saturnset match h0 m0]
          if { $status == 1 } {
            set buffer_saturnset [format "%02d:%02d" $h0 $m0]
          }
          set status [regexp -- {([^:]+):([^:]+)} $l_saturntransit match h0 m0]
          if { $status == 1 } {
            set buffer_saturntransit [format "%02d:%02d" $h0 $m0]
          }
          set status [regexp -- {([^:]+):([^:]+)} $l_uranusrise match h0 m0]
          if { $status == 1 } {
            set buffer_uranusrise [format "%02d:%02d" $h0 $m0]
          }
          set status [regexp -- {([^:]+):([^:]+)} $l_uranusset match h0 m0]
          if { $status == 1 } {
            set buffer_uranusset [format "%02d:%02d" $h0 $m0]
          }
          set status [regexp -- {([^:]+):([^:]+)} $l_uranustransit match h0 m0]
          if { $status == 1 } {
            set buffer_uranustransit [format "%02d:%02d" $h0 $m0]
          }
          set status [regexp -- {([^:]+):([^:]+)} $l_neptunerise match h0 m0]
          if { $status == 1 } {
            set buffer_neptunerise [format "%02d:%02d" $h0 $m0]
          }
          set status [regexp -- {([^:]+):([^:]+)} $l_neptuneset match h0 m0]
          if { $status == 1 } {
            set buffer_neptuneset [format "%02d:%02d" $h0 $m0]
          }
          set status [regexp -- {([^:]+):([^:]+)} $l_neptunetransit match h0 m0]
          if { $status == 1 } {
            set buffer_neptunetransit [format "%02d:%02d" $h0 $m0]
          }

        }

        set status [regexp -- {([^:]+):([^:]+)} $l_moonrise match h0 m0]
        if { $status == 1 } {
          set buffer_moonrise [format "%02d:%02d" $h0 $m0]
        }
        set status [regexp -- {([^:]+):([^:]+)} $l_moonset match h0 m0]
        if { $status == 1 } {
          set buffer_moonset [format "%02d:%02d" $h0 $m0]
        }
        set buffer_moonage [format "%.1f" $l_moonage]

      } else {

        # Unsupported/Unreliable YEAR in suncalc...

        set buffer_sunrise "-"
        set buffer_sunset "-"
        set buffer_nightend "-"
        set buffer_night "-"
        set buffer_moonrise "-"
        set buffer_moonset "-"

      }

    }

    if { $flg_date_changed != 0 || $flg_time_changed != 0 || $flg_site_changed != 0 || $flag_needs_update_datetime_info != 0 } {

      # Do scheduling ...
      do_scheduling

    }

    # reset and count-down
    set flag_needs_update_datetime_info 0
    if { 0 < $counter_for_delayed_computing } {
      set counter_for_delayed_computing [expr $counter_for_delayed_computing - 1]
      if { $counter_for_delayed_computing == 100 } {
        set counter_for_delayed_computing 0
      }
    }

  }

  if { $flag_during_input_ldatetime == 0 } {

    set buffer_ldate_label $current_ldate
    set buffer_ltime_label $current_ltime

  }

  #set buffer_internal_info $diff_sec

  # ウエイト(必要に応じて可変にして良い。ただしマシンパワーの消費とcounter_for_delayed_computingの設定に注意)
  if { 1 < $diff_sec } {
    after 500 show_date_time_info
  } else {
    after 500 show_date_time_info
  }

}

proc unset_detailed_planets_info {} {
  .pw forget .fr_planetsinfoall
  .pw add .fr_planetsinfo
}

proc set_detailed_planets_info {} {
  .pw forget .fr_planetsinfo
  .pw add .fr_planetsinfoall
}


####################################################################
##                                                                ##
##                             M A I N                            ##
##                                                                ##
####################################################################

# ウィンドゥ名称,属性の設定
wm title . "Intersteller Console :: date time"
wm resizable . 0 0

# ウィジェットの設定
option add *Labelframe.padX "2"
option add *Labelframe.padY "2"
option add *Entry.justify "center"

# flag,counter (選択表示で使用)
set flag_during_input_ldatetime 0
set flag_needs_update_datetime_info 0
set counter_for_delayed_computing 0

# 初期値
# 現在の時刻を保持
set current_ldate "0000-00-00"
set current_ltime "00:00:00"
# 以下、ラベル用
set buffer_ldate_label "0000-00-00"
set buffer_ltime_label "00:00:00"
set buffer_date_label "0000-00-00"
set buffer_time_label "00:00:00"
set buffer_lon_label "0.0"
set buffer_lat_label "0.0"
set buffer_alt_label "0m"

set buffer_sunrise  "00:00"
set buffer_sunset   "00:00"
set buffer_night    "00:00"
set buffer_nightend "00:00"
set buffer_moonrise  "00:00"
set buffer_moonset   "00:00"
set buffer_moonage   "0.0"

set buffer_mercuryrise  "00:00"
set buffer_mercuryset   "00:00"
set buffer_mercurytransit   "00:00"
set buffer_venusrise  "00:00"
set buffer_venusset   "00:00"
set buffer_venustransit   "00:00"
set buffer_marsrise  "00:00"
set buffer_marsset   "00:00"
set buffer_marstransit   "00:00"
set buffer_jupiterrise  "00:00"
set buffer_jupiterset   "00:00"
set buffer_jupitertransit   "00:00"
set buffer_saturnrise  "00:00"
set buffer_saturnset   "00:00"
set buffer_saturntransit   "00:00"
set buffer_uranusrise  "00:00"
set buffer_uranusset   "00:00"
set buffer_uranustransit   "00:00"
set buffer_neptunerise  "00:00"
set buffer_neptuneset   "00:00"
set buffer_neptunetransit   "00:00"

set buffer_internal_info "-"

# 太陽・月情報用連想配列
array set asarr_sunmoon_info {}
array set asarr_sunplanets_info {}
array set asarr_moon_info {}


########################################################################

frame .fr_rootwin
frame .fr_root_left

########################################################################

labelframe .lf_dateinfo -text "Date Time Info" -font $font_labelframe

frame .fr_ldatetm
label .l_ldatetm -text "スクリーン日時" -width 16
entry .e_ldate -textvariable buffer_ldate_label -width 14 -state disable
entry .e_ltime -textvariable buffer_ltime_label -width 12 -state disable
pack .l_ldatetm .e_ldate .e_ltime -side left -expand 1 -fill both -in .fr_ldatetm

bind .e_ldate <Return> "send_ssc_ldatetime"
bind .e_ltime <Return> "send_ssc_ldatetime"
bind .e_ldate <ButtonPress-1> "setup_ldatetime_field 1"
bind .e_ltime <ButtonPress-1> "setup_ldatetime_field 1"

frame .fr_lonlat
label .l_lonlat -text "場所" -width 16
label .l_lon -textvariable buffer_lon_label
label .l_lat -textvariable buffer_lat_label
label .l_alt -textvariable buffer_alt_label
pack .l_lonlat .l_lon .l_lat .l_alt -side left -expand 1 -fill both -in .fr_lonlat

frame .fr_datetm
label .l_datetm -text "スクリーンUTC" -width 16
label .l_date -textvariable buffer_date_label -width 14
label .l_time -textvariable buffer_time_label -width 12
pack .l_datetm .l_date .l_time -side left -expand 1 -fill both -in .fr_datetm

#

frame .fr_suntime
label .l_suntime0 -text "太陽" -width 15

frame .fr_sunrise
label .l_suntime1 -text "   出 " -width 6 -padx 0
label .l_sunrise -textvariable buffer_sunrise -width 5 -padx 0
pack .l_suntime1 .l_sunrise -side left -in .fr_sunrise

frame .fr_sunset
label .l_suntime2 -text "   没 " -width 6 -padx 0
label .l_sunset  -textvariable buffer_sunset  -width 5 -padx 0
pack .l_suntime2 .l_sunset -side left -in .fr_sunset

pack .l_suntime0 .fr_sunrise .fr_sunset -side left -expand 1 -fill x -in .fr_suntime

#

frame .fr_nighttm
label .l_nighttm0 -text "天文薄明" -width 15

frame .fr_nightend
label .l_nighttm1 -text "   始 " -width 6 -padx 0
label .l_nightend  -textvariable buffer_nightend -width 5 -padx 0
pack .l_nighttm1 .l_nightend -side left -in .fr_nightend

frame .fr_night
label .l_nighttm2 -text "   終 " -width 6 -padx 0
label .l_night -textvariable buffer_night -width 5 -padx 0
pack .l_nighttm2 .l_night -side left -in .fr_night

pack .l_nighttm0 .fr_nightend .fr_night -side left -expand 1 -fill x -in .fr_nighttm

#

frame .fr_moontm

frame .fr_moontime
label .l_moontime0 -text " 月" -width 3 -padx 0
label .l_moontime1 -text "(月齢" -width 5 -padx 0
label .l_moontime2 -textvariable buffer_moonage -width 4 -padx 0
label .l_moontime3 -text ")" -width 1 -padx 0
label .l_moontime4 -text " " -width 1 -padx 0
pack .l_moontime0 -side left -expand 1 -fill x -in .fr_moontime
pack .l_moontime1 .l_moontime2 .l_moontime3 -side left -expand 0 -fill x -in .fr_moontime
pack .l_moontime4 -side left -expand 1 -fill x -in .fr_moontime

frame .fr_moonrise
label .l_moontime01 -text "   出 " -width 6 -padx 0
label .l_moonrise -textvariable buffer_moonrise -width 5 -padx 0
pack .l_moontime01 .l_moonrise -side left -in .fr_moonrise

frame .fr_moonset
label .l_moontime02 -text "   没 " -width 6 -padx 0
label .l_moonset  -textvariable buffer_moonset  -width 5 -padx 0
pack .l_moontime02 .l_moonset -side left -in .fr_moonset

pack .fr_moontime .fr_moonrise .fr_moonset -side left -expand 1 -fill x -in .fr_moontm

pack .fr_ldatetm .fr_lonlat .fr_datetm .fr_suntime .fr_nighttm .fr_moontm -expand 1 -fill both -in .lf_dateinfo
pack .lf_dateinfo -expand 0 -fill x -padx 4 -pady 3 -in .fr_root_left


################################################################

labelframe .lf_setdate -text "Set Date Time" -font $font_labelframe

frame .fr_setdate

frame .fr_cb1
checkbutton .cb_setdate -text "入力" -variable flag_during_input_ldatetime -command "setup_ldatetime_field"
checkbutton .cb_immediate -text "即送信" -variable flag_immediate_input
pack .cb_immediate -side left -in .fr_cb1
frame .fr_cb2
#pack .cb_setdate -side left -in .fr_cb1
button .b_setdate -text "SEND" -command "send_ssc_ldatetime"
button .b_cancel -text "Cancel" -command "setup_ldatetime_field 0"
pack .b_setdate .b_cancel -side left -in .fr_cb2
pack .fr_cb1 -in .fr_setdate
pack .fr_cb2 -side left -padx 4 -in .fr_setdate

frame .fr_bpm_y
frame .fr_bp_y
button .bp_y3 -text "+" -font $font_pmbtn -bg $date_button_background -command "set_ldatetime_by_ymds 1000 0 0 0"
button .bp_y2 -text "+" -font $font_pmbtn -bg $date_button_background -command "set_ldatetime_by_ymds 100 0 0 0"
button .bp_y1 -text "+" -font $font_pmbtn -bg $date_button_background -command "set_ldatetime_by_ymds 10 0 0 0"
button .bp_y0 -text "+" -font $font_pmbtn -bg $date_button_background -command "set_ldatetime_by_ymds 1 0 0 0"
pack .bp_y3 .bp_y2 .bp_y1 .bp_y0 -side left -fill both -in .fr_bp_y
frame .fr_bm_y
button .bm_y3 -text "-" -font $font_pmbtn -bg $date_button_background -command "set_ldatetime_by_ymds -1000 0 0 0"
button .bm_y2 -text "-" -font $font_pmbtn -bg $date_button_background -command "set_ldatetime_by_ymds -100 0 0 0"
button .bm_y1 -text "-" -font $font_pmbtn -bg $date_button_background -command "set_ldatetime_by_ymds -10 0 0 0"
button .bm_y0 -text "-" -font $font_pmbtn -bg $date_button_background -command "set_ldatetime_by_ymds -1 0 0 0"
pack .bm_y3 .bm_y2 .bm_y1 .bm_y0 -side left -fill both -in .fr_bm_y
pack .fr_bp_y .fr_bm_y -expand 1 -fill both -in .fr_bpm_y

label .l_y_mm -text "-" -font $font_pmbtn

frame .fr_bpm_mm
frame .fr_bp_mm
button .bp_mm1 -text "+" -font $font_pmbtn -bg $date_button_background -command "set_ldatetime_by_ymds 0 10 0 0"
button .bp_mm0 -text "+" -font $font_pmbtn -bg $date_button_background -command "set_ldatetime_by_ymds 0 1 0 0"
pack .bp_mm1 .bp_mm0 -side left -fill both -in .fr_bp_mm
frame .fr_bm_mm
button .bm_mm1 -text "-" -font $font_pmbtn -bg $date_button_background -command "set_ldatetime_by_ymds 0 -10 0 0"
button .bm_mm0 -text "-" -font $font_pmbtn -bg $date_button_background -command "set_ldatetime_by_ymds 0 -1 0 0"
pack .bm_mm1 .bm_mm0 -side left -fill both -in .fr_bm_mm
pack .fr_bp_mm .fr_bm_mm -expand 1 -fill both -in .fr_bpm_mm

label .l_mm_d -text "-" -font $font_pmbtn

frame .fr_bpm_d
frame .fr_bp_d
button .bp_d1 -text "+" -font $font_pmbtn -bg $date_button_background -command "set_ldatetime_by_ymds 0 0 10 0"
button .bp_d0 -text "+" -font $font_pmbtn -bg $date_button_background -command "set_ldatetime_by_ymds 0 0 1 0"
pack .bp_d1 .bp_d0 -side left -fill both -in .fr_bp_d
frame .fr_bm_d
button .bm_d1 -text "-" -font $font_pmbtn -bg $date_button_background -command "set_ldatetime_by_ymds 0 0 -10 0"
button .bm_d0 -text "-" -font $font_pmbtn -bg $date_button_background -command "set_ldatetime_by_ymds 0 0 -1 0"
pack .bm_d1 .bm_d0 -side left -fill both -in .fr_bm_d
pack .fr_bp_d .fr_bm_d -expand 1 -fill both -in .fr_bpm_d

label .l_d_h -text "T" -font $font_pmbtn

frame .fr_bpm_h
frame .fr_bp_h
button .bp_h1 -text "+" -font $font_pmbtn -bg $time_button_background -command "set_ldatetime_by_ymds 0 0 0 36000"
button .bp_h0 -text "+" -font $font_pmbtn -bg $time_button_background -command "set_ldatetime_by_ymds 0 0 0 3600"
pack .bp_h1 .bp_h0 -side left -fill both -in .fr_bp_h
frame .fr_bm_h
button .bm_h1 -text "-" -font $font_pmbtn -bg $time_button_background -command "set_ldatetime_by_ymds 0 0 0 -36000"
button .bm_h0 -text "-" -font $font_pmbtn -bg $time_button_background -command "set_ldatetime_by_ymds 0 0 0 -3600"
pack .bm_h1 .bm_h0 -side left -fill both -in .fr_bm_h
pack .fr_bp_h .fr_bm_h -expand 1 -fill both -in .fr_bpm_h

label .l_h_m -text ":" -font $font_pmbtn

frame .fr_bpm_m
frame .fr_bp_m
button .bp_m1 -text "+" -font $font_pmbtn -bg $time_button_background -command "set_ldatetime_by_ymds 0 0 0 600"
button .bp_m0 -text "+" -font $font_pmbtn -bg $time_button_background -command "set_ldatetime_by_ymds 0 0 0 60"
pack .bp_m1 .bp_m0 -side left -fill both -in .fr_bp_m
frame .fr_bm_m
button .bm_m1 -text "-" -font $font_pmbtn -bg $time_button_background -command "set_ldatetime_by_ymds 0 0 0 -600"
button .bm_m0 -text "-" -font $font_pmbtn -bg $time_button_background -command "set_ldatetime_by_ymds 0 0 0 -60"
pack .bm_m1 .bm_m0 -side left -fill both -in .fr_bm_m
pack .fr_bp_m .fr_bm_m -expand 1 -fill both -in .fr_bpm_m

label .l_m_s -text ":" -font $font_pmbtn

frame .fr_bpm_s
frame .fr_bp_s
button .bp_s1 -text "+" -font $font_pmbtn -bg $time_button_background -command "set_ldatetime_by_ymds 0 0 0 10"
button .bp_s0 -text "+" -font $font_pmbtn -bg $time_button_background -command "set_ldatetime_by_ymds 0 0 0 1"
pack .bp_s1 .bp_s0 -side left -fill both -in .fr_bp_s
frame .fr_bm_s
button .bm_s1 -text "-" -font $font_pmbtn -bg $time_button_background -command "set_ldatetime_by_ymds 0 0 0 -10"
button .bm_s0 -text "-" -font $font_pmbtn -bg $time_button_background -command "set_ldatetime_by_ymds 0 0 0 -1"
pack .bm_s1 .bm_s0 -side left -fill both -in .fr_bm_s
pack .fr_bp_s .fr_bm_s -expand 1 -fill both -in .fr_bpm_s

pack .fr_setdate .fr_bpm_y .l_y_mm .fr_bpm_mm .l_mm_d .fr_bpm_d .l_d_h .fr_bpm_h .l_h_m .fr_bpm_m .l_m_s .fr_bpm_s -side left -expand 1 -fill both -in .lf_setdate

pack .lf_setdate -expand 0 -fill x -padx 4 -pady 3 -in .fr_root_left


########################################################################

panedwindow .pw -sashwidth 4
pack .pw -expand 1 -fill x -padx 3 -pady 2 -in .fr_root_left

########################################################################

frame .fr_planetsinfoall

####

labelframe .lf_planetsinfo0 -text "Planets Rise/Transit/Set" -font $font_labelframe

#frame .fr_planetslbl0
#label .l_planetslbl0  -text "    " -width 4
#label .l_planetslbl0r -text " 出 " -width 5
#label .l_planetslbl0s -text " 没 " -width 5
#pack .l_planetslbl0 .l_planetslbl0r .l_planetslbl0s -side left -expand 1 -fill x -in .fr_planetslbl0

frame .fr_mercurytime
label .l_mercurytime0 -text "水星" -width 4 -font $font_small
#label .l_mercurytime1 -text "出" -width 2 -font $font_small
label .l_mercuryrise -textvariable buffer_mercuryrise -width 5 -font $font_small
label .l_mercurytransit -textvariable buffer_mercurytransit -width 5 -font $font_small
label .l_mercuryset  -textvariable buffer_mercuryset -width 5 -font $font_small
#label .l_mercurytime2 -text "没" -width 2 -font $font_small
pack .l_mercurytime0 .l_mercuryrise .l_mercurytransit .l_mercuryset -side left -expand 1 -fill x -in .fr_mercurytime

frame .fr_venustime
label .l_venustime0 -text "金星" -width 4 -font $font_small
#label .l_venustime1 -text "出" -width 2 -font $font_small
label .l_venusrise -textvariable buffer_venusrise -width 5 -font $font_small
label .l_venustransit  -textvariable buffer_venustransit  -width 5 -font $font_small
label .l_venusset  -textvariable buffer_venusset  -width 5 -font $font_small
#label .l_venustime2 -text "没" -width 2 -font $font_small
pack .l_venustime0 .l_venusrise .l_venustransit .l_venusset -side left -expand 1 -fill x -in .fr_venustime

frame .fr_marstime
label .l_marstime0 -text "火星" -width 4 -font $font_small
#label .l_marstime1 -text "出" -width 2 -font $font_small
label .l_marsrise -textvariable buffer_marsrise -width 5 -font $font_small
label .l_marstransit -textvariable buffer_marstransit -width 5 -font $font_small
label .l_marsset  -textvariable buffer_marsset  -width 5 -font $font_small
#label .l_marstime2 -text "没" -width 2 -font $font_small
pack .l_marstime0 .l_marsrise .l_marstransit .l_marsset -side left -expand 1 -fill x -in .fr_marstime

button .b_plns_compact -text "コンパクト表示" -pady 0 -font $font_small -command "unset_detailed_planets_info"

pack .fr_mercurytime .fr_venustime .fr_marstime .b_plns_compact -expand 0 -fill x -in .lf_planetsinfo0

####

labelframe .lf_planetsinfo1 -text "Planets Rise/Transit/Set" -font $font_labelframe

#frame .fr_planetslbl1
#label .l_planetslbl1  -text "    " -width 4
#label .l_planetslbl1r -text " 出 " -width 5
#label .l_planetslbl1s -text " 没 " -width 5
#pack .l_planetslbl1 .l_planetslbl1r .l_planetslbl1s -side left -expand 1 -fill x -in .fr_planetslbl1

frame .fr_jupitertime
label .l_jupitertime0 -text "木星" -width 6 -font $font_small
#label .l_jupitertime1 -text "出" -width 2 -font $font_small
label .l_jupiterrise -textvariable buffer_jupiterrise -width 5 -font $font_small
label .l_jupitertransit  -textvariable buffer_jupitertransit  -width 5 -font $font_small
label .l_jupiterset  -textvariable buffer_jupiterset  -width 5 -font $font_small
#label .l_jupitertime2 -text "没" -width 2 -font $font_small
pack .l_jupitertime0 .l_jupiterrise .l_jupitertransit .l_jupiterset -side left -expand 1 -fill x -in .fr_jupitertime

frame .fr_saturntime
label .l_saturntime0 -text "土星" -width 6 -font $font_small
#label .l_saturntime1 -text "出" -width 2 -font $font_small
label .l_saturnrise -textvariable buffer_saturnrise -width 5 -font $font_small
label .l_saturntransit  -textvariable buffer_saturntransit  -width 5 -font $font_small
label .l_saturnset  -textvariable buffer_saturnset  -width 5 -font $font_small
#label .l_saturntime2 -text "没" -width 2 -font $font_small
pack .l_saturntime0 .l_saturnrise .l_saturntransit .l_saturnset -side left -expand 1 -fill x -in .fr_saturntime

frame .fr_uranustime
label .l_uranustime0 -text "天王星" -width 6 -font $font_small
#label .l_uranustime1 -text "出" -width 2 -font $font_small
label .l_uranusrise -textvariable buffer_uranusrise -width 5 -font $font_small
label .l_uranustransit  -textvariable buffer_uranustransit  -width 5 -font $font_small
label .l_uranusset  -textvariable buffer_uranusset  -width 5 -font $font_small
#label .l_uranustime2 -text "没" -width 2 -font $font_small
pack .l_uranustime0 .l_uranusrise .l_uranustransit .l_uranusset -side left -expand 1 -fill x -in .fr_uranustime

frame .fr_neptunetime
label .l_neptunetime0 -text "海王星" -width 6 -font $font_small
#label .l_neptunetime1 -text "出" -width 2 -font $font_small
label .l_neptunerise -textvariable buffer_neptunerise -width 5 -font $font_small
label .l_neptunetransit  -textvariable buffer_neptunetransit  -width 5 -font $font_small
label .l_neptuneset  -textvariable buffer_neptuneset  -width 5 -font $font_small
#label .l_neptunetime2 -text "没" -width 2 -font $font_small
pack .l_neptunetime0 .l_neptunerise .l_neptunetransit .l_neptuneset -side left -expand 1 -fill x -in .fr_neptunetime

pack .fr_jupitertime .fr_saturntime .fr_uranustime .fr_neptunetime -expand 0 -fill both -in .lf_planetsinfo1

####

pack .lf_planetsinfo0 .lf_planetsinfo1 -side left -expand 1 -fill both -in .fr_planetsinfoall

#pack .fr_planetsinfoall -expand 0 -fill x -padx 4 -pady 3 -in .fr_root_left

#.pw add .fr_planetsinfoall


########################################################################

frame .fr_planetsinfo

####

labelframe .lf00_planetsinfo -text "Planets Rise/Set" -font $font_labelframe
#labelframe .lf00_planetsinfo -text "Planets Rise/Transit/Set" -font $font_labelframe

button .b_plns_all -text "詳" -font $font_small -padx 0 -pady 0 -command "set_detailed_planets_info"

####

frame .fr00_venustime
label .l00_venustime0 -text " 金星" -width 5 -font $font_small
label .l00_venusrise -textvariable buffer_venusrise -width 5 -font $font_small
label .l00_venustransit  -textvariable buffer_venustransit  -width 5 -font $font_small
label .l00_venusset  -textvariable buffer_venusset  -width 5 -font $font_small
pack .l00_venustime0 .l00_venusrise .l00_venusset -side left -expand 1 -in .fr00_venustime
#pack .l00_venustime0 .l00_venusrise .l00_venustransit .l00_venusset -side left -expand 1 -in .fr00_venustime

frame .fr00_jupitertime
label .l00_jupitertime0 -text " 木星" -width 5 -font $font_small
label .l00_jupiterrise -textvariable buffer_jupiterrise -width 5 -font $font_small
label .l00_jupitertransit  -textvariable buffer_jupitertransit  -width 5 -font $font_small
label .l00_jupiterset  -textvariable buffer_jupiterset  -width 5 -font $font_small
pack .l00_jupitertime0 .l00_jupiterrise .l00_jupiterset -side left -expand 1 -in .fr00_jupitertime
#pack .l00_jupitertime0 .l00_jupiterrise .l00_jupitertransit .l00_jupiterset -side left -expand 1 -in .fr00_jupitertime

frame .fr00_saturntime
label .l00_saturntime0 -text " 土星" -width 5 -font $font_small
label .l00_saturnrise -textvariable buffer_saturnrise -width 5 -font $font_small
label .l00_saturntransit  -textvariable buffer_saturntransit  -width 5 -font $font_small
label .l00_saturnset  -textvariable buffer_saturnset  -width 5 -font $font_small
pack .l00_saturntime0 .l00_saturnrise .l00_saturnset -side left -expand 1 -in .fr00_saturntime
#pack .l00_saturntime0 .l00_saturnrise .l00_saturntransit .l00_saturnset -side left -expand 1 -in .fr00_saturntime

pack .b_plns_all -side left -expand 0 -fill x -in .lf00_planetsinfo
pack .fr00_venustime .fr00_jupitertime .fr00_saturntime -side left -expand 1 -fill x -in .lf00_planetsinfo
#pack .b_plns_all .fr00_jupitertime .fr00_saturntime -side left -expand 1 -fill x -in .lf00_planetsinfo

####

pack .lf00_planetsinfo -side left -expand 1 -fill both -in .fr_planetsinfo

.pw add .fr_planetsinfo


################################################################

labelframe .lf_pcinfo -text "PC Info" -font $font_labelframe -fg $pcinfo_foreground

frame .fr_pc_datetm
frame .fr_pc_datetm_l0
button .b_pcdatetm -text "To Form" -width 8 -font $font_small -command "set_pcdatetime"
label .l_pcdatetm -text "PC日時" -width 8 -fg $pcinfo_foreground
label .l_pcdate -textvariable buffer_pcdate_label -width 14 -fg $pcinfo_foreground
label .l_pctime -textvariable buffer_pctime_label -width 12 -fg $pcinfo_foreground
if { $flag_dome_mode == 0 } {
  pack .l_pcdatetm -side left -expand 1 -fill x -in .fr_pc_datetm_l0
  pack .b_pcdatetm -side left -expand 0 -fill x -in .fr_pc_datetm_l0
  pack .fr_pc_datetm_l0 .l_pcdate .l_pctime -expand 0 -fill x -in .fr_pc_datetm
} else {
  pack .b_pcdatetm .l_pcdatetm -side left -expand 0 -fill x -in .fr_pc_datetm_l0
  pack .fr_pc_datetm_l0 .l_pcdate .l_pctime -side left -expand 1 -fill x -in .fr_pc_datetm
}

pack .fr_pc_datetm -expand 1 -fill both -in .lf_pcinfo


################################################################

labelframe .lf_scheduling -text "Scheduling" -font $font_labelframe

checkbutton .cb_lightmoon -text "月明/光害を制御" -font $font_scheduling -variable flag_light_moon_pollution
checkbutton .cb_astrodawn -text "朝薄明で太陽系ON" -font $font_scheduling -variable flag_astronomical_dawn

pack .cb_lightmoon .cb_astrodawn -side left -fill both -in .lf_scheduling


########################################################################

labelframe .lf_timelst -text "List of User's Time" -font $font_labelframe

frame .fr_tml_lbl
label .l_timelst -text "ユーザ時刻送信" -font $font_small
button .b_tml_edit -text "編集" -padx 0 -pady 0 -font $font_small -command "exec -ignorestderr $text_editor $config_list_start_time &"
checkbutton .cb_tml_today -text "本日日付も送信" -font $font_scheduling -variable flag_send_today_with_users_time

if { $flag_dome_mode == 0 } {
  pack .l_timelst -expand 1 -side left -fill x -in .fr_tml_lbl
  pack .b_tml_edit -expand 0 -side left -fill x -in .fr_tml_lbl
  pack .fr_tml_lbl -expand 0 -fill x -in .lf_timelst
  pack .cb_tml_today -expand 0 -fill x -in .lf_timelst
} else {
  pack .l_timelst -expand 1 -side left -fill x -in .fr_tml_lbl
  pack .cb_tml_today -expand 1 -side left -fill x -in .fr_tml_lbl
  pack .b_tml_edit -expand 0 -side left -fill x -in .fr_tml_lbl
  pack .fr_tml_lbl -expand 0 -fill x -in .lf_timelst
}

frame .fr_tml_spc -height 2
pack .fr_tml_spc -expand 0 -fill x -in .lf_timelst

#

array set timelist {}

if { [catch {open $config_list_start_time r} fid] } {
  # do nothing
} else {
  set i 0
  while { [gets $fid line] >= 0 } {
    set s [string trim $line]
    if { [string length $s] != 0 && [string index $s 0] ne "#" } {
      set status [regexp -- {^([0-9]+)[ ]*[:][ ]*([0-9]+)} $s match h0 m0]
      if { $status == 1 } {
        set h1 [expr $h0 % 24]
        set m1 [expr $m0 % 60]
        set timelist($i) [format "%2d:%02d" $h1 $m1]
        incr i
      } else {
        set status [regexp -- {^([A-Za-z]+)[ ]*} $s match s0]
        if { $status == 1 } {
          if { [string tolower $s0] eq "now" } {
            set timelist($i) "-"
            incr i
          }
        }
      }
    }
  }
  close $fid
}

if { [array size timelist] == 0 } {
  set timelist(0) "-"
  set timelist(1) "20:00"
}

#

if { $flag_dome_mode == 0 } {
  set len_col 3
} else {
  set len_col 8
}
set len_timelist [array size timelist]
set fr_id 0
set m [expr $len_timelist % $len_col]

if { $m == 0 } {
  set i_len $len_timelist
} else {
  set i_len [expr $len_timelist + $len_col - $m]
}

for {set i 0} {$i < $i_len} {incr i} {

  set m [expr $i % $len_col]
  if { $m == 0 } {
    set fr_id [expr $i / $len_col]
    frame .fr_tml_$fr_id
  }

  if { $i < $len_timelist } {
    if { $timelist($i) eq "-" } {
      button .b_tml_$i -text " NOW " -font $font_small -padx 0 -pady 0 -command "set_start_time $timelist($i)"
    } else {
      button .b_tml_$i -text $timelist($i) -font $font_small -padx 0 -pady 0 -command "set_start_time $timelist($i)"
    }
  } else {
    button .b_tml_$i -padx 0 -pady 0 -text "--:--" -font $font_small
  }
  pack .b_tml_$i -expand 1 -side left -fill x -in .fr_tml_$fr_id

  incr m
  if { $m == $len_col } {
    pack .fr_tml_$fr_id -expand 0 -fill x -in .lf_timelst
  }

}

################################################################

labelframe .lf_internal -text "Internal Info" -font $font_labelframe

entry .e_debug -textvariable buffer_internal_info -font $font_internal -justify left
pack .e_debug -expand 1 -fill both -in .lf_internal


########################################################################

# PC日時、時刻設定ボタンの配置
# - Navigationモード : 右側に縦長で表示
# - Domeモード :       下側に横長で表示

if { $flag_dome_mode == 0 } {
  pack .lf_scheduling -expand 0 -fill x -padx 4 -pady 3 -in .fr_root_left
  pack .lf_internal -expand 1 -fill x -padx 4 -pady 3 -in .fr_root_left
  pack .fr_root_left -expand 0 -side left -padx 0 -pady 0 -in .fr_rootwin
  pack .lf_pcinfo -expand 0 -fill x -padx 4 -pady 3 -in .fr_rootwin
  pack .lf_timelst -expand 1 -fill both -padx 4 -pady 3 -in .fr_rootwin
} else {
  pack .lf_pcinfo -expand 0 -fill x -padx 4 -pady 3 -in .fr_root_left
  pack .lf_scheduling -expand 0 -fill x -padx 4 -pady 3 -in .fr_root_left
  pack .lf_timelst -expand 0 -fill x -padx 4 -pady 3 -in .fr_root_left
  pack .lf_internal -expand 0 -fill x -padx 4 -pady 3 -in .fr_root_left
  pack .fr_root_left -expand 0 -padx 0 -pady 0 -in .fr_rootwin
}

########################################################################

pack .fr_rootwin

########################################################################


# 無限ループ
show_date_time_info

