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