;;; ==================================================================
;;;  FiberQ CAD  --  fq-ribbon.lsp
;;;  Sloj izmedju trake (FiberQ.cuix) i biblioteke fq-sema.lsp
;;;
;;;  Ribon ne moze da pozove internu funkciju tipa (fq:kabl "Vazdusni")
;;;  na citak nacin, pa svaka stavka trake ovde dobija svoju kratku
;;;  komandu.  Iste te komande rade i kucanjem u komandnoj liniji.
;;;
;;;  Ucitava se posle fq-sema.lsp.  Ako fq-sema.lsp jos nije ucitan,
;;;  prva pozvana komanda ce pokusati da ga ucita sama.
;;;
;;;  GLAVNE KOMANDE
;;;    FQRIBBON     ucitava traku FiberQ CAD u AutoCAD
;;;    FQRIBBONOFF  uklanja traku
;;;    FIBERQ / FQ  DCL paleta, i dalje radi
;;;
;;;  Copyright (c) 2026 Vladimir Vukovic
;;;  MIT licenca, ceo tekst je u fajlu LICENSE.
;;; ==================================================================

(vl-load-com)

;;  Bezuslovno, isto kao u fq-sema.lsp -- vidi tamo zasto nije uslovno.
(setq *FQ-VERZIJA* "1.0.0")


;;; ------------------------------------------------------------------
;;;  1. VEZA SA BIBLIOTEKOM
;;; ------------------------------------------------------------------

;; Trazi fajl na svim mestima na kojima FiberQ moze da stoji.
;; findfile pretrazuje AutoCAD-ovu putanju za podrsku, a puna putanja
;; se proverava direktno.  Vraca punu putanju ili nil.
;;
;; DVE STVARI KOJE IZGLEDAJU KAO SITNICE, A NISU.
;;
;; 1. Golo ime ide POSLEDNJE.  findfile pretrazuje i folder tekuceg
;;    crteza, pa je golo ime na prvom mestu znacilo: otvoris tudji
;;    crtez pored koga stoji stara raspakovana kopija fq-sema.lsp, i
;;    prvo dugme na traci ucita NJU umesto instalirane.  Posle toga se
;;    lovi greska koje u instaliranom kodu nema.
;;
;; 2. Kandidati se grade USLOVNO.  (strcat (getenv "APPDATA") ...) puca
;;    ako getenv vrati nil, a fq:run zove (fq:lib) izvan svakog catch-a,
;;    pa bi u tom slucaju prestalo da radi svako dugme na traci -- ne
;;    jedno, nego sva.
(defun fq:find (naziv / p l e)
  (setq p nil l nil)
  (if (and (boundp '*FQ-DIR*) *FQ-DIR* (= (type *FQ-DIR*) 'STR))
    (setq l (cons (strcat *FQ-DIR* "\\" naziv) l)))
  (foreach v '("APPDATA" "ProgramData")
    (if (and (setq e (getenv v)) (= (type e) 'STR))
      (setq l (cons (strcat e "\\Autodesk\\ApplicationPlugins"
                            "\\FiberQ.bundle\\Contents\\" naziv)
                    l))))
  (setq l (reverse l))
  (foreach k (append l (list naziv))
    (if (not p) (setq p (findfile k))))
  p)

;;;  PREVOD U OVOM FAJLU IDE KROZ STRAZU, i to je jedini fajl kome
;;;  treba.  Razlog nije opreznost nego uloga: fq-ribbon.lsp je
;;;  UCITAVAC.  On sam ucitava fq-jezik.lsp, pa svaka njegova poruka
;;;  moze da se ispise u trenutku kad prevodilac jos ne postoji.
;;;
;;;  Jedan takav trenutak je stvaran i cest: korisnik kroz APPLOAD
;;;  ucita SAMO fq-ribbon.lsp.  Tada linija 290-ak sama pozove
;;;  c:FQRIBBON, na nivou fajla, a fq:lib jos nije radio.  U paketu i u
;;;  punom APPLOAD-u fq-jezik.lsp stigne prvi, pa se straza ne okine.
;;;
;;;  Rezerva NIJE prevod nego pojas: vraca GO KLJUC, tacno ono sto radi
;;;  i sam fq:t kad kljuc ne nadje.  Propust se tada vidi u komandnoj
;;;  liniji umesto da ostavi prazninu koja lici na uredan ispis.
;;;
;;;  Bez ukrasa ispred kljuca, iako bi "FiberQ: " izgledalo urednije za
;;;  celu poruku: kroz istu funkciju prolaze i pojedine reci ("da",
;;;  "horizontalno") koje se umecu USRED recenice, pa bi ih prefiks
;;;  razbio.
(defun fq:rt (k vals)
  (if (car (atoms-family 1 (list "FQ:TF")))
    (fq:tf k vals)
    k))

;; Ucitava jedan biblioteni fajl ako trazena funkcija nije prisutna.
;;
;;  OVE DVE PORUKE SE NAMERNO NE PREVODE.  One prijavljuju da biblioteka
;;  fali -- a fq-jezik.lsp je jedan od fajlova koje ova ista funkcija
;;  trazi.  Poruka "ne nalazim fq-jezik.lsp" ne sme da zavisi od
;;  fq-jezik.lsp, ni preko straze, jer bi kroz fq:rt ispala kao gol
;;  kljuc bas onom korisniku kome je najpotrebnija.  Engleski, jer je
;;  podrazumevan i jer je ovo poruka o pokvarenoj instalaciji.
(defun fq:load1 (naziv / p)
  (setq p (fq:find naziv))
  (if p
    (vl-catch-all-apply 'load (list p))
    (progn
      (princ (strcat "\nCannot find " naziv " on the support file search path."))
      (alert (strcat "FiberQ\n\nCannot find " naziv ".\n\n"
                     "Add the folder holding that file to\n"
                     "Options / Files / Support File Search Path."))))
  p)

;; Ucitava biblioteku ako nije prisutna.  Vraca T ako je posle ovoga
;; sve na broju.  fq-kucista.lsp je opcion: ako ga nema, rade sve
;; stare komande, samo ZOK, patch panel i MDU nisu dostupni.
;;  fq-jezik.lsp ide PRVI i to je uslov, ne uredan raspored: baner na
;;  dnu fq-sema.lsp i fq-kucista.lsp zove fq:t na nivou fajla.  Da se
;;  ucita posle njih, oba bi ispisala engleski minimum iz svoje straze,
;;  pa bi jezik proradio tek od sledeceg pokretanja -- a to se vidi kao
;;  "FQJEZIK ne radi", ne kao redosled.
(defun fq:lib ( / )
  (if (not fq:t)     (fq:load1 "fq-jezik.lsp"))
  (if (not fq:kabl)  (fq:load1 "fq-sema.lsp"))
  (if (not fq:pkuc)  (fq:load1 "fq-kucista.lsp"))
  (if fq:kabl T nil))

;; Omotac za svaku stavku trake.  Proverava biblioteku, pa izvrsava
;; izraz, pa hvata greske da ribon ne bi ostavio komandu u polovicnom
;; stanju.  Jedna stavka trake = jedan undo korak, isto kao na paleti.
(defun fq:run (izraz / er)
  (if (fq:lib)
    (progn
      (vl-catch-all-apply 'fq:undo-poc nil)
      (setq er (vl-catch-all-apply 'eval (list izraz)))
      (vl-catch-all-apply 'fq:undo-kraj nil)
      ;; Esc nije greska -- vidi fq:otkaz u fq-sema.lsp.  Ovde ide kroz
      ;; atoms-family jer fq:run sme da radi i pre nego sto je
      ;; biblioteka ucitana: fq:lib bas tada moze da prijavi da fajl
      ;; nije nadjen, a ta poruka mora da prodje.
      ;;
      ;; Alert NAMERNO nema, iako ga c:FQ ima: 39 dugmadi trake ne sme
      ;; da pocne da otvara modalne prozore kojih do sada nije bilo.
      (if (and (vl-catch-all-error-p er)
               (not (and (car (atoms-family 1 (list "FQ:OTKAZ")))
                         (fq:otkaz er))))
        (princ (fq:rt "traka.greska"
                      (list (vl-catch-all-error-message er)))))
      (vl-catch-all-apply 'fq:upd nil)))
  (princ))


;;; ------------------------------------------------------------------
;;;  2. KABLOVI
;;; ------------------------------------------------------------------

;; Kategorija ide KODOM, ne nazivom.  fq:kabl prima oboje -- fq:nazkod
;; poredi i kolonu koda -- ali sa nazivom bi srpska kolona *FQ-KODOVI*
;; postala nosiva za dugme koje engleski korisnik pritiska.  Kod je
;; jedina kolona koja se po dogovoru ne menja.
(defun c:FQKVAZ () (fq:run '(fq:kabl "kbAerial")))
(defun c:FQKPOD () (fq:run '(fq:kabl "kbDuct")))
(defun c:FQKMIK () (fq:run '(fq:kabl "kbMicro")))
(defun c:FQKINS () (fq:run '(fq:kabl "kbIndoor")))


;;; ------------------------------------------------------------------
;;;  3. NASTAVCI I SPAJANJE
;;; ------------------------------------------------------------------

(defun c:FQNAS   () (fq:run '(fq:pnast "N")))
(defun c:FQNAL   () (fq:run '(fq:pnast "NL")))
(defun c:FQREZ15 () (fq:run '(fq:prez 15.0)))


;;; ------------------------------------------------------------------
;;;  4. SPLITERI
;;; ------------------------------------------------------------------

(defun c:FQSPL2  () (fq:run '(fq:pspl 2)))
(defun c:FQSPL4  () (fq:run '(fq:pspl 4)))
(defun c:FQSPL8  () (fq:run '(fq:pspl 8)))
(defun c:FQSPL16 () (fq:run '(fq:pspl 16)))
(defun c:FQSPL32 () (fq:run '(fq:pspl 32)))
(defun c:FQSPL64 () (fq:run '(fq:pspl 64)))


;;; ------------------------------------------------------------------
;;;  5. ODF MODULI I ODO ORMARI
;;; ------------------------------------------------------------------

;; ODF i ODO idu kroz katalog iz fq-kucista.lsp, isto kao ZOK, patch
;; panel i MDU: dugme crta odmah, bez niza pitanja u komandnoj liniji.
;; Stare komande FQODF i FQODO i dalje postoje i rade po starom.
(defun c:FQODF576 () (fq:run '(fq:pkuc "ODF" 576)))
(defun c:FQODF288 () (fq:run '(fq:pkuc "ODF" 288)))
(defun c:FQODF144 () (fq:run '(fq:pkuc "ODF" 144)))
(defun c:FQODF96  () (fq:run '(fq:pkuc "ODF" 96)))
(defun c:FQODF72  () (fq:run '(fq:pkuc "ODF" 72)))
(defun c:FQODF48  () (fq:run '(fq:pkuc "ODF" 48)))
(defun c:FQODF24  () (fq:run '(fq:pkuc "ODF" 24)))
(defun c:FQODF12  () (fq:run '(fq:pkuc "ODF" 12)))

(defun c:FQODO12  () (fq:run '(fq:pkuc "ODO" 12)))
(defun c:FQODO24  () (fq:run '(fq:pkuc "ODO" 24)))
(defun c:FQODO48  () (fq:run '(fq:pkuc "ODO" 48)))
(defun c:FQODO72  () (fq:run '(fq:pkuc "ODO" 72)))
(defun c:FQODO96  () (fq:run '(fq:pkuc "ODO" 96)))


;;; ------------------------------------------------------------------
;;;  6. OLT I ONT
;;; ------------------------------------------------------------------

(defun c:FQOLT8  () (fq:run '(fq:polt 8)))
(defun c:FQOLT16 () (fq:run '(fq:polt 16)))
(defun c:FQONTK  () (fq:run '(fq:pont)))


;;; ------------------------------------------------------------------
;;;  7. NAMENA VLAKNA
;;;  Kljucevi su isti kao u *FQ-NAMENE* u fq-sema.lsp.
;;; ------------------------------------------------------------------

;; Namena KODOM, iz istog razloga kao kategorija kabla iznad.  Do sada je
;; ovde stajao srpski TOKEN ("Izgradnja", ne "U izgradnji"): fq:nazkod
;; poredi svih pet kolona pa je i to radilo, ali je kolonu tokena cinilo
;; nosivom za dugme koje pritiska engleski korisnik.  Token je uz to
;; jedina kolona koja se bira po tome kako se lepo kuca, dakle najpodlozniji
;; promeni -- a kod se po dogovoru ne menja nikad.
(defun c:FQNMRAD () (fq:run '(fq:setnam "nmWork")))
(defun c:FQNMPLA () (fq:run '(fq:setnam "nmPlan")))
(defun c:FQNMIZG () (fq:run '(fq:setnam "nmBuild")))
(defun c:FQNMPRI () (fq:run '(fq:setnam "nmAcc")))
(defun c:FQNMRZS () (fq:run '(fq:setnam "nmRsvd")))
(defun c:FQNMOST () (fq:run '(fq:setnam "nmDmg")))
(defun c:FQNMSPL () (fq:run '(fq:setnam "nmSpl")))
(defun c:FQNMRZV () (fq:run '(fq:setnam "nmSpare")))
(defun c:FQNMPRO () (fq:run '(fq:setnam "nmThru")))
(defun c:FQNMSLO () (fq:run '(fq:setnam "nmFree")))


;;; ------------------------------------------------------------------
;;;  8. STATUS, ORIJENTACIJA, PREGLED
;;;
;;;  Ribon nema radio dugmad, pa su ovo obicne komande.  Trenutno
;;;  stanje se ispisuje u komandnu liniju i vidi se u FQSTANJE.
;;; ------------------------------------------------------------------

;; Prikaz statusa ide kroz fq:stnaziv iz fq-sema.lsp, ne kroz svoj
;; inline (if ...).  Dva koda su inace imala tri oblika prikaza -- ovde,
;; u info-plocici palete i u fq:tally -- pa bi Faza 5 morala da lovi
;; sva tri.  Poziv je unutar defun tela, sto je jedini dozvoljen oblik:
;; fq-ribbon.lsp se ucitava pre fq-sema.lsp, ali fq:lib ga ucita pre
;; nego sto se fq:stanje ikad izvrsi.
;;  Sest umetaka umesto dvanaest delova strcat-a.  Red reci nije isti u
;;  dva jezika, pa natpis i vrednost ne smeju da budu dva odvojena
;;  fragmenta -- inace se prevodilac ne moze pomeriti ni za jedan.
;; Kljuc doslovno u obe grane, ne (fq:rt (if ...)): provera tabela cita
;; samo literal odmah iza fq:rt, pa bi racunat kljuc ostao neproveren.
(defun fq:dane (b)
  (if b (fq:rt "opste.da" nil) (fq:rt "opste.ne" nil)))

(defun fq:stanje ()
  (princ (fq:rt "traka.stanje"
                (list (fq:stnaziv *fq-st*)
                      (if (= *fq-ugao* 0)
                        (fq:rt "opste.orijentacija.h" nil)
                        (fq:rt "opste.orijentacija.v" nil))
                      (fq:dane *FQ-DRAG*)
                      (fq:dane *FQ-SIRI*)
                      (fq:dane *FQ-SNAP*)
                      (if *fq-kod* *fq-kod* "-"))))
  (princ))

(defun c:FQSTPROJ () (fq:lib) (setq *fq-st* "stProjektovano") (fq:stanje))
(defun c:FQSTIZV  () (fq:lib) (setq *fq-st* "stIzvedeno")     (fq:stanje))
(defun c:FQORIH   () (fq:lib) (setq *fq-ugao* 0)              (fq:stanje))
(defun c:FQORIV   () (fq:lib) (setq *fq-ugao* 90)             (fq:stanje))
(defun c:FQDRAG   () (fq:lib) (setq *FQ-DRAG* (not *FQ-DRAG*)) (fq:stanje))
;; Da li nov kabl sam siri ram kucista koje stoji na njegovom kraju.
;; Isto dugme postoji i na staroj DCL paleti.
(defun c:FQSIRI   () (fq:lib) (setq *FQ-SIRI* (not *FQ-SIRI*)) (fq:stanje))
;; Hvatanje na prvi konektor rama dok traje pregled.  Isti obrazac kao
;; FQDRAG: prvo biblioteka, jer se prekidac zove iz hladnog starta.
(defun c:FQSNAP   () (fq:lib) (setq *FQ-SNAP* (not *FQ-SNAP*)) (fq:stanje))
(defun c:FQSTANJE () (fq:lib) (fq:stanje))


;;; ------------------------------------------------------------------
;;;  9. UCITAVANJE I UKLANJANJE TRAKE
;;; ------------------------------------------------------------------

(setq *FQ-MENUGROUP* "FIBERQ")

;; Vraca objekat menu grupe ako je ucitana, inace nil.
(defun fq:mg ( / r)
  (setq r nil)
  (vl-catch-all-apply
    '(lambda ()
       (vlax-for g (vla-get-menugroups (vlax-get-acad-object))
         (if (= (strcase (vla-get-name g)) *FQ-MENUGROUP*)
           (setq r g)))))
  r)

;;  Ime paketa po jeziku.  Dva odvojena fajla, ne dva taba u jednom --
;;  vidi make-cuix.ps1 zasto.  Ime menu grupe je u oba isto ("FIBERQ"),
;;  pa se dva jezika ne mogu naci ucitana istovremeno: fq:mg nadje onaj
;;  koji stoji, bez obzira koji je.
;;
;;  Engleski je FiberQ.cuix, dakle bez sufiksa.  To je paket koji vidi
;;  Autodesk App Store i koji dobija onaj ko nikad ne dirne FQJEZIK.
;;
;;  *fq-jezik* dolazi iz fq-jezik.lsp, koji se ucitava PRVI.  boundp je
;;  ipak tu: ovaj fajl sme da bude ucitan sam, a tada bez trake ne bi
;;  bilo ni poruke o tome sto je nema.
(defun fq:cuixime ()
  (if (and (boundp '*fq-jezik*) (= *fq-jezik* "SR"))
    "FiberQ_SR.cuix"
    "FiberQ.cuix"))

(defun c:FQRIBBON ( / p er)
  (if (fq:mg)
    (princ (fq:rt "traka.vec.ucitana" nil))
    (progn
      (setq p (fq:find (fq:cuixime)))
      (if (not p)
        (progn
          (princ (fq:rt "traka.nema.cuix" nil))
          (alert (fq:rt "traka.nema.cuix.alert" nil)))
        (progn
          (setq er (vl-catch-all-apply
                     'vla-load
                     (list (vla-get-menugroups (vlax-get-acad-object)) p)))
          (if (vl-catch-all-error-p er)
            (princ (fq:rt "traka.cuix.greska"
                          (list (vl-catch-all-error-message er))))
            (princ (fq:rt "traka.ucitana" (list p))))))))
  (princ))

(defun c:FQRIBBONOFF ( / g er)
  (if (setq g (fq:mg))
    (progn
      (setq er (vl-catch-all-apply 'vla-unload (list g)))
      (if (vl-catch-all-error-p er)
        (princ (fq:rt "traka.uklanjanje.greska"
                      (list (vl-catch-all-error-message er))))
        (princ (fq:rt "traka.uklonjena" nil))))
    (princ (fq:rt "traka.nije.ucitana" nil)))
  (princ))


;;; ------------------------------------------------------------------
;;;  10. SAMOSTALNO UCITAVANJE PRI POKRETANJU
;;;
;;;  Postavi  (setq *FQ-RIBBON-AUTO* nil)  pre ucitavanja ovog fajla
;;;  ako ne zelis da se traka ucitava sama.
;;; ------------------------------------------------------------------

(if (not (boundp '*FQ-RIBBON-AUTO*)) (setq *FQ-RIBBON-AUTO* T))

(if (and *FQ-RIBBON-AUTO* (not (fq:mg)))
  (vl-catch-all-apply 'c:FQRIBBON nil))

;;; --- baner ---------------------------------------------------------
;;;
;;;  Straza nad fq:t.  Ovaj fajl je najizlozeniji: u paketu se ucitava
;;;  PRVI od biblioteke, a kroz APPLOAD je jedini koji korisnik rucno
;;;  ucitava -- tada fq-jezik.lsp jos nije ucitan, jer to radi fq:lib
;;;  tek pri prvoj komandi.  Bez straze bi ceo ovaj fajl otisao tiho.
(if (car (atoms-family 1 (list "FQ:T")))
  (princ (strcat "\nFiberQ CAD " *FQ-VERZIJA* (fq:t "start.ribbon")))
  (princ (strcat "\nFiberQ CAD " *FQ-VERZIJA*
                 " -- fq-ribbon.lsp loaded.  FQRIBBON / FQRIBBONOFF,"
                 " palette is FIBERQ.")))
(princ)
