;;; dynamic osnap toolbar
;;; OpenDCL
;;; 
;;;



(if (not dcl-GetVersion)
  (princ "\nLoading OpenDCL Runtime... ")
)
(setvar 'cmdecho 0)
(vl-cmdf "_Opendcl")
(setvar 'cmdecho 1)

(defun Osnaps-OnLoad ()
  ;; Remove existing reactors:
  (mapcar
    '(lambda (rea)
      (if (= "OSNAPS" (vlr-data rea))
        (vlr-remove rea)
      )
    )
    (apply 'append (mapcar 'cdr (vlr-reactors)))
  )
  ;; Create new reactors:
  (vlr-sysvar-reactor
    "OSNAPS"
    '(
      (:vlr-sysvarchanged . Osnaps-CallBackSysvarChanged)
    )
  )
  (vlr-docmanager-reactor
    "OSNAPS"
    '(
      (:vlr-documentbecamecurrent . Osnaps-CallBackDocumentBecameCurrent)
      (:vlr-documenttobedeactivated . Osnaps-CallBackDocumentToBeDeactivated)
    )
  )
  (vlr-command-reactor
    "OSNAPS"
    '(
      (:vlr-commandcancelled . Osnaps-CallBackCommandCancelled)
      (:vlr-commandfailed    . Osnaps-CallBackCommandCancelled)
      (:vlr-commandwillstart . Osnaps-CallBackCommandWillStart)
    )
  )
  ;; Load ODCL and show dialog:
  (if (not (vl-position "Osnaps" (dcl-GetProjects)))
    (dcl-Project-Load "Osnaps")
  )
  (dcl-Form-Show Osnaps/Main)
  ;; Hide Geometric center button if required:
  (if
    (and
      (dcl-Control-GetVisible Osnaps/Main/btnGce)
      (not
        (and
          (= "BRICSCAD" (strcase (getvar 'product)))
          (< 15 (atoi (getvar '_vernum)))
        )
      )
    )
    (progn
      (dcl-Control-SetVisible Osnaps/Main/btnGce nil)
      (dcl-Control-SetWidth Osnaps/Main (- (dcl-Control-GetWidth Osnaps/Main) 32))
    )
  )
  ;; Update the buttons:
  (Osnaps-UpdateButtons nil)
  (princ)
)

(defun Osnaps-CallBackSysvarChanged (rea lst)
  (if (= "OSMODE" (car lst))
    (Osnaps-UpdateButtons nil)
  )
)

(defun Osnaps-CallBackDocumentBecameCurrent (rea lst)
  (Osnaps-UpdateButtons nil)
)

(defun Osnaps-CallBackDocumentToBeDeactivated (rea lst)
  (Osnaps-UpdateButtons T)
)

(defun Osnaps-CallBackCommandCancelled (rea lst)
  (if (vl-position (car lst) '("OPEN" "QNEW"))
    (Osnaps-UpdateButtons nil)
  )
)

(defun Osnaps-CallBackCommandWillStart (rea lst)
  (if (vl-position (car lst) '("OPEN" "QNEW"))
    (Osnaps-UpdateButtons T)
  )
)

(defun Osnaps-UpdateButtons (disableP / osm)
  (if (dcl-Form-IsActive Osnaps/Main)
    (dcl-Form-Enable Osnaps/Main (not disableP))
  )
  (setq osm (getvar 'osmode))
  (mapcar
    '(lambda (bit btn)
      (if (setq btn (eval (read (strcat "Osnaps/Main/btn" btn))))
        (if (= 16384 bit)
          (cond
            (disableP
              (dcl-Control-SetCaption btn "?")
              (dcl-Control-SetBackColor btn -16)
              (dcl-Control-SetForeColor btn -19)
            )
            ((zerop osm)
              (dcl-Control-SetCaption btn "OFF")
              (dcl-Control-SetBackColor btn 0)
              (dcl-Control-SetForeColor btn 7)
            )
            ((= (logand osm bit) bit)
              (dcl-Control-SetCaption btn "OFF")
              (dcl-Control-SetBackColor btn 8)
              (dcl-Control-SetForeColor btn 7)
            )
            (T
              (dcl-Control-SetCaption btn "ON")
              (dcl-Control-SetBackColor btn 7)
              (dcl-Control-SetForeColor btn 0)
            )
          )
          (dcl-Control-SetBackColor
            btn
            (cond
              (disableP                 -16)
              ((= (logand osm bit) bit)   3)
              (T                          1)
            )
          )
        )
      )
    )
    '(    1     2     4     8    16    32    64   128   256   512  1024  2048  4096  8192   16384  0)
    '("End" "Mid" "Cen" "Nod" "Qua" "Int" "Ins" "Per" "Tan" "Nea" "Gce" "App" "Ext" "Par" "OnOff" "Cln") ; Gce = Geometric center (BricsCAD).
  )
)



(defun c:Osnaps/Main/btnEnd#OnClicked () (set_os_end) (princ))
(defun c:Osnaps/Main/btnMid#OnClicked () (set_os_mid) (princ))
(defun c:Osnaps/Main/btnCen#OnClicked () (set_os_cen) (princ))
(defun c:Osnaps/Main/btnNod#OnClicked () (set_os_nod) (princ))
(defun c:Osnaps/Main/btnQua#OnClicked () (set_os_qua) (princ))
(defun c:Osnaps/Main/btnInt#OnClicked () (set_os_int) (princ))
(defun c:Osnaps/Main/btnIns#OnClicked () (set_os_ins) (princ))
(defun c:Osnaps/Main/btnPer#OnClicked () (set_os_per) (princ))
(defun c:Osnaps/Main/btnTan#OnClicked () (set_os_tan) (princ))
(defun c:Osnaps/Main/btnNea#OnClicked () (set_os_nea) (princ))
(defun c:Osnaps/Main/btnGce#OnClicked () (set_os_gcen) (princ)) ; Gce = Geometric center (BricsCAD).
(defun c:Osnaps/Main/btnApp#OnClicked () (set_os_app) (princ))
(defun c:Osnaps/Main/btnExt#OnClicked () (set_os_ext) (princ))
(defun c:Osnaps/Main/btnPar#OnClicked () (set_os_par) (princ))

(defun c:Osnaps/Main/btnOnOff#OnClicked () (setvar 'osmode (boole 6 (getvar 'osmode) 16384)) (princ))
(defun c:Osnaps/Main/btnClose#OnClicked () (dcl-Form-Close Osnaps/Main) (princ))

(defun c:Osnaps/Main/btnCln#OnClicked () (set_os_clear) (princ))

(Osnaps-OnLoad) ; Starts the reactors, loads the ODCL and updates the dialog.
(princ)



;;;
;;; functions to swith mode


(Defun set_os_end ()
  (setq getosend (getvar "osmode"))
  (setq getosend_fix (fix (/ getosend 1)))
  (setq getosend_bep (rem getosend_fix 2))
  (setq os_mode_old (getvar "osmode"))
  (if (= getosend_bep 1)
    (setq os_mode_new (- os_mode_old 1))
    (setq os_mode_new (+ os_mode_old 1))
  )
  (setvar "osmode" os_mode_new)
  (setq lineosend (getvar "osmode"))
  (setq lineosend_fix (fix (/ lineosend 1)))
  (setq lineosend_bep (rem lineosend_fix 2))
  (if (= lineosend_bep 1)
    (prompt "\nEND ON        ")
    (prompt "\nEND OFF       ")
  )
  (princ)
)

(defun set_os_mid ()
  (setq getosmid (getvar "osmode"))
  (setq getosmid_fix (fix (/ getosmid 2)))
  (setq getosmid_bep (rem getosmid_fix 2))
  (setq os_mode_old (getvar "osmode"))
  (if (= getosmid_bep 1)
    (setq os_mode_new (- os_mode_old 2))
    (setq os_mode_new (+ os_mode_old 2))
  )
  (setvar "osmode" os_mode_new)
  (setq lineosmid (getvar "osmode"))
  (setq lineosmid_fix (fix (/ lineosmid 2)))
  (setq lineosmid_bep (rem lineosmid_fix 2))
  (if (= lineosmid_bep 1)
    (prompt "\nMID ON        ")
    (prompt "\nMID OFF       ")
  )
  (princ)
)

(defun set_os_cen ()
  (setq getoscen (getvar "osmode"))
  (setq getoscen_fix (fix (/ getoscen 4)))
  (setq getoscen_bep (rem getoscen_fix 2))
  (setq os_mode_old (getvar "osmode"))
  (if (= getoscen_bep 1)
    (setq os_mode_new (- os_mode_old 4))
    (setq os_mode_new (+ os_mode_old 4))
  )
  (setvar "osmode" os_mode_new)
  (setq lineoscen (getvar "osmode"))
  (setq lineoscen_fix (fix (/ lineoscen 4)))
  (setq lineoscen_bep (rem lineoscen_fix 2))
  (if (= lineoscen_bep 1)
    (prompt "\nCEN ON        ")
    (prompt "\nCEN OFF       ")
  )
  (princ)
)

(defun set_os_nod ()
  (setq getosnod (getvar "osmode"))
  (setq getosnod_fix (fix (/ getosnod 8)))
  (setq getosnod_bep (rem getosnod_fix 2))
  (setq os_mode_old (getvar "osmode"))
  (if (= getosnod_bep 1)
    (setq os_mode_new (- os_mode_old 8))
    (setq os_mode_new (+ os_mode_old 8))
  )
  (setvar "osmode" os_mode_new)
  (setq lineosnod (getvar "osmode"))
  (setq lineosnod_fix (fix (/ lineosnod 8)))
  (setq lineosnod_bep (rem lineosnod_fix 2))
  (if (= lineosnod_bep 1)
    (prompt "\nNOD ON        ")
    (prompt "\nNOD OFF       ")
  )
  (princ)
)

(defun set_os_qua ()
  (setq getosqua (getvar "osmode"))
  (setq getosqua_fix (fix (/ getosqua 16)))
  (setq getosqua_bep (rem getosqua_fix 2))
  (setq os_mode_old (getvar "osmode"))
  (if (= getosqua_bep 1)
    (setq os_mode_new (- os_mode_old 16))
    (setq os_mode_new (+ os_mode_old 16))
  )
  (setvar "osmode" os_mode_new)
  (setq lineosqua (getvar "osmode"))
  (setq lineosqua_fix (fix (/ lineosqua 16)))
  (setq lineosqua_bep (rem lineosqua_fix 2))
  (if (= lineosqua_bep 1)
    (prompt "\nQUA ON        ")
    (prompt "\nQUA OFF       ")
  )
  (princ)
)

(defun set_os_int ()
  (setq getosint (getvar "osmode"))
  (setq getosint_fix (fix (/ getosint 32)))
  (setq getosint_bep (rem getosint_fix 2))
  (setq os_mode_old (getvar "osmode"))
  (if (= getosint_bep 1)
    (setq os_mode_new (- os_mode_old 32))
    (setq os_mode_new (+ os_mode_old 32))
  )
  (setvar "osmode" os_mode_new)
  (setq lineosint (getvar "osmode"))
  (setq lineosint_fix (fix (/ lineosint 32)))
  (setq lineosint_bep (rem lineosint_fix 2))
  (if (= lineosint_bep 1)
    (prompt "\nINT ON        ")
    (prompt "\nINT OFF       ")
  )
  (princ)
)

(defun set_os_ins ()
  (setq getosins (getvar "osmode"))
  (setq getosins_fix (fix (/ getosins 64)))
  (setq getosins_bep (rem getosins_fix 2))
  (setq os_mode_old (getvar "osmode"))
  (if (= getosins_bep 1)
    (setq os_mode_new (- os_mode_old 64))
    (setq os_mode_new (+ os_mode_old 64))
  )
  (setvar "osmode" os_mode_new)
  (setq lineosins (getvar "osmode"))
  (setq lineosins_fix (fix (/ lineosins 64)))
  (setq lineosins_bep (rem lineosins_fix 2))
  (if (= lineosins_bep 1)
    (prompt "\nINS ON        ")
    (prompt "\nINS OFF       ")
  )
  (princ)
)

(defun set_os_per ()
  (setq getosper (getvar "osmode"))
  (setq getosper_fix (fix (/ getosper 128)))
  (setq getosper_bep (rem getosper_fix 2))
  (setq os_mode_old (getvar "osmode"))
  (if (= getosper_bep 1)
    (setq os_mode_new (- os_mode_old 128))
    (setq os_mode_new (+ os_mode_old 128))
  )
  (setvar "osmode" os_mode_new)
  (setq lineosper (getvar "osmode"))
  (setq lineosper_fix (fix (/ lineosper 128)))
  (setq lineosper_bep (rem lineosper_fix 2))
  (if (= lineosper_bep 1)
    (prompt "\nPER ON        ")
    (prompt "\nPER OFF       ")
  )
  (princ)
)

(defun set_os_tan ()
  (setq getostan (getvar "osmode"))
  (setq getostan_fix (fix (/ getostan 256)))
  (setq getostan_bep (rem getostan_fix 2))
  (setq os_mode_old (getvar "osmode"))
  (if (= getostan_bep 1)
    (setq os_mode_new (- os_mode_old 256))
    (setq os_mode_new (+ os_mode_old 256))
  )
  (setvar "osmode" os_mode_new)
  (setq lineostan (getvar "osmode"))
  (setq lineostan_fix (fix (/ lineostan 256)))
  (setq lineostan_bep (rem lineostan_fix 2))
  (if (= lineostan_bep 1)
    (prompt "\nTAN ON        ")
    (prompt "\nTAN OFF       ")
  )
  (princ)
)

(defun set_os_nea ()
  (setq getosnea (getvar "osmode"))
  (setq getosnea_fix (fix (/ getosnea 512)))
  (setq getosnea_bep (rem getosnea_fix 2))
  (setq os_mode_old (getvar "osmode"))
  (if (= getosnea_bep 1)
    (setq os_mode_new (- os_mode_old 512))
    (setq os_mode_new (+ os_mode_old 512))
  )
  (setvar "osmode" os_mode_new)
  (setq lineosnea (getvar "osmode"))
  (setq lineosnea_fix (fix (/ lineosnea 512)))
  (setq lineosnea_bep (rem lineosnea_fix 2))
  (if (= lineosnea_bep 1)
    (prompt "\nNEA ON        ")
    (prompt "\nNEA OFF       ")
  )
  (princ)
)

(Defun set_os_gcen ()
  (setq getosgcen (getvar "osmode"))
  (setq getosgcen_fix (fix (/ getosgcen 1024)))
  (setq getosgcen_bep (rem getosgcen_fix 2))
  (setq os_mode_old (getvar "osmode"))
  (if (= getosgcen_bep 1)
    (setq os_mode_new (- os_mode_old 1024))
    (setq os_mode_new (+ os_mode_old 1024))
  )
  (setvar "osmode" os_mode_new)
  (setq lineosgcen (getvar "osmode"))
  (setq lineosgcen_fix (fix (/ lineosgcen 1024)))
  (setq lineosgcen_bep (rem lineosgcen_fix 2))
  (if (= lineosgcen_bep 1)
    (prompt "\nGCEN ON        ")
    (prompt "\nGCEN OFF       ")
  )
  (princ)
)

  (defun set_os_app ()
    (setq getosapp (getvar "osmode"))
    (setq getosapp_fix (fix (/ getosapp 2048)))
    (setq getosapp_bep (rem getosapp_fix 2))
    (setq os_mode_old (getvar "osmode"))
    (if	(= getosapp_bep 1)
      (setq os_mode_new (- os_mode_old 2048))
      (setq os_mode_new (+ os_mode_old 2048))
    )
    (setvar "osmode" os_mode_new)
    (setq lineosapp (getvar "osmode"))
    (setq lineosapp_fix (fix (/ lineosapp 2048)))
    (setq lineosapp_bep (rem lineosapp_fix 2))
    (if	(= lineosapp_bep 1)
      (prompt "\nAPP ON        ")
      (prompt "\nAPP OFF       ")
    )
    (princ)
  )

  (defun set_os_ext ()
    (setq getosext (getvar "osmode"))
    (setq getosext_fix (fix (/ getosext 4096)))
    (setq getosext_bep (rem getosext_fix 2))
    (setq os_mode_old (getvar "osmode"))
    (if	(= getosext_bep 1)
      (setq os_mode_new (- os_mode_old 4096))
      (setq os_mode_new (+ os_mode_old 4096))
    )
    (setvar "osmode" os_mode_new)
    (setq lineosext (getvar "osmode"))
    (setq lineosext_fix (fix (/ lineosext 4096)))
    (setq lineosext_bep (rem lineosext_fix 2))
    (if	(= lineosext_bep 1)
      (prompt "\nEXT ON        ")
      (prompt "\nEXT OFF       ")
    )
    (princ)
  )

  (defun set_os_par ()
    (setq getospar (getvar "osmode"))
    (setq getospar_fix (fix (/ getospar 8192)))
    (setq getospar_bep (rem getospar_fix 2))
    (setq os_mode_old (getvar "osmode"))
    (if	(= getospar_bep 1)
      (setq os_mode_new (- os_mode_old 8192))
      (setq os_mode_new (+ os_mode_old 8192))
    )
    (setvar "osmode" os_mode_new)
    (setq lineospar (getvar "osmode"))
    (setq lineospar_fix (fix (/ lineospar 8192)))
    (setq lineospar_bep (rem lineospar_fix 2))
    (if	(= lineospar_bep 1)
      (prompt "\nPAR ON        ")
      (prompt "\nPAR OFF       ")
    )
    (princ)
  )


(defun set_os_clear ()
 (setvar "osmode" 0)
)