format/default to support lib.ivannp

format_default

#
# Copyright (C) 1996-2001, Thomas Andrews
#
# $Id: default 277 2008-10-27 17:36:14Z thomasoa $
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
# 
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
# 
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
#
# This is set up to make output look like an okbridge screen.
#
set board_info [ list ]
set comments [ list ]

namespace eval formatter {
    variable loc
    set loc(row:east) 4
    set loc(col:east) 19
    set loc(row:north) 0
    set loc(col:north) 10
    set loc(row:west) 4
    set loc(col:west) 1
    set loc(row:south) 8
    set loc(col:south) 10
    variable suitletters [list S: H: D: C:]
    variable suitsunicode [list "\u2660" "\u2665" "\u2666" "\u2663"]
    variable suitsymbols $suitletters
    variable voidsymbol "---"

    stringbox ::formatter::writer 12 60

    foreach hand {north east west south} {
	::formatter::writer subbox ::formatter::writer.$hand $loc(row:$hand) $loc(col:$hand) 4 16
    }

    proc puthand {hand} {
        variable suitsymbols
        variable voidsymbol
	writer.$hand  clear
	set row 0
	foreach suit {spades hearts diamonds clubs} symbol $suitsymbols {
	    
writer.$hand write $row 0 "$symbol [$hand -void $voidsymbol $suit]"
	    incr row
	}
    }	

    proc write_deal {} {
	foreach hand {north east south west} {
	    puthand $hand
	}
	puts stdout [writer compact]
    }
}

if {$deal::unicode && [info exists env(LANG)] && [string first "UTF-8" [string toupper $env(LANG)]]>=0} {
   set ::formatter::suitsymbols $::formatter::suitsunicode
}

proc clear_board_info { } {
   global board_info

   set board_info [ list ]
}

proc append_board_info { comment } {
   global board_info

   lappend board_info $comment
}

proc clear_comments { } {
   global comments

   set comments [ list ]
}

proc append_comment { comment } {
   global comments

   lappend comments $comment
}

proc write_deal {} {
   global comments
   global board_info

   set len [ llength $board_info ]
   if { $len > 0 } {
      foreach comment $board_info {
         puts "$comment"
      }
      puts ""
   }

   formatter::write_deal

   set len [ llength $comments ]
   if { $len > 0 } {
      puts ""
      foreach comment $comments {
         puts "$comment"
      }
   }
    puts stdout "--------------------------"
}

proc flush_deal {} {
}