From CCP4 wiki
Revision as of 23:13, 9 February 2008 by Wgscott (talk | contribs) (Here moved to Coot-scheme1: had a stupid name)
(diff) ← Older revision | Latest revision (diff) | Newer revision → (diff)
Jump to navigation Jump to search
;; A demo gui to move about to molecules.
(define (molecule-centres-gui)

  ;; first, we create a window and a frame to be put into it.
  ;; we create a vbox (a vertical box container) that will contain the
  ;; buttons for each of the coordinate molecules
  (let* ((window (gtk-window-new 'toplevel))
	 (frame (gtk-frame-new "Molecule Centres"))
	 (vbox (gtk-vbox-new #f 3)))

    ;; add the frame to the window and the vbox to the frame
    (gtk-container-add window frame)
    (gtk-container-add frame vbox)
    (gtk-container-border-width vbox 6)

    ;; for each molecule, test if this is a molecule that has a
    ;; molecule (it might have been closed or contain a map).  The we
    ;; construct a button label that is the molecule number and the
    ;; molecule name and create a button with that label.
    ;; then we attach a signal to the "clicked" event on the newly
    ;; created button.  In the function that subsequently happen (on a
    ;; click) we add a text message to the status bar and set the
    ;; graphics rotation centre to the centre of the molecule.  Each
    ;; of these buttons is packed into the vbox (the #f #f means no
    ;; expansion and no filling).  The padding round each button is 3
    ;; pixels.
     (lambda (molecule-number)

       (if (is-valid-model-molecule? molecule-number)
	   (let* ((name (molecule-name molecule-number))
		  (label (string-append (number->string molecule-number) " " name))
		  (button (gtk-button-new-with-label label)))
	     (gtk-signal-connect button "clicked"
				 (lambda args
				   (let ((s (format #f "Centred on ~a" label)))
				     (add-status-bar-text s)
				     (apply set-rotation-centre (molecule-centre molecule-number)))))

	     (gtk-box-pack-start vbox button #f #f 3)
	     (gtk-widget-show button))))

    (gtk-widget-show-all window)))