home *** CD-ROM | disk | FTP | other *** search
/ BUG 15 / BUGCD1998_06.ISO / aplic / felixcad / fcaddata.z / FLX_SETP.LSP < prev    next >
Lisp/Scheme  |  1996-09-30  |  7KB  |  167 lines
  1. ;;; FLX_SETP.LSP
  2. ;;; ================================================================
  3. ;;; Drawing Setup Dialog for FelixCAD
  4. ;;; ================================================================
  5. ;;; Created: Sept 01, 1996 / vp
  6. ;;; Changed: Sept 29, 1996 / vp
  7. ;;; ================================================================
  8. ;;; Note: This routine is called by FLX_MAIN.LSP
  9. ;;; ================================================================
  10.  
  11. (defun FLX_SETUP ( / DlgInit prefix n i lun_lst aun_lst
  12.                      auprec luprec aunits lunits angdir) 
  13.   (defun *error*(msg)
  14.      (setq *error* nil)
  15.      (princ)
  16.   )
  17.   (setq prefix (if (= (getvar "ACTDB") -1) "DEF" ""))
  18.   (setq lun_lst (list 
  19.      "Decimal"                          ; 2 -> 0
  20.      "Fractional"                       ; 5 -> 1
  21.      "Architectural (feet and inches)"  ; 4 -> 2
  22.      "Engineering (feet and inches)"    ; 3 -> 3
  23.      "Scientific (decimal)"             ; 1 -> 4
  24.   ))
  25.   (setq aun_lst (list 
  26.      "Decimal Degrees"                  ; 0
  27.      "Degrees-minutes-seconds"          ; 1
  28.      "Grads"                            ; 2
  29.      "Radians"                          ; 3
  30.      "Surveyor's Units"                 ; 4
  31.   ))
  32.   (defun Cv_lunits_var ( / n i)
  33.      (setq n (getvar (strcat prefix "LUNITS")))
  34.      (setq i (cond
  35.        ((= n 2) 0) ((= n 5) 1) ((= n 3) 3) ((= n 4) 2) ((= n 1) 4)
  36.      ))
  37.   )
  38.   (defun Cv_lunits_lst ( / n i)
  39.     (setq n lunits) 
  40.     (setq i (cond
  41.       ((= n 0) 2) ((= n 1) 5) ((= n 3) 3) ((= n 2) 4) ((= n 4) 1)
  42.     ))
  43.   )
  44.   ;;; get current local system variables
  45.   (setq luprec (getvar (strcat prefix "LUPREC")))
  46.   (setq auprec (getvar (strcat prefix "AUPREC")))
  47.   (setq lunits (Cv_lunits_var))
  48.   (setq aunits (getvar (strcat prefix "AUNITS")))
  49.   (setq angdir (getvar (strcat prefix "ANGDIR")))
  50.   (setq angbase (getvar (strcat prefix "ANGBASE")))
  51.  
  52.   ;;; ---------------------------------------------------------------------------------
  53.   ;;; Main dialog
  54.   ;;; ---------------------------------------------------------------------------------
  55.   (defun DlgInit () ;;; ### ( / FillList UpdateLuprecList UpdateAuprecList Example cbox lstn val) 
  56.      (if FLX$WIN95 (foreach n 
  57.         '("IDCANCEL" "IDOK" "IDHELP" "GroupBox1" "GroupBox2" "Button1" "Radio1" "Radio2" 
  58.           "ComboBox1" "ComboBox2" "ComboBox3" "ComboBox4"
  59.           "Static1" "Static2" "Static3" "Static4" "Static5" "Static6" "Static7"  "Static8" 
  60.           "Edit1" "Edit2" "Edit3" "Edit4" "Example1" "Example2" "Example3"
  61.          )
  62.           (Dlg_TileSetFont n 2)
  63.      ))
  64.      (defun FillList (cbox lstn val)
  65.        (Dlg_ListStart cbox)(mapcar 'Dlg_ListAdd lstn)(Dlg_ListEnd) 
  66.        (Dlg_TileSet   cbox (nth val lstn)) 
  67.      )
  68.      (defun UpdateLuprecList()
  69.        (setq lup_lst (if (or (= lunits 1)(= lunits 2))
  70.          (list "0" "1/2" "1/4" "1/8" "1/16" "1/32" "1/64" "1/128" "1/256")
  71.          (list "0" "0.1" "0.01" "0.001" "0.0001" "0.00001" "0.000001" 
  72.                "0.0000001" "0.00000001")
  73.        ))
  74.        (FillList "ComboBox2" lup_lst luprec)
  75.      )
  76.      (defun UpdateAuprecList()
  77.        (setq aup_lst 
  78.          (list "0" "0.1" "0.01" "0.001" "0.0001" "0.00001" "0.000001" 
  79.                "0.0000001" "0.00000001")
  80.        )
  81.        (FillList "ComboBox4" aup_lst auprec)
  82.      )
  83.      (defun Example()
  84.        (Dlg_TileSet "Example1" (rtos 123.45678901234 (Cv_lunits_lst) luprec))
  85.        (Dlg_TileSet "Example2" (angtos (/ pi 4.00) aunits auprec))
  86.        (Dlg_TileSet "Example3" (angtos (/ pi 5.10) aunits auprec))
  87.        (Dlg_TileSet "Static8"  (angtos angbase aunits auprec))
  88.      )
  89.      ;;; Set dialog controls
  90.      (Example)
  91.      (FillList "ComboBox1" lun_lst lunits) 
  92.      (UpdateLuprecList)
  93.      (FillList "ComboBox3" aun_lst aunits) 
  94.      (UpdateAuprecList)
  95.      (if (= angdir 0) (Dlg_TileSet "Radio1" "1") (Dlg_TileSet "Radio2" "1") ) 
  96.      ;;; Reactors to dialog events
  97.      (Dlg_TileAction "ComboBox1" 
  98.         "(setq lunits (- 5 (length (member $value lun_lst))))(UpdateLuprecList)(example)"
  99.      )
  100.      (Dlg_TileAction "ComboBox2"
  101.          "(setq luprec (- 9 (length (member $value lup_lst))))(example)"
  102.      )
  103.      (Dlg_TileAction "ComboBox3" 
  104.          "(setq aunits (- 5 (length (member $value aun_lst))))(UpdateAuprecList)(example)"
  105.      ) 
  106.      (Dlg_TileAction "ComboBox4" 
  107.          "(setq auprec (- 9 (length (member $value aup_lst))))(example)"
  108.      )
  109.      (Dlg_TileAction "Radio1"   "(setq angdir 0)")
  110.      (Dlg_TileAction "Radio2"   "(setq angdir 1)")
  111.      (Dlg_TileAction "Button1"  "(Ang0direction)(example)")
  112.      (Dlg_TileAction "IDOK"     "(setq dialog_ok T)(Dlg_DialogDone)") 
  113.      (Dlg_TileAction "IDCANCEL" "(setq dialog_ok nil)(Dlg_DialogDone)") 
  114.  ) 
  115.   ;;; ---------------------------------------------------------------------------------
  116.   ;;; Sub-dialog to set Angle 0 directions
  117.   ;;; ---------------------------------------------------------------------------------
  118.   (defun Ang0direction( / DlgInit2 dialog_ok current_angbase example2)
  119.      (defun DlgInit2()
  120.         (if FLX$WIN95 (foreach n 
  121.           '("IDCANCEL" "IDOK" "IDHELP" "GroupBox1"
  122.             "Radio1" "Radio2" "Radio3" "Radio4" 
  123.             "Static1" "Static2" "Static3" "Static4" "Static5" "Static6" 
  124.            )
  125.            (Dlg_TileSetFont n 2)
  126.         ))
  127.         (cond
  128.           ((= angbase 0.0)        (Dlg_TileSet "Radio1" "1"))
  129.           ((= angbase (/ pi 2.0)) (Dlg_TileSet "Radio2" "1"))
  130.           ((= angbase pi)         (Dlg_TileSet "Radio3" "1"))
  131.           ((= angbase (* pi 1.5)) (Dlg_TileSet "Radio4" "1"))
  132.         )
  133.         (defun Example2 ()
  134.           (Dlg_TileSet "Static2"  (angtos angbase aunits auprec))
  135.         )
  136.         (Dlg_TileSet    "Static2"  (angtos angbase aunits auprec))
  137.         (Dlg_TileAction "Radio1"   "(setq angbase 0.00)(example2)")
  138.         (Dlg_TileAction "Radio2"   "(setq angbase (/ pi 2.00))(example2)")
  139.         (Dlg_TileAction "Radio3"   "(setq angbase pi)(example2)")
  140.         (Dlg_TileAction "Radio4"   "(setq angbase (* pi 1.50))(example2)")
  141.         (Dlg_TileAction "IDOK"     "(setq dialog_ok T)(Dlg_DialogDone)") 
  142.         (Dlg_TileAction "IDCANCEL" "(setq dialog_ok nil)(Dlg_DialogDone)") 
  143.      )
  144.      (setq current_angbase angbase)
  145.      (if (FLX_DLGDSP "flx_dlg" "BEARINGS" "(princ)" "(DlgInit2)") (princ)(exit)) 
  146.      (setq angbase (if dialog_ok angbase current_angbase))
  147.   )
  148.   ;;; ---------------------------------------------------------------------------------
  149.   ;;; MAIN (continued)
  150.   ;;; ---------------------------------------------------------------------------------
  151.   (if (FLX_DLGDSP "flx_dlg" "SETUP" "(princ)" "(DlgInit)") (princ) (exit)) 
  152.  
  153.   (if dialog_ok (progn
  154.     (setvar (strcat prefix "LUNITS") (cv_lunits_lst))
  155.     (setvar (strcat prefix "AUNITS") aunits)
  156.     (setvar (strcat prefix "LUPREC") luprec)
  157.     (setvar (strcat prefix "AUPREC") auprec) 
  158.     (setvar (strcat prefix "ANGDIR") angdir)
  159.     (setvar (strcat prefix "ANGBASE") angbase)
  160.   ))
  161.   (setq *error* nil)
  162.   (princ) 
  163. )      
  164. (princ)
  165.  
  166.  
  167.