wl

Unnamed repository; edit this file 'description' to name the repository.
git clone https://logand.com/git/wl.git/
Log | Files | Refs | LICENSE

swing6.l (2259B)

      1 # http://life.csu.edu.au/java-tut/uiswing/learn/example-1dot4/LunarPhases.java
      2 # http://life.csu.edu.au/java-tut/uiswing/learn/example-1dot4/images/image0.jpg
      3 
      4 (load "swing.l")
      5 
      6 (println "@@@@@@@@@@@" I)
      7 (setq I ## TODO bug here?
      8    #(fmap '((X) (cons X X)) '(0 1 2 3 4 5 6 7))
      9    'fmap)
     10 (println "@@@@@@@@@@@" I)
     11 
     12 (setq I
     13    (fmap '((X) (cons X (jnew ImageIcon (pack "image" X ".jpg")))) '(0 1 2 3 4 5 6 7)) )
     14 
     15 (JFrame 'setDefaultLookAndFeelDecorated true)
     16 (setq F (jnew JFrame "Lunar Phases")
     17       S (jnew JPanel)
     18       D (jnew JPanel)
     19       M (jnew JPanel)
     20       L (jnew JLabel)
     21       C (jnew JComboBox
     22            (jvector "New" "Waxing Crescent" "First Quarter" "Waxing Gibbous"
     23               "Full" "Waning Gibbous" "Third Quarter" "Waning Crescent" ) ) )
     24 
     25 (de onCombo (M E)
     26    (job '((L . `L) (C . `C) (I . `I))
     27       (when (= "comboBoxChanged" (E 'getActionCommand))
     28          (L 'setIcon (cdr (assoc (jnum (C 'getSelectedIndex)) I))) ) ) )
     29 
     30 (F 'setDefaultCloseOperation (jfield JFrame 'EXIT_ON_CLOSE))
     31 (F 'setContentPane M)
     32 (M 'setLayout (jnew BoxLayout M (jfield BoxLayout 'PAGE_AXIS)))
     33 (M 'setBorder (BorderFactory 'createEmptyBorder 5 5 5 5))
     34 (M 'add S)
     35 (M 'add D)
     36 (L 'setHorizontalAlignment (jfield JLabel 'CENTER))
     37 (L 'setVerticalAlignment (jfield JLabel 'CENTER))
     38 (L 'setVerticalTextPosition (jfield JLabel 'CENTER))
     39 (L 'setHorizontalTextPosition (jfield JLabel 'CENTER))
     40 (L 'setBorder (BorderFactory 'createCompoundBorder
     41                  (BorderFactory 'createLoweredBevelBorder)
     42                  (BorderFactory 'createEmptyBorder 5 5 5 5) ) )
     43 (L 'setBorder (BorderFactory 'createCompoundBorder
     44                  (BorderFactory 'createEmptyBorder 0 0 10 0)
     45                  (L 'getBorder) ) )
     46 (C 'setSelectedIndex 3)
     47 (L 'setIcon (cdr (assoc 2 I)))
     48 (C 'addActionListener (jproxy NIL 'onCombo ActionListener))
     49 (L 'setText "")
     50 (S 'setBorder (BorderFactory 'createCompoundBorder
     51                  (BorderFactory 'createTitledBorder "Select Phase")
     52                  (BorderFactory 'createEmptyBorder 5 5 5 5) ) )
     53 (D 'setBorder (BorderFactory 'createCompoundBorder
     54                  (BorderFactory 'createTitledBorder "Display Phase")
     55                  (BorderFactory 'createEmptyBorder 5 5 5 5) ) )
     56 (D 'add L)
     57 (S 'add C)
     58 (F 'pack)
     59 (F 'setVisible true)