extra/periodic-table/periodic-table.factor

   1 ! Copyright (C) 2023 John Benediktsson
   2 ! See https://factorcode.org/license.txt for BSD license
   3
   4 USING: accessors assocs colors kernel math math.parser sequences
   5 ui ui.gadgets ui.gadgets.borders ui.gadgets.labels
   6 ui.gadgets.tracks ui.pens.solid ;
   7
   8 IN: periodic-table
   9
  10 SYMBOLS: +alkali-metal+ +alkaline-earth-metal+ +lanthanide+
  11     +actinide+ +transition-metal+ +unknown+
  12     +post-transition-metal+ +metalloid+ +reactive-non-metal+
  13     +halogen+ +noble-gas+ ;
  14
  15 CONSTANT: group-colors {
  16     { +alkali-metal+          COLOR: #ff6268 }
  17     { +alkaline-earth-metal+  COLOR: #ffddb2 }
  18     { +lanthanide+            COLOR: #ffbffb }
  19     { +actinide+              COLOR: #ff98c9 }
  20     { +transition-metal+      COLOR: #ffbfc1 }
  21     { +unknown+               COLOR: #cccccc }
  22     { +post-transition-metal+ COLOR: #999999 }
  23     { +metalloid+             COLOR: #cbcc9e }
  24     { +reactive-non-metal+    COLOR: #b6fda9 }
  25     { +halogen+               COLOR: #ffffa6 }
  26     { +noble-gas+             COLOR: #beffff }
  27 }
  28
  29 CONSTANT: elements {
  30     { "H" "Hydrogen" +reactive-non-metal+ }
  31     { "He" "Helium" +noble-gas+ }
  32     { "Li" "Lithium" +alkali-metal+ }
  33     { "Be" "Beryllium" +alkaline-earth-metal+ }
  34     { "B" "Boron" +metalloid+ }
  35     { "C" "Carbon" +reactive-non-metal+ }
  36     { "N" "Nitrogen" +reactive-non-metal+ }
  37     { "O" "Oxygen" +reactive-non-metal+ }
  38     { "F" "Fluorine" +reactive-non-metal+ }
  39     { "Ne" "Neon" +noble-gas+ }
  40     { "Na" "Sodium" +alkali-metal+ }
  41     { "Mg" "Magnesium" +alkaline-earth-metal+ }
  42     { "Al" "Aluminium" +post-transition-metal+ }
  43     { "Si" "Silicon" +metalloid+ }
  44     { "P" "Phosphorus" +reactive-non-metal+ }
  45     { "S" "Sulfur" +reactive-non-metal+ }
  46     { "Cl" "Chlorine" +reactive-non-metal+ }
  47     { "Ar" "Argon" +noble-gas+ }
  48     { "K" "Potassium" +alkali-metal+ }
  49     { "Ca" "Calcium" +alkaline-earth-metal+ }
  50     { "Sc" "Scandium" +transition-metal+ }
  51     { "Ti" "Titanium" +transition-metal+ }
  52     { "V" "Vanadium" +transition-metal+ }
  53     { "Cr" "Chromium" +transition-metal+ }
  54     { "Mn" "Manganese" +transition-metal+ }
  55     { "Fe" "Iron" +transition-metal+ }
  56     { "Co" "Cobalt" +transition-metal+ }
  57     { "Ni" "Nickel" +transition-metal+ }
  58     { "Cu" "Copper" +transition-metal+ }
  59     { "Zn" "Zinc" +post-transition-metal+ }
  60     { "Ga" "Gallium" +post-transition-metal+ }
  61     { "Ge" "Germanium" +metalloid+ }
  62     { "As" "Arsenic" +metalloid+ }
  63     { "Se" "Selenium" +reactive-non-metal+ }
  64     { "Br" "Bromine" +reactive-non-metal+ }
  65     { "Kr" "Krypton" +noble-gas+ }
  66     { "Rb" "Rubidium" +alkali-metal+ }
  67     { "Sr" "Strontium" +alkaline-earth-metal+ }
  68     { "Y" "Yttrium" +transition-metal+ }
  69     { "Zr" "Zirconium" +transition-metal+ }
  70     { "Nb" "Niobium" +transition-metal+ }
  71     { "Mo" "Molybdenum" +transition-metal+ }
  72     { "Tc" "Technetium" +transition-metal+ }
  73     { "Ru" "Ruthenium" +transition-metal+ }
  74     { "Rh" "Rhodium" +transition-metal+ }
  75     { "Pd" "Palladium" +transition-metal+ }
  76     { "Ag" "Silver" +transition-metal+ }
  77     { "Cd" "Cadmium" +post-transition-metal+ }
  78     { "In" "Indium" +post-transition-metal+ }
  79     { "Sn" "Tin" +post-transition-metal+ }
  80     { "Sb" "Antimony" +metalloid+ }
  81     { "Te" "Tellurium" +metalloid+ }
  82     { "I" "Iodine" +reactive-non-metal+ }
  83     { "Xe" "Xenon" +noble-gas+ }
  84     { "Cs" "Caesium" +alkali-metal+ }
  85     { "Ba" "Barium" +alkaline-earth-metal+ }
  86     { "La" "Lanthanum" +lanthanide+ }
  87     { "Ce" "Cerium" +lanthanide+ }
  88     { "Pr" "Praseodymium" +lanthanide+ }
  89     { "Nd" "Neodymium" +lanthanide+ }
  90     { "Pm" "Promethium" +lanthanide+ }
  91     { "Sm" "Samarium" +lanthanide+ }
  92     { "Eu" "Europium" +lanthanide+ }
  93     { "Gd" "Gadolinium" +lanthanide+ }
  94     { "Tb" "Terbium" +lanthanide+ }
  95     { "Dy" "Dysprosium" +lanthanide+ }
  96     { "Ho" "Holmium" +lanthanide+ }
  97     { "Er" "Erbium" +lanthanide+ }
  98     { "Tm" "Thulium" +lanthanide+ }
  99     { "Yb" "Ytterbium" +lanthanide+ }
 100     { "Lu" "Lutetium" +lanthanide+ }
 101     { "Hf" "Hafnium" +transition-metal+ }
 102     { "Ta" "Tantalum" +transition-metal+ }
 103     { "W" "Tungsten" +transition-metal+ }
 104     { "Re" "Rhenium" +transition-metal+ }
 105     { "Os" "Osmium" +transition-metal+ }
 106     { "Ir" "Iridium" +transition-metal+ }
 107     { "Pt" "Platinum" +transition-metal+ }
 108     { "Au" "Gold" +transition-metal+ }
 109     { "Hg" "Mercury" +post-transition-metal+ }
 110     { "Tl" "Thallium" +post-transition-metal+ }
 111     { "Pb" "Lead" +post-transition-metal+ }
 112     { "Bi" "Bismuth" +post-transition-metal+ }
 113     { "Po" "Polonium" +post-transition-metal+ }
 114     { "At" "Astatine" +post-transition-metal+ }
 115     { "Rn" "Radon" +noble-gas+ }
 116     { "Fr" "Francium" +alkali-metal+ }
 117     { "Ra" "Radium" +alkaline-earth-metal+ }
 118     { "Ac" "Actinium" +actinide+ }
 119     { "Th" "Thorium" +actinide+ }
 120     { "Pa" "Protactinium" +actinide+ }
 121     { "U" "Uranium" +actinide+ }
 122     { "Np" "Neptunium" +actinide+ }
 123     { "Pu" "Plutonium" +actinide+ }
 124     { "Am" "Americium" +actinide+ }
 125     { "Cm" "Curium" +actinide+ }
 126     { "Bk" "Berkelium" +actinide+ }
 127     { "Cf" "Californium" +actinide+ }
 128     { "Es" "Einsteinium" +actinide+ }
 129     { "Fm" "Fermium" +actinide+ }
 130     { "Md" "Mendelevium" +actinide+ }
 131     { "No" "Nobelium" +actinide+ }
 132     { "Lr" "Lawrencium" +actinide+ }
 133     { "Rf" "Rutherfordium" +transition-metal+ }
 134     { "Db" "Dubnium" +transition-metal+ }
 135     { "Sg" "Seaborgium" +transition-metal+ }
 136     { "Bh" "Bohrium" +transition-metal+ }
 137     { "Hs" "Hassium" +transition-metal+ }
 138     { "Mt" "Meitnerium" +unknown+ }
 139     { "Ds" "Darmstadtium" +unknown+ }
 140     { "Rg" "Roentgenium" +unknown+ }
 141     { "Cn" "Copernicium" +post-transition-metal+ }
 142     { "Nh" "Nihonium" +unknown+ }
 143     { "Fl" "Flerovium" +unknown+ }
 144     { "Mc" "Moscovium" +unknown+ }
 145     { "Lv" "Livermorium" +unknown+ }
 146     { "Ts" "Tennesine" +unknown+ }
 147     { "Og" "Oganesson" +unknown+ }
 148 }
 149
 150 CONSTANT: periodic-table {
 151     {   1   f   f   f   f   f   f   f   f   f   f   f   f   f   f   f   f   2 }
 152     {   3   4   f   f   f   f   f   f   f   f   f   f   5   6   7   8   9  10 }
 153     {  11  12   f   f   f   f   f   f   f   f   f   f  13  14  15  16  17  18 }
 154     {  19  20  21  22  23  24  25  26  27  28  29  30  31  32  33  34  35  36 }
 155     {  37  38  39  40  41  42  43  44  45  46  47  48  49  50  51  52  53  54 }
 156     {  55  56  57  72  73  74  75  76  77  78  79  80  81  82  83  84  85  86 }
 157     {  87  88  89 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 }
 158     f
 159     {   f   f   f  58  59  60  61  62  63  64  65  66  67  68  69  70  71   f }
 160     {   f   f   f  90  91  92  93  94  95  96  97  98  99 100 101 102 103   f }
 161 }
 162
 163 :: <element> ( atomic-number symbol name -- gadget )
 164     vertical <track>
 165     atomic-number number>string <label>
 166         [ 10 >>size ] change-font f track-add
 167     symbol <label> [ t >>bold? ] change-font f track-add
 168     name <label> [ 8 >>size ] change-font f track-add ;
 169
 170 : <legend> ( -- gadget )
 171     horizontal <track> { 3 3 } >>gap
 172     group-colors [
 173         [ name>> rest but-last <label> { 3 3 } <border> ]
 174         [ <solid> >>interior ] bi*
 175         f track-add
 176     ] assoc-each ;
 177
 178 : <periodic-table> ( -- gadget )
 179     vertical <track> { 3 3 } >>gap
 180     periodic-table [
 181         horizontal <track> { 3 3 } >>gap swap
 182         [
 183             [
 184                 [
 185                     dup 1 - elements nth first3
 186                     [ <element> ] [ group-colors at ] bi*
 187                 ] [
 188                     "" <label> f
 189                 ] if*
 190                 [ { 40 35 } >>pref-dim { 5 5 } <border> ]
 191                 [ [ <solid> >>interior ] when* ] bi*
 192                 f track-add
 193             ] each
 194         ] [
 195             "" <label> { 20 20 } >>pref-dim f track-add
 196         ] if*
 197         f track-add
 198     ] each <legend> f track-add ;
 199
 200 MAIN-WINDOW: periodic-table-window
 201     { { title "Periodic Table" } }
 202     <periodic-table> { 5 5 } <border> >>gadgets ;