chiark - git - mdw - jlisp/blob - rolling.lisp

   1 ;;; -*-lisp-*-
   2 ;;;
   3 ;;; Compute rectangular-section wire sizes
   4 ;;;
   5 ;;; (c) 2007 Mark Wooding
   6 ;;;
   7
   8 ;;;----- Licensing notice ---------------------------------------------------
   9 ;;;
  10 ;;; This program is free software; you can redistribute it and/or modify
  11 ;;; it under the terms of the GNU General Public License as published by
  12 ;;; the Free Software Foundation; either version 2 of the License, or
  13 ;;; (at your option) any later version.
  14 ;;;
  15 ;;; This program is distributed in the hope that it will be useful,
  16 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;;; GNU General Public License for more details.
  19 ;;;
  20 ;;; You should have received a copy of the GNU General Public License
  21 ;;; along with this program; if not, write to the Free Software Foundation,
  22 ;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  23
  24 (install-dep-syntax)
  25
  26 (defwindow rolling-window () ("Rolling")
  27   (let* ((width (make-dep))
  28          (thick (make-dep))
  29          (length (make-dep))
  30          (stock-type (make-dep :round))
  31          (stock-size (make-dep))
  32          (volume #[(* ?width ?thick ?length)])
  33          (stock-length #[(/ ?volume
  34                             (case ?stock-type
  35                               (:round (* 1/4 pi (expt ?stock-size 2)))
  36                               (:square (expt ?stock-size 2))
  37                               (t (dep-bad))))])
  38          (sq-size #[(expt (* (expt ?width 2) ?thick) 1/3)])
  39          (rnd-diam #[(/ (* 2 ?sq-size) (sqrt pi))])
  40          (start-length #[(/ ?volume (expt ?sq-size 2))]))
  41     (within-group ("Required size")
  42       (make-input "Width:" width)
  43       (make-input "Thickness:" thick)
  44       (make-input "Length:" length))
  45     (within-group ("You should start with")
  46       (make-output "Square side:" sq-size)
  47       (make-output "Round diameter:" rnd-diam)
  48       (make-output "Length:" start-length))
  49     (within-group ("Initial stock")
  50       (make-radio-dep stock-type
  51                       '(:round "Round section"
  52                         :square "Square section"))
  53       (make-input "Stock size:" stock-size)
  54       (make-output "Stock length:" stock-length))
  55     #+ no
  56     (within-group ("Other data")
  57       (make-output "Volume:" volume))))
  58
  59 (rolling-window)
  60
  61 ;;;----- That's all, folks --------------------------------------------------