# glennj's solution

## to Diamond in the Tcl Track

Published at May 15 2020 · 0 comments
Instructions
Test suite
Solution

#### Note:

This exercise has changed since this solution was written.

The diamond kata takes as its input a letter, and outputs it in a diamond shape. Given a letter, it prints a diamond starting with 'A', with the supplied letter at the widest point.

## Requirements

• The first row contains one 'A'.
• The last row contains one 'A'.
• All rows, except the first and last, have exactly two identical letters.
• All rows have as many trailing spaces as leading spaces. (This might be 0).
• The diamond is horizontally symmetric.
• The diamond is vertically symmetric.
• The diamond has a square shape (width equals height).
• The letters form a diamond shape.
• The top half has the letters in ascending order.
• The bottom half has the letters in descending order.
• The four corners (containing the spaces) are triangles.

## Examples

In the following examples, spaces are indicated by `路` characters.

Diamond for letter 'A':

``````A
``````

Diamond for letter 'C':

``````路路A路路

C路路路C

``````

Diamond for letter 'E':

``````路路路路A路路路路

E路路路路路路路E

``````

## Submitting Incomplete Solutions

It's possible to submit an incomplete solution so you can see how others have completed the exercise.

## Running the tests

To run the test suite, execute one of the following commands:

``````tclsh diamond.test            # Will stop testing after the first failure.
RUN_ALL=1 tclsh diamond.test  # Will run all tests and report all failures.
``````

## Feedback, Issues, Pull Requests

The exercism/tcl repository on GitHub is the home for all of the Tcl exercises on Exercism.

If you have feedback about an exercise, or want to help implementing a new one, head over there and create an issue. We'll do our best to help you!

## Source

### diamond.test

``````#!/usr/bin/env tclsh
set version 1.1.0
package require tcltest
namespace import ::tcltest::*
source "diamond.tcl"

proc fail_fast {} {
return [expr {
![info exists ::env(RUN_ALL)]
|| [string is boolean -strict \$::env(RUN_ALL)]
&& !\$::env(RUN_ALL)
}]
}

proc failed {} {
return [expr {\$::tcltest::numTests(Failed) > 0}]
}

if {[fail_fast]} {
proc test args {
if {[failed]} {::tcltest::configure -skip *}
uplevel [list ::tcltest::test {*}\$args]
}
}

proc cleanupTests {} {
set failed [failed]
uplevel 1 ::tcltest::cleanupTests
if {\$failed} {exit 1}
}

if {\$::argv0 eq [info script]} {

test diamond-1 "Degenerate case with a single 'A' row" -body {
diamond  "A"
} -returnCodes ok -result "A"

test diamond-2 "Degenerate case with no row containing 3 distinct groups of spaces" -body {
diamond  "B"
} -returnCodes ok -result [join {
" A "
"B B"
" A "
} \n]

test diamond-3 "Smallest non-degenerate case with odd diamond side length" -body {
diamond  "C"
} -returnCodes ok -result [join {
"  A  "
" B B "
"C   C"
" B B "
"  A  "
} \n]

test diamond-4 "Smallest non-degenerate case with even diamond side length" -body {
diamond  "D"
} -returnCodes ok -result [join {
"   A   "
"  B B  "
" C   C "
"D     D"
" C   C "
"  B B  "
"   A   "
} \n]

test diamond-1 "Largest possible diamond" -body {
diamond  "Z"
} -returnCodes ok -result [join {
"                         A                         "
"                        B B                        "
"                       C   C                       "
"                      D     D                      "
"                     E       E                     "
"                    F         F                    "
"                   G           G                   "
"                  H             H                  "
"                 I               I                 "
"                J                 J                "
"               K                   K               "
"              L                     L              "
"             M                       M             "
"            N                         N            "
"           O                           O           "
"          P                             P          "
"         Q                               Q         "
"        R                                 R        "
"       S                                   S       "
"      T                                     T      "
"     U                                       U     "
"    V                                         V    "
"   W                                           W   "
"  X                                             X  "
" Y                                               Y "
"Z                                                 Z"
" Y                                               Y "
"  X                                             X  "
"   W                                           W   "
"    V                                         V    "
"     U                                       U     "
"      T                                     T      "
"       S                                   S       "
"        R                                 R        "
"         Q                               Q         "
"          P                             P          "
"           O                           O           "
"            N                         N            "
"             M                       M             "
"              L                     L              "
"               K                   K               "
"                J                 J                "
"                 I               I                 "
"                  H             H                  "
"                   G           G                   "
"                    F         F                    "
"                     E       E                     "
"                      D     D                      "
"                       C   C                       "
"                        B B                        "
"                         A                         "
} \n]

cleanupTests
}``````
``````proc diamond {letter} {
set alphabet {A B C D E F G H I J K L M N O P Q R S T U V W X Y Z}
set n [lsearch -exact \$alphabet \$letter]
if {\$n == -1} then {error "invalid input"}

set height [expr {2 * \$n + 1}]
set result [lrepeat \$height [lrepeat \$height " "]]

for {set i 0; set j \$n} {\$i <= \$n} {incr i; incr j -1} {
set letter [lindex \$alphabet \$i]
lset result     \$i     \$j \$letter
lset result     \$i end-\$j \$letter
lset result end-\$i     \$j \$letter
lset result end-\$i end-\$j \$letter
}

return [join [lmap row \$result {join \$row ""}] \n]
}``````