;;; ==================================================================
;;;  FiberQ CAD  --  fq-sema.lsp
;;;  Biblioteka za crtanje seme opticke FTTH / GPON mreze
;;;  AutoCAD i BricsCAD, cist AutoLISP + DCL
;;;
;;;  GLAVNA KOMANDA:  FIBERQ  (paleta), krace FQ
;;;
;;;  Copyright (c) 2026 Vladimir Vukovic
;;;  MIT licenca, ceo tekst je u fajlu LICENSE pored ovoga.
;;; ==================================================================

(vl-load-com)

;;; ------------------------------------------------------------------
;;;  0. VERZIJA
;;;
;;;  Isti string stoji u sva tri .lsp fajla i u PackageContents.xml, i
;;;  postavlja se BEZUSLOVNO, ne kroz (if (not (boundp ...))).  Razlog:
;;;  fq-kucista.lsp se ucitava posle ovoga, pa bi uslovni upis ostavio
;;;  verziju onog fajla koji je slucajno prvi stigao -- a kod mesanog
;;;  para (nov fq-sema, star fq-kucista) bas to je podatak koji hoces
;;;  da vidis.  Ovako FQVERZIJA uvek pokazuje verziju POSLEDNJEG
;;;  ucitanog fajla, a test-lisp.ps1 proverava da su svi isti pre
;;;  pakovanja, tako da se u isporuci ne mogu razlikovati.
;;; ------------------------------------------------------------------

(setq *FQ-VERZIJA* "1.0.0")


;;; ------------------------------------------------------------------
;;;  1. PODESAVANJA
;;; ------------------------------------------------------------------

(setq *FQ-PITCH*  0.80)   ; vertikalni raster vlakana i portova
(setq *FQ-GAP*    0.80)   ; dodatni razmak izmedju cevcica
(setq *FQ-TXTH*   0.54)   ; osnovna visina teksta
(setq *FQ-LEN*   40.00)   ; podrazumevana duzina linije vlakna
(setq *FQ-CEVIN*  5.00)   ; uvlak elipse cevcice od kraja linije
(setq *FQ-CEVRU*  0.95)   ; poluosa elipse cevcice duz kabla
(setq *FQ-TXTDX*  0.60)   ; razmak natpisa vlakna od elipse cevcice
(setq *FQ-TXT2*      T)   ; natpis vlakna na oba kraja, ne u sredini
(setq *FQ-KLBLDX* 1.50)   ; pomeraj oznake kabla
(setq *FQ-VLACI*     7)   ; boja linije vlakna pri crtanju kabla
(setq *FQ-VELIKI*  200)   ; iznad ovoliko vlakana trazi se potvrda
(setq *FQ-NAST-MARG* 2.00); margina rama nastavka iznad i ispod snopa
(setq *FQ-NAST-TIT*  2.60); oznaka nastavka iznad rama
(setq *FQ-NAST-TIT0* 2.20); ranija visina oznake, dok mesto jos nije bilo
                          ; pod njom; za natpise iz starijih crteza
(setq *FQ-SPD*       0.44); precnik crne tacke splajsa, mereno iz seme
(setq *FQ-SPOJ-KOR*  0.50); razmak izmedju uspravnih prelaza dva spoja
(setq *FQ-SPOJ-MAX*  3.50); najveci pomak prelaza od sredine nastavka
(setq *FQ-ODV-DX*    0.80); stepen izmedju lomova u vertikalnom odvodu
(setq *FQ-DRAG*        T) ; pregled kabla dok se pomera mis
(setq *FQ-DRAG-MAX*  240) ; iznad ovoliko vlakana pregled crta rede
(setq *FQ-SNAP*        T) ; hvatanje na prvi konektor rama u pregledu
(setq *FQ-SNAP-ACI*    4) ; boja markera; ne crvena, jer je prvo vlakno
                          ; pregleda crveno i pada bas na uhvacenu tacku
(setq *FQ-SNAP-RAM* "FQ_ODF,FQ_ODO,FQ_ZOK") ; lejeri ramova koji se hvataju
(setq *fq-snapkes*   nil) ; kes ciljeva, gradi se jednom po petlji pregleda
(setq *fq-snaphit*   nil) ; poslednji uhvacen cilj, cita ga fq:snapuzmi
;;  Oba se ZADAJU na ulazu u svaku pick funkciju, i nikad se ne vracaju
;;  na staru vrednost na izlazu.  Projekat nema nijedan *error* handler,
;;  pa bi obrazac "zapamti, ugasi, vrati na kraju" na Esc usred komande
;;  ostavio hvatanje ugaseno do kraja sesije, bez ikakvog oporavka:
;;  jedini setq na T bio bi ovaj red, a on se izvrsava samo pri
;;  ucitavanju fajla.  Ovako svaka sledeca komanda sama kaze sta hoce.
(setq *fq-dragre*    nil) ; opis siluete, da se moze pregraditi pod drugim uglom
(setq *fq-dragsnap*    T) ; da li tekuci pregled uopste hvata
(setq *FQ-LEN-MIN*  12.00); najkraci kabl, da se elipse cevcica ne sudare
(setq *FQ-SIRI*        T) ; nov kabl sam siri ram kucista ili nastavka
                          ; na svom kraju, i sam se uvlaci u njega
(setq *FQ-LOM-MIN*  1.00) ; najkraci deo vlakna izmedju dva loma
(setq *fq-lomkabl*   nil) ; katalog crta kabl sa lomovima, pamti se u sesiji


;;; ------------------------------------------------------------------
;;;  2. COLOR CODE STANDARDI
;;;
;;;  Tabela moze imati bilo koji broj boja, ne mora 12.
;;;  Isti niz se koristi za cevcice i za vlakna u cevcici.
;;;  Boje su ACI brojevi.
;;;
;;;  TIA-598 je osnovni standard. Ne moze da se obrise ni preimenuje,
;;;  i uvek se vraca u listu ako ga u sacuvanom fajlu nema.
;;;  Svoje standarde pravis komandom FQCC, dugme Color code na paleti.
;;;  Cuvaju se u fajl fq-boje.dat i ucitavaju sami pri pokretanju.
;;; ------------------------------------------------------------------

(setq *FQ-CC-BAZNI* "TIA-598")

(setq *FQ-CC-TIA*
 '(("Plava"      .   5) ("Narandzasta" .  30)
   ("Zelena"     .   3) ("Braon"       .  34)
   ("Siva"       .   8) ("Bela"        .   7)
   ("Crvena"     .   1) ("Crna"        . 250)
   ("Zuta"       .   2) ("Ljubicasta"  .   6)
   ("Roze"       . 221) ("Tirkizna"    .   4)))

;; IEC 60304 NIJE isti niz kao TIA-598, iako je do verzije 1.0 ovde
;; stajalo (setq *FQ-CC-IEC* *FQ-CC-TIA*).  IEC pocinje CRVENOM:
;;   1 crvena  2 zelena  3 plava  4 zuta  5 bela  6 siva
;;   7 braon   8 ljubicasta  9 tirkizna  10 crna  11 narandzasta  12 roze
;; To je isti niz koji je ranije stajao pod imenom jednog holandskog
;; proizvodjaca kablova; tabela je bila tacna, ime pogresno, a zapis
;; nazvan "IEC" je bio kopija TIA tabele.  Zamena je vazna i van
;; marketplace-a: IEC 60304 se koristi u Nemackoj, Austriji, Svajcarskoj,
;; Danskoj i na Balkanu, pa je ovde bio bas onaj standard po kome se
;; najverovatnije radi -- a davao je americke boje.
;;
;; Crteze nacrtane pre ove ispravke ovo NE menja: boja vlakna je vec
;; upisana u entitet, a polje 14 zapisa vlakna (naziv standarda) nista
;; ne cita nazad.  Menja se samo ono sto se crta odsad.
(setq *FQ-CC-IEC*
 '(("Crvena"     .   1) ("Zelena"      .   3)
   ("Plava"      .   5) ("Zuta"        .   2)
   ("Bela"       .   7) ("Siva"        .   8)
   ("Braon"      .  34) ("Ljubicasta"  .   6)
   ("Tirkizna"   .   4) ("Crna"        . 250)
   ("Narandzasta".  30) ("Roze"        . 221)))

;;; Zapis standarda je  (naziv  boje  oznake-grupa).
;;; Oznake su za vlakna preko duzine tabele, redom za drugu, trecu i
;;; cetvrtu grupu. Prva grupa je uvek bez oznake i ne upisuje se.
;;; Oznaka ide uz standard, a ne globalno, jer se nacin obelezavanja
;;; preko dvanaest vlakana razlikuje od proizvodjaca do proizvodjaca:
;;; prsten je najcesci, ali ne i jedini.  Svoj niz i svoje oznake
;;; pravis komandom FQCC.
(setq *FQ-CC*
  (list (list *FQ-CC-BAZNI* *FQ-CC-TIA* '("-p"  "-2p"  "-3p"))
        (list "IEC 60304"   *FQ-CC-IEC* '("-p"  "-2p"  "-3p"))))

(setq *fq-kod* *FQ-CC-BAZNI*)   ; aktivni standard

;; rezerva kada standard nema svoje oznake, ili je zapis stariji
(setq *FQ-PRSTEN* '("" "-p" "-2p" "-3p"))

;;; Poznate boje. Svi standardi za opticka vlakna koje sam video
;;; koriste ovih dvanaest, razlikuje se samo redosled. Zato se novi
;;; standard sastavlja biranjem iz ovog spiska, a ne unosom boje.
(setq *FQ-POZNATE*
 '(("Plava"      .   5) ("Narandzasta" .  30)
   ("Zelena"     .   3) ("Braon"       .  34)
   ("Siva"       .   8) ("Bela"        .   7)
   ("Crvena"     .   1) ("Crna"        . 250)
   ("Zuta"       .   2) ("Ljubicasta"  .   6)
   ("Roze"       . 221) ("Tirkizna"    .   4)))


;;; ------------------------------------------------------------------
;;;  3. KATALOG KABLOVA
;;;    (kategorija ((tip ((cevcica vlakana) ...)) ...))
;;; ------------------------------------------------------------------

(setq *FQ-KABLOVI*
 '(("Vazdusni"
     (("ADSS 03"
        ((1 2) (1 4) (1 6) (1 8) (1 12) (1 24)
         (2 6) (2 12) (2 24)
         (3 4)
         (4 6) (4 12)
         (6 6) (6 8) (6 12)
         (8 6) (8 12) (8 24)
         (12 12) (12 24)
         (24 12)
         (36 12)))))

   ("Podzemni"
     (("TOSM 03"
        ((1 2) (1 4) (1 6) (1 8) (1 12) (1 24)
         (2 6) (2 12) (2 24)
         (3 4)
         (4 6) (4 12)
         (6 6) (6 8) (6 12)
         (8 6) (8 12) (8 24)
         (10 24)
         (12 12) (12 24)
         (24 12)))))

   ("Podzemni mikro"
     (("TO(M)SM 03"
        ((1 2) (1 4) (1 6) (1 8) (1 12) (1 24)
         (2 6) (2 12) (2 24)
         (3 4)
         (4 6) (4 12)
         (6 6) (6 8) (6 12)
         (8 6) (8 12) (8 24)
         (10 24)
         (12 12) (12 24)
         (24 12)))))

   ("Instalacioni"
     (("BUTTERFLY H"
        ((1 1) (1 2)))
      ("TOMM 03"
        ((1 2) (2 2) (2 6) (2 12) (2 24)
         (4 6) (4 12)
         (6 6) (6 12) (6 24)
         (8 6) (8 12)))
      ("RISER H"
        ((2 6) (2 12)
         (4 6) (4 12)
         (6 4)
         (8 6) (8 12)
         (12 4)
         (36 12)))))))


;;; --- orijentacija --------------------------------------------------
;;;  (naziv  ugao u stepenima)
(setq *FQ-ORI*
  '(("Horizontalno"        0)
    ("Vertikalno nagore"  90)
    ("Vertikalno nadole" 270)))

(setq *fq-ugao* 0)          ; tekuca orijentacija za sve elemente
;; Hvataljka samostalnog splitera: nil = kraj prvog izlaza (kako je
;; bilo oduvek), T = kraj ulaza.  Postavlja je fq:pickspl na svakom
;; pozivu, a menja taster I u pregledu; ovde stoji samo da bi bila
;; vezana i pre prve komande.
(setq *fq-splul* nil)
(setq *fq-a*   0.0)        ; tekuci ugao crtanja u radijanima


;;; --- ODO ormar (izmereno iz ODO_ormar.dxf) ------------------------
(setq *FQ-ODO-W*    12.00)
(setq *FQ-ODO-LEV*   2.80)
(setq *FQ-ODO-MARG*  2.00)
(setq *FQ-ODO-DX*    0.50)
;; Visina na koju fq:drawodo i fq:drawodospl zakace oznaku ormara, iznad
;; rama.  Konstanta a ne broj u crtacu, jer istu meru cita i fq:kucproz:
;; prozor za brisanje koji je ne dosegne ostavlja stari naslov u crtezu,
;; pa se to mora javiti.  Trecu kopiju broja u proveri niko ne bi drzao
;; u koraku sa crtacima, a razisla bi se tiho -- poruka bi izostala
;; tacno onda kad je najpotrebnija.  Isti par uloga ima *FQ-ODF-TIT1*.
(setq *FQ-ODO-TIT1*  3.10)
;; Drugi red iznad rama, adresa.  Obrazac je PAR, isto kao *FQ-ODF-TIT1*
;; i *FQ-ODF-TIT2*: ODO ima dva natpisa iznad rama i oba se mere istim
;; prozorom, pa bi imenovan samo prvi ostavio drugi kao go broj na dva
;; mesta -- tacno ona treca kopija zbog koje se konstanta i uvodi.
(setq *FQ-ODO-TIT2*  1.50)
;; Montaza koju nudi fq:odoask.  KODOVI, ne reci -- do bloka 3 su ovde
;; stajale gole srpske reci, pa je engleski token "Indoor" morao natrag u
;; "unutrasnji" da bi se poklopio.  Ovako se ne poklapa nista: vrednost
;; je vec ono sto ide u xdata.  Domen "mnt" ima jos tri koda, koji stizu
;; iz kataloga kucista i ovde se ne nude.
(setq *FQ-ODO-UNU*  "mtIndoor")
(setq *FQ-ODO-SPO*  "mtOutdoor")
;; Vlakno koje je uslo u ormar ali nije zavrsilo na portu crta se kao
;; kratak zavrsetak sa kolutom.  ISKLJUCENO od 22.08.2026.
;;
;; Do ogledalnog kucista se to skoro nije ni videlo: kod ormara na
;; POCETKU kabla svako vlakno ide dalje sa kablom, pa ga fq:prolaziu
;; preskoci.  Kolut je dobijao samo dolazni kabl, a dolazni kabl je do
;; tada zavrsavao u ormaru koji mu je legao preko -- dakle u crtezu koji
;; se ionako precrtavao.  Sada ormar na kraju kabla izgleda kako treba,
;; pa se kolut prvi put video u punom broju: devet praznih krugova u
;; koloni ispod tri zauzeta porta.
;;
;; Podatak koji je nosio vec stoji u crtezu: portovi su nacrtani samo
;; tamo gde nesto jeste, a vlakna svejedno idu do kolone.  Prekidac
;; ostaje, jer geometrija nije uklonjena nego samo iskljucena -- vrati se
;; na T ako kolut zatreba.
(setq *FQ-ODO-VISI*  nil) ; vlakna bez porta se crtaju kako vise u ormaru
(setq *FQ-ODO-VISU* 0.92) ; koliko takvo vlakno ulazi u ram
(setq *FQ-ODO-VISR* 0.15) ; poluprecnik koluta na kraju
(setq *FQ-ODO-PW*   1.83) ; sirina simbola porta, mereno od kolone nalevo

;;; --- ODF modul (izmereno iz ODF.dxf) ------------------------------
(setq *FQ-ODF-DESNO* 5.80)
(setq *FQ-ODF-PAD*   0.90)
(setq *FQ-ODF-DX*    1.00)
(setq *FQ-ODF-MARG*  1.60)
(setq *FQ-ODF-KS*    0.438)
(setq *FQ-ODF-NUMX*  1.50)
(setq *FQ-ODF-NUMH*  0.42)
(setq *FQ-ODF-TITH*  1.70)
(setq *FQ-ODF-TIT1*  6.30)
(setq *FQ-ODF-TIT2*  3.60)
(setq *FQ-ODF-PRE*  "OR ")
(setq *FQ-ODF-KON*  "SC/APC")

;;; --- spliter, samostalno telo -------------------------------------
;;;
;;;  Mere su preslikane iz splitera koji stoji u ZOK kutiji, da telo
;;;  splitera bude iste velicine bez obzira na to gde je nacrtano.
;;;  Ranije je samostalni spliter imao telo 6.0 x 4.0 i izlaze duge 8,
;;;  a ceo ODO ram je visok po 0.8 na red vlakna, pa je spliter pored
;;;  kucista izgledao kao da je iz drugog crteza i nije mogao da se
;;;  postavi u njega.
;;;
;;;  Drugo svodjenje na merilo.  I posle prvog je telo ostalo krupnije
;;;  od svega uz sta stoji: 2.20 visine je 2.75 reda vlakna, a naslov
;;;  od 0.62 * 1.40 = 0.87 je vise nego DVOSTRUKO visi od broja porta u
;;;  ODO ormaru pored koga stoji (0.72 * *FQ-TXTH* = 0.39).  Zato telo
;;;  ide na tacno dva reda rastera, a naslov na visinu bliskiju broju
;;;  porta.  Vodilje IN i OUT su bile gole linije duge 7.00 od ukupno
;;;  12.20 gabarita, dakle 57 odsto duzine na nista; one se skracuju
;;;  najvise, jer se izlaz sada i tako zavrsava tacno na konektoru.
;;;
;;;  PAZNJA: *FQ-SPL-W*, *FQ-SPL-H* i *FQ-SPL-TITH* cita i fq:odospl u
;;;  fq-kucista.lsp, pa se telo menja i u ODO ormaru.  To je i namera.
;;;  ZOK kutija ima svoje *FQ-ZOK-SP...*, koje treba drzati u koraku.
;;;  *FQ-SPL-IN* i *FQ-SPL-OUT* postoje SAMO ovde, kucista ih ne citaju.
(setq *FQ-SPL-W*    2.00) ; sirina tela splitera, ista kao u ZOK kutiji
(setq *FQ-SPL-H*    1.60) ; visina tela splitera, tacno dva reda rastera
(setq *FQ-SPL-DX*   2.60) ; razmak tela od kolone izlaza
(setq *FQ-SPL-IN*   2.00) ; duzina ulazne linije levo od tela
(setq *FQ-SPL-OUT*  1.60) ; duzina izlazne linije desno od kolone
(setq *FQ-SPL-TITH* 0.90) ; visina naslova; 0.62 * 0.90 = 0.56, uporedivo
                          ; sa brojem porta u ODO ormaru (0.39)
(setq *FQ-SPL-VX*   1.20) ; koliko ulaz zaobilazi telo sa strane

;;; --- OLT i ONT ----------------------------------------------------
;;;
;;;  Mere su do sada stajale kao goli brojevi u fq:drawolt i fq:drawont.
;;;  Izvucene su zato sto ih od sada cita i druga strana: crtac i
;;;  silueta uz mis moraju da daju istu geometriju, a dva puta prepisan
;;;  broj se razidje tiho -- silueta pokazuje jedno, nacrta se drugo, i
;;;  to se ni u jednoj statickoj proveri ne vidi.
;;;
;;;  Telo OLT-a ide po rasteru *FQ-PITCH*, isto kao portovi ormara:
;;;  prvi PON je *FQ-OLT-GORE* redova ispod temena, koliko treba oznaci
;;;  iznad rama, a dno tela je (np + *FQ-OLT-DNO*) redova ispod temena,
;;;  pa ispod poslednjeg PON-a ostane isti zazor kao iznad prvog.
(setq *FQ-OLT-W*    14.00) ; sirina tela OLT-a
(setq *FQ-OLT-PON*   4.00) ; duzina PON patrljka desno od tela
(setq *FQ-OLT-GORE*  2.00) ; redova rastera od temena do prvog PON-a
(setq *FQ-OLT-DNO*   3.00) ; redova rastera preko np, do dna tela

;;;  ONT nema raster: jedna kutija sa dva reda teksta i privod koji
;;;  ulazi u SREDINU leve ivice.  Visina privoda se zato ne kotira
;;;  posebno nego se racuna iz *FQ-ONT-H*, pa kutija sme da se promeni
;;;  bez druge ispravke.
(setq *FQ-ONT-W*     9.00) ; sirina tela ONT-a
(setq *FQ-ONT-H*     2.60) ; visina tela ONT-a
(setq *FQ-ONT-PRI*   4.00) ; duzina privoda levo od tela

;;; --- nastavak, gde se nalazi --------------------------------------
;;;
;;;  Nastavak u projektu nikad ne visi u vazduhu: stoji u oknu, na
;;;  stubu, u kanalu.  Mesto ide u zapis i ispisuje se odmah ispod
;;;  oznake, IZNAD rama, pa se cita sa crteza i grupise u specifikaciji.
;;;
;;;  Ranije je stajalo ispod rama.  Tamo mu vise nije mesto: izvod iz
;;;  nastavka spusta donju ivicu rama za citavu duzinu novog kabla, pa
;;;  bi natpis ili odlutao daleko nanize ili se nasao usred snopa.
;;;  Gornja ivica se ne pomera nikad, i tamo je natpis uvek uz oznaku.
(setq *FQ-NAST-LOK*
  '("okno" "stub" "u zemlji" "u kanalu" "na fasadi" "ostalo"))
(setq *FQ-NAST-W*    8.00) ; podrazumevana sirina rama nastavka
(setq *FQ-NAST-MINW* 1.60) ; najuzi ram koji se sme povuci misem
(setq *FQ-NAST-LOKH* 1.30) ; ispis mesta iznad rama, pod oznakom

;;  PAZNJA na imena.  AutoLISP ne razlikuje velika i mala slova u
;;  imenima simbola, pa bi *fq-nast-lok* bio ISTA promenljiva kao
;;  *FQ-NAST-LOK* i tiho bi je prepisao stringom.  Zapamcene vrednosti
;;  zato nose kratko *fq-na-...*, a ne malu varijantu imena liste.
(setq *fq-na-lok*  "okno")  ; lepljivo, kao status i orijentacija
(setq *fq-na-br*   "")
(setq *fq-na-tip*  "N")     ; poslednji izabran tip, N ili NL
;;  Serija: dijalog se posle crtanja odmah vraca, dok je kvacica.
;;  Na dugom kablu ide pet latentnih nastavaka jedan za drugim, a
;;  brojevi okana nisu redni (KO 1 pa KO 50), pa se broj kuca svaki
;;  put; polje Broj je zato vec u fokusu i oznaceno.
(setq *fq-na-vise* nil)     ; nastavi sa sledecim nastavkom
(setq *fq-na-isti* T)       ; u seriji koristi isti kabl

;;; --- presecanje vlakna --------------------------------------------
;;;
;;;  Oba kraja presecenog vlakna ostaju u crtezu i zavrsavaju UNUTAR
;;;  rama elementa u kome je rez.  Uvlace se *FQ-PRS-ULAZ* od ivice
;;;  rama, a ne malo oko sredine: nastavak je cesto sirok nekoliko
;;;  desetina jedinica, pa bi se zev od jedne jedinice u sredini jedva
;;;  video i izgledalo bi kao da se nista nije desilo.
;;;
;;;  Zev je najmanji razmak koji mora da ostane, za slucaj uskog rama.
(setq *FQ-PRS-ULAZ* 1.50)
(setq *FQ-PRS-ZEV*  1.20)
(setq *FQ-PRS-UKI*  "-U") ; nastavak id-a kraka koji se ukida
;; Lejeri elemenata koji mogu da prime rez: nastavak i sva kucista.
(setq *FQ-KUT-LEJERI* "FQ_NASTAVAK,FQ_ODF,FQ_ODO,FQ_ZOK")

;;; --- NAMENA VLAKNA  (kljuc  naziv  ACI  debljina) -----------------
(setq *FQ-NAMENE*
  ;;  (kljuc  naziv  ACI  debljina  KOD)
  ;;
  ;;  Kod je na KRAJU zapisa, ne na pocetku.  Tri citaca uzimaju
  ;;  (cadr rec), (caddr rec) i (cadddr rec) -- fq:namena, fq:setnam i
  ;;  legenda -- pa bi kod na pocetku pomerio sva tri odjednom.  Na
  ;;  kraju je (nth 4 rec) i ne pomera nista.
  ;;
  ;;  PAZNJA za citaoca: kljuc i naziv su ovde slucajno JEDNAKI kod osam
  ;;  od deset unosa.  Razlikuju se samo Izgradnja/U izgradnji i
  ;;  Primljeno/Funkcionalno primljeno.  Ko proveri "Radno" zakljucice
  ;;  da se u xdata vec upisuje kljuc -- ne upisuje se, upisuje se NAZIV,
  ;;  i za ta dva unosa je to bio drugaciji string nego kljuc.
  '(("Slobodno"    "Slobodno"                 7  -1  "nmFree")
    ("Radno"       "Radno"                    1  30  "nmWork")
    ("Planirano"   "Planirano"                4  30  "nmPlan")
    ("Izgradnja"   "U izgradnji"              2  30  "nmBuild")
    ("Primljeno"   "Funkcionalno primljeno"   5  30  "nmAcc")
    ("Rezervisano" "Rezervisano"              6  30  "nmRsvd")
    ;;  TRI STANJA KOJA SU DO 1.0.0 IZGLEDALA ISTO KAO SLOBODNO.
    ;;
    ;;  Sva cetiri su nosila (7 -1), dakle tacno ono sto vlakno vec ima
    ;;  cim se kabl nacrta -- pa se namena upisana u polje 10 videla samo
    ;;  u specifikaciji, koja ih preko fq:tallyst grupise kao cetiri
    ;;  razlicite stavke.  Legenda je pri tom ispisivala cetiri identicne
    ;;  crne linije uz cetiri razlicita natpisa.
    ;;
    ;;  Slobodno OSTAJE 7: dugme se zove "vrati crno" i to je jedino
    ;;  stanje kome je crna sama definicija, ne podrazumevana vrednost.
    ;;
    ;;  Brojevi su birani iz PUNE ACI palete, ne iz prvih devet, i to je
    ;;  uslov a ne ukras: dvanaest boja color code standarda zauzima
    ;;  {1 2 3 4 5 6 7 8 30 34 221 250}, sest vec obojenih namena {1 2 3
    ;;  4 5 6}, pa svaka od te dve grupe otpada.  Debljina ostaje -1, da
    ;;  ova tri stanja i dalje budu vizuelno slabija od radnog vlakna.
    ;;
    ;;    42  (165 124   0) tamna zlatno-oker -- nije 30 ni 34 ni 2
    ;;   122  (  0 165 124) prigusena teal    -- tamnija i od 3 i od 4
    ;;   150  (  0 127 255) celicno plava     -- 5 je (0 0 255), na
    ;;                                           ekranu skoro crna
    ;;
    ;;  Ikone na traci NE prate ovu tabelu same od sebe: make-icons.ps1
    ;;  ima svoj hes $ACI i broj rucno prepisan u svaki scriptblock
    ;;  (FiberBar 42 / 122 / 150).  Ko menja ovu kolonu, menja i njih, pa
    ;;  regenerise traku -- inace ikona ostane siva uz obojenu liniju.
    ("Rezervno"    "Rezervno"                42  -1  "nmSpare")
    ("Prolazno"    "Prolazno"               122  -1  "nmThru")
    ("Spliter"     "Spliter"                150  -1  "nmSpl")
    ("Osteceno"    "Osteceno"                 3  30  "nmDmg")))

;;; --- KODOVI TRAJNIH NABRAJANJA ------------------------------------
;;;
;;;  Ono sto ide u xdata je KOD; ono sto korisnik vidi je NAZIV.
;;;  Citaci su fq:nazkod i fq:kodnaz, dole uz fq:stnaziv.
;;;
;;;  Tabela se cita PO DOMENU, ne kao jedna ravna lista.  Razlog nije
;;;  uredan raspored: rec "stub" postoji i kao mesto nastavka (gore,
;;;  *FQ-NAST-LOK*) i kao montaza ZOK kutije (katalog u fq-kucista.lsp),
;;;  sa razlicitim znacenjem.  Ravna tabela bi ih spojila i ZOK na stubu
;;;  bi u specifikaciji postao nastavak u oknu -- videlo bi se tek kao
;;;  pogresan red, nikad kao greska.  Isto vazi za "unutrasnji", koji
;;;  postoji u tri kataloske liste.
;;;
;;;  Citanje po domenu je i jedini razlog zasto citaci smeju da rade
;;;  preko strcase.  Par "Prolazno" (namena, polje 10) / "prolazno"
;;;  (prolaznost, polje 9) je ziv i stvarno se poredi -- ali nikad u
;;;  istoj listi, jer su "nam" i "pro" razdvojeni domeni.  Isto vazi za
;;;  "Spliter" (namena) / "SPLITER" (kljuc vrste).  Ravna tabela bi ovo
;;;  spojila i fq:tally bi poceo da broji prolazna vlakna kao vlakna
;;;  namene Prolazno.
;;;
;;;  ODATLE USLOV: unutar JEDNOG domena ne smeju postojati dva unosa
;;;  koja se razlikuju samo po velicini slova.  test-lisp.ps1 obara
;;;  build ako se pojave -- vidi odeljak "tabela *FQ-KODOVI*".
;;;
;;;  Zapis je (kod  tokenSr  nazivSr  nazivEn  tokenEn).
;;;
;;;  TOKEN je ono sto predaje getkword i sto korisnik KUCA; NAZIV je ono
;;;  sto vidi.  Kod namene se token i srpski naziv razlikuju samo kod dva
;;;  unosa od deset -- ali kolona ostaje, jer ih engleski razdvaja svuda.
;;;
;;;  TOKEN NE SME IMATI RAZMAK.  initget razdvaja kljucne reci razmakom,
;;;  pa "Podzemni mikro" nikad nije ni mogao biti token -- tamo je token
;;;  "Mikro", a pun naziv zivi u trecoj koloni.  Isto vazi za engleski:
;;;  naziv je "Under construction", token "Construction".
;;;
;;;  Peta kolona je dodata u bloku 3 Faze 5, i to NA KRAJ -- isto pravilo
;;;  koje vazi za polja xdata.  Ko doda sesti clan, mora ga dodati svuda:
;;;  test-lisp.ps1 broji kolone i obara build na prvom nepotpunom zapisu.
;;;
;;;  CETVRTA KOLONA JE DODATA U BLOKU 2 FAZE 5.  Ovo je jedino mesto u
;;;  projektu gde kod, kljuc i oba naziva stoje jedan pored drugog, pa je
;;;  i jedino mesto na kome se prevod trajnog nabrajanja moze odrzavati
;;;  a da se dve tabele ne razidju.  Zbog toga engleski naziv NIJE otisao
;;;  u *FQ-STR-EN*: tamo bi kljuc bio jos jedna niska koja se mora drzati
;;;  u koraku sa ovom tabelom, i to bez ijedne provere koja bi to cuvala.
;;;
;;;  fq:kodnaz bira kolonu po tekucem jeziku.  fq:nazkod poredi SVE
;;;  cetiri -- zatecen crtez nosi srpski naziv, nov engleski, a oba
;;;  moraju dati isti kod i isti red specifikacije.
;;;
;;;  SVAKI ZAPIS MORA IMATI TACNO PET CLANOVA.  Zaboravljen engleski
;;;  naziv ne obara nista: fq:kodnaz tiho padne na srpski, i to bas za
;;;  taj jedan unos, pa specifikacija na engleskom dobije jedan srpski
;;;  red medju ostalima.  test-lisp.ps1 zato broji clanove.
;;;
;;;  Domeni: "nam" namena vlakna    "pro" prolaznost
;;;          "lok" mesto nastavka   "kat" kategorija kabla
;;;          "vrs" vrsta vlakna     "mnt" montaza kucista
;;;          "nas" tip nastavka
(setq *FQ-KODOVI*
 '(("nam"
     (("nmFree"  "Slobodno"    "Slobodno"               "Free"               "Free")
      ("nmWork"  "Radno"       "Radno"                  "Working"            "Working")
      ("nmPlan"  "Planirano"   "Planirano"              "Planned"            "Planned")
      ("nmBuild" "Izgradnja"   "U izgradnji"            "Under construction" "Construction")
      ("nmAcc"   "Primljeno"   "Funkcionalno primljeno" "Accepted"           "Accepted")
      ("nmRsvd"  "Rezervisano" "Rezervisano"            "Reserved"           "Reserved")
      ;; Token NIJE naziv kod ova dva unosa, i to namerno.  "Spare" bi sa
      ;; "Splitter" delio prefiks "Sp", a "Through" sa nicim -- ali
      ;; "Transit" i "Unused" daju deset razlicitih pocetnih slova, pa se
      ;; na engleskom svaka namena bira JEDNIM otkucanim slovom.  Nikad
      ;; ne birati par gde je jedan token strogi prefiks drugog.
      ("nmSpare" "Rezervno"    "Rezervno"               "Spare"              "Unused")
      ("nmThru"  "Prolazno"    "Prolazno"               "Through"            "Transit")
      ("nmSpl"   "Spliter"     "Spliter"                "Splitter"           "Splitter")
      ("nmDmg"   "Osteceno"    "Osteceno"               "Damaged"            "Damaged")))
   ("pro"
     (("prThru" "Prolazno"  "prolazno"  "through" "Through")
      ("prCut"  "Preseceno" "preseceno" "cut"     "Cut")))
   ;; Mesto nastavka danas ne prolazi kroz initget -- bira se u dijalogu,
   ;; a -FQNASTAVAK ga uzima golim getstring-om.  Tokeni su ipak upisani
   ;; kao JEDNA rec, jer kolona po zaglavlju jeste token: cim neko doda
   ;; initget, "u zemlji" bi postalo dva tokena i getkword bi vratio "u".
   ;; Pun naziv zivi u trecoj koloni i fq:nazkod ga i dalje prepoznaje.
   ("lok"
     (("lkManhole" "Okno"   "okno"      "manhole"   "Manhole")
      ("lkPole"    "Stub"   "stub"      "pole"      "Pole")
      ("lkBuried"  "Zemlja" "u zemlji"  "buried"    "Buried")
      ("lkDuct"    "Kanal"  "u kanalu"  "in duct"   "Duct")
      ("lkFacade"  "Fasada" "na fasadi" "on facade" "Facade")
      ("lkOther"   "Ostalo" "ostalo"    "other"     "Other")))
   ;; kbMicro: KLJUC je "Mikro", ne "Podzemni mikro".  Kljuc je token
   ;; koji predaje getkword, a initget ne dozvoljava razmak u tokenu --
   ;; zato token nikad i nije mogao biti pun naziv.  Naziv "Podzemni
   ;; mikro" ostaje u trecoj koloni i dalje ga prepoznaje fq:nazkod, pa
   ;; paleta i traka, koje salju pun naziv, rade nepromenjeno.
   ("kat"
     (("kbAerial" "Vazdusni"     "Vazdusni"       "Aerial"     "Aerial")
      ("kbDuct"   "Podzemni"     "Podzemni"       "Duct"       "Duct")
      ("kbMicro"  "Mikro"        "Podzemni mikro" "Micro duct" "Micro")
      ("kbIndoor" "Instalacioni" "Instalacioni"   "Indoor"     "Indoor")))
   ;; Kod je ovde vec medjunarodna skracenica, pa je KLJUC isti kao kod:
   ;; struka kaze SM i MM, ne "jednomodno".  Da kljuc glasi "Singlemode",
   ;; a naziv "singlemode", dva clana istog zapisa bi se razlikovala samo
   ;; po velicini slova -- bezopasno za citace (isti zapis), ali bi
   ;; oborilo proveru u test-lisp.ps1, koja razliku unutar zapisa ne ume
   ;; da razlikuje od razlike izmedju zapisa.  Ovako je i kraci prompt.
   ("vrs"
     (("SM" "SM" "singlemode" "singlemode" "SM")
      ("MM" "MM" "multimode"  "multimode"  "MM")))
   ;;  Montaza je dosla POSLE ostalih, i to kao ispravka: do ove izmene
   ;;  je u polje 5 zapisa ODO i polje 6 zapisa ZOK isla gola srpska
   ;;  rec.  Bas ta rec, "unutrasnji", navedena je u komentaru gore kao
   ;;  razlog zasto se tabela uopste cita po domenu -- a sama domen nije
   ;;  imala.  Popis iz Faze 4 ju je promasio jer je gledao samo
   ;;  nabrajanja koja stizu kroz initget, a montaza stize i iz kataloga.
   ;;
   ;;  NABRAJANJE NIJE ZATVORENO, i to je razlika u odnosu na sva ostala
   ;;  osim "lok".  Montaze se citaju iz kataloga kucista, koji korisnik
   ;;  menja i cuva u fq-kucista.dat, a -FQZOK je uzima golim getstring-om.
   ;;  Ko upise "u sahtu", to mora da prezivi put kroz kod netaknuto.
   ;;  Zato katalog ostaje na nazivima i ne zna nista o kodovima: prevod
   ;;  radi crtac, na jednom mestu po vrsti, a nepoznato oba citaca
   ;;  propustaju.
   ;;
   ;;  "stub" postoji i u domenu "lok", sa drugim znacenjem -- tamo je
   ;;  mesto nastavka.  To je tacno onaj par zbog koga tabela ima domene:
   ;;  u ravnoj listi bi ZOK na stubu u specifikaciji postao nastavak.
   ;;  TOKEN JE VELIKIM POCETNIM SLOVOM, naziv malim.  Do bloka 3 je ova
   ;;  kolona bila prepis naziva, jer montaza kroz initget nije ni
   ;;  prolazila -- fq:odoask ju je pitao zakucanim "Unutrasnji
   ;;  Spoljasnji".  Od bloka 3 spisak gradi tabela, pa lowercase token
   ;;  ide pravo u initget: AutoCAD skracenicu cita iz VELIKIH slova
   ;;  kljucne reci, a "unutrasnji" ih nema nijedno.
   ;;
   ;;  Razlika samo u velicini slova unutar istog zapisa je bezopasna i
   ;;  provera je propusta -- oba clana vode na isti kod.  Isti par
   ;;  postoji i u domenu "pro" ("prolazno" / "Prolazno").
   ("mnt"
     (("mtIndoor"  "Unutrasnji"  "unutrasnji"  "indoor"        "Indoor")
      ("mtOutdoor" "Spoljasnji"  "spoljasnji"  "outdoor"       "Outdoor")
      ("mtFree"    "Samostojeci" "samostojeci" "free-standing" "Freestanding")
      ("mtWall"    "Zid"         "zid"         "wall"          "Wall")
      ("mtPole"    "Stub"        "stub"        "pole"          "Pole")))
   ;;  KOD JE OVDE ZAMRZNUT SPOLJA.  "N" i "NL" stoje u tabeli zamrznutog
   ;;  u CLAUDE.md i ulaze u oznaku nastavka, dakle u polje 2 zapisa
   ;;  NASTAVAK, u svakom vec nacrtanom crtezu.  Ovaj domen im dodaje
   ;;  token i naziv; sam kod se ne dira.
   ;;
   ;;  KOD NIJE PREFIKS, ma koliko danas izgledao isto.  Prefiks oznake
   ;;  pravi fq:napre, i on jedini sme da dobije engleski oblik u bloku 7.
   ;;  Do ove izmene su to bile bukvalno iste niske -- (strcat tip " ") na
   ;;  dva mesta -- pa bi prevod prefiksa promenio ono sto stoji u xdata.
   ;;  Zato NIKAD (fq:kodnaz "nas" tip) kao prefiks.
   ("nas"
     (("N"  "Nastavak" "obican"   "ordinary" "Splice")
      ("NL" "Latentni" "latentni" "latent"   "Latent")))))

(setq *FQ-LW-TANKA*  13)

;;; --- opticki budzet -----------------------------------------------
;;;
;;;  Slabljenje po kilometru zavisi od VRSTE vlakna, i to za red velicine.
;;;  Do 1.0.0 je postojala jedna tabela, *FQ-ATT*, sa tri singlemode
;;;  talasne duzine -- pa je multimode trasa racunata sa 0.35 dB/km umesto
;;;  ~3 dB/km.  Budzet je izlazio DESET PUTA bolji nego sto jeste, i to bez
;;;  ijedne poruke.  To je jedini nacin na koji je ova komanda mogla da
;;;  slaze: rezultat ide u projekat kao dokaz da veza radi.
;;;
;;;  Vrste su razdvojene i po talasnim duzinama, ne samo po brojevima:
;;;  1310/1490/1550 nemaju smisla na multimode vlaknu, ni 850/1300 na
;;;  singlemode.  Zato initget u c:FQBUDZET nudi samo one koje pripadaju
;;;  vrsti procitanoj iz vlakna -- vidi fq:attab i fq:attlist.
(setq *FQ-ATT-SM* '((1310 . 0.35) (1490 . 0.24) (1550 . 0.22)))
(setq *FQ-ATT-MM* '(( 850 . 3.00) (1300 . 1.00)))
(setq *FQ-G-VAR*  0.10)
(setq *FQ-G-KON*  0.30)
(setq *FQ-MARGIN* 3.00)

(setq *fq-st*   "stProjektovano")
;; Vrsta vlakna za SLEDECI nacrtan kabl.  Ide u zapis isto kao *fq-kod*
;; (color code): crtaci je citaju iz globalne, ne primaju kao argument.
;; Tako je jer je i jedno i drugo osobina kabla koja se bira pre crtanja
;; i vazi za sva vlakna tog kabla -- a i zato sto bi nov argument menjao
;; potpis dva crtaca i cetiri poziva, a broj argumenata nijedna staticka
;; provera ne hvata.
(setq *fq-vrs*  "SM")
(setq *fq-cnt*  nil)
;; vlakno koje je FQTRASA poslednji put oznacila u crtezu.  Oznaka je
;; ekranski efekat (redraw ... 3) i ne prolazi kroz undo, pa mora da se
;; skida izricito -- vidi fq:trskini.
(setq *fq-tr-ozn* nil)
(setq *fq-keep* T)
(setq *fq-duzmis* T)      ; duzina kabla se povlaci misem posle tacke
;; poravnanje sledeceg kabla: (red  ugao  redovi  u0)
;; u0 je zakljucan polozaj duz kabla, ili nil kada se pokazuje misem
(setq *fq-por*  nil)


;;; ------------------------------------------------------------------
;;;  4. COLOR CODE, PRISTUP
;;; ------------------------------------------------------------------

;; Da li je to osnovni, zasticeni standard
(defun fq:bazni (nm) (= (strcase nm) (strcase *FQ-CC-BAZNI*)))

;; Tabela aktivnog standarda, sa zastitom od prazne ili nepostojece.
;; Ako aktivnog nema, pada na osnovni, pa tek onda na prvi u listi.
(defun fq:cctab ( / rec tab)
  (setq rec (assoc *fq-kod* *FQ-CC*))
  (setq tab (if rec (cadr rec) nil))
  (if (or (not tab) (= 0 (length tab)))
    (setq tab (cadr (assoc *FQ-CC-BAZNI* *FQ-CC*))))
  (if (or (not tab) (= 0 (length tab)))
    (setq tab (cadr (car *FQ-CC*))))
  (if (or (not tab) (= 0 (length tab)))
    (setq tab *FQ-CC-TIA*))
  tab)

;; PAZNJA: lokalna promenljiva se NE sme zvati t, jer je T u AutoLISP-u
;; ugradjena vrednost tacno. Zato ovde stoji tab.
(defun fq:col (i / tab)
  (setq tab (fq:cctab))
  (nth (rem (1- i) (length tab)) tab))

(defun fq:cname (i) (car (fq:col i)))
(defun fq:caci  (i) (cdr (fq:col i)))

;;; --- naziv boje za PRIKAZ, blok 8 ---------------------------------
;;;
;;;  Isporuceni TIA-598 nosi SRPSKA imena boja, pa je engleski crtez do
;;;  bloka 8 ispisivao "1.Plava" pored "48 outdoor" i "designed" -- po
;;;  jedan natpis na svako vlakno, najvidljiviji tekst u celom crtezu.
;;;
;;;  ACI BROJ JE VEC KOD.  *FQ-BOJENAZ* preslikava ime u ACI na oba
;;;  jezika, pa obrnut smer daje prikaz bez ijedne nove tabele i bez
;;;  diranja formata fq-boje.dat, koji je zamrznut i koji cita i
;;;  starija instalacija.
;;;
;;;  Tri stvari cine ovo drukcijim od ostalih nabrajanja, i sve tri su
;;;  razlog zasto se rec NE zamenjuje kodom:
;;;   - niz boja je OTVOREN, FQCC pravi svoj standard;
;;;   - fq-boje.dat je zamrznut format;
;;;   - rec je vec u polju 6 svakog nacrtanog vlakna.
;;;
;;;  Zato: u zapis i u standard ide rec kakva jeste, a prevodi se samo
;;;  ono sto se ISPISUJE.  Zatecen crtez se ne prepisuje.

;; ACI -> naziv na tekucem jeziku, nil ako taj ACI nije poznata boja.
;;
;; Kljucevi su DOSLOVNI, iako bi tabela (aci . kljuc) bila kraca: takav
;; poziv provera vidi kao racunat kljuc, a racunat kljuc je dozvoljen
;; samo uz svoju proveru.  Dvanaest grana je jeftinije od trinaeste
;; provere.
(defun fq:bojnaz (aci)
  (cond ((= aci 5)   (fq:t "boja.plava"))
        ((= aci 30)  (fq:t "boja.narandzasta"))
        ((= aci 3)   (fq:t "boja.zelena"))
        ((= aci 34)  (fq:t "boja.braon"))
        ((= aci 8)   (fq:t "boja.siva"))
        ((= aci 7)   (fq:t "boja.bela"))
        ((= aci 1)   (fq:t "boja.crvena"))
        ((= aci 250) (fq:t "boja.crna"))
        ((= aci 2)   (fq:t "boja.zuta"))
        ((= aci 6)   (fq:t "boja.ljubicasta"))
        ((= aci 221) (fq:t "boja.roze"))
        ((= aci 4)   (fq:t "boja.tirkizna"))))

;; Naziv i-te boje aktivnog standarda, za prikaz.  Ide preko ACI-ja koji
;; standard vec nosi, ne preko reci -- rec je ono sto treba zameniti.
;; Korisnikova boja, ciji ACI nije medju poznatima, pada na svoju rec.
(defun fq:cprikaz (i / n)
  (if (setq n (fq:bojnaz (fq:caci i))) n (fq:cname i)))

;; Naziv za vec upisanu REC, kad indeksa nema -- FQTRASA cita polje 6
;; zatecenog vlakna.  Rec -> ACI -> naziv; nepoznata rec prolazi kroz.
(defun fq:bojrec (w / p n)
  (cond ((not w) "")
        ((= w "") "")
        ((and (setq p (assoc (strcase w) *FQ-BOJENAZ*))
              (setq n (fq:bojnaz (cdr p))))
         n)
        (T w)))

;; Oznake grupa aktivnog standarda, sa praznom prvom grupom na pocetku.
;; Ako standard nema svoje oznake, uzima se opsta rezerva.
(defun fq:ccpr ( / rec p)
  (setq rec (assoc *fq-kod* *FQ-CC*)
        p   (if rec (caddr rec) nil))
  (if (and p (listp p) (> (length p) 0))
    (cons "" p)
    *FQ-PRSTEN*))

;; oznaka grupe za vlakno preko duzine tabele
(defun fq:cring (i / g p)
  (setq g (/ (1- i) (length (fq:cctab)))
        p (fq:ccpr))
  (if (< g (length p))
    (nth g p)
    (strcat "-" (itoa g) "p")))


;;; ------------------------------------------------------------------
;;;  4a. RAD SA LISTAMA
;;; ------------------------------------------------------------------

;; Prepoznati nazivi boja za brzi unos liste. Kljuc je velikim slovima.
(setq *FQ-BOJENAZ*
 '(("PLAVA" . 5)   ("BLUE" . 5)
   ("NARANDZASTA" . 30) ("ORANGE" . 30)
   ("ZELENA" . 3)  ("GREEN" . 3)
   ("BRAON" . 34)  ("BROWN" . 34)  ("SMEDJA" . 34)
   ("SIVA" . 8)    ("SLATE" . 8)   ("GREY" . 8)  ("GRAY" . 8)
   ("BELA" . 7)    ("WHITE" . 7)
   ("CRVENA" . 1)  ("RED" . 1)
   ("CRNA" . 250)  ("BLACK" . 250)
   ("ZUTA" . 2)    ("YELLOW" . 2)
   ("LJUBICASTA" . 6) ("VIOLET" . 6) ("PURPLE" . 6)
   ("ROZE" . 221)  ("ROSE" . 221)  ("PINK" . 221)
   ("TIRKIZNA" . 4) ("AQUA" . 4)   ("TURQUOISE" . 4)))

(defun fq:trim (s)
  (while (and (> (strlen s) 0) (= (substr s 1 1) " "))
    (setq s (substr s 2)))
  (while (and (> (strlen s) 0) (= (substr s (strlen s) 1) " "))
    (setq s (substr s 1 (1- (strlen s)))))
  s)

(defun fq:split (s sep / i c out cur)
  (setq out nil cur "" i 1)
  (while (<= i (strlen s))
    (setq c (substr s i 1))
    (if (= c sep)
      (setq out (cons cur out) cur "")
      (setq cur (strcat cur c)))
    (setq i (1+ i)))
  (reverse (cons cur out)))

(defun fq:clamp (i n) (max 0 (min i (1- n))))

;; redni broj vrednosti u listi, 0 ako je nema
(defun fq:poz (v lst / i r)
  (setq i 0 r 0)
  (foreach x lst
    (if (equal x v) (setq r i))
    (setq i (1+ i)))
  r)

;; prvih n elemenata liste
(defun fq:prvih (l n / out i)
  (setq out nil i 0)
  (while (and l (< i n))
    (setq out (cons (car l) out) l (cdr l) i (1+ i)))
  (reverse out))

(defun fq:setnth (lst n val / i out)
  (setq i 0 out nil)
  (foreach x lst (setq out (cons (if (= i n) val x) out) i (1+ i)))
  (reverse out))

(defun fq:remnth (lst n / i out)
  (setq i 0 out nil)
  (foreach x lst (if (/= i n) (setq out (cons x out))) (setq i (1+ i)))
  (reverse out))

(defun fq:swap (lst a b / va vb)
  (setq va (nth a lst) vb (nth b lst))
  (fq:setnth (fq:setnth lst a vb) b va))

(defun fq:jenaziv (nm)
  (if (assoc nm *FQ-CC*) T nil))


;;; ------------------------------------------------------------------
;;;  4b. CUVANJE STANDARDA U FAJL
;;;
;;;  Fajl fq-boje.dat se trazi redom: u putanjama za podrsku,
;;;  pored fq-sema.lsp, u korisnickom folderu AutoCAD-a, pa u temp.
;;;  Format: po jedan standard u redu, kao LISP lista.
;;; ------------------------------------------------------------------

(defun fq:datname () "fq-boje.dat")

;; PISANJE i CITANJE nemaju isti spisak, i to je ceo smisao ove izmene.
;;
;; Stari fq:ccpaths je vracao jedan spisak za oba, a na njegovom drugom
;; mestu je stajao folder u kome lezi fq-sema.lsp.  U isporuci je to
;; Contents folder ApplicationPlugins bundle-a: instalacioni folder u
;; koji dodatak nema pravo da pise, i koji Autodesk App Store revizija
;; izricito proverava.  Prvo mesto je bilo jos gore -- (findfile) nadje
;; fq-boje.dat pored TUDJEG crteza, pa bi se tudja podesavanja i citala
;; i prepisivala.  Cetvrto je bilo TEMPPREFIX, gde sacuvano nestane.
;;
;; Sada se pise samo u korisnicki profil, a nasledjena mesta ostaju
;; SAMO za citanje, da onaj ko je vec nesto sacuvao to ne izgubi.
(defun fq:ccwpaths ( / l p)
  (setq l nil)
  (if (setq p (getvar "ROAMABLEROOTPREFIX"))
    (setq l (cons (strcat p (fq:datname)) l)))
  (if (setq p (getenv "APPDATA"))
    (setq l (cons (strcat p "\\FiberQ\\" (fq:datname)) l)))
  (reverse l))

(defun fq:ccpaths ( / l p)
  (setq l (fq:ccwpaths))
  (if (setq p (findfile (fq:datname)))
    (setq l (append l (list p))))
  l)

;;; --- upis koji ne unistava ono sto vec postoji --------------------
;;;
;;;  (open p "w") skracuje fajl na nulu ODMAH, pre nego sto je i jedan
;;;  red napisan.  Ako se izmedju toga i (close) bilo sta desi -- pun
;;;  disk, greska u samom ispisu, AutoCAD koji padne -- korisnik ostaje
;;;  bez jedinog primerka svog kataloga ili svojih color code tabela.
;;;  Poruka koju dobije kaze da nije sacuvano, a istina je da je i staro
;;;  izgubljeno.  To je najgori oblik greske: tih i nepovratan.
;;;
;;;  Zato se pise pored, u <ime>.tmp, pa se gotov fajl premesta na
;;;  mesto.  Stari se prvo skloni u <ime>.bak i vrati ako premestanje
;;;  ne prodje, pa ni prozor izmedju dva rename-a ne ostavlja korisnika
;;;  bez fajla.

(defun fq:tmpime (p) (strcat p ".tmp"))

(defun fq:zameni (cilj priv / bak ok)
  (setq bak (strcat cilj ".bak") ok nil)
  (if (findfile priv)
    (progn
      (if (findfile bak) (vl-file-delete bak))
      ;; ako cilja jos nema, nema ni sta da se cuva
      (if (findfile cilj) (vl-file-rename cilj bak))
      (setq ok (vl-file-rename priv cilj))
      (cond (ok (if (findfile bak) (vl-file-delete bak)))
            ;; premestanje nije proslo: vrati stari na mesto, pa neka
            ;; korisnik dobije poruku o neuspehu umesto praznog fajla
            ((findfile bak) (vl-file-rename bak cilj)))
      (if (not ok) (vl-file-delete priv))))
  ok)

(defun fq:ccsave ( / f out p s pr)
  (setq out nil)
  (foreach p (fq:ccwpaths)
    (if (and (not out) (setq pr (fq:tmpime p)) (setq f (open pr "w")))
      (progn
        (write-line ";; FiberQ color code standardi" f)
        (write-line ";; Generisano komandom FQCC, moze se menjati i rucno." f)
        (foreach s *FQ-CC* (prin1 s f) (write-line "" f))
        (close f)
        (if (fq:zameni p pr) (setq out p)))))
  out)

(defun fq:ccload ( / f fn s x out p)
  (setq fn nil)
  (foreach p (fq:ccpaths)
    (if (and (not fn) (findfile p)) (setq fn p)))
  (if (and fn (setq f (open fn "r")))
    (progn
      (setq out nil)
      (while (setq s (read-line f))
        (if (and (> (strlen s) 3) (/= (substr s 1 1) ";"))
          (progn
            (setq x (vl-catch-all-apply 'read (list s)))
            (if (and (not (vl-catch-all-error-p x))
                     (listp x)
                     (= (type (car x)) 'STR)
                     (listp (cadr x)))
              (setq out (cons x out))))))
      (close f)
      (if out
        (progn
          (setq *FQ-CC* (reverse out))
          ;; osnovni standard mora da postoji, vrati ga ako fali
          (if (not (assoc *FQ-CC-BAZNI* *FQ-CC*))
            (setq *FQ-CC* (cons (list *FQ-CC-BAZNI* *FQ-CC-TIA*
                                      '("-p" "-2p" "-3p"))
                                *FQ-CC*)))
          (if (not (assoc *fq-kod* *FQ-CC*))
            (setq *fq-kod* *FQ-CC-BAZNI*))
          (list (length *FQ-CC*) fn))
        nil))
    nil))


;;; ------------------------------------------------------------------
;;;  4bb. KATALOG KABLOVA U FAJL
;;;
;;;  *FQ-KABLOVI* je do 1.0.0 bio jedini katalog bez svog .dat fajla:
;;;  boje su imale FQCC, kucista FQKATSAVE, kablovi nista.  Tip kabla
;;;  koji korisnik upise u dijalogu vazio je za taj jedan kabl i nestajao
;;;  sa sesijom.
;;;
;;;  Ovo je JEDINI .dat ciji se format odredjuje sada, bez nasledja, pa
;;;  verziju nosi od prvog dana -- za razliku od fq-kucista.dat, gde je
;;;  morala da se dopisuje naknadno i gde "1" znaci "fajl bez nje".
;;;
;;;  Citac NE IZVRSAVA ono sto procita.  (load) nad korisnickim .dat
;;;  fajlom znaci da se sve sto se u njemu nadje izvrsava sa punim
;;;  pravima AutoLISP-a, pri svakom pokretanju.  Isti razlog kao kod
;;;  fq:katparse; test-lisp.ps1 obara build ako se (load pojavi u
;;;  biblioteci.
;;; ------------------------------------------------------------------

(setq *FQ-KBL-VERZIJA* "1")
(setq *fq-kbl-ucit* nil)   ; putanja iz koje je katalog kablova ucitan
(setq *fq-kbl-dop*  0)     ; koliko je tipova dopisano iz isporuke

(defun fq:kblpaths ( / l p)
  (setq l nil)
  (if (setq p (getvar "ROAMABLEROOTPREFIX"))
    (setq l (cons (strcat p "Support\\fq-kablovi.dat") l)))
  (if (setq p (getenv "APPDATA"))
    (setq l (cons (strcat p "\\FiberQ\\fq-kablovi.dat") l)))
  (reverse l))

;; Jedan tip: (ime ((cevcica vlakana) ...)).  Kapacitet mora biti par
;; pozitivnih celih brojeva -- nula cevcica prolazi kroz fq:velik i
;; nacrta kabl bez ijedne cevcice, prazan zapis koji specifikacija broji
;; kao stavku.
(defun fq:kbltipok (x / k)
  (and (= (type x) 'LIST)
       (setq k (vl-list-length x))
       (>= k 2)
       (= (type (car x)) 'STR)
       (/= (car x) "")
       (listp (cadr x))
       (cadr x)
       (not (vl-some
              '(lambda (c)
                 (not (and (= (type c) 'LIST)
                           (equal (vl-list-length c) 2)
                           (= (type (car  c)) 'INT)
                           (= (type (cadr c)) 'INT)
                           (> (car  c) 0)
                           (> (cadr c) 0))))
              (cadr x)))))

;; Jedna kategorija: (naziv (tipovi)).  BAR dva clana, ne tacno dva --
;; isti razlog kao kod fq:katok: cim neka kasnija verzija doda trece
;; polje, "tacno dva" bi tiho odbacilo ceo korisnicki katalog.
(defun fq:kblok (r / n)
  (and (= (type r) 'LIST)
       (setq n (vl-list-length r))
       (>= n 2)
       (= (type (car r)) 'STR)
       (/= (car r) "")
       (listp (cadr r))
       (cadr r)
       (not (vl-some '(lambda (x) (not (fq:kbltipok x))) (cadr r)))))

;; Vraca (kablovi verzija) ili nil.  Nista ne upisuje u globalne.
(defun fq:kblparse (p / f s tt blok kbl ver x)
  (setq kbl nil blok nil ver "0")
  (if (setq f (open p "r"))
    (progn
      (while (setq s (read-line f))
        (setq tt (vl-string-trim " \t" s))
        (cond
          ((= tt "") nil)
          ((= (substr tt 1 1) ";") nil)
          ;; vl-string-search, a ne wcmatch: ime globalne je puno
          ;; zvezdica, a one su u wcmatch-u dzokeri.  Verzija ide PRVA,
          ;; jer "*FQ-KBL-VERZIJA*" i "*FQ-KABLOVI*" nisu jedno u drugom
          ;; ali bi neko trece ime lako moglo da bude.
          ((vl-string-search "*FQ-KBL-VERZIJA*" (strcase tt))
            (setq x (vl-catch-all-apply 'read (list tt)))
            (if (and (not (vl-catch-all-error-p x))
                     (listp x)
                     (= (type (caddr x)) 'STR))
              (setq ver (caddr x))))
          ((vl-string-search "*FQ-KABLOVI*" (strcase tt)) (setq blok T))
          ((= tt "))") (setq blok nil))
          (blok
            (setq x (vl-catch-all-apply 'read (list tt)))
            (if (and (not (vl-catch-all-error-p x)) (fq:kblok x))
              (setq kbl (cons x kbl))))))
      (close f)
      (list (reverse kbl) ver))
    nil))

;; Tipovi iz ISPORUCENOG kataloga kojih u korisnickom nema, dopisani na
;; kraj svoje kategorije; kategorija koje uopste nema dopisuje se cela.
;; Postojeci zapisi se NE diraju.
;;
;; Spaja se po TIPU, ne po kategoriji: kategorija ima cetiri i one se ne
;; menjaju, a ono sto nova verzija donosi jesu novi tipovi unutar njih.
(defun fq:kblspoj (kor isp / out n rec tipovi ime)
  (setq out kor n 0)
  (foreach r isp
    (if (not (setq rec (assoc (car r) out)))
      (setq out (append out (list r)) n (+ n (length (cadr r))))
      (progn
        (setq tipovi (cadr rec)
              ime    (mapcar '(lambda (x) (strcase (car x))) tipovi))
        (foreach tp (cadr r)
          (if (not (member (strcase (car tp)) ime))
            (setq tipovi (append tipovi (list tp))
                  ime    (append ime (list (strcase (car tp))))
                  n      (1+ n))))
        (setq out (subst (fq:setnthx rec 1 tipovi) rec out)))))
  (setq *fq-kbl-dop* n)
  out)

;; Sve ili nista, isto pravilo kao kod fq:katload: katalog koji je pola
;; korisnicki pola fabricki gori je od oba.
(defun fq:kblload ( / p r x)
  (setq r nil *fq-kbl-dop* 0)
  (foreach p (fq:kblpaths)
    (if (and (not r) (findfile p))
      (progn
        (setq x (vl-catch-all-apply 'fq:kblparse (list p)))
        (if (and (not (vl-catch-all-error-p x)) x (car x))
          (progn
            ;; *FQ-KABLOVI* je ovde jos ISPORUCEN katalog -- ova funkcija
            ;; se zove na nivou fajla, ispod njegovog setq.
            (setq *FQ-KABLOVI*
                  (if (= (cadr x) *FQ-KBL-VERZIJA*)
                    (car x)
                    (fq:kblspoj (car x) *FQ-KABLOVI*)))
            (setq r p))))))
  r)

(defun c:FQKABLSAVE ( / *error* f p r ok pr)
  (setq *error* fq:err)
  (setq ok nil)
  (foreach p (fq:kblpaths)
    (if (not ok)
      (progn
        (setq pr (fq:tmpime p)
              f  (vl-catch-all-apply 'open (list pr "w")))
        (if (and f (not (vl-catch-all-error-p f)))
          (progn
            (write-line ";;; FiberQ katalog kablova, pravi FQKABLSAVE" f)
            (write-line (strcat "(setq *FQ-KBL-VERZIJA* \""
                                *FQ-KBL-VERZIJA* "\")") f)
            (write-line "(setq *FQ-KABLOVI* '(" f)
            ;; vl-prin1-to-string, a ne rucno lepljenje navodnika: tip
            ;; kabla sa navodnikom u imenu inace pravi fajl koji se ne
            ;; moze procitati nazad, a to se vidi tek pri sledecem
            ;; pokretanju
            (foreach r *FQ-KABLOVI*
              (write-line (strcat "  " (vl-prin1-to-string r)) f))
            (write-line "))" f)
            (close f)
            (if (fq:zameni p pr) (setq ok p)))))))
  (if ok
    (princ (fq:tf "kbl.sacuvan" (list ok)))
    (princ (fq:tf "kbl.ne.sacuvan" (list (car (fq:kblpaths))))))
  (princ))

;; Dopisuje nov tip u kategoriju.  Vraca T ako je stvarno dopisan.
;;
;; Kapacitete NASLEDJUJE od tipa koji je u dijalogu bio izabran kada je
;; ime ukucano.  To je jedina vrednost koju dijalog u tom trenutku ima, i
;; po smislu je tacna: nov tip se upisuje kao varijanta onoga sto je vec
;; izabrano.  Ko hoce drugaciji spisak, menja fq-kablovi.dat rucno --
;; zato je fajl obican tekst.
;;
;; fq:setnthx menja samo polje 1 i prenosi ostalo, isti razlog kao u
;; fq:kc-addmod: zapis kategorije sme jednog dana da dobije trece polje.
(defun fq:kbladdtip (katn tipn kaps / rec tipovi)
  (if (and tipn (/= tipn "") kaps (setq rec (assoc katn *FQ-KABLOVI*)))
    (progn
      (setq tipovi (cadr rec))
      (if (vl-some '(lambda (x) (= (strcase (car x)) (strcase tipn))) tipovi)
        nil
        (progn
          (setq *FQ-KABLOVI*
                (subst (fq:setnthx rec 1
                                   (append tipovi (list (list tipn kaps))))
                       rec *FQ-KABLOVI*))
          T)))))


;;; ------------------------------------------------------------------
;;;  4c. FQCC   editor color code standarda
;;; ------------------------------------------------------------------

;;;  Standard se sastavlja biranjem iz spiska poznatih boja, jer se svi
;;;  standardi za opticka vlakna razlikuju samo po redosledu istih boja.
;;;
;;;  Sve se desava U dijalogu. Ranije je svaka izmena zatvarala i
;;;  ponovo otvarala prozor, pa je sastavljanje jednog standarda
;;;  znacilo dvanaest krugova kroz komandnu liniju.
;;;  Jedino dugme koje izlazi je Ostala boja, jer DCL ne dozvoljava
;;;  da se iz dijaloga otvori drugi dijalog.
;;;
;;;  Nista nije trajno dok se ne klikne Sacuvaj u fajl.

;; --- zapis standarda, uvek sa sva tri clana -----------------------
(defun fq:ccrec (nm boje pr) (list nm boje pr))

(defun fq:ccput (i nm boje pr)
  (setq *FQ-CC* (fq:setnth *FQ-CC* i (fq:ccrec nm boje pr))))

;; --- punjenje lista -----------------------------------------------

(defun fq:ccstdfill ( / s)
  (start_list "std")
  (foreach s *FQ-CC*
    (add_list (strcat (if (= (car s) *fq-kod*) "* " "  ")
                      (car s)
                      "   (" (itoa (length (cadr s))) ")"
                      (if (fq:bazni (car s)) (fq:t "dcl.cc.osnovni") ""))))
  (end_list)
  T)

;;  Obe liste pokazuju naziv boje kroz fq:bojnaz, po ACI-ju, isto kao
;;  natpis uz vlakno i legenda.  Prevodi se SAMO prikaz -- redosled se
;;  ne dira, a on je jedino sto ove dve liste vracaju: dugmad rade po
;;  indeksu, ne po tekstu.
;;
;;  Korisnikova boja, ciji ACI nije medju poznatima, pada na svoju rec.
(defun fq:ccbojfill (idx / rec i c nm)
  (start_list "boj")
  (setq rec (nth idx *FQ-CC*) i 1)
  (if rec
    (foreach c (cadr rec)
      (add_list (strcat (itoa i) ".  "
                        (if (setq nm (fq:bojnaz (cdr c))) nm (car c))))
      (setq i (1+ i))))
  (end_list)
  T)

(defun fq:ccpozfill ( / i c nm)
  (start_list "poz")
  (setq i 1)
  (foreach c *FQ-POZNATE*
    (add_list (strcat (if (setq nm (fq:bojnaz (cdr c))) nm (car c))
                      "   ACI " (itoa (cdr c))))
    (setq i (1+ i)))
  (end_list)
  T)

;; Traka boja desno od liste. DCL list_box ne ume da boji redove,
;; pa se ceo niz prikazuje kao vertikalna traka u image polju.
(defun fq:cctraka (kljuc lst / n w h i y1 y2 c)
  (setq n (length lst))
  (start_image kljuc)
  (setq w (dimx_tile kljuc) h (dimy_tile kljuc))
  (fill_image 0 0 w h -2)
  (if (> n 0)
    (progn
      (setq i 0)
      (foreach c lst
        (setq y1 (/ (* i h) n)
              y2 (/ (* (1+ i) h) n))
        (fill_image 0 y1 w (- y2 y1) (cdr c))
        (setq i (1+ i)))
      ;; tanka linija izmedju traka, da se bela i siva razdvoje
      (setq i 1)
      (while (< i n)
        (fill_image 0 (/ (* i h) n) w 1 8)
        (setq i (1+ i)))))
  (end_image)
  T)

;; --- osvezavanje celog dijaloga -----------------------------------
;;  set_tile nad list_box-om okida i njegovu akciju, pa bi bez ove
;;  brave osvezavanje pozivalo samo sebe.

(defun fq:ccinfo (s)
  (set_tile "info" s)
  T)

(defun fq:ccosv ( / rec)
  (if *fq-busy*
    T
    (progn
      (setq *fq-busy* T)
      (setq *fq-si* (fq:clamp *fq-si* (length *FQ-CC*)))
      (setq rec (nth *fq-si* *FQ-CC*))
      (setq *fq-bi* (fq:clamp *fq-bi* (max 1 (length (cadr rec)))))
      (fq:ccstdfill)
      (set_tile "std" (itoa *fq-si*))
      (fq:ccbojfill *fq-si*)
      (if (cadr rec) (set_tile "boj" (itoa *fq-bi*)))
      (fq:cctraka "img" (cadr rec))
      (set_tile "prs" (fq:ccprstr (caddr rec)))
      (fq:ccinfo (fq:tf "cc.info.stanje" (list *fq-kod* (car rec) (itoa (length (cadr rec))))))
      (setq *fq-busy* nil)
      T)))

;; oznake grupa kao tekst za polje, i nazad
(defun fq:ccprstr (p / s x)
  (setq s "")
  (foreach x (if p p '())
    (setq s (if (= s "") x (strcat s ", " x))))
  s)

(defun fq:ccprlst (s / out x)
  (setq out nil)
  (foreach x (fq:split s ",")
    (setq x (fq:trim x))
    (if (/= x "") (setq out (cons x out))))
  (reverse out))

;; --- radnje nad bojama --------------------------------------------

(defun fq:cc-dodaj ( / rec p)
  (setq rec (nth *fq-si* *FQ-CC*)
        p   (nth *fq-pi* *FQ-POZNATE*))
  (if (not p)
    (fq:ccinfo (fq:t "cc.info.izaberi.boju"))
    (progn
      (fq:ccput *fq-si* (car rec)
                (append (cadr rec) (list (cons (car p) (cdr p))))
                (caddr rec))
      (setq *fq-bi* (1- (length (cadr (nth *fq-si* *FQ-CC*)))))
      (fq:ccosv)
      (fq:ccinfo (fq:tf "cc.info.dodata" (list (car p) (itoa (1+ *fq-bi*))))))))

(defun fq:cc-ukloni ( / rec lst)
  (setq rec (nth *fq-si* *FQ-CC*) lst (cadr rec))
  (if (not lst)
    (fq:ccinfo (fq:t "cc.info.prazan"))
    (progn
      (fq:ccput *fq-si* (car rec) (fq:remnth lst *fq-bi*) (caddr rec))
      (setq *fq-bi* (fq:clamp *fq-bi* (max 1 (1- (length lst)))))
      (fq:ccosv)
      (fq:ccinfo (fq:t "cc.info.uklonjena")))))

(defun fq:cc-pomeri (d / rec lst j)
  (setq rec (nth *fq-si* *FQ-CC*) lst (cadr rec) j (+ *fq-bi* d))
  (if (or (not lst) (< j 0) (>= j (length lst)))
    (fq:ccinfo (fq:t "cc.info.kraj"))
    (progn
      (fq:ccput *fq-si* (car rec) (fq:swap lst *fq-bi* j) (caddr rec))
      (setq *fq-bi* j)
      (fq:ccosv)
      (fq:ccinfo (fq:tf "cc.info.pomerena" (list (itoa (1+ j))))))))

(defun fq:cc-zameni ( / rec lst p)
  (setq rec (nth *fq-si* *FQ-CC*)
        lst (cadr rec)
        p   (nth *fq-pi* *FQ-POZNATE*))
  (if (or (not lst) (not p))
    (fq:ccinfo (fq:t "cc.info.izaberi.mesto"))
    (progn
      (fq:ccput *fq-si* (car rec)
                (fq:setnth lst *fq-bi* (cons (car p) (cdr p)))
                (caddr rec))
      (fq:ccosv)
      (fq:ccinfo (fq:tf "cc.info.zamenjena" (list (itoa (1+ *fq-bi*)) (car p)))))))

;; ceo niz odjednom, upisan zarezima
(defun fq:cc-lista ( / rec s lst w p ne)
  (setq rec (nth *fq-si* *FQ-CC*)
        s   (get_tile "lst")
        lst nil
        ne  "")
  (if (= (fq:trim s) "")
    (fq:ccinfo (fq:t "cc.info.niz"))
    (progn
      (foreach w (fq:split s ",")
        (setq w (fq:trim w))
        (if (/= w "")
          (progn
            (setq p (assoc (strcase w) *FQ-BOJENAZ*))
            (if p
              (setq lst (cons (cons w (cdr p)) lst))
              (setq ne (if (= ne "") w (strcat ne ", " w)))))))
      (setq lst (reverse lst))
      (if (not lst)
        (fq:ccinfo (fq:t "cc.info.ne.prepoznato"))
        (progn
          (fq:ccput *fq-si* (car rec) lst (caddr rec))
          (setq *fq-bi* 0)
          (fq:ccosv)
          (fq:ccinfo (fq:tf "cc.info.upisano" (list (itoa (length lst)) (if (= ne "") "" (fq:tf "cc.info.nepoznate" (list ne)))))))))))

(defun fq:cc-prsten ( / rec)
  (setq rec (nth *fq-si* *FQ-CC*))
  (fq:ccput *fq-si* (car rec) (cadr rec) (fq:ccprlst (get_tile "prs")))
  (fq:ccosv)
  (fq:ccinfo (fq:t "cc.info.grupe")))

;; --- radnje nad standardima ---------------------------------------

(defun fq:cc-novi (kopija / nm rec)
  (setq nm  (fq:trim (get_tile "snm"))
        rec (nth *fq-si* *FQ-CC*))
  (cond
    ((= nm "") (fq:ccinfo (fq:t "cc.info.upisi.naziv")))
    ((fq:jenaziv nm) (fq:ccinfo (fq:t "cc.info.vec.postoji")))
    (T
     (setq *FQ-CC* (append *FQ-CC*
                           (list (fq:ccrec nm
                                           (if kopija (cadr rec) nil)
                                           (if kopija (caddr rec) nil))))
           *fq-si*  (1- (length *FQ-CC*))
           *fq-bi*  0)
     (fq:ccosv)
     (if kopija
       (fq:ccinfo (fq:tf "cc.info.kopija"     (list nm)))
       (fq:ccinfo (fq:tf "cc.info.prazan.nov" (list nm)))))))

(defun fq:cc-preimenuj ( / nm rec)
  (setq nm  (fq:trim (get_tile "snm"))
        rec (nth *fq-si* *FQ-CC*))
  (cond
    ((fq:bazni (car rec))
     (fq:ccinfo (fq:t "cc.info.osnovni.pre")))
    ((= nm "")       (fq:ccinfo (fq:t "cc.info.novi.naziv")))
    ((fq:jenaziv nm) (fq:ccinfo (fq:t "cc.info.vec.postoji")))
    (T
     (if (= *fq-kod* (car rec)) (setq *fq-kod* nm))
     (fq:ccput *fq-si* nm (cadr rec) (caddr rec))
     (fq:ccosv)
     (fq:ccinfo (fq:tf "cc.info.preimenovano" (list nm))))))

;; Brisanje trazi drugi klik, jer u dijalogu nema Da/Ne pitanja.
(defun fq:cc-obrisi ( / rec)
  (setq rec (nth *fq-si* *FQ-CC*))
  (cond
    ((fq:bazni (car rec))
     (fq:ccinfo (fq:t "cc.info.osnovni.bri")))
    ((<= (length *FQ-CC*) 1)
     (fq:ccinfo (fq:t "cc.info.bar.jedan")))
    ((/= *fq-del* *fq-si*)
     (setq *fq-del* *fq-si*)
     (fq:ccinfo (fq:tf "cc.info.potvrdi" (list (car rec)))))
    (T
     (setq *FQ-CC* (fq:remnth *FQ-CC* *fq-si*)
           *fq-si* (fq:clamp *fq-si* (length *FQ-CC*))
           *fq-bi* 0
           *fq-del* -1)
     (if (not (assoc *fq-kod* *FQ-CC*)) (setq *fq-kod* *FQ-CC-BAZNI*))
     (fq:ccosv)
     (fq:ccinfo (fq:t "cc.info.obrisan")))))

(defun fq:cc-aktivan ( / rec)
  (setq rec (nth *fq-si* *FQ-CC*))
  (if (not (cadr rec))
    (fq:ccinfo (fq:t "cc.info.prazan.aktivan"))
    (progn
      (setq *fq-kod* (car rec))
      (fq:ccosv)
      (fq:ccinfo (fq:tf "cc.info.aktivan" (list *fq-kod*))))))

;; Poruka o neuspehu nosi PUNU putanju koja je pokusana.  Bez nje
;; korisnik ne moze da uradi nista osim da javi "ne radi": ne zna ni gde
;; se pisalo, ni da li mu je taj folder uopste dostupan.
(defun fq:cc-sacuvaj ( / p)
  (setq p (fq:ccsave))
  (if p
    (fq:ccinfo (fq:tf "cc.info.sacuvano" (list p)))
    (fq:ccinfo (fq:tf "cc.info.ne.mogu" (list (car (fq:ccwpaths)))))))

;; --- DCL ----------------------------------------------------------
;;
;;  DCL fajl se sklapa u toku rada, red po red, i pise u TEMPPREFIX pri
;;  SVAKOM otvaranju dijaloga.  Otuda i to da prebacivanje jezika hvata
;;  vec otvaran dijalog: nema kesa, sledece otvaranje pise nov fajl.
;;
;;  Prevodi se samo `label`.  Kljuc (`key = "mod"`) ostaje kakav jeste --
;;  po njemu se polje nalazi iz koda, kroz get_tile i action_tile, a
;;  promasaj se ne vidi kao greska nego kao polje koje je uvek prazno.

;;  Navodnik u natpisu razbija DCL.  On nema nacina da ga oznaci kao deo
;;  niske, pa `rack 19"` zatvori nisku na pola i ostatak reda ostane kao
;;  besmislena sintaksa -- dijalog se ne otvori, a poruka govori o DCL
;;  fajlu, ne o imenu standarda.
;;
;;  Do 1.0.0 je to bilo zapisano kao poznato ogranicenje, jer je tekst u
;;  DCL ulazio sa vise mesta i nije ga bilo gde presresti.  Sada ulazi
;;  kroz fq:dcll, pa presretanje ima gde da stoji: navodnik postaje dva
;;  apostrofa, sto se za inc i cita isto (`rack 19''`).
;;
;;  Vazi za SVE sto u natpis ulazi -- i za tabelu niski i za korisnicki
;;  katalog.  Nase niske navodnik nemaju, ali ih niko ne cuva od toga da
;;  ga jednog dana dobiju.
(defun fq:dclq (s / i n out)
  (if (not s)
    ""
    (progn
      (setq out "" i 1 n (strlen s))
      (while (<= i n)
        (setq out (strcat out (if (= (substr s i 1) "\"") "''" (substr s i 1)))
              i   (1+ i)))
      out)))

;;  Jedan red DCL-a kome je natpis promenljiv: tri dela, a onaj u sredini
;;  uvek prolazi kroz fq:dclq.
;;
;;  Prima VEC PREVEDEN tekst, ne kljuc, i to je namerno.  Da prima kljuc,
;;  fq:t bi ga dobio kao promenljivu, svih osamdesetak poziva bi postalo
;;  "racunat kljuc" i nijedan se ne bi proveravao -- tacno ona rupa zbog
;;  koje provera racunate kljuceve i prijavljuje.  Ovako kljuc ostaje
;;  doslovna niska odmah iza fq:t, na mestu poziva.
(defun fq:dcll (f pre s po)
  (write-line (strcat pre (fq:dclq s) po) f))

(defun fq:dclcc ( / fn f)
  (setq fn (strcat (getvar "TEMPPREFIX") "fq-cc.dcl"))
  (setq f (open fn "w"))
  (if f
    (progn
      (fq:dcll f "fqcc : dialog { label = \"" (fq:t "dcl.naslov.cc") "\";")
      (write-line " : row {" f)

      (fq:dcll f "  : boxed_column { label = \"" (fq:t "dcl.cc.standardi") "\";")
      (write-line "   : list_box { key = \"std\"; width = 28; height = 13; }" f)
      (fq:dcll f "   : edit_box { key = \"snm\"; label = \"" (fq:t "dcl.cc.naziv") "\";")
      (write-line "                edit_width = 16; }" f)
      (write-line "   : row {" f)
      (fq:dcll f "    : button { key = \"snew\"; label = \"" (fq:t "dcl.cc.novi") "\"; }")
      (fq:dcll f "    : button { key = \"scop\"; label = \"" (fq:t "dcl.cc.kopiraj") "\"; }")
      (write-line "   }" f)
      (write-line "   : row {" f)
      (fq:dcll f "    : button { key = \"sren\"; label = \"" (fq:t "dcl.cc.preimenuj") "\"; }")
      (fq:dcll f "    : button { key = \"sdel\"; label = \"" (fq:t "dcl.cc.obrisi") "\"; }")
      (write-line "   }" f)
      (write-line "   : button { key = \"act\";" f)
      (fq:dcll f "              label = \"" (fq:t "dcl.cc.aktivan") "\"; }")
      (write-line "  }" f)

      (fq:dcll f "  : boxed_column { label = \"" (fq:t "dcl.cc.redosled") "\";")
      (write-line "   : row {" f)
      (write-line "    : list_box { key = \"boj\"; width = 22; height = 13; }" f)
      (write-line "    : image { key = \"img\"; width = 4; height = 13;" f)
      (write-line "              color = -2; }" f)
      (write-line "   }" f)
      (write-line "   : row {" f)
      (fq:dcll f "    : button { key = \"bup\";  label = \"" (fq:t "dcl.cc.gore") "\"; }")
      (fq:dcll f "    : button { key = \"bdn\";  label = \"" (fq:t "dcl.cc.dole") "\"; }")
      (write-line "   }" f)
      (write-line "   : row {" f)
      (fq:dcll f "    : button { key = \"bdel\"; label = \"" (fq:t "dcl.cc.ukloni") "\"; }")
      (fq:dcll f "    : button { key = \"bzam\"; label = \"" (fq:t "dcl.cc.zameni") "\"; }")
      (write-line "   }" f)
      (write-line "  }" f)

      (fq:dcll f "  : boxed_column { label = \"" (fq:t "dcl.cc.poznate") "\";")
      (write-line "   : row {" f)
      (write-line "    : list_box { key = \"poz\"; width = 20; height = 13; }" f)
      (write-line "    : image { key = \"img2\"; width = 4; height = 13;" f)
      (write-line "              color = -2; }" f)
      (write-line "   }" f)
      (write-line "   : button { key = \"padd\";" f)
      (fq:dcll f "              label = \"" (fq:t "dcl.cc.dodaj") "\"; }")
      (write-line "   : button { key = \"pcus\";" f)
      (fq:dcll f "              label = \"" (fq:t "dcl.cc.ostala") "\"; }")
      (write-line "  }" f)

      (write-line " }" f)

      (fq:dcll f " : boxed_row { label = \"" (fq:t "dcl.cc.niz") "\";")
      (write-line "  : edit_box { key = \"lst\"; edit_width = 52; }" f)
      (fq:dcll f "  : button { key = \"lok\"; label = \"" (fq:t "dcl.cc.primeni.niz") "\"; }")
      (write-line " }" f)
      (fq:dcll f " : boxed_row { label = \"" (fq:t "dcl.cc.prefiksi") "\";")
      (write-line "  : edit_box { key = \"prs\"; edit_width = 30; }" f)
      (fq:dcll f "  : button { key = \"pok\"; label = \"" (fq:t "dcl.cc.primeni.pre") "\"; }")
      (write-line " }" f)
      (write-line " : text { key = \"info\"; label = \"\"; width = 88; }" f)
      (write-line " : row {" f)
      (write-line "  : button { key = \"sav\";" f)
      (fq:dcll f "             label = \"" (fq:t "dcl.cc.sacuvaj") "\"; width = 20; }")
      (fq:dcll f "  : button { key = \"cancel\"; label = \"" (fq:t "dcl.zatvori") "\";")
      (write-line "             is_cancel = true; is_default = true; width = 14; }" f)
      (write-line " }" f)
      (write-line "}" f)
      (close f)
      fn)
    nil))

;; --- komanda ------------------------------------------------------

(defun c:FQCC ( / *error* fn id r rec nm aci)
  (setq *error* fq:err)
  (if (not *fq-si*) (setq *fq-si* 0))
  (if (not *fq-bi*) (setq *fq-bi* 0))
  (if (not *fq-pi*) (setq *fq-pi* 0))
  (setq r 5)
  (while (/= r 0)
    (setq *fq-si*  (fq:clamp *fq-si* (length *FQ-CC*))
          *fq-busy* nil
          *fq-del* -1
          fn       (fq:dclcc))
    (if (and fn
             (>= (setq id (load_dialog fn)) 0)
             (new_dialog "fqcc" id))
      (progn
        (fq:ccpozfill)
        (fq:cctraka "img2" *FQ-POZNATE*)
        (set_tile "poz" (itoa (fq:clamp *fq-pi* (length *FQ-POZNATE*))))
        (fq:ccosv)

        (action_tile "std" "(setq *fq-si* (atoi $value) *fq-bi* 0)(fq:ccosv)")
        (action_tile "boj" "(setq *fq-bi* (atoi $value))")
        (action_tile "poz" "(setq *fq-pi* (atoi $value))")

        (action_tile "padd" "(fq:cc-dodaj)")
        (action_tile "bdel" "(fq:cc-ukloni)")
        (action_tile "bup"  "(fq:cc-pomeri -1)")
        (action_tile "bdn"  "(fq:cc-pomeri 1)")
        (action_tile "bzam" "(fq:cc-zameni)")
        (action_tile "lok"  "(fq:cc-lista)")
        (action_tile "pok"  "(fq:cc-prsten)")

        (action_tile "snew" "(fq:cc-novi nil)")
        (action_tile "scop" "(fq:cc-novi T)")
        (action_tile "sren" "(fq:cc-preimenuj)")
        (action_tile "sdel" "(fq:cc-obrisi)")
        (action_tile "act"  "(fq:cc-aktivan)")
        (action_tile "sav"  "(fq:cc-sacuvaj)")

        ;; jedino dugme koje mora da izadje iz dijaloga
        (action_tile "pcus" "(done_dialog 5)")
        (action_tile "cancel" "(done_dialog 0)")

        (setq r (start_dialog))
        (unload_dialog id)

        (if (= r 5)
          (progn
            (setq rec (nth *fq-si* *FQ-CC*))
            (setq nm (getstring T (fq:t "cc.pitaj.boja")))
            (if (= nm "")
              (princ (fq:t "opste.otkazano"))
              (progn
                (setq aci (acad_colordlg 7 nil))
                (if (not aci)
                  (princ (fq:t "opste.otkazano"))
                  (progn
                    (fq:ccput *fq-si* (car rec)
                              (append (cadr rec) (list (cons nm aci)))
                              (caddr rec))
                    (setq *fq-bi* (1- (length (cadr (nth *fq-si* *FQ-CC*)))))
                    (princ (fq:tf "cc.boja.dodata" (list nm (itoa aci)))))))))))
      (progn (princ (fq:t "cc.editor.ne")) (setq r 0))))
  (princ (fq:tf "cc.aktivan" (list *fq-kod*)))
  (princ))



;;; ------------------------------------------------------------------
;;;  5. LEJERI I STILOVI   (naziv  ACI  debljina)
;;; ------------------------------------------------------------------

;;;  IME LEJERA JE ZAMRZNUTO, OPIS PRATI JEZIK.
;;;
;;;  Zapis je (ime aci debljina nazivSr nazivEn).  Naziv NE ulazi u ime
;;;  lejera i nikad nece: imena stoje u svakom vec nacrtanom crtezu, a u
;;;  kodu se javljaju oko 250 puta kao filteri ssget-a.  Preimenovanje se
;;;  ne bi videlo kao greska nego kao prazna specifikacija.
;;;
;;;  Naziv ide u DESCRIPTION lejera, kolonu koju AutoCAD pokazuje u
;;;  Layer Properties Manager-u -- vidi fq:layopis.  Time korisnik koji ne
;;;  zna srpski dobija "Fiber" pored FQ_VLAKNO, a nijedan filter, nijedan
;;;  zatecen crtez i nijedno pravilo se ne dira.
;;;
;;;  OBA NAZIVA STOJE OVDE, ne u *FQ-STR-*.  Isti razlog kao kod
;;;  *FQ-KODOVI* i *FQ-POLJA*: ovo je jedino mesto gde ime lejera i oba
;;;  naziva stoje jedan uz drugi, pa ne mogu da se raziju.  Kljuc niske bi
;;;  bio jos jedna niska koju treba drzati u koraku sa ovom tabelom.
(setq *FQ-LAYERS*
  (list (list "FQ_VLAKNO"    7 *FQ-LW-TANKA* "Vlakno"          "Fiber")
        (list "FQ_CEVCICA"   7 *FQ-LW-TANKA* "Cevcica kabla"   "Cable tube")
        (list "FQ_OZNAKA"    7 *FQ-LW-TANKA* "Oznake vlakana"  "Fiber labels")
        (list "FQ_NASTAVAK"  1 25            "Nastavak"        "Closure")
        ;; FQ_KASETA nijedan crtac ne koristi -- kaseta se ne crta (vidi
        ;; komentar uz red nastavka u c:FQLEGENDA).  Ostaje u tabeli
        ;; namerno, za slucaj da kaseta jednog dana dobije svoj simbol;
        ;; prazan lejer nista ne kosta.
        (list "FQ_KASETA"    7 *FQ-LW-TANKA* "Kasete nastavka" "Closure cassettes")
        (list "FQ_VARENJE"   1 *FQ-LW-TANKA* "Varenje"         "Splice")
        (list "FQ_SPLITER"   5 25            "Spliter"         "Splitter")
        (list "FQ_ODF"       4 25            "ODF modul"       "ODF module")
        (list "FQ_ODO"       3 25            "ODO ormar"       "FDH cabinet")
        (list "FQ_OLT"       6 25            "OLT"             "OLT")
        (list "FQ_ONT"       2 25            "ONT i privod"    "ONT and drop")
        (list "FQ_REZERVA"  30 *FQ-LW-TANKA* "Rezerva kabla"   "Cable slack")
        (list "FQ_TABELA"    8 *FQ-LW-TANKA* "Specifikacija i budzet" "Bill of materials and budget")
        (list "FQ_LEGENDA"   8 *FQ-LW-TANKA* "Legenda simbola" "Symbol legend")
        ;; FQ_ZOK crta fq-kucista.lsp, a stoji ovde.  Ranije ga je taj
        ;; fajl sam dopisivao pri ucitavanju, pod uslovom da je
        ;; *FQ-LAYERS* vec vezan -- pa je zavisio od redosleda i
        ;; FQSTIL je znao da prijavi 14 lejera umesto 15.  Lejer nije
        ;; tajna fq-kucista.lsp-a, samo ga on koristi; spisak lejera
        ;; jeste jedan i mora da bude potpun bez obzira ko se ucitao.
        ;; Boja 4 je ista koju nosi FQ_ODF: ZOK je po nameni mali ODF.
        (list "FQ_ZOK"       4 25            "ZOK kutija"      "FAT box")))

;;  Naziv lejera na tekucem jeziku, iz *FQ-LAYERS*.
;;
;;  Zapis od TRI clana vraca nil, i to je namerno: takav zapis pravi samo
;;  pojas u fq-kucista.lsp, kad se uz nov fq-kucista.lsp ucita STARIJI
;;  fq-sema.lsp.  Tada opisa prosto nema, a fq:layopis nil propusta.
(defun fq:layime (p)
  (if (= *fq-jezik* "EN") (nth 4 p) (nth 3 p)))

;;  Opis lejera -- kolona Description u Layer Properties Manager-u.
;;
;;  Cuva se kao xdata na samom zapisu lejera, pod aplikacijom
;;  "AcAecLayerStandard", i to kao DVE niske grupe 1000: prva prazna,
;;  druga opis.  To nije dokumentovan API nego de-facto konvencija koju
;;  AutoCAD prati otkad ta kolona postoji.  Ako je neka verzija ignorise,
;;  lejer ostane bez opisa i nista se ne lomi -- zato i nema poruke o
;;  neuspehu.
;;
;;  ZASTO OPIS, A NE PREVEDENO IME.  Imena lejera su zamrznuta: stoje u
;;  svakom vec nacrtanom crtezu i u kodu su filteri ssget-a na oko 250
;;  mesta.  Preimenovanje se ne bi videlo kao greska nego kao prazna
;;  specifikacija.  Opis je jedini sloj koji sme da prati jezik.
;;
;;  entget se poziva SA spiskom aplikacija, pa se u d nadje samo xdata
;;  ove jedne; entmod onda menja samo nju i tudja xdata na lejeru ostaje
;;  netaknuta.  Bez spiska bi d bio bez ijedne xdata, pa bi entmod obrisao
;;  sve sto je neko drugi tamo ostavio.
(defun fq:layopis (nm opis / e d)
  (if (and (= (type opis) 'STR)
           (/= opis "")
           (setq e (tblobjname "LAYER" nm)))
    (progn
      (regapp "AcAecLayerStandard")
      (setq d (vl-remove-if '(lambda (x) (= (car x) -3))
                            (entget e '("AcAecLayerStandard"))))
      (entmod (append d
                      (list (list -3 (list "AcAecLayerStandard"
                                           (cons 1000 "")
                                           (cons 1000 opis)))))))))

;;  Opis se upisuje SAMO pri pravljenju lejera, unutar iste grane.
;;
;;  fq:layer zove fq:init, a fq:init se izvrsava pred SVAKOM komandom.
;;  Bezuslovan upis bi znacio sedamnaest entmod-ova nad tabelom lejera po
;;  svakoj komandi -- i, gore od cene, crtez bi bio oznacen kao izmenjen
;;  cak i kad korisnik samo pogleda podatke o elementu.
;;
;;  Zatecen crtez, kome lejeri vec postoje, opise dobija kroz FQSTIL,
;;  koji ionako postoji da bi zatecen crtez doveo na standard.
(defun fq:layer (nm cl lw opis)
  (if (not (tblsearch "LAYER" nm))
    (progn
      (entmake (list '(0 . "LAYER")
                     '(100 . "AcDbSymbolTableRecord")
                     '(100 . "AcDbLayerTableRecord")
                     (cons 2 nm) '(70 . 0) (cons 62 cl)
                     '(6 . "Continuous") (cons 370 lw)))
      (fq:layopis nm opis)))
  nm)

;; ZNAK grupe 62 je stanje ugasenosti, ne boja.  AutoCAD ugasen lejer
;; belezi kao NEGATIVNU boju, pa je bezuslovni (subst (cons 62 cl) ...)
;; palio svaki ugasen FQ_ lejer na koji naidje.  Korisnik bi pokrenuo
;; FQSTIL da poravna debljine i dobio bi nazad sve sto je namerno
;; sakrio -- a to na velikom crtezu izgleda kao da je komanda nesto
;; nacrtala.  Zato se znak cita pre upisa i vraca posle njega.
;;
;; Vraca rezultat entmod-a, ne golo T: nad lejerom u tudjem, zakljucanom
;; ili spoljno vezanom sloju entmod vrati nil, a stari kod je i tada
;; tvrdio da je uspeo.
(defun fq:layerset (nm cl lw opis / e d st)
  (if (setq e (tblobjname "LAYER" nm))
    (progn
      (setq d  (entget e)
            st (if (and (assoc 62 d) (minusp (cdr (assoc 62 d)))) -1 1))
      (if (assoc  62 d) (setq d (subst (cons 62 (* st cl)) (assoc 62 d) d))
                        (setq d (append d (list (cons  62 cl)))))
      (if (assoc 370 d) (setq d (subst (cons 370 lw) (assoc 370 d) d))
                        (setq d (append d (list (cons 370 lw)))))
      (fq:layopis nm opis)
      (if (entmod d) T nil))
    nil))

(defun fq:style (nm font)
  (if (not (tblsearch "STYLE" nm))
    (entmake (list '(0 . "STYLE")
                   '(100 . "AcDbSymbolTableRecord")
                   '(100 . "AcDbTextStyleTableRecord")
                   (cons 2 nm) '(70 . 0) '(40 . 0.0) '(41 . 1.0)
                   '(50 . 0.0) '(71 . 0) '(42 . 0.2)
                   (cons 3 font) '(4 . ""))))
  nm)

(defun fq:init ()
  (foreach p *FQ-LAYERS*
    (fq:layer (car p) (cadr p) (caddr p) (fq:layime p)))
  (fq:style "FQ_TXT"  "arial.ttf")
  (fq:style "FQ_TXTB" "arialbd.ttf")
  ;; Upozorenje o zakljucanom lejeru vazi za JEDNU komandu.  Da se spisak
  ;; ne prazni, prvi kabl bi javio, a svaki sledeci bi tiho propao --
  ;; korisnik bi popravio lejer, video da poruke nema, i zakljucio da je
  ;; sve u redu.  fq:init zove svaka crtacka komanda na ulazu.
  (setq *fq-zaklog* nil)
  ;; Ogledalo vazi za JEDNO kuciste i nikad se ne nasledjuje.  fq:init
  ;; zove svaka crtacka komanda na ulazu, pa ovde staje svako curenje iz
  ;; prethodne: kabl nacrtan posle ogledalnog ormara isao bi ulevo, a to
  ;; se ne bi videlo kao kvar nego kao pogresan klik.  Crtaci kucista
  ;; postavljaju *fq-m* POSLE fq:init, kroz fq:sistem.
  (setq *fq-m* 1.0)
  ;; Kes slobodnih kolona za uspravne prelaze spoja vazi za JEDNU
  ;; komandu.  Da ostane, sledeca komanda bi racunala sa kolonama iz
  ;; proslog nastavka i razmicala prelaze koji se ni ne dodiruju.
  ;; Brojac gustine se iz istog razloga prazni ovde, a ne posle ispisa.
  (setq *fq-spkol*  nil
        *fq-spgust* 0)
  T)

(defun fq:lwon ()
  (if (= 0 (getvar "LWDISPLAY"))
    (progn (setvar "LWDISPLAY" 1)
           (princ (fq:t "opste.lwdisplay"))))
  T)

;;; ------------------------------------------------------------------
;;;  BRAVA: crta se samo u svetskom koordinatnom sistemu
;;;
;;;  U celom projektu nema nijednog poziva (trans).  Tacke iz getpoint
;;;  i grread dolaze u TEKUCEM UCS-u, a ulaze pravo u entmake grupe 10
;;;  i 11, koje ocekuju svetske koordinate.  Dok je UCS svetski, to je
;;;  isto i sve radi; cim se UCS pomeri ili zarotira, sve pada na
;;;  pogresno mesto.
;;;
;;;  Kvar je opasan bas zato sto NE lici na kvar: kabl se nacrta, ima
;;;  svoja vlakna, svoje oznake i svoj xdata zapis, samo lezi hiljadu
;;;  jedinica u stranu ili zakosen.  U pogledu na ceo crtez to se ne
;;;  vidi, a specifikacija je uredna.
;;;
;;;  Pravi prevod kroz (trans) je zaseban posao za sledece izdanje.
;;;  Do tada je brava mala, sigurna i sprecava jedini stvarno los
;;;  ishod -- crtez koji izgleda ispravno a nije.
;;;
;;;  UCS se NE popravlja sam: (command "_.UCS" "_W") iz komande koja
;;;  odmah otvara DCL dijalog upada u zamku sa (command) usred dijaloga.
;;;  Zato se samo kaze sta da se otkuca.
;;; ------------------------------------------------------------------

(defun fq:ucsok ()
  (if (= 1 (getvar "WORLDUCS"))
    T
    (progn
      (princ (fq:t "opste.ucs.1"))
      (princ (fq:t "opste.ucs.2"))
      (princ (fq:t "opste.ucs.3"))
      nil)))

;; getpoint sa bravom.  Vraca tacku, ili nil ako UCS nije svetski.
;;
;; NE DIRAJ (getpoint msg) u ovom telu skriptom koja menja getpoint na
;; sirem skupu fajlova.  Bas to se desilo u 1.0.0: skripta iz Bloka 7
;; je prepisivala jednoargumentne (getpoint X) u (fq:gp X) kroz oba
;; fajla i prepisala i ovaj -- funkcija je pocela da zove samu sebe.
;; Rekurzija je bezuslovna, jer fq:ucsok na svetskom UCS-u uvek vrati T,
;; pa je AutoCAD padao na stack overflow kod FQOLT, FQONT, FQREZERVA,
;; FQSPLAJS, FQODVOD, FQPRESECI, FQTABELA i FQLEGENDA.
;;
;; Kvar je delovao hirovito jer FQKABL i ostali crtaci pod
;; podrazumevanim *FQ-DRAG* = T uopste ne prolaze ovuda -- oni idu kroz
;; fq:dragpt i grread.  Zato je proba UCS brave prosla.
;;
;; Obe staticke provere su prosle: test-lisp.ps1 tada nije imao proveru
;; samopoziva.  Sada je ima.
(defun fq:gp (msg)
  (if (fq:ucsok) (getpoint msg) nil))

(defun c:FQSTIL ( / *error* n)
  (setq *error* fq:err)
  (fq:init)
  (setq n 0)
  (foreach p *FQ-LAYERS*
    (if (fq:layerset (car p) (cadr p) (caddr p) (fq:layime p)) (setq n (1+ n))))
  (fq:lwon)
  (princ (fq:tf "cc.primenjen" (list (itoa n))))
  (princ))

;; Prisilno osvezavanje ekrana. Bez ovoga se novo nacrtani elementi
;; ne vide dok se paleta ponovo ne zatvori.
(defun fq:upd ( / doc)
  (vl-catch-all-apply 'redraw '())
  (if (setq doc (fq:doc))
    (vl-catch-all-apply 'vla-Regen (list doc 1)))
  (princ))

(defun fq:txtw (s h sty / tb)
  (setq tb (vl-catch-all-apply
             'textbox
             (list (list (cons 1 s) (cons 40 h) (cons 7 sty) '(41 . 1.0)))))
  (if (and (not (vl-catch-all-error-p tb)) tb (listp tb) (listp (car tb)))
    (abs (- (car (cadr tb)) (car (car tb))))
    (* 0.78 h (strlen s))))


;;; ------------------------------------------------------------------
;;;  6. PODACI NA ENTITETIMA  (XDATA, appid FIBERQ)
;;;
;;;  Zapis vlakna:
;;;   0 "VLAKNO"  1 id       2 kabl     3 cevcica  4 vlakno u cevcici
;;;   5 broj      6 boja     7 status   8 veza     9 prolazno
;;;  10 namena   11 etiketa  12 kategorija        13 ugao
;;;  14 standard boja       15 lanac spojenih vlakana
;;;  16 opis vlakna         17 rukohvat teksta opisa   (oba: FQOPIS)
;;;  18 vrsta vlakna, "SM" / "MM" / "" nepoznato
;;;  19 stvarna duzina deonica, "K1:120.50 + K2:80.00"   (FQDUZINA)
;;;
;;;  DOPISUJE SE SAMO NA KRAJ, i to popunjeno do trazenog indeksa.
;;;  Polja 16 i 17 pise FQOPIS iz fq-kucista.lsp, polje 19 FQDUZINA, a
;;;  crtaci ih ostavljaju prazna -- zato zapis od crtaca ima 20 clanova,
;;;  ne 17.  Ko dopise jedan clan manje, sledece polje sleti u tudje.
;;;
;;;  Status vlakna je u polju 7, ne u poslednjem (fq:vstat to zna po
;;;  vrsti), pa dopisivanje na kraj ne pomera status.  Za vrste kod kojih
;;;  fq:vstat pada na (fq:last d) to NE vazi -- tamo dopisivanje polja
;;;  pomera status i mora prvo da se prosiri fq:vstat.
;;; ------------------------------------------------------------------

;;; ------------------------------------------------------------------
;;;  ZAKLJUCAN LEJER: upis koji tiho ne uspe
;;;
;;;  Izmereno u AutoCAD Map 3D 2021 (R24.0), sva tri ponasanja:
;;;    entsel  nad entitetom na zakljucanom lejeru ga VRACA
;;;    entmod  nad njim vrati nil i ne uradi nista
;;;    entmake NA zakljucan lejer prolazi i uredno crta
;;;
;;;  Zajedno prave najgori mogucan ishod.  Kabl se nacrta, izgleda
;;;  gotovo, a nijedno vlakno nema xdata: specifikacija ga ne vidi,
;;;  opticki budzet ga ne racuna, FQTRASA ga ne prati.  Nijedne poruke,
;;;  nijednog vizuelnog traga -- greska se otkrije tek kad se preda
;;;  projekat u kome fali pola stavki.
;;;
;;;  Zato fq:xd od sada vraca nil kad upis ne prodje, a prvi neuspeh se
;;;  prijavi jednom PO LEJERU.  Po lejeru, ne po entitetu: kabl 4x12
;;;  bi inace ispisao istu poruku 48 puta i korisnik bi je nagonski
;;;  preskocio.
;;; ------------------------------------------------------------------

(setq *fq-zaklog* nil)   ; lejeri za koje je upozorenje u ovoj komandi izdato

;; Sta je STVARNO sa lejerom.  Ne tvrdi "zakljucan" bezuslovno: entmod
;; pada i na zamrznutom lejeru, a i iz razloga koje odavde ne vidimo.
;; Ista tri stanja cita i fq:snapvidljiv.
(defun fq:zaklstanje (lej / e d f)
  (if (and lej (setq e (tblobjname "LAYER" lej)))
    (progn
      (setq d (entget e)
            f (cdr (assoc 70 d)))
      ;; Vraca vec PREVEDENU rec, ne kljuc.  Da vraca kljuc, pozivalac
      ;; bi radio (fq:t st) -- racunat kljuc, koji provera tabela ne
      ;; vidi.  Ovako prevod stoji tu gde se stanje i utvrdjuje, i sva
      ;; tri kljuca su doslovna.  Jedini citac je fq:zakljavi.
      (cond ((and f (= 4 (logand f 4))) (fq:t "zak.stanje.zakljucan"))
            ((and f (= 1 (logand f 1))) (fq:t "zak.stanje.zamrznut"))
            ((and (assoc 62 d) (minusp (cdr (assoc 62 d))))
             (fq:t "zak.stanje.ugasen"))
            (T nil)))
    nil))

;; Javi jednom po lejeru.  Uvek vraca nil, da pozivalac moze da je
;; stavi kao poslednju granu u if i dobije ispravnu povratnu vrednost.
;;
;; posao kaze KOJI je zahvat pao, jer posledice nisu iste:
;;   "upis"     entmod nije prosao.  Geometrija JESTE nacrtana, ali bez
;;              zapisa -- specifikacija i budzet je ne vide.
;;   "brisanje" entdel nije prosao.  Stari crtez je ostao gde je bio;
;;              onaj ko je hteo da precrta mora sam da odustane.
;; Do 1.0.0 je poruka bezuslovno tvrdila "Nacrtano jeste", pa je kod
;; neuspelog brisanja lagala: tada nije nacrtano nista.
(defun fq:zakljavi (e posao / lej st)
  (setq lej (cdr (assoc 8 (entget e))))
  (if (and lej (not (member lej *fq-zaklog*)))
    (progn
      (setq *fq-zaklog* (cons lej *fq-zaklog*)
            st          (fq:zaklstanje lej))
      ;;  posao OSTAJE INTERNI TOKEN i vise se NE ispisuje.  Do bloka 4
      ;;  je ista niska i poredjena (= posao "upis") i umetana u
      ;;  recenicu -- pa bi prevod poruke morao da promeni i ono sto se
      ;;  poredi, na dva mesta koja se ne vide jedno iz drugog.  Sada
      ;;  token bira KLJUC, a recenica zivi u tabeli.
      (setq st (if st
                 (fq:tf "zak.razlog" (list st))
                 (fq:t "zak.razlog.nepoznat")))
      (if (= posao "upis")
        (princ (fq:tf "zak.upis"     (list lej st)))
        (princ (fq:tf "zak.brisanje" (list lej st))))))
  nil)

;; Vraca e ako je zapis stvarno upisan, inace nil.  Nijedan od dvadeset
;; pozivalaca ne racuna sa povratnom vrednoscu, pa nil nista ne lomi --
;; a onima koji je budu citali daje istinu umesto bezuslovnog e.
;; e sme da bude nil.  Crtacke primitive od 1.0.0 vracaju nil kada
;; entmake ne prodje, a poziv je po pravilu ugnjezden — (fq:xd (fq:Wrect
;; ...) ...) — pa bi bez ove grane pao (entget nil) i srusio komandu na
;; pola nacrtanog elementa.  Tisi izlaz je ovde ispravan: onaj ko je
;; pokusao da crta vec je dobio poruku od svoje grane.
(defun fq:xd (e lst)
  (if (not e)
    nil
    (progn
      (regapp "FIBERQ")
      (if (entmod (append (entget e)
                          (list (list -3 (cons "FIBERQ"
                                  (mapcar '(lambda (s) (cons 1000 s)) lst))))))
        e
        (fq:zakljavi e "upis")))))

;; entdel nad VEC obrisanim entitetom ga vraca u crtez (zapisano uz
;; fq:opisbrisi), pa se zove tacno jednom, a uspeh se proverava
;; entget-om.  Vraca T samo ako entiteta stvarno vise nema.
(defun fq:brisi (e / r)
  (if (not e)
    nil
    (progn
      (setq r (vl-catch-all-apply 'entdel (list e)))
      (if (vl-catch-all-error-p r)
        nil
        (if (vl-catch-all-error-p (vl-catch-all-apply 'entget (list e)))
          T
          (if (entget e) (fq:zakljavi e "brisanje") T))))))

(defun fq:xdget (e / d)
  (setq d (cdr (assoc -3 (entget e '("FIBERQ")))))
  (if d (mapcar 'cdr (cdr (car d)))))

;; Dodaj zavrsetak vlaknu, ne brisi postojeci.
;; Vlakno ima dva kraja, pa moze da stoji i na ODF-u i na ODO-u.
;; Ponavljanje istog zavrsetka se preskace, da uzastopna primena
;; istog ODF-a ne bi pravila "port + port".
;; e sme da bude nil kod samostalno postavljenog ODF-a ili ODO-a,
;; tada vlakno jos ne postoji pa nema kome da se upise zavrsetak
(defun fq:addveza (e s / d st l)
  (if (and e (setq d (fq:xdget e)))
    (progn
      (setq st (fq:vl-veza d)
            l  (fq:delovi st))
      (if (or (= s "") (member s l))
        st
        (progn (setq st (if (= st "") s (strcat st " + " s)))
               (fq:xdput e 8 st)
               st)))))

(defun fq:xdput (e n v / d i out)
  (if (setq d (fq:xdget e))
    (progn
      (setq i 0 out nil)
      (foreach s d
        (setq out (cons (if (= i n) v s) out) i (1+ i)))
      (fq:xd e (reverse out)))))

(defun fq:f (n l) (if (and l (< n (length l))) (nth n l) ""))

;; Spaja dva dela natpisa razdvojnikom, ali samo ako oba postoje.
;;
;; Model kucista sme da bude prazan -- katalog se od verzije 1.0
;; isporucuje bez ijednog modela, jer su tamo ranije stajala imena
;; stvarnih proizvodjaca.  Bezuslovno spajanje bi zato davalo "ODO -48"
;; u specifikaciji i "Patch panel , zauzeto 12", a to lici na gresku u
;; podacima umesto na podatak koji nije upisan.
(defun fq:spoj (a raz b)
  (cond ((= a "") b)
        ((= b "") a)
        (T (strcat a raz b))))

;; Oznaka ispred natpisa kabla, bez ponavljanja.
;;
;;  disp je natpis koji ide u crtez, i on VEC nosi oznaku kod dva od tri
;;  puta: c:FQKABL ga uvek gradi kao (strcat oz "   " lbl), a fq:kabl
;;  onda kada je oznaka ukucana umesto <auto>.  Poruka je zato glasila
;;  "Kabl K2   K2   1x12".  Natpis u crtezu je bio ispravan sve vreme --
;;  duplirala se samo poruka, sto lici na gresku a nije.
;;
;;  Poredi se oznaka ZAJEDNO sa razdvojnikom.  Bez njega bi kabl K1
;;  prepoznao natpis "K12   ADSS 03" kao svoj i pojeo bi mu prvu cifru.
(defun fq:kablnat (oz disp / p)
  (setq p (strcat oz "   "))
  (if (and (/= oz "")
           (>= (strlen disp) (strlen p))
           (= (substr disp 1 (strlen p)) p))
    disp
    (fq:spoj oz "   " disp)))
(defun fq:last (l) (nth (1- (length l)) l))

;;; --- imenovani pristup poljima ------------------------------------
;;;  Indeksi se pisu SAMO ovde. Svako drugo mesto zove ove funkcije.
;;;  Ranije je svaki citalac kucao svoj indeks, pa je jedna greska za
;;;  jedno mesto u fq:najnast prosla neprimeceno.

;; VLAKNO
(defun fq:vl-id   (d) (fq:f  1 d))   ; K1/2/3
(defun fq:vl-kabl (d) (fq:f  2 d))
(defun fq:vl-cev  (d) (fq:f  3 d))
(defun fq:vl-brc  (d) (fq:f  4 d))   ; vlakno u cevcici
(defun fq:vl-br   (d) (fq:f  5 d))   ; redni broj u kablu
(defun fq:vl-boja (d) (fq:f  6 d))
(defun fq:vl-st   (d) (fq:f  7 d))
(defun fq:vl-veza (d) (fq:f  8 d))   ; zavrseci, vise njih deli " + "
(defun fq:vl-pro  (d) (fq:f  9 d))   ; prolazno / preseceno
(defun fq:vl-nam  (d) (fq:f 10 d))
(defun fq:vl-lbl  (d) (fq:f 11 d))
(defun fq:vl-kat  (d) (fq:f 12 d))
(defun fq:vl-ang  (d) (if (= (fq:f 13 d) "") 0 (atoi (fq:f 13 d))))
(defun fq:vl-cc   (d) (fq:f 14 d))
(defun fq:vl-lan  (d) (fq:f 15 d))   ; lanac spojenih vlakana
;; Polja 16 i 17 su opis vlakna i rukohvat tog teksta; citaci su im
;; fq:vl-opis i fq:vl-oph, i stoje u fq-kucista.lsp uz samu komandu
;; FQOPIS.  Zato vrsta pocinje tek od 18.
(defun fq:vl-vrsta (d) (fq:f 18 d))  ; "SM", "MM" ili "" = nepoznato
(defun fq:vl-duz  (d) (fq:f 19 d))   ; "K1:120.50 + K2:80.00", "" = nema

;;; --- polje 19: stvarna duzina deonice -----------------------------
;;;
;;;  Sema nije geodetska podloga: nacrtanih 116.9 jedinica nije 116.9
;;;  metara na terenu, a za narucivanje kabla treba ovo drugo.  Zato se
;;;  stvarna duzina UPISUJE, a ne meri iz geometrije.  Geometrijska
;;;  duzina se i dalje moze izracunati kad zatreba -- vlakno je jedna
;;;  polilinija -- pa ovo polje nosi samo ono sto se izracunati NE moze.
;;;
;;;  ZASTO OZNACEN OBLIK, a ne go broj.  fq:spoj1 zadrzava CEO zapis
;;;  vlakna A i menja samo polja 8 i 15; da je ovde stajalo "120.50",
;;;  vlakno spojeno kroz K1 i K2 tvrdilo bi da je dugacko koliko i K1.
;;;  Nista ne bi palo i nista se ne bi videlo -- specifikacija bi samo
;;;  bila manja od stvarne, sto je najgori nacin da podatak bude
;;;  pogresan.  Oznacen zapis se pri spajanju spaja, kao polja 8 i 15,
;;;  i istim razdvojnikom " + ", koji je za polje 8 vec zamrznut.
;;;
;;;  DUZINA JE PODATAK KABLA, prepisan na svako njegovo vlakno -- isto
;;;  kao oznaka kabla (polje 2) i standard boja (polje 14).  Zato se
;;;  sabira po OZNACI KABLA, nikad po vlaknu: dvanaest vlakana kabla K1
;;;  nose istu duzinu, a i dva kraka presecenog vlakna, pa bi sabiranje
;;;  po vlaknu dalo trinaest puta vecu metrazu od stvarne.
;;;
;;;  Deli se po POSLEDNJOJ dvotacki.  Oznaka kabla je korisnicki tekst
;;;  i sme da sadrzi dvotacku ("okno 3: izvod"), broj ne sme.

;; "K1/2/3" -> "K1".  Oznaka kabla je deo id-a pre prve kose crte.
(defun fq:idkabl (id) (car (fq:split id "/")))

;; "K1:120.50" -> ("K1" . "120.50"), nil ako zapis nije takav
(defun fq:duzpar (z / i p)
  (setq i (strlen z) p 0)
  (while (> i 0)
    (if (and (= p 0) (= (substr z i 1) ":")) (setq p i))
    (setq i (1- i)))
  (if (and (> p 1) (< p (strlen z)))
    (cons (fq:trim (substr z 1 (1- p))) (fq:trim (substr z (1+ p))))
    nil))

;; duzina tog kabla u zapisu, "" ako je nema
(defun fq:duzuzmi (s kab / v pr z)
  (setq v "")
  (foreach z (fq:delovi s)
    (setq pr (fq:duzpar z))
    (if (and pr (= (strcase (car pr)) (strcase kab))) (setq v (cdr pr))))
  v)

;; Zameni ili dopisi unos za taj kabl.  Prazno v BRISE unos, pa ista
;; funkcija sluzi i za ispravku pogresno unete duzine.
(defun fq:duzupis (s kab v / out nasao pr r z)
  (setq out nil nasao nil)
  (foreach z (fq:delovi s)
    (setq pr (fq:duzpar z))
    (if (and pr (= (strcase (car pr)) (strcase kab)))
      (progn (setq nasao T)
             (if (/= v "") (setq out (cons (strcat kab ":" v) out))))
      (setq out (cons z out))))
  (if (and (not nasao) (/= v ""))
    (setq out (cons (strcat kab ":" v) out)))
  (setq r "")
  (foreach z (reverse out) (setq r (fq:spoji2 r z)))
  r)

;; Spoj dva zapisa duzina, bez udvajanja PO OZNACI KABLA.
;;
;;  fq:spoji2 ovde ne bi bio dovoljan: on preskace samo kada su cele
;;  niske jednake.  Krak "K1:120.50" i krak "K1:120.50 + K2:80.00" nisu
;;  jednaki, pa bi K1 usao dvaput i metraza tog kabla se udvostrucila.
(defun fq:duzspoj (a b / r pr z)
  (setq r a)
  (foreach z (fq:delovi b)
    (setq pr (fq:duzpar z))
    (if (and pr (= (fq:duzuzmi r (car pr)) ""))
      (setq r (fq:duzupis r (car pr) (cdr pr)))))
  r)

;; Oznake kablova kroz koje vlakno prolazi, redom, bez ponavljanja.
;; Lanac (polje 15) je merodavan; polje 2 je rezerva za zatecen zapis
;; kome lanac nije upisan.
(defun fq:duzkabli (d / ids out k x)
  (setq ids (fq:delovi (if (= (fq:vl-lan d) "") (fq:vl-id d) (fq:vl-lan d)))
        out nil)
  (foreach x ids
    (setq k (fq:idkabl x))
    (if (not (member k out)) (setq out (cons k out))))
  (setq out (reverse out))
  (if out out (list (fq:vl-kabl d))))

;; Krak koji je presecanjem ukinut nosi *FQ-PRS-UKI* na kraju id-a.
;; Kada se dva kraka spajaju nazad u pravo vlakno, identitet nosi onaj
;; koji NIJE ukinut, pa se vlakno vraca pod svojim starim id-em.
(defun fq:ukinut (d / id n)
  (setq id (fq:vl-id d) n (strlen *FQ-PRS-UKI*))
  (and (> (strlen id) n)
       (= (substr id (1+ (- (strlen id) n))) *FQ-PRS-UKI*)))

(defun fq:osnovid (d / id n)
  (setq id (fq:vl-id d) n (strlen *FQ-PRS-UKI*))
  (if (fq:ukinut d) (substr id 1 (- (strlen id) n)) id))

;; NASTAVAK.  Ram se NE cita odavde nego iz geometrije, vidi fq:najnast.
;; Polja 3 do 6 ostaju kao snimak u trenutku crtanja, samo za uvid.
;;
;; Mesto (polja 9 i 10) je dopisano NA KRAJ zapisa, iza statusa.
;; Status nastavka stoji u polju 8 i tako ga cita fq:vstat, pa
;; dodavanje polja iza njega nista ne pomera: nastavci iz starijih
;; crteza vracaju "" i rade nepromenjeno.
(defun fq:na-oz  (d) (fq:f 1 d))
(defun fq:na-tip (d) (fq:f 2 d))
(defun fq:na-ang (d) (if (= (fq:f 7 d) "") 0 (atoi (fq:f 7 d))))
(defun fq:na-st  (d) (fq:f 8 d))
(defun fq:na-lok (d) (fq:f 9 d))     ; okno, stub, u kanalu...
(defun fq:na-br  (d) (fq:f 10 d))    ; broj okna ili stuba

;; Mesto kao jedan red teksta, onako kako se ispisuje pod oznakom.
(defun fq:na-mesto (l b)
  (cond ((and (= l "") (= b "")) "")
        ((= b "") l)
        ((= l "") b)
        (T (strcat l " " b))))

;; VARENJE
(defun fq:va-a  (d) (fq:f 1 d))
(defun fq:va-b  (d) (fq:f 2 d))
(defun fq:va-st (d) (fq:f 4 d))
(defun fq:va-oz (d) (fq:f 5 d))      ; oznaka nastavka

;;; --- MAPA POLJA ZA PRIKAZ -----------------------------------------
;;;
;;;  Zapis je (vrsta nazivSr nazivEn (indeks kljucNatpisa nacin) ...).
;;;  Cita je samo c:FQINFO, i samo za PRIKAZ.
;;;
;;;  Tabela NE zamenjuje citace gore.  Oni ostaju jedino mesto odakle
;;;  kod uzima vrednost polja; ovde stoji redosled, natpis i nacin
;;;  prevoda.  Zato stoji odmah pod njima: dva spiska indeksa u dva
;;;  udaljena dela fajla se razidju tiho, jedan pod drugim ne.
;;;
;;;  OBA NAZIVA VRSTE STOJE U SAMOJ TABELI, ne u *FQ-STR-*.  Isti razlog
;;;  kao kod naziva u *FQ-KODOVI*: ovo je jedino mesto gde kljuc vrste i
;;;  oba naziva stoje jedan uz drugi, pa ne mogu da se raziju.  Za pet
;;;  vrsta kucista prednost ipak ima katalog, kroz fq:vrime -- korisnik
;;;  sme da ih preimenuje i to mora da se postuje.
;;;
;;;  NACIN je:
;;;     ""      ispisi doslovno
;;;     "st"    kroz fq:stnaziv   (stProjektovano -> izvedeno / designed)
;;;     "boja"  kroz fq:bojrec    (rec -> ACI -> naziv na tekucem jeziku)
;;;     ostalo  IME DOMENA iz *FQ-KODOVI*, kroz fq:kodnaz, koji zatecenu
;;;             srpsku rec i danasnji kod svodi na isti prikaz
;;;
;;;  KLJUC NATPISA JE RACUNAT: fq:t ga dobija kao promenljivu, pa ga
;;;  odeljak "kljuc mora biti doslovna niska" po sopstvenom ugovoru ne
;;;  vidi.  Zato ga -- kao i kod *FQ-MENU* -- proverava odeljak koji
;;;  gleda SAMU TABELU: da je natpis kljuc a ne zaostao tekst, da postoji
;;;  u obe tabele niski, da nosi tacno jedan umetak, i da je nacin ""
;;;  ili "st" ili "boja" ili domen koji u *FQ-KODOVI* stvarno postoji.
;;;
;;;  INDEKS KOJI U MAPI FALI SE NE PRIKAZUJE, i to je ponegde namerno:
;;;  polja 3-6 nastavka su snimak rama u trenutku crtanja (merodavna je
;;;  geometrija, vidi fq:najnast), a polje 17 vlakna je rukohvat teksta
;;;  opisa.  Oba ostaju vidljiva u sirovom redu, koji c:FQINFO i dalje
;;;  ispisuje poslednji.
;;;
;;;  PP je raspored ODF-a, IPAN raspored ODO-a -- polje po polje, jer ih
;;;  crta isti crtac a kljuc menja fq:kucprepis.  Upisani su ipak
;;;  odvojeno: kljuc vrste je zamrznut, pa se dva kljuca ne smeju svesti
;;;  na jedan cak ni kad im je sadrzaj isti danas.
(setq *FQ-POLJA*
 '(("VLAKNO" "Vlakno" "Fiber"
     ((1  "info.p.id"          "")     (2  "info.p.kabl"       "")
      (3  "info.p.cevcica"     "")     (4  "info.p.ucevcici"   "")
      (5  "info.p.rbr"         "")     (6  "info.p.boja"       "boja")
      (7  "info.p.status"      "st")   (8  "info.p.zavrseci"   "")
      (9  "info.p.prolaznost"  "pro")  (10 "info.p.namena"     "nam")
      (11 "info.p.natpis"      "")     (12 "info.p.kategorija" "kat")
      (13 "info.p.ugao"        "")     (14 "info.p.colorcode"  "")
      (15 "info.p.lanac"       "")     (16 "info.p.opis"       "")
      (18 "info.p.vrsta"       "vrs")  (19 "info.p.duzina"     "")))

   ("ODF" "ODF modul" "ODF module"
     ((1 "info.p.oznaka"    "")  (2 "info.p.model"  "")
      (3 "info.p.kapacitet" "")  (4 "info.p.zauzeto" "")
      (5 "info.p.konektor"  "")  (6 "info.p.letva"  "")
      (7 "info.p.status"    "st")))

   ("PP" "Patch panel" "Patch panel"
     ((1 "info.p.oznaka"    "")  (2 "info.p.model"  "")
      (3 "info.p.kapacitet" "")  (4 "info.p.zauzeto" "")
      (5 "info.p.konektor"  "")  (6 "info.p.letva"  "")
      (7 "info.p.status"    "st")))

   ("ODO" "ODO ormar" "FDH cabinet"
     ((1 "info.p.oznaka"    "")  (2 "info.p.kapacitet" "")
      (3 "info.p.zauzeto"   "")  (4 "info.p.model"     "")
      (5 "info.p.montaza"   "mnt") (6 "info.p.adresa"  "")
      (7 "info.p.status"    "st")))

   ("IPAN" "MDU ormar" "MDU cabinet"
     ((1 "info.p.oznaka"    "")  (2 "info.p.kapacitet" "")
      (3 "info.p.zauzeto"   "")  (4 "info.p.model"     "")
      (5 "info.p.montaza"   "mnt") (6 "info.p.adresa"  "")
      (7 "info.p.status"    "st")))

   ("ZOK" "ZOK kutija" "FAT box"
     ((1 "info.p.oznaka"    "")  (2 "info.p.model"     "")
      (3 "info.p.kapacitet" "")  (4 "info.p.zauzeto"   "")
      (5 "info.p.konektor"  "")  (6 "info.p.montaza"   "mnt")
      (7 "info.p.spliter"   "")  (8 "info.p.status"    "st")
      (9 "info.p.adresa"    "")))

   ("NASTAVAK" "Nastavak" "Closure"
     ((1 "info.p.oznaka" "")   (2  "info.p.tip"    "nas")
      (7 "info.p.ugao"   "")   (8  "info.p.status" "st")
      (9 "info.p.mesto"  "lok") (10 "info.p.broj"  "")))

   ("SPLITER" "Spliter" "Splitter"
     ((1 "info.p.oznaka"   "")  (2 "info.p.odnos"  "")
      (3 "info.p.gubitak"  "")  (4 "info.p.status" "st")))

   ("ULAZ" "Ulaz splitera" "Splitter input"
     ((1 "info.p.spliter" "")  (2 "info.p.status" "st")))

   ("IZLAZ" "Izlaz splitera" "Splitter output"
     ((1 "info.p.spliter" "")  (2 "info.p.izlaz" "")
      (3 "info.p.status"  "st")))

   ("OLT" "OLT" "OLT"
     ((1 "info.p.oznaka" "")  (2 "info.p.portovi" "")
      (3 "info.p.status" "st")))

   ("PON" "PON port" "PON port"
     ((1 "info.p.olt" "")  (2 "info.p.port" "")
      (3 "info.p.status" "st")))

   ("ONT" "ONT" "ONT"
     ((1 "info.p.oznaka" "")  (2 "info.p.korisnik" "")
      (3 "info.p.status" "st")))

   ("PRIVOD" "Privod" "Drop"
     ((1 "info.p.ont" "")  (2 "info.p.korisnik" "")
      (3 "info.p.status" "st")))

   ("VARENJE" "Varenje" "Splice"
     ((1 "info.p.vlaknoa" "")  (2 "info.p.vlaknob"  "")
      (3 "info.p.nacin"   "")  (4 "info.p.status"   "st")
      (5 "info.p.nastavak" "")))

   ("REZERVA" "Rezerva kabla" "Cable slack"
     ((1 "info.p.duzinam" "")  (2 "info.p.status" "st")))))

;; Status elementa. Kod vlakna je u polju 7, kod varenja u polju 4,
;; kod nastavka u polju 8. Kod ostalih je poslednje polje.
;; Varenje i nastavak imaju polja iza statusa, zato ne moze fq:last.
(defun fq:vstat (d)
  (cond ((= (car d) "VLAKNO")   (fq:vl-st d))
        ((= (car d) "VARENJE")  (fq:va-st d))
        ((= (car d) "NASTAVAK") (fq:na-st d))
        ;; ZOK je od 24.08.2026 cetvrta vrsta sa IZRICITIM indeksom, i
        ;; jedina koja ga je dobila naknadno.  Morala je: kutija je
        ;; dobila deseto polje (adresu), a dok se status citao kao
        ;; POSLEDNJI clan, dopisana adresa bi postala status -- kutija
        ;; bi u specifikaciji stajala pod statusom "Cvijiceva 79".
        ;;
        ;; Zatecen zapis od devet polja i dalje radi: status mu JESTE
        ;; osmi clan, pa ista grana cita i stari i nov crtez.  Zato se
        ;; migracija ne trazi -- vidi CLAUDE.md, "Novo polje se dopisuje
        ;; na kraj samo kod VLAKNO, VARENJE i NASTAVAK", i recenicu
        ;; odmah uz nju: tamo se prvo prosiruje fq:vstat.
        ((= (car d) "ZOK")      (fq:f 8 d))
        (T (fq:last d))))

;; Prikaz statusa.
;;
;;  Status je VEC kod -- "stProjektovano" / "stIzvedeno" -- i takav
;;  stoji u svakom nacrtanom crtezu.  Ne dira se, po istom pravilu po
;;  kome se nije dirao ni kljuc "IPAN".  Nedostajao mu je samo PRIKAZ:
;;  sirov kod je curio korisniku na jedanaest mesta ispisa, a preko
;;  c:FQTABELA i u sam crtez, kao TEXT "| stProjektovano".
;;
;;  Mala slova, jer se svih jedanaest mesta nalazi usred recenice:
;;  "ODO 1 (48) zidni, projektovano".  Info-plocica palete i FQSTANJE
;;  su radili isto ovo kroz svoj inline (if ...), pa su i oni sada
;;  ovde -- inace bi za dva koda postojala tri oblika prikaza.
;;
;;  Nepoznat kod prolazi kroz, nepromenjen.  Crtez iz buduce verzije
;;  sme da nosi status koji ova ne poznaje, i bolje ga je pokazati
;;  sirovog nego pretvoriti u prazno -- isto merilo kao (T tip) u
;;  fq:tally.
;;  Zapis je (kod  nazivSr  nazivEn  tokenSr  tokenEn).  Redosled kolona
;;  NIJE isti kao u *FQ-KODOVI* i to je namerno: tabela je do bloka 3
;;  imala samo kod i naziv, pa su tokeni dopisani NA KRAJ umesto da se
;;  postojece kolone pomeraju.  Isto pravilo kao za polja xdata.
;;
;;  "designed" / "as-built" su termini iz izvodjacke dokumentacije.
;;  "planned" se namerno NE koristi: to je vec engleski naziv namene
;;  nmPlan, a status i namena stoje jedan pored drugog u istom redu
;;  specifikacije.  Token je zato "Designed", a ne "Planned".
;;  Token je "Asbuilt", ne "AsBuilt".  AutoCAD skracenicu kljucne reci
;;  cita iz VELIKIH slova, i ocekuje ih na pocetku; kod "AsBuilt" bi
;;  velika slova bila A i B, a to nije nastavak jednog drugog.  Radi li
;;  to ipak ili ne, zavisi od verzije -- a token je ono sto korisnik
;;  kuca i ne sme da zavisi ni od cega takvog.
(setq *FQ-STATUSI*
 '(("stProjektovano" "projektovano" "designed" "Projektovano" "Designed")
   ("stIzvedeno"     "izvedeno"     "as-built" "Izvedeno"     "Asbuilt")))

;; Kod iz tokena statusa, u oba jezika.  Nepoznato daje nil, pa pozivalac
;; sam bira podrazumevano -- getkword vraca nil i na prazan Enter.
(defun fq:stkod (tok / r)
  (if (and tok (/= tok ""))
    (car (vl-some '(lambda (x)
                     (if (or (= (strcase (fq:f 3 x)) (strcase tok))
                             (= (strcase (fq:f 4 x)) (strcase tok))
                             (= (strcase (car   x)) (strcase tok)))
                       x))
                  *FQ-STATUSI*))))

;;  Mala slova u oba jezika: svih jedanaest mesta ispisa je usred
;;  recenice -- "ODO 1 (48) indoor, designed".
;;  Status se, za razliku od *FQ-KODOVI*, u zapis upisuje uvek kao kod
;;  (fq:askst ga prevodi iz tokena), pa ovde nema sta da se normalizuje.
;;  Poredjenje je zato golo assoc, kao i pre.
(defun fq:stnaziv (k / r naz)
  (cond ((not k) "")
        ((setq r (assoc k *FQ-STATUSI*))
         (setq naz (if (= *fq-jezik* "EN") (fq:f 2 r) (cadr r)))
         (if (and naz (/= naz "")) naz (cadr r)))
        (T k)))

;;; --- citaci tabele *FQ-KODOVI* ------------------------------------
;;;
;;;  Tabela je gore, uz *FQ-NAMENE*, jer je konstanta; citaci su ovde,
;;;  uz fq:stnaziv, jer rade isti posao -- kod u prikaz i natrag.
;;;
;;;  NEPOZNATO PROLAZI KROZ, NEPROMENJENO.  To nije popustljivost nego
;;;  zahtev: -FQNASTAVAK uzima mesto preko getstring, a -FQZOK montazu
;;;  isto tako, pa korisnicko "u podrumu" mora da prezivi put kroz kod
;;;  netaknuto, u oba smera.  Nabrajanja "lok" i montaza nisu zatvorena
;;;  i nikad nece biti.
;;;
;;;  Povratna vrednost je UVEK string, nikad nil: nil u strcat prekida
;;;  crtanje, isto pravilo koje vazi za fq:kc-zmod i fq:f.
;;;
;;;  IME BEZ ZNAKA >.  test-lisp.ps1 vadi imena regexom koji > ne
;;;  sadrzi, pa bi se fq:nam->kod i pri definiciji i pri pozivu skratilo
;;;  na fq:nam-.  Build ne bi pao -- svako fq:nam->* bi se slilo u jedan
;;;  token i provera nedefinisanih poziva bi tiho prestala da radi za
;;;  celu porodicu.  Zato fq:nazkod i fq:kodnaz.
;;;
;;;  LOKALNA SE NE SME ZVATI t.  AutoLISP ne razlikuje velika i mala
;;;  slova u imenima simbola, pa bi (defun ... / t) postavilo T na nil
;;;  na ulazu i sopstvena (T ...) grana ovog cond-a se nikad ne bi
;;;  okinula -- nepoznata vrednost bi se vracala kao nil umesto kroz.

;; Kod iz onoga sto je stiglo: prima kod, kljuc ili naziv.
;;
;;  Poredjenje NE gleda velika i mala slova.  Prvo je gledalo, zbog
;;  para "Prolazno" (namena) / "prolazno" (prolaznost) -- ali ta
;;  opasnost ne postoji otkad se tabela cita po DOMENU: ta dva su u
;;  razlicitim domenima i nikad se ne traze u istoj listi.
;;
;;  Bez ovoga je -FQNASTAVAK sa otkucanim "OKNO" davao dva reda
;;  specifikacije za isto mesto, "OKNO" i "okno".  Sada se svodi na
;;  isti kod, pa i na isti red.
;;
;;  USLOV KOJI SE NE SME PREKRSITI: unutar JEDNOG domena ne smeju
;;  postojati dva unosa koja se razlikuju samo po velicini slova.
;;  Danas ih nema ni u jednom od cetiri domena -- provereno rucno.
;;  Ko doda peti domen ili nov unos, mora to da proveri, jer bi se
;;  inace tiho biralo prvo poklapanje.
(defun fq:nazkod (dom s / tb r)
  (cond
    ((not s) "")
    ((= s "") "")
    ((not (setq tb (cadr (assoc dom *FQ-KODOVI*)))) s)
    ;; Poredi SVIH PET kolona: kod, oba tokena, oba naziva.  Zatecen
    ;; crtez nosi srpski naziv, nov engleski, a getkword predaje token na
    ;; jeziku koji je bio aktivan -- i sve to mora dati ISTI kod, inace
    ;; isti element daje dva reda specifikacije, sto je tacno onaj kvar
    ;; zbog koga kodovi uopste postoje.
    ;;
    ;; Odavde i to da se token vise ne mora premoscivati rucnim cond-om:
    ;; "Mikro" i "Micro" su u tabeli, pa ih ova funkcija sama razresava.
    ((setq r (vl-some '(lambda (x)
                         (if (or (= (strcase (car    x)) (strcase s))
                                 (= (strcase (cadr   x)) (strcase s))
                                 (= (strcase (caddr  x)) (strcase s))
                                 (= (strcase (fq:f 3 x)) (strcase s))
                                 (= (strcase (fq:f 4 x)) (strcase s)))
                           x))
                      tb))
     (car r))
    (T s)))

;; Naziv za prikaz, na TEKUCEM jeziku.  Isti ugovor: nepoznato prolazi
;; doslovno, i isto poredjenje bez obzira na velicinu slova.
;;
;;  Kolona se bira po *fq-jezik* iz fq-jezik.lsp.  Ako tog fajla nema,
;;  simbol je nevezan i AutoLISP ga cita kao nil, pa uslov ne prolazi i
;;  dobija se srpski naziv.  To je ista rezerva koju ima i baner, samo
;;  obrnutog smera -- i bezopasna, jer instalacija bez fq-jezik.lsp ionako
;;  nije ispravna.
;;
;;  Ako engleske kolone nema (zapis od tri clana, sto test-lisp.ps1
;;  zabranjuje), pada se na srpski naziv umesto da se vrati prazno.
;;  Prazan naziv bi u specifikaciji dao red koji pocinje razdvojnikom,
;;  isto kao prazan model kucista pre fq:spoj.
(defun fq:kodnaz (dom k / tb r naz kod)
  (cond
    ((not k) "")
    ((= k "") "")
    ((not (setq tb (cadr (assoc dom *FQ-KODOVI*)))) k)
    (T
      ;; NAJPRE NORMALIZUJ.  Do bloka 2 je ova funkcija poredila samo
      ;; prvu kolonu, dakle primala je iskljucivo kod -- a vrednost joj
      ;; stize i kao NAZIV: montaza iz kataloga kucista, mesto nastavka
      ;; iz dijaloga.  Tada je naziv padao na (T k) i vracao se
      ;; nepromenjen, sto je na srpskom izgledalo tacno i zato prezivelo.
      ;; Na engleskom se videlo odmah: u ramu "unutrasnji", a u istoj
      ;; specifikaciji "indoor" -- jer fq:tally normalizuje pre prikaza,
      ;; a crtac nije.
      ;;
      ;; Kroz fq:nazkod, ne sopstvenim poredjenjem: kolone poznaje jedno
      ;; mesto.  Peta kolona jednog dana ne sme da trazi izmenu na dva.
      (setq kod (fq:nazkod dom k))
      (if (setq r (vl-some '(lambda (x)
                              (if (= (strcase (car x)) (strcase kod)) x))
                           tb))
        (progn
          (setq naz (if (= *fq-jezik* "EN") (fq:f 3 r) (caddr r)))
          (if (and naz (/= naz "")) naz (caddr r)))
        ;; Nepoznato prolazi kroz, nepromenjeno -- korisnicko "u sahtu"
        ;; iz -FQZOK i "u podrumu" iz -FQNASTAVAK moraju da prezive.
        k))))

;;; --- tokeni za initget i za prompt --------------------------------
;;;
;;;  Spisak se GRADI IZ TABELE, ne kuca uz svaki initget.  Dva ista
;;;  spiska na dva mesta se pre ili kasnije razidju, i to tiho: initget
;;;  koji ne zna za token samo ga ne prihvati, a prompt koji ga navodi
;;;  ostane da laze.  Isti razlog zbog koga kategorija nema kolonu koda
;;;  u *FQ-KABLOVI*.
;;;
;;;  Podskup se predaje kao lista kodova.  Nije svaka domena u celini
;;;  ponudjena na svakom mestu: ODO ormar bira samo izmedju unutrasnjeg
;;;  i spoljasnjeg, iako domen "mnt" ima i zid i stub, koji stizu iz
;;;  kataloga kucista.  nil znaci "cela domena".

;; Tokeni domene na tekucem jeziku, kao lista stringova.
;;  kods  lista kodova koji se nude, ili nil za sve
(defun fq:tokovi (dom kods / tb out tok)
  (setq tb (cadr (assoc dom *FQ-KODOVI*)) out nil)
  (foreach x tb
    (if (or (not kods) (member (car x) kods))
      (progn
        (setq tok (if (= *fq-jezik* "EN") (fq:f 4 x) (cadr x)))
        (if (and tok (/= tok "")) (setq out (cons tok out))))))
  (reverse out))

;; Token jednog koda, za podrazumevanu vrednost u promptu.
;;
;;  Prompt pokazuje skraceno podrazumevano -- "<P>", "<D>".  To slovo se
;;  RACUNA iz tokena, ne kuca: otkucano bi bilo jos jedno mesto koje mora
;;  da se menja u koraku sa tabelom, i to mesto koje nista ne proverava.
;;  Vraca "" ako koda nema, pa substr ne padne.
(defun fq:tok1 (dom kod / l)
  (setq l (fq:tokovi dom (list kod)))
  (if l (car l) ""))

;; Tokeni statusa na tekucem jeziku.
;;
;;  Status ima svoju tabelu i drugi redosled kolona -- tokeni su tamo
;;  dopisani NA KRAJ, pa je tokenSr treci a tokenEn cetvrti clan.  Zato
;;  zasebna funkcija umesto sestog domena u *FQ-KODOVI*: kod statusa je
;;  zamrznut i cita ga fq:stnaziv, koji sa domenima nema nikakve veze.
(defun fq:sttokovi ( / out tok x)
  (foreach x *FQ-STATUSI*
    (setq tok (if (= *fq-jezik* "EN") (fq:f 4 x) (fq:f 3 x)))
    (if (and tok (/= tok "")) (setq out (cons tok out))))
  (reverse out))

;; Lista niski -> jedna niska sa razdvojnikom.
;;
;;  Isti spisak treba i initget-u (razmak) i promptu (kosa crta), a lista
;;  se racuna JEDNOM i spaja dvaput:
;;
;;    (setq l (fq:tokovi "kat" nil))
;;    (initget (fq:spisak l " "))
;;    (getkword (fq:tf "kabl.pitaj.kategorija"
;;                     (list (fq:spisak l "/") ...)))
;;
;;  Tako initget i prompt ne mogu da se raziju ni u jednoj buducoj
;;  izmeni -- oba citaju istu promenljivu, ne istu tabelu dvaput.
;;
;;  Uglaste zagrade NISU ovde nego u niski poruke: neka mesta iza njih
;;  nose jos i podrazumevanu vrednost, "[A/B] <A>: ", a neka ne.
(defun fq:spisak (lst raz / s x)
  (setq s "")
  (foreach x lst (setq s (if (= s "") x (strcat s raz x))))
  s)

;; Nabrajanje od dva tokena koje NE ide u xdata.
;;
;;  Vraca T ako je izabran DRUGI token, nil za prvi i za prazan Enter --
;;  prvi je uvek podrazumevan i prompt ga pokazuje prvim slovom.
;;
;;  ZASTO NE *FQ-KODOVI*.  Tamo je svaki unos par kod-naziv koji negde
;;  zavrsi u crtezu, pa se mora cuvati zauvek i citati normalizovano.
;;  Ovi tokeni ne zavrsavaju nigde -- "Vlakno" i "Rucno" samo granaju
;;  komandu -- pa bi u tabeli kodova bili peti tocak, uz jos jedan domen
;;  koji nijedan citac ne trazi.  Mesto im je u tabeli niski, kao i
;;  svakom drugom tekstu koji korisnik vidi a crtez ne pamti.
;;  POSLEDNJA TRI UMETKA SU UVEK token A, token B i prvo slovo prvog.
;;  vals su ono sto dolazi PRE njih, i sme da bude nil.  Pravilo je
;;  fiksno da bi prevodilac u svakoj takvoj niski znao gde su tokeni,
;;  ma koliko brojeva stajalo ispred: "[%4/%5] <%4>" je uvek na kraju.
(defun fq:dvatok (ka kb msg vals / a b kw)
  (setq a (fq:t ka) b (fq:t kb))
  (initget (strcat a " " b))
  (setq kw (getkword (fq:tf msg (append vals (list a b (substr a 1 1))))))
  (= kw b))

;;; --- undo grupe ---------------------------------------------------
;;;  Paleta se vrti u jednom pozivu komande FQ, pa bi bez ovoga cela
;;;  sesija palete bila jedan jedini undo korak. Ovako je jedan
;;;  element jedan korak, kako korisnik i ocekuje.
;;;
;;;  PAZNJA: ovde se NE sme koristiti (command "_.UNDO" "_BEGIN").
;;;  Paleta odmah posle toga otvara DCL dijalog, a ako command iz bilo
;;;  kog razloga ostavi UNDO da ceka unos, dijalog ne moze da se otvori
;;;  i cela akcija pukne. VLA oznake ne diraju komandnu liniju.

(defun fq:doc ( / doc)
  (setq doc (vl-catch-all-apply 'vla-get-ActiveDocument
                                (list (vlax-get-acad-object))))
  (if (vl-catch-all-error-p doc) nil doc))

(defun fq:undo-poc ( / doc)
  (if (setq doc (fq:doc))
    (vl-catch-all-apply 'vla-StartUndoMark (list doc)))
  T)

(defun fq:undo-kraj ( / doc)
  (if (setq doc (fq:doc))
    (vl-catch-all-apply 'vla-EndUndoMark (list doc)))
  T)

;;; --- otkaz nije kvar ---------------------------------------------
;;;
;;;  Esc u getpoint, getstring i ostalim get* funkcijama NE vraca nil
;;;  nego BACA gresku "Function cancelled".  Zato svaki vl-catch-all-apply
;;;  u projektu hvata i obican prekid, pa se korisniku ispisuje
;;;
;;;    FiberQ, greska: Function cancelled
;;;
;;;  na svako odustajanje.  To je pogresno na dva nacina: uci ga da ne
;;;  cita poruke o greskama, i sakrije pravu gresku kad se desi, jer
;;;  izgleda isto kao pet prethodnih otkaza.
;;;
;;;  Poredjenje je labavo i po tekstu, jer se tekst razlikuje medju
;;;  verzijama i klonovima: AutoCAD kaze "Function cancelled",
;;;  BricsCAD "quit / exit abort".  Nema koda greske koji bi se citao.
;;;  Bolje je propustiti neku retku poruku kao otkaz nego pretvarati
;;;  svako odustajanje u prijavu kvara.
(defun fq:otkaz (er / m)
  (if (vl-catch-all-error-p er)
    (progn
      (setq m (vl-catch-all-error-message er))
      (or (not m)
          (= m "")
          (wcmatch (strcase m) "*CANCEL*,*QUIT*,*ABORT*")))
    nil))

;; Poruka o gresci, ali samo ako je stvarno greska.  Vraca T kad je
;; nesto ispisano, da pozivalac moze da granara ako mu treba.
(defun fq:greska (er uvod)
  (cond ((not (vl-catch-all-error-p er)) nil)
        ((fq:otkaz er) nil)
        (T (princ (strcat uvod (vl-catch-all-error-message er))) T)))

;; Ciscenje posle prekida.  *fq-por* se NAMERNO ne dira: poravnanje je
;; korisnikova odluka koja prezivljava vise komandi, pa bi ga ciscenje
;; ovde tiho bacalo bas kad se korisnik predomisli usred poteza.
;; fq:undo-kraj se NE zove odavde.  Kroz paletu i traku undo grupu
;; zatvara onaj ko ju je otvorio, a *error* tamo ionako ne dolazi na
;; red; kod kucane komande grupa nikad nije ni otvorena, pa bi
;; EndUndoMark zatvarao tudju.
;; *fq-m* se, za razliku od *fq-por*, ciscenju PREDAJE.  Ono nije
;; korisnikova odluka nego stanje transforma koje vazi za jedno kuciste;
;; Esc usred precrtavanja ogledalnog ormara bi ga inace ostavio na -1.0,
;; pa bi sledeca komanda crtala u ogledalu bez ijednog traga zasto.
(defun fq:cisti ()
  (setq *fq-snapkes* nil
        *fq-snaphit* nil
        *fq-m*       1.0)
  (vl-catch-all-apply 'redraw nil)
  T)

;;; --- *error* za komande koje se KUCAJU ---------------------------
;;;
;;;  Kroz paletu i traku je Esc vec tih: vl-catch-all-apply uhvati
;;;  gresku PRE nego sto AutoLISP pozove *error*, pa ovaj handler tamo
;;;  nikad ne dodje na red.  Bas zato ga sme nositi svaka komanda --
;;;  ne moze da promeni tok petlje u c:FQ ni omotaca fq:run, sto je
;;;  bio glavni razlog da se zajednicki omotac ranije odbaci.
;;;
;;;  Kada se komanda kuca, nema ko da uhvati, pa AutoCAD ispisuje svoje
;;;    ; error: Function cancelled
;;;  na svaki Esc.  Handler tu poruku prepoznaje i cuti, a pravu gresku
;;;  i dalje ispisuje -- i to sa imenom dodatka, da se zna odakle je.
;;;
;;;  Postavlja se ISKLJUCIVO kao lokalna promenljiva komande:
;;;    (defun c:FQNESTO ( / *error* ...)  (setq *error* fq:err) ...)
;;;  Tako ga AutoLISP sam vrati na prethodni pri izlasku, pa nijedan
;;;  drugi dodatak u sesiji ne oseti da smo bili tu.  Globalno
;;;  postavljanje bi sakrilo greske tudjeg koda i to je zabranjeno.
;;;
;;;  Ako fq-sema.lsp nije ucitan, fq:err je nil i (setq *error* nil)
;;;  vraca podrazumevano ponasanje AutoCAD-a -- dakle tacno ono sto je
;;;  bilo pre ove izmene.  Zato nema provere.
(defun fq:err (m)
  (fq:cisti)
  (if (and m (= (type m) 'STR)
           (not (wcmatch (strcase m) "*CANCEL*,*QUIT*,*ABORT*")))
    (princ (fq:tf "traka.greska" (list m))))
  (princ))

;;; --- ssget koji ne puca u praznom crtezu --------------------------
;;;  Dok u crtezu nema nijednog FIBERQ elementa, aplikacija FIBERQ nije
;;;  ni registrovana. Filter (-3 ("FIBERQ")) se tada trazi nad necim
;;;  cega nema, pa se prvo registruje pa tek onda trazi.

(defun fq:ssx (flt / ss)
  (regapp "FIBERQ")
  (setq ss (vl-catch-all-apply 'ssget (list "_X" flt)))
  (if (vl-catch-all-error-p ss) nil ss))

;;; --- pomocno za nizove --------------------------------------------

(defun fq:cifre? (s / i c ok)
  (setq ok (> (strlen s) 0) i 1)
  (while (and ok (<= i (strlen s)))
    (setq c (ascii (substr s i 1)))
    (if (or (< c 48) (> c 57)) (setq ok nil))
    (setq i (1+ i)))
  ok)

;;; ------------------------------------------------------------------
;;;  BROJ IZ POLJA ZA UNOS
;;;
;;;  Na srpskom Windows-u je decimalni razdvojnik ZAREZ, i korisnik ga
;;;  tako i kuca.  atof zna samo tacku: iz "7,5" procita 7.0 i stane na
;;;  zarezu.  Ne javi gresku, ne vrati nil -- vrati broj koji je za
;;;  pola manji.  Ta duzina onda ide u crtez i u zapis vlakna, pa se
;;;  greska otkrije tek kad se meri sa papira.
;;;
;;;  vl-string-subst, a ne rucno rastavljanje: (vl-load-com) je pozvan
;;;  na vrhu fajla, poziv je jedan, i test-lisp.ps1 sam upucuje na ovaj
;;;  idiom.
;;; ------------------------------------------------------------------

;; Da li se s uopste cita kao broj.  Prazan string, sama tacka i sam
;; minus nisu brojevi, a atof bi za sva tri vratio 0.0 bez ikakvog
;; znaka da nije procitao nista.
(defun fq:realan? (s / i c ok tac cif)
  (setq s (vl-string-subst "." "," s))
  (if (and (> (strlen s) 0) (= (substr s 1 1) "-")) (setq s (substr s 2)))
  (setq ok (> (strlen s) 0) i 1 tac 0 cif 0)
  (while (and ok (<= i (strlen s)))
    (setq c (ascii (substr s i 1)))
    (cond ((and (>= c 48) (<= c 57)) (setq cif (1+ cif)))
          ((= c 46)                  (setq tac (1+ tac)))
          (T                         (setq ok nil)))
    (setq i (1+ i)))
  (and ok (> cif 0) (< tac 2)))

;; Realan broj iz stringa, ili rez ako se ne cita kao broj.
(defun fq:areal (s rez)
  (if (fq:realan? s)
    (atof (vl-string-subst "." "," s))
    rez))

;; Pitanje za realan broj koje prihvata i zarez.
;;
;; getreal NE pomaze: on sam odbija "7,5" sa "Requires numeric value",
;; pre nego sto string uopste stigne do naseg koda.  Na srpskom
;; Windows-u je zarez decimalni razdvojnik i korisnik ga tako kuca, pa
;; je pitanje o duzini bilo neprolazno dok se ne pogodi da treba tacka.
;;
;; getstring prima sve, pa fq:areal odlucuje.  Prazan unos daje rez,
;; isto kao Enter na getreal-u.  Necitljiv unos to i kaze i pita ponovo
;; -- tiho uzimanje podrazumevane vrednosti bi na duzini kabla znacilo
;; 40 metara umesto 7.5, bez ijednog znaka da broj nije procitan.
(defun fq:pitajreal (poruka rez / s v)
  (setq v nil)
  (while (not v)
    (setq s (fq:trim (getstring T poruka)))
    (cond ((= s "")        (setq v rez))
          ((fq:realan? s)  (setq v (fq:areal s rez)))
          (T (princ (fq:tf "opste.nije.broj" (list s))))))
  v)

;; Ceo broj iz stringa, ili rez.  Prazno polje NIJE greska: kod broja
;; iskoriscenih portova prazno znaci "koliko kabl ima vlakana", pa se
;; prazno i nesto necitljivo namerno ne razlikuju -- oba daju rez.
(defun fq:acel (s rez)
  (if (fq:cifre? (vl-string-trim " " s)) (atoi s) rez))

;; da li niz s pocinje zadatim pocetkom
(defun fq:posle2 (s pre)
  (if (and (>= (strlen s) (strlen pre))
           (= (strcase (substr s 1 (strlen pre))) (strcase pre)))
    T
    nil))

;; ako s pocinje sa pre a ostatak su same cifre, vrati taj broj
(defun fq:posle (s pre / n r)
  (setq n (strlen pre))
  (if (and (> (strlen s) n) (= (strcase (substr s 1 n)) (strcase pre)))
    (progn (setq r (substr s (1+ n)))
           (if (fq:cifre? r) (atoi r) nil))
    nil))

;; spoj dva zapisa u lanac razdvojen znakom +, prazni se preskacu
(defun fq:spoji2 (a b)
  (cond ((= a "") b)
        ((= b "") a)
        ((= a b)  a)
        (T (strcat a " + " b))))

;; razlozi lanac "A + B + C" na listu delova bez praznina
(defun fq:delovi (s / out w)
  (setq out nil)
  (foreach w (fq:split s "+")
    (setq w (fq:trim w))
    (if (/= w "") (setq out (cons w out))))
  (reverse out))

;; Najveci broj koji je vec upotrebljen uz date prefikse, iz CRTEZA.
;; Sesijski brojac se gubi pri zatvaranju AutoCAD-a, pa bi se sutra
;; napravio drugi K1. Zato se gleda sta u crtezu stvarno postoji.
;;
;; Prima LISTU prefiksa i vraca listu najvecih brojeva.  Prolaz kroz
;; sve FIBERQ entitete je najskuplji deo posla u velikom crtezu, a
;; dijalog nastavka trazi i "N " i "NL ", pa se ne radi dvaput.
;; Polje se trimuje PRE fq:posle, i to izvan lambda-e.
;;
;; Dva razloga.  Prvi: oznaka "ODO 7 " sa razmakom na kraju nije prosla
;; kroz fq:cifre?, pa je fq:posle vratio nil i brojac je sledecem ormaru
;; opet ponudio 7 -- dva ormara sa istom oznakom, a specifikacija ih
;; grupise u jedan red.  Drugi: ovako se fq:f i fq:trim zovu jednom po
;; entitetu i polju, umesto jednom po PREFIKSU; na crtezu sa nekoliko
;; hiljada zapisa to je razlika koja se oseti kad se otvori dijalog.
(defun fq:maxbrojevi (pres / ss i d out v k s)
  (setq ss  (fq:ssx '((-3 ("FIBERQ"))))
        i   0
        out (mapcar '(lambda (p) 0) pres))
  (if ss
    (while (< i (sslength ss))
      (setq d (fq:xdget (ssname ss i)))
      (if d
        (foreach k '(1 2)
          (setq s (fq:trim (fq:f k d)))
          (setq out (mapcar
                      '(lambda (p m)
                         (if (and (setq v (fq:posle s p)) (> v m))
                           v m))
                      pres out))))
      (setq i (1+ i))))
  out)

(defun fq:maxbroj (pre) (car (fq:maxbrojevi (list pre))))

;; Koji bi broj bio sledeci, BEZ trosenja.  fq:next pamti sta je izdao,
;; pa bi drugi poziv dao sledeci broj; pregled u dijalogu zato mora da
;; pita ovako, inace bi u prozoru pisalo N 5 a u crtezu N 6.
;; Sesijski brojac vazi samo dok ga CRTEZ potvrdjuje.
;;
;; Ranije je bilo (max sesija+1 crtez+1), pa broj jednom izdat nikad
;; nije silazio.  Posledica: postavis OLT3, obrises ga, i sledeci je
;; OLT4 iako u crtezu nema nijednog OLT-a.  Posle nekoliko brisanja
;; oznake nemaju veze sa onim sto se vidi, a specifikacija ima rupe u
;; numeraciji koje niko ne ume da objasni.
;;
;; Sada: kad je crtez ISPOD brojaca, ti elementi su obrisani ili
;; ponisteni, pa brojevi ponovo ulaze u opticaj, a zastareo zapis se
;; sam brise.  Rupa koju ovo ostavlja -- element nacrtan na zakljucanom
;; lejeru nema xdata pa ga fq:maxbrojevi ne vidi -- vec je pokrivena
;; glasnim upozorenjem iz fq:zakljavi.
(defun fq:peekb (pre mx / rec)
  (if (and (setq rec (assoc pre *fq-cnt*)) (< mx (cdr rec)))
    (setq *fq-cnt* (vl-remove rec *fq-cnt*)))
  (1+ mx))

(defun fq:peekn (pre) (fq:peekb pre (fq:maxbroj pre)))
(defun fq:peek  (pre) (strcat pre (itoa (fq:peekn pre))))

;; Dva prefiksa odjednom, jedan prolaz kroz crtez.  Vraca dve oznake.
(defun fq:peek2 (p1 p2 / mx)
  (setq mx (fq:maxbrojevi (list p1 p2)))
  (list (strcat p1 (itoa (fq:peekb p1 (car mx))))
        (strcat p2 (itoa (fq:peekb p2 (cadr mx))))))

(defun fq:next (pre / rec n)
  (setq n   (fq:peekn pre)
        rec (assoc pre *fq-cnt*))
  (setq *fq-cnt* (if rec
                   (subst (cons pre n) rec *fq-cnt*)
                   (cons (cons pre n) *fq-cnt*)))
  (strcat pre (itoa n)))

;;  OTKAZIVANJE se ne resava ovde nego u fq:peekb.
;;
;;  Prvi pokusaj je bio "vrati broj u else grani na otkaz".  Ne radi:
;;  Esc u getpoint BACA gresku, ne vraca nil, pa se else grana nikad ne
;;  izvrsi -- u komandnoj liniji se to vidi kao "Function cancelled".
;;
;;  Drugi je bio fq:peek za poruku pa fq:next pred crtanje.  Radi, ali
;;  placa DVA puna prolaza kroz crtez po elementu, a fq:maxbrojevi je
;;  najskuplji deo posla u velikom crtezu.
;;
;;  Ostalo je najjeftinije: brojac se ne brani od otkaza, nego se sam
;;  spusti cim vidi da ga crtez ne potvrdjuje.  Isti mehanizam pokriva
;;  i Esc, i UNDO, i obicno brisanje -- a nijedno od toga ne mora da
;;  zna za brojac.

;; svetska temena polilinije, redom
(defun fq:pl10 (e / out x)
  (setq out nil)
  (foreach x (entget e)
    (if (= (car x) 10) (setq out (cons (cdr x) out))))
  (reverse out))

;; Filter po lejeru je ovde bitan. Bez njega se prolazi kroz svaki
;; FIBERQ entitet u crtezu, a u vecem projektu ih ima desetine hiljada.
;;
;; Vraca (broj  prvo-teme  poslednje-teme  entitet).
;; Oba kraja su potrebna jer posle vertikalnog odvoda dva kraja
;; vlakna vise nisu u istom redu, pa se ne sme uvek uzimati prvo teme.
(defun fq:cablefibers (kabl / ss i e d pl out)
  (setq ss  (fq:ssx '((8 . "FQ_VLAKNO") (-3 ("FIBERQ"))))
        out nil
        i   0)
  (if ss
    (while (< i (sslength ss))
      (setq e (ssname ss i) d (fq:xdget e))
      (if (and d (= (car d) "VLAKNO") (= (fq:vl-kabl d) kabl))
        (progn
          (setq pl (fq:pl10 e))
          (if pl
            (setq out (cons (list (atoi (fq:vl-br d)) (car pl) (last pl) e)
                            out)))))
      (setq i (1+ i))))
  (if out (vl-sort out '(lambda (a b) (< (car a) (car b)))) nil))

;; Kraj vlakna blizi koordinati uref, u sistemu kabla.
;;
;; Kada je vlakno USPRAVNO u tom sistemu — izvod iz nastavka je bas
;; takav — oba kraja su na istoj koordinati duz kabla i poredjenje
;; nista ne resava.  Tada presudjuje redosled temena i uzima se
;; POSLEDNJE, jer se izvod bas zato i crta sa gornjim krajem na kraju
;; liste.  Isto pravilo vazi i u fq:sporend; da se ova dva razidju,
;; grupno spajanje bi za izvod merilo donji kraj, daleko ispod rama.
(defun fq:krajuz (r uref)
  (if (< (abs (- (car (fq:loc (cadr r))) uref))
         (abs (- (car (fq:loc (caddr r))) uref)))
    (cadr r)
    (caddr r)))

;; svedi listu na (broj tacka entitet), uzimajuci kraj blizi uref
(defun fq:krajevi (raw uref)
  (mapcar '(lambda (r) (list (car r) (fq:krajuz r uref) (cadddr r))) raw))

;; vraca (kabl  lista-vlakana  ugao-u-stepenima  u-klika  temena-klika)
;; Lista je svedena na kraj kabla koji je korisnik pokazao klikom,
;; pa ODF, ODO i nastavak sada mogu i na desni kraj, i na kraj odvoda.
;;
;;  Cetvrti i peti clan su dopisani 22.08.2026, za nastavak na kablu sa
;;  lomovima.  uref je kraj vlakna blizi kliku i za ODF i ODO je to ono
;;  sto treba; nastavak medjutim stoji TAMO GDE JE KLIKNUTO, a ne na
;;  kraju kabla, pa mu treba sama tacka klika i putanja kliknutog
;;  vlakna -- iz njih se dobija i pojas snopa i deonica bez preloma.
;;  Dopisano na kraj, pa stari pozivaoci (car/cadr/caddr) ne znaju ni
;;  da se nesto promenilo.
(defun fq:pickcable (por / s d kabl raw fl ang uref pts)
  (setq s (entsel por))
  (if (not s)
    (progn (princ (fq:t "opste.nista")) nil)
    (progn
      (setq d (fq:xdget (car s)))
      (if (not (and d (= (car d) "VLAKNO")))
        (progn (princ (fq:t "opste.nije.vlakno.kabla")) nil)
        (progn
          (setq kabl (fq:vl-kabl d)
                ang  (fq:vl-ang d))
          (setq *fq-a* (fq:deg ang))
          (setq pts  (fq:orient (car s) (cadr s))
                uref (car (last pts))
                raw  (fq:cablefibers kabl)
                fl   (if raw (fq:krajevi raw uref) nil))
          (if (not fl)
            (progn (princ (fq:t "kabl.nema.vlakana")) nil)
            (progn
              (princ (fq:tf "kabl.izabran" (list kabl (fq:vl-lbl d) (itoa (length fl)) (itoa ang) (rtos uref 2 2))))
              (list kabl fl ang (car (fq:loc (cadr s))) pts))))))))


;;; ------------------------------------------------------------------
;;;  7. KOORDINATNI SISTEM CRTANJA
;;;
;;;  Sve se crta u lokalnim koordinatama (u, v):
;;;    u  ide duz vlakna
;;;    v  ide popreko, nanize su negativne vrednosti
;;;  *fq-a* je ugao u radijanima, 0 znaci horizontalno udesno.
;;;
;;;  LOKALNI SISTEM JE ZAKACEN ZA SVETSKI, i to je odluka, ne propust.
;;;
;;;  fq:w i fq:loc rotiraju oko koordinatnog pocetka SVETSKOG sistema.
;;;  Nijedan ugao, pravac ni podatak u xdata se ne prevodi kroz (trans):
;;;  polje 13 zapisa vlakna nosi ugao u svetskim stepenima, isto tako ga
;;;  cita fq:kucugao, i tako stoji u svakom vec nacrtanom crtezu.
;;;
;;;  Zato se crtanje van svetskog UCS-a BLOKIRA (fq:ucsok), umesto da se
;;;  tacke prevode.  Delimican prevod bi bio gori od oba cista resenja:
;;;  cim bi se jedna strana prevodila a druga ne, ugao iz xdata i ugao
;;;  iz geometrije bi se razisli i svaki stariji crtez bi postao
;;;  necitljiv.  Pun prevod je zaseban posao, i onda se menjaju OBA
;;;  smera odjednom.
;;;
;;;  OGLEDALO (*fq-m*).  Kuciste se uvek crta na strani -u od kolone
;;;  konektora, jer je kabl na strani +u.  Kuciste na DRUGOM kraju kabla
;;;  ima kabl sa strane -u, pa mora da se preslika: kolona ostaje gde
;;;  jeste, telo ide na +u.
;;;
;;;  To se resava OVDE, u samom transformu, a ne u crtacima.  *fq-m* je
;;;  1.0 ili -1.0 i mnozi se sa u pri izlasku u svet.  Time svaki crtac
;;;  kucista -- fq:drawodo, fq:drawodf, fq:drawzok, fq:drawodfn,
;;;  fq:drawodospl, fq:port, fq:kon, fq:visi -- daje ogledalnu sliku bez
;;;  ijedne izmene u sebi, i pravilo parnosti ostaje ispunjeno samo
;;;  po sebi.  Alternativa je bila znak uz svaki od nekoliko stotina
;;;  pomeraja od u0; taj put ne bi prezivela nijedna sledeca izmena.
;;;
;;;  Preslikava se SAMO u, nikad v.  Rotacija za 180 stepeni bi bila
;;;  kraca (dovoljan bi bio *fq-a*), ali ona obara i v: naslov ormara bi
;;;  otisao ispod rama, model i montaza iznad, a redovi bi se citali
;;;  odozdo.  Ogledalo je vertikalna osa, ne tacka.
;;;
;;;  Osa preslikavanja je NEBITNA i zato je uzeta nula.  Sve sto crtac
;;;  crta izvedeno je iz u0, a i sam u0 dolazi kroz fq:loc, pa se pomeraj
;;;  ose skrati: tacka na lokalnom u0+x uvek padne na svetsko ue-x.
;;;
;;;  fq:w i fq:loc ostaju TACNI INVERZI, jer je u -> -u samo sebi
;;;  inverzno.  Zbog toga ceo racun koji se vodi u lokalnim koordinatama
;;;  -- fq:kucgeo, fq:kucbrisi, fq:prolaziu, fq:konredovi -- radi
;;;  nepromenjen; menja se samo gde to na kraju padne u svetu.
;;;
;;;  U crtezu se ogledalo NE PAMTI kao polje.  fq:Wrect pravi temena
;;;  redom (ul vt) (ur vt) (ur vb) (ul vb), pa prva ivica pokazuje u
;;;  smeru +u; preslikana, pokazuje na suprotnu stranu i fq:kucugao
;;;  vrati ugao kabla + 180.  Ram sam nosi svoju orijentaciju, kao i do
;;;  sada, i nijedno polje u xdata ne mora da se dopisuje -- a kod vrsta
;;;  ODO, ZOK i IPAN se i ne sme, jer im fq:vstat status cita kao
;;;  POSLEDNJI clan zapisa.
;;; ------------------------------------------------------------------

(defun fq:deg (d) (* pi (/ d 180.0)))

;; 1.0 obicno, -1.0 ogledalno.  Postavlja se uvek uz *fq-a*, kroz
;; fq:sistem; golo (setq *fq-a* ...) znaci "bez ogledala".
(setq *fq-m* 1.0)

;; Jedini ispravan nacin da se postavi sistem kucista.
;;   ang  ugao KABLA u stepenima
;;   ogl  T ako je kuciste na strani +u od kolone
;;
;; Ugao rama iz crteza (fq:kucugao) je kod ogledalnog kucista ang+180,
;; pa se ovde predaje ang, ne ono sto je procitano.  Vidi fq:kucogl.
(defun fq:sistem (ang ogl)
  (setq *fq-a* (fq:deg ang)
        *fq-m* (if ogl -1.0 1.0)))

(defun fq:w2 (u v / um)
  (setq um (* *fq-m* u))
  (list (- (* um (cos *fq-a*)) (* v (sin *fq-a*)))
        (+ (* um (sin *fq-a*)) (* v (cos *fq-a*)))))

(defun fq:w (u v / p) (setq p (fq:w2 u v)) (list (car p) (cadr p) 0.0))

;; svetska tacka u lokalne koordinate
(defun fq:loc (p)
  (list (* *fq-m*
           (+ (* (car p) (cos *fq-a*)) (* (cadr p) (sin *fq-a*))))
        (- (* (cadr p) (cos *fq-a*)) (* (car p) (sin *fq-a*)))))

;; --- svetski vektori, za racun koji ne staje u jedan sistem --------
;;
;;  Kabl sa lomovima i izvod iz kucista imaju dva kraja pod razlicitim
;;  uglom, pa se njihova geometrija racuna u svetskim koordinatama, a
;;  tek se svaki kraj posebno cita u svom (u, v) sistemu.

(defun fq:pzbir  (a b) (list (+ (car a) (car b)) (+ (cadr a) (cadr b)) 0.0))
(defun fq:pputa  (d s) (list (* s (car d)) (* s (cadr d)) 0.0))

;; jedinicni vektor od a ka b, nil ako su tacke iste
(defun fq:jed (a b / dx dy l)
  (setq dx (- (car b) (car a))
        dy (- (cadr b) (cadr a))
        l  (sqrt (+ (* dx dx) (* dy dy))))
  (if (< l 1e-9) nil (list (/ dx l) (/ dy l))))

;; normala nalevo od pravca, to jest rotacija za +90
(defun fq:levo (d) (list (- (cadr d)) (car d)))

;; jedinicni vektor zadatog ugla u stepenima
(defun fq:uvek (a / r) (setq r (fq:deg a)) (list (cos r) (sin r)))

;; projekcija tacke m na pravu kroz a u pravcu d
(defun fq:naosu (a d m / t2)
  (setq t2 (+ (* (- (car m) (car a)) (car d))
              (* (- (cadr m) (cadr a)) (cadr d))))
  (list (+ (car a) (* t2 (car d))) (+ (cadr a) (* t2 (cadr d))) 0.0))

;; ugao vektora u celim stepenima, 0..359
(defun fq:stepen (d / a)
  (setq a (/ (* 180.0 (atan (cadr d) (car d))) pi))
  (if (< a 0.0) (setq a (+ a 360.0)))
  (rem (fix (+ a 0.5)) 360))


;;; ------------------------------------------------------------------
;;;  8. CRTACKE PRIMITIVE
;;;
;;;  Svaka vraca rukohvat nacrtanog entiteta, ili nil ako entmake nije
;;;  prosao.  Golo (entlast) posle neuspelog entmake vraca PRETHODNI
;;;  entitet u crtezu, dakle tudji, i to bez ijednog znaka da nesto nije
;;;  u redu.  Odatle ide dalje: taj rukohvat se upise u xdata, a sledeca
;;;  komanda ga procita kao svoj i entdel-uje tudji crtez.
;;;
;;;  Merenje u AutoCAD Map 3D 2021: entmake na ZAKLJUCAN lejer prolazi,
;;;  a lejer koji ne postoji AutoCAD sam napravi.  Dakle nijedan od dva
;;;  ocekivana razloga ne obara entmake, i ovo je pojas a ne popravka
;;;  poznatog kvara.
;;;
;;;  NIJEDAN UPIS U xdata VISE NE IDE PREKO (entlast).  Do 21.08.2026 je
;;;  trinaest mesta imalo oblik (fq:xd (entlast) ...) -- ODF, ODO, ODO sa
;;;  spliterom, nastavak, spliter, OLT, ONT, rezerva i dva varenja.  Svi
;;;  su prepisani na (fq:xd (fq:Wnesto ...) ...), pa rukohvat dolazi iz
;;;  iste zagrade koja ga je napravila.  test-lisp.ps1 cuva taj oblik.
;;;
;;;  Kod rezerve se usput videlo zasto oblik nije samo stvar ukusa:
;;;  zapis tamo ide na NATPIS, a pre njega se nacrtaju tri koture.  Koji
;;;  entitet nosi zapis moglo se procitati jedino iz redosleda poziva.
;;;
;;;  Golo (entlast) ostaje ispravno na jednom mestu: fq:kucdraw ga uzima
;;;  PRE crtanja, kao marker odakle fq:kucprepis krece entnext-om.  Tamo
;;;  se tudji entitet i trazi.
;;; ------------------------------------------------------------------

;; --- svetske, za slucajeve gde se crta izmedju dve pokazane tacke ---

(defun fq:line (p1 p2 aci lay xd / e)
  (if (entmake (list '(0 . "LINE") (cons 8 lay) (cons 62 aci)
                     (cons 10 p1) (cons 11 p2)))
    (progn
      (setq e (entlast))
      (if xd (fq:xd e xd))
      e)
    nil))

;; --- lokalne, rotiraju se sa *fq-a* --------------------------------

(defun fq:Wline (u1 v1 u2 v2 aci lay xd)
  (fq:line (fq:w u1 v1) (fq:w u2 v2) aci lay xd))

(defun fq:Wpl (uvs aci lay cl / l)
  (setq l (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity")
                (cons 8 lay) (cons 62 aci) '(100 . "AcDbPolyline")
                (cons 90 (length uvs)) (cons 70 (if cl 1 0))))
  (foreach uv uvs
    (setq l (append l (list (cons 10 (fq:w2 (car uv) (cadr uv)))))))
  (if (entmake l) (entlast) nil))

(defun fq:Wrect (u1 v1 u2 v2 aci lay)
  (fq:Wpl (list (list u1 v1) (list u2 v1) (list u2 v2) (list u1 v2))
          aci lay T))

;; polilinija sa podacima
(defun fq:Wpl2 (uvs aci lay xd / e)
  (setq e (fq:Wpl uvs aci lay nil))
  (if xd (fq:xd e xd))
  e)

;; Polilinija po SVETSKIM tackama.  Vlakno kabla sa lomovima prolazi
;; kroz vise uglova, pa se ne moze zapisati u jednom (u, v) sistemu.
(defun fq:plsvet (pts aci lay xd / l e)
  (setq l (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity")
                (cons 8 lay) (cons 62 aci) '(100 . "AcDbPolyline")
                (cons 90 (length pts)) '(70 . 0)))
  (foreach p pts
    (setq l (append l (list (cons 10 (list (car p) (cadr p)))))))
  (if (entmake l)
    (progn
      (setq e (entlast))
      (if xd (fq:xd e xd))
      e)
    nil))

;;; --- rad sa polilinijom vlakna, sve u lokalnim koordinatama -------

;; temena polilinije kao lista (u v)
(defun fq:plpts (e) (mapcar 'fq:loc (fq:pl10 e)))

;; Prepisi temena polilinije novim (u,v) parovima, redom.  Menjaju se
;; grupe 10 koje vec postoje, pa broj temena ostaje isti i zapis na
;; entitetu se ne dira.
(defun fq:plsetpts (e uvs / d i out p)
  (setq d (entget e) i 0 out nil)
  (foreach x d
    (if (and (= (car x) 10) (< i (length uvs)))
      (progn (setq p   (nth i uvs)
                   out (cons (cons 10 (fq:w2 (car p) (cadr p))) out)
                   i   (1+ i)))
      (setq out (cons x out))))
  (entmod (reverse out))
  e)

;; Tacka umetanja teksta.  Kod poravnatog teksta merodavna je grupa 11,
;; inace 10; AutoCAD u entget uvek vraca i 11, pa se gleda 72 i 73.
;;
;; Ovo NIJE sitnica.  Tekst se u fq:Wtext postavlja tackom 11, a
;; AutoCAD tacku 10 prepise na donji levi ugao ispisa.  Ko posle trazi
;; natpis po tacki 10 promasi ga za pola sirine teksta i pola visine, a
;; sirina zavisi od samog teksta, pa promasaj nije ni stalan.
(defun fq:txtpt (d / h v)
  (setq h (cdr (assoc 72 d))
        v (cdr (assoc 73 d)))
  (if (and (assoc 11 d)
           (or (and h (/= h 0)) (and v (/= v 0))))
    (cdr (assoc 11 d))
    (cdr (assoc 10 d))))

;; Pomeri tekst za du duz kabla i dv popreko.  Poravnat tekst nosi i
;; tacku 11, pa moraju obe, inace tekst ostane gde je bio a ram ode.
(defun fq:txtpom (e du dv / d out lc)
  (setq d (entget e) out nil)
  (foreach x d
    (if (member (car x) '(10 11))
      (progn (setq lc  (fq:loc (cdr x))
                   out (cons (cons (car x)
                                   (fq:w (+ (car lc) du) (+ (cadr lc) dv)))
                             out)))
      (setq out (cons x out))))
  (entmod (reverse out))
  e)

;; da li je poslednji segment vodoravan u sistemu kabla
(defun fq:vodoravan (pts / n a b)
  (setq n (length pts))
  (if (< n 2)
    nil
    (progn (setq b (nth (1- n) pts) a (nth (- n 2) pts))
           (< (abs (- (cadr b) (cadr a))) 1e-6))))

;; okreni listu tako da izabrani kraj bude poslednji
(defun fq:orient (e p / pts a b)
  (setq pts (fq:plpts e)
        a   (car pts)
        b   (last pts))
  (if (< (distance (fq:w (car a) (cadr a)) p)
         (distance (fq:w (car b) (cadr b)) p))
    (reverse pts)
    pts))

;; ukloni uzastopna ista temena
(defun fq:dedup (pts / out)
  (setq out nil)
  (foreach p pts
    (if (or (not out)
            (> (+ (abs (- (car p) (car (car out))))
                  (abs (- (cadr p) (cadr (car out))))) 1e-6))
      (setq out (cons p out))))
  (reverse out))

;; Ukloni temena koja lezu na pravoj izmedju suseda.  Kada se dva kraka
;; presecenog vlakna spoje nazad u pravo vlakno, na mestu spoja ostanu
;; dva suvisna temena; bez ovoga bi vlakno izgledalo pravo ali bi ga
;; svaki STRETCH lomio bas tamo gde je nekada bio rez.
(defun fq:ravna (pts / n i p q r out)
  (setq n (length pts))
  (if (< n 3)
    pts
    (progn
      (setq out (list (car pts)) i 1)
      (while (< i (1- n))
        (setq p (fq:last out) q (nth i pts) r (nth (1+ i) pts))
        (if (> (abs (- (* (- (car  q) (car  p)) (- (cadr r) (cadr p)))
                       (* (- (cadr q) (cadr p)) (- (car  r) (car  p)))))
               1e-6)
          (setq out (append out (list q))))
        (setq i (1+ i)))
      (append out (list (fq:last pts))))))

;; Tacka putanje na koordinati u duz kabla.  Ako putanja tu ne prolazi
;; (vlakno se zavrsava pre te koordinate), vraca njen blizi kraj, pa
;; splajs uvek legne NA vlakno a ne pored njega.
(defun fq:tackana (pts u / r)
  (if (setq r (fq:podeli pts u))
    (fq:last (car r))
    (if (<= (abs (- (car (car pts)) u)) (abs (- (car (fq:last pts)) u)))
      (car pts)
      (fq:last pts))))

;;; --- pojas snopa NA datoj koordinati ------------------------------
;;;
;;;  Do 22.08.2026 se visina rama nastavka racunala iz KRAJEVA vlakana,
;;;  a koji kraj se uzima biralo je fq:krajuz -- poredeci samo
;;;  koordinatu duz kabla.  Kod pravog kabla su oba kraja u istom redu,
;;;  pa se to nikad nije videlo.  Kod kabla sa lomovima krajevi jednog
;;;  vlakna leze na potpuno razlicitim visinama, pa se ram kacio za
;;;  pojas u kome vlakna ZAVRSAVAJU, a ne za mesto gde kabl prolazi.
;;;  Posledica na crtezu: ram ogroman i zakacen za gornju deonicu, i
;;;  neuredno poravnanje, jer poravnanje cita bas taj ram.
;;;
;;;  Merodavno je gde snop STVARNO prolazi na koordinati nastavka, pa
;;;  se meri kroz fq:tackana -- istu funkciju koja vec brine da splajs
;;;  legne na vlakno a ne pored njega.

;; v vrednosti vlakana koja STVARNO prolaze kroz koordinatu u
;;
;;  Namerno fq:podeli, ne fq:tackana.  fq:tackana za vlakno koje se
;;  zavrsava pre te koordinate vraca njegov blizi KRAJ, jer je pravljena
;;  za splajs, koji mora da legne na vlakno a ne pored njega.  Ovde bi
;;  bas to vratilo staru gresku na mala vrata: preseceno ili skraceno
;;  vlakno lezi u drugom pojasu, pa bi ram opet obuhvatio i njega.
;;  fq:podeli vrati nil kada putanja tu ne prolazi, i to je tacan
;;  odgovor -- takvog vlakna na tom mestu nema.
(defun fq:vopseg (fl u / vs pts r x)
  (setq vs nil)
  (foreach x fl
    (setq pts (fq:plpts (caddr x)))
    (if (and pts (>= (length pts) 2))
      (progn
        (setq r (fq:podeli pts u))
        (if r (setq vs (cons (cadr (fq:last (car r))) vs))))))
  ;;  Nijedno vlakno tu ne prolazi -- nastavak je iza kraja kabla.  Tada
  ;;  je fq:tackana ISPRAVNA, jer su svima najblizi krajevi na istoj
  ;;  strani, pa daju jedan pojas.  Mesati se ne sme: dok bar jedno
  ;;  vlakno prolazi, ono koje se zavrsilo ranije lezi u drugom pojasu
  ;;  i naduvalo bi ram -- to je bio prvobitni kvar.
  (if (not vs)
    (foreach x fl
      (setq pts (fq:plpts (caddr x)))
      (if (and pts (>= (length pts) 2))
        (setq vs (cons (cadr (fq:tackana pts u)) vs)))))
  vs)

;; u-opseg VODORAVNE deonice koja sadrzi u, ili nil ako je nema.
;;
;;  Nastavak fizicki stoji na jednom mestu trase i nikad ne obuhvata
;;  prelom, pa se prevlacenje zaustavlja na kraju deonice na kojoj je
;;  kabl pokazan.  Bez toga bi ram presao prelom i obuhvatio i
;;  vodoravni i uspravni deo snopa -- crtez koji na terenu ne postoji.
(defun fq:deonica (pts u / n i a b u1 u2 out)
  (setq n (length pts) i 0 out nil)
  (while (and (< i (1- n)) (not out))
    (setq a (nth i pts) b (nth (1+ i) pts))
    (if (< (abs (- (cadr a) (cadr b))) 1e-6)
      (progn
        (setq u1 (min (car a) (car b))
              u2 (max (car a) (car b)))
        (if (and (>= u (- u1 1e-6)) (<= u (+ u2 1e-6)))
          (setq out (list u1 u2)))))
    (setq i (1+ i)))
  out)

;; skrati ili produzi poslednji vodoravni segment do koordinate us
(defun fq:trimto (pts us / n a b s out)
  (setq n (length pts))
  (if (< n 2)
    pts
    (progn
      (setq b (nth (1- n) pts) a (nth (- n 2) pts))
      (if (> (abs (- (cadr b) (cadr a))) 1e-6)
        pts                                   ; poslednji segment nije vodoravan
        (progn
          (setq s (if (> (car b) (car a)) 1.0 -1.0)
                out (reverse pts))
          ;; Odbaci temena iza us u smeru kretanja, ali SAMO dok se ide
          ;; po istom redu.  Teme na kome se vlakno lomi nadole ne sme
          ;; da nestane: bez ovog uslova bi od pravog ugla ostala
          ;; dijagonala od kraja vlakna do skracene tacke.
          (while (and (> (length out) 1)
                      (< (abs (- (cadr (cadr out)) (cadr b))) 1e-6)
                      (> (* s (- (car (car out)) us)) 1e-6))
            (setq out (cdr out)))
          (reverse (cons (list us (cadr b)) out)))))))

;; Deli putanju na koordinati us duz kabla.  Vraca dva dela,
;; (deo-do-us  deo-od-us), ili nil ako putanja tu uopste ne prolazi.
;;
;; Trazi se od KRAJA liste unazad.  Kabl sa lomovima moze istu
;; koordinatu da preseca vise puta, a nastavak, kuciste i spliter uvek
;; stoje na poslednjem pravom delu vlakna, pa je merodavan poslednji
;; prelaz.  Teme reza se dobija linearnom interpolacijom, tako da rez
;; radi i na kosom delu, ne samo na vodoravnom.
(defun fq:podeli (pts us / n i k a b t2 p la lb j)
  (setq n (length pts) i (1- n) k nil)
  (while (and (> i 0) (not k))
    (setq b (nth i pts) a (nth (1- i) pts))
    (if (or (and (<= (car a) us) (>= (car b) us))
            (and (>= (car a) us) (<= (car b) us)))
      (setq k i)
      (setq i (1- i))))
  (if (not k)
    nil
    (progn
      (setq a  (nth (1- k) pts)
            b  (nth k pts)
            t2 (if (< (abs (- (car b) (car a))) 1e-9)
                 0.0
                 (/ (- us (car a)) (- (car b) (car a))))
            p  (list us (+ (cadr a) (* t2 (- (cadr b) (cadr a)))))
            la nil  lb nil  j 0)
      (foreach q pts
        (if (< j k) (setq la (cons q la)) (setq lb (cons q lb)))
        (setq j (1+ j)))
      (list (reverse (cons p la))
            (cons p (reverse lb))))))

;; napravi novo vlakno od liste temena, preuzmi izgled sa uzora
(defun fq:mkfiber (pts uzor xd / e d aci lw)
  (setq d   (entget uzor)
        aci (cdr (assoc 62 d))
        lw  (cdr (assoc 370 d)))
  (setq e (fq:Wpl (fq:dedup pts) (if aci aci 7) "FQ_VLAKNO" nil))
  (if lw (fq:setlw e lw))
  (if xd (fq:xd e xd))
  e)

(defun fq:Wdot (u v d aci lay / p r)
  (setq p (fq:w2 u v) r (* 0.25 d))
  (if (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity")
                 (cons 8 lay) (cons 62 aci) '(100 . "AcDbPolyline")
                 '(90 . 2) '(70 . 1) (cons 43 (* 0.5 d))
                 (cons 10 (list (- (car p) r) (cadr p))) '(42 . 1.0)
                 (cons 10 (list (+ (car p) r) (cadr p))) '(42 . 1.0)))
    (entlast)
    nil))

(defun fq:Well (cu cv ru rv aci lay / c maj rat b)
  (setq c  (fq:w cu cv)
        ru (max ru 0.10)
        rv (max rv 0.10))
  (if (>= ru rv)
    (setq maj (list (* ru (cos *fq-a*)) (* ru (sin *fq-a*)) 0.0)
          rat (/ rv ru))
    (progn
      (setq b (+ *fq-a* (* 0.5 pi)))
      (setq maj (list (* rv (cos b)) (* rv (sin b)) 0.0)
            rat (/ ru rv))))
  (if (entmake (list '(0 . "ELLIPSE") '(100 . "AcDbEntity")
                 (cons 8 lay) (cons 62 aci) '(100 . "AcDbEllipse")
                 (cons 10 c) (cons 11 maj) '(210 0.0 0.0 1.0)
                 (cons 40 rat) '(41 . 0.0) (cons 42 (* 2.0 pi))))
    (entlast)
    nil))

;; hj: 0 levo, 1 sredina, 2 desno    vj: 0 osnovna linija, 2 sredina
;; Ako bi tekst ispao naopako, okrece se za 180 i menja poravnanje,
;; pa uvek ostaje citljiv.
(defun fq:Wtext (u v h s aci lay sty hj vj / p a l)
  (setq p (fq:w u v) a *fq-a*)
  (if (and (> a (* 0.5 pi)) (<= a (* 1.5 pi)))
    (setq a  (- a pi)
          hj (cond ((= hj 0) 2) ((= hj 2) 0) (T 1))))
  ;; Ogledalo obrce i poravnanje.  Natpis se i dalje CITA sleva nadesno
  ;; -- preslikan tekst se ne cita -- pa se preslikava samo tacka za koju
  ;; je zakacen: sto je u lokalnom sistemu poravnato ulevo, u svetu mora
  ;; udesno.  Bez ovoga bi svaki natpis kucista otisao za svoju sirinu na
  ;; pogresnu stranu, a to je vidljivo tek na dugackom natpisu.
  ;;
  ;; Uslov se SLAZE sa gornjim, ne iskljucuje ga.  Merilo je da li
  ;; pravac citanja (a posle ispravke) gleda na istu stranu kao lokalno
  ;; +u, a to je (* *fq-m* (cos *fq-a*), * *fq-m* (sin *fq-a*)).  Za sva
  ;; cetiri ugla i oba znaka daje tacno ovaj par uslova, i tamo gde se
  ;; oba okinu (ogledalo pod 180) poravnanje se vraca na pocetno, sto je
  ;; i tacno.
  (if (< *fq-m* 0.0)
    (setq hj (cond ((= hj 0) 2) ((= hj 2) 0) (T 1))))
  (setq l (list '(0 . "TEXT") (cons 8 lay) (cons 62 aci) (cons 7 sty)
                (cons 10 p) (cons 40 h) (cons 1 s) (cons 50 a)))
  (if (or (/= hj 0) (/= vj 0))
    (setq l (append l (list (cons 11 p) (cons 72 hj) (cons 73 vj)))))
  (if (entmake l) (entlast) nil))

;; e sme da bude nil, iz istog razloga kao u fq:xd.
(defun fq:setcolor (e aci / d)
  (if (not e)
    nil
    (progn
      (setq d (entget e))
      (if (assoc 62 d)
        (entmod (subst (cons 62 aci) (assoc 62 d) d))
        (entmod (append d (list (cons 62 aci))))))))

(defun fq:setlw (e lw / d)
  (if (not e)
    nil
    (progn
      (setq d (entget e))
      (if (assoc 370 d)
        (entmod (subst (cons 370 lw) (assoc 370 d) d))
        (entmod (append d (list (cons 370 lw))))))))

;;  Podrazumevano je PRVI token, i to skracen na prvo slovo -- <P> na
;;  srpskom, <D> na engleskom.  Slovo se ne kuca u prompt nego racuna,
;;  jer bi inace bilo sedamnaesto mesto koje mora da se menja u koraku sa
;;  tabelom.  Uslov koji to nosi: prvo slovo prvog tokena mora biti
;;  jednoznacno, a kod dva statusa u oba jezika i jeste (P/I, D/A).
(defun fq:askst ( / l s kod)
  (setq l (fq:sttokovi))
  (initget (fq:spisak l " "))
  ;; (fq:f 0 l), ne (car l): fq:f vraca "" umesto nil, a (substr nil 1 1)
  ;; obara komandu.  Isti ugovor koji vec nose fq:t, fq:kodnaz i fq:kc-zmod.
  (setq s (getkword (fq:tf "opste.pitaj.status"
                           (list (fq:spisak l "/") (substr (fq:f 0 l) 1 1)))))
  ;; getkword vraca nil i na prazan Enter i na nepoznat token, pa se
  ;; podrazumevana vrednost bira ovde, a ne u tabeli.
  (if (setq kod (fq:stkod s)) kod "stProjektovano"))

;; Vrsta vlakna za sledeci kabl.  Podrazumevana je ono sto je poslednji
;; put izabrano u sesiji, ne fiksno SM: ko crta multimode mrezu, crta je
;; ceo dan.
;;
;; POSTAVLJA *fq-vrs*, ne samo sto vraca -- crtaci vrstu citaju odatle,
;; isto kao color code.  Poziv koji vrednost samo procita, a ne upise,
;; nacrtao bi kabl sa prethodnom vrstom.
;;
;; SM i MM se NE prevode -- to su medjunarodne oznake, i tabela ih zato
;; nosi isto u obe jezicke kolone.  Spisak ipak ide kroz tabelu: ne zbog
;; prevoda nego zato da bi postojao jedan izvor.  Zakucan "SM MM" pored
;; domena "vrs" je drugi spisak istog nabrajanja, a takva dva se pre ili
;; kasnije raziju -- isto pravilo po kome kategorija nema kolonu koda u
;; *FQ-KABLOVI*.
(defun fq:askvrs ( / l s)
  (setq l (fq:tokovi "vrs" nil))
  (initget (fq:spisak l " "))
  (setq s (getkword (fq:tf "vlakno.pitaj.vrsta"
                           (list (fq:spisak l "/") *fq-vrs*))))
  (if s (setq *fq-vrs* (fq:nazkod "vrs" s)))
  *fq-vrs*)

(defun fq:splgub (k)
  (cond ((= k 2)   3.6) ((= k 4)   7.3) ((= k 8)  10.5)
        ((= k 16) 13.7) ((= k 32) 17.0) ((= k 64) 20.5)
        ((<= k 1)  0.0)
        (T (+ 0.8 (* 3.01 (/ (log k) (log 2)))))))


;;; ==================================================================
;;;  9. KABL
;;; ==================================================================

;;  Da je podrazumevano, pa se vraca T kad fq:dvatok NIJE dao drugi
;;  token -- i na prazan Enter, i na izabrano "Da".
(defun fq:velik (nt nf / n)
  (setq n (* nt nf))
  (if (<= n *FQ-VELIKI*)
    T
    (not (fq:dvatok "opste.tok.da" "opste.tok.ne" "kabl.velik"
                    (list (itoa nt) (itoa nf) (itoa n))))))

;;; --- redovi vlakana -----------------------------------------------
;;;
;;;  JEDINO mesto gde se racuna na kojoj visini lezi koje vlakno.
;;;  Zovu ga i crtanje kabla, i pregled uz mis, i samostalni ODF i ODO.
;;;  Ako se ovo razidje po vise mesta, kabl i pregled prestanu da se
;;;  poklapaju, a to je greska koja se tesko primeti.
;;;
;;;  Prvi red je v0. Korak je *FQ-PITCH*, a na prelazu cevcice jos
;;;  *FQ-GAP*. Ako je zadata lista rows, redovi se preuzimaju iz nje
;;;  dok traje, pa se dalje nastavlja prirodnim rasterom.

(defun fq:redovi (nt nf v0 rows / i j n v vp rr out)
  (setq n 0 vp nil rr rows out nil i 1)
  (while (<= i nt)
    (setq j 1)
    (while (<= j nf)
      (setq n   (1+ n)
            v   (cond (rr        (car rr))
                      ((not vp)  v0)
                      (T (- vp *FQ-PITCH* (if (= j 1) *FQ-GAP* 0.0))))
            rr  (cdr rr)
            vp  v
            out (cons v out)
            j   (1+ j)))
    (setq i (1+ i)))
  (reverse out))


;;; --- pregled kabla dok se pomera mis ------------------------------
;;;
;;;  Kabl se do sada crtao na slepo, pa se posle popravljao komandom
;;;  MOVE. Ovde se pre crtanja prikazuju privremeni vektori koji prate
;;;  mis, pa se odmah vidi gde ce vlakna leci u odnosu na postojece.
;;;
;;;  Radi preko grread i grvecs, dakle bez ijednog poziva command i bez
;;;  kreiranja entiteta. Ako se odustane, u crtezu ne ostaje nista.
;;;
;;;  Cena je sto grread ne prolazi kroz object snap. Kome zatreba
;;;  hvatanje ili kucanje koordinata, iskljuci Pregled na paleti i
;;;  vraca se klasican unos tacke.

;; matrica pomeranja za grvecs
(defun fq:mtrans (p)
  (list (list 1.0 0.0 0.0 (car p))
        (list 0.0 1.0 0.0 (cadr p))
        (list 0.0 0.0 1.0 (if (caddr p) (caddr p) 0.0))
        (list 0.0 0.0 0.0 1.0)))

;; Vektori kabla u odnosu na tacku umetanja, kao (boja p1 p2 ...).
;; Prvo vlakno je crveno, da se vidi koji red je referentni.
;; Kod velikih kablova crta se samo prvo i poslednje vlakno cevcice,
;; inace bi se na svakom pomeraju misa slalo previse vektora.
;; Linije kabla za zadatu duzinu, iz vec izracunatih redova.
;; Pri povlacenju duzine se lg menja na svaki pomeraj misa, pa se
;; redovi racunaju jednom spolja a ovde se samo sklapaju linije.
(defun fq:lenvecs (rr lg retko nf / out n j v aci)
  (setq out nil n 0)
  (foreach v rr
    (setq n   (1+ n)
          j   (1+ (rem (1- n) nf))
          aci (if (= n 1) 1 *FQ-VLACI*))
    (if (or (not retko) (= j 1) (= j nf))
      (setq out (cons (fq:w lg v)
                      (cons (fq:w 0.0 v)
                            (cons aci out))))))
  (reverse out))

;; redovi u odnosu na tacku umetanja, prvo vlakno u nuli
(defun fq:relred (nt nf rows)
  (fq:redovi nt nf 0.0
             (if rows (mapcar '(lambda (x) (- x (car rows))) rows) nil)))

(defun fq:kablvecs (nt nf lg ang rows / sa out)
  (setq sa *fq-a*)
  (setq *fq-a* (fq:deg ang))
  (setq out (fq:lenvecs (fq:relred nt nf rows) lg
                        (> (* nt nf) *FQ-DRAG-MAX*) nf))
  (setq *fq-a* sa)
  out)

;;; --- hvatanje na prvi konektor rama --------------------------------
;;;
;;;  grread ne prolazi kroz object snap AutoCAD-a: vraca sirovu tacku
;;;  ispod kursora, pa je svejedno da li je kursorski snap ukljucen.
;;;  Zato pregled ima svoje hvatanje.
;;;
;;;  Hvata se SAMO prvi konektor rama kucista (ODF, PP, ODO, MDU, ZOK).
;;;  Uskost je namerna.  Krajevi vlakana i izlazi splitera se NE hvataju
;;;  jer im se ugao ne moze pouzdano procitati: lomljenom vlaknu se u
;;;  zapis upisuje ugao POSLEDNJEG dela (vidi zaglavlje sekcije 9b), pa
;;;  bi pocetni kraj dao pogresan ugao, a xdata IZLAZ je u kucistima
;;;  zakacena na DIJAGONALU lepeze, ne na vodoravan patrljak, pa bi ugao
;;;  ispao proizvoljan.  Tacna tacka uz pogresan ugao je tiho pogresna
;;;  sema, a to je gore nego da hvatanja uopste nema.
;;;
;;;  Red, ugao i kolona se NE racunaju ovde nego se uzimaju iz fq:porram,
;;;  iste one koju koristi FQPORAVNAJ.  Jedan racun na jednom mestu;
;;;  kopija bi se pre ili kasnije razisla sa originalom.
;;;
;;;  U *fq-por* se NE upisuje nista.  Taj zapis se ponistava tek posle
;;;  uspesno nacrtanog kabla, pa bi posle odustajanja ostao da visi i
;;;  sledeca komanda ne bi ni pitala za tacku.  Hvatanje daje tacku i
;;;  ugao, a to je sve sto mu i treba; ugao se preuzima kroz fq:snapuzmi.

;; Poluprecnik hvatanja u jedinicama crteza.  APERTURE je u pikselima,
;; pa se preko visine pogleda prevodi u crtez i polje hvatanja ostaje
;; iste velicine na ekranu bez obzira na zum.  Racuna se na svaki pomeraj
;; misa: tocak misa ume da zumira i usred grread petlje, a dva getvar-a
;; i jedno mnozenje su jeftinija od pretpostavke koja ne mora da vazi.
(defun fq:snapr ( / ap vs sh)
  (setq ap (getvar "APERTURE")
        vs (getvar "VIEWSIZE")
        sh (cadr (getvar "SCREENSIZE")))
  (if (and ap vs sh (> sh 0) (> ap 0))
    (* vs (/ (float ap) (float sh)))
    (* 0.01 (if vs vs 100.0))))

;; Da li se ram uopste VIDI.  ssget "_X" ne pita ni za lejer ni za
;; prostor, pa bi se inace hvatalo na ugasen ili zamrznut lejer i na
;; ramove iz tudjeg layouta: marker bi iskakao na praznom delu ekrana, a
;; tacka i ugao bi dolazili sa neceg sto korisnik ne gleda.
;; Prostor u kome se TRENUTNO crta.  CTAB vraca ime layouta i kada
;; korisnik radi u model prostoru KROZ plivajuci viewport, a entiteti
;; koje tada crta nose 410 = "Model".  Golo poredjenje sa CTAB bi u tom
;; slucaju odbacilo sve ciljeve i hvatanje bi tiho prestalo da radi bas
;; u prostoru u kome se radi.  CVPORT veci od 1 znaci da je aktivan
;; plivajuci viewport, dakle model prostor.
(defun fq:snapprostor ()
  (if (or (= (getvar "TILEMODE") 1) (> (getvar "CVPORT") 1))
    "Model"
    (getvar "CTAB")))

(defun fq:snapvidljiv (e / d lej tab)
  (setq d   (entget e)
        lej (cdr (assoc 8 d))
        tab (tblsearch "LAYER" lej))
  (and tab
       (not (minusp (cdr (assoc 62 tab))))          ; ugasen lejer
       (= 0 (logand 1 (cdr (assoc 70 tab))))        ; zamrznut lejer
       (equal (if (assoc 410 d) (cdr (assoc 410 d)) "Model")
              (fq:snapprostor))))

;; Kes ciljeva, po jedan zapis (tacka ugao opis) za svaki ram.
;; Gradi se JEDNOM po pozivu fq:dragpt: ssget na svaki pomeraj misa bi
;; zaustavio pregled na svakom iole vecem crtezu.
;;
;; Ramova je malo i svi nose FIBERQ zapis, pa filter po lejeru i po
;; zapisu vraca tacno njih.  Vlakna kroz ovaj filter ne prolaze jer su
;; na svom lejeru, pa granica broja ciljeva ne treba.
;; Okvir rama u lokalnom (u,v) pod datim uglom: (ul ur vt vb).
(defun fq:snaprect (e ang ogl / sa sm pts uu vv)
  (setq sa *fq-a* sm *fq-m*)
  (fq:sistem ang ogl)
  (setq pts    (mapcar 'fq:loc (fq:pl10 e))
        uu     (mapcar 'car  pts)
        vv     (mapcar 'cadr pts)
        *fq-a* sa
        *fq-m* sm)
  (list (apply 'min uu) (apply 'max uu)
        (apply 'max vv) (apply 'min vv)))

;; Da li iznad ovog rama stoji jos jedan ram ISTOG razdelnika, to jest da
;; li je ovo drugi ili dalji modul ODF/PP-a.
;;
;; Takav modul ima marginu 0.5 * *FQ-PITCH*, a prvi *FQ-ODF-MARG*;
;; fq:porram oduzima uvek onu prvog, pa bi cilj pao 1.20 ispod prvog
;; konektora, u prazno.  Greska je starija od hvatanja i ista je u
;; FQPORAVNAJ, ali tamo korisnik svesno klikne bas taj ram, a ovde bi
;; cilj iskakao sam od sebe.  Zato se takav modul preskace.
;;
;; Meri se RUCNO, nad vec procitanim spiskom.  Isto radi i fq:odfiznad u
;; fq-kucista.lsp, nad svojim spiskom iz fq:kucsvi — dve funkcije, isto
;; merilo.  Do 1.0.0 je ona isla kroz ssget "_C", a prozorski izbor uzima
;; samo ono sto je u tekucem POGLEDU: modul iznad koji nije na ekranu ne
;; bi bio nadjen.  Ovde bi to znacilo da se modul ne preskoci i da cilj
;; padne u prazno — bas ono protiv cega ova provera i postoji.  Isti
;; razlog je zapisan uz fq:kucbrisi i uz fq:kucsvi.
;;
;; Trazi se ram iste sirine (moduli jednog razdelnika su uvek jednako
;; siroki, jer fq:drawodfn racuna ul i ur JEDNOM pre petlje po modulima)
;; i istog ugla, cija donja ivica stoji na nasoj gornjoj, sa zazorom do
;; *FQ-PITCH* + *FQ-GAP* za slucaj da granica modula padne na prelaz
;; cevcice.
;;
;; Kandidat mora da bude ODF ili PP.  Stara fq:odfsused je trazila po
;; lejeru FQ_ODF, pa je i ona to podrazumevala; bez te provere bi ODO,
;; MDU ili ZOK slucajno iste sirine, postavljen tacno iznad ODF-a, tiho
;; ukinuo cilj tom ODF-u.
(defun fq:snapmodul (r ang svi / ul ur vt gore x found)
  (setq ul    (nth 0 r)
        ur    (nth 1 r)
        vt    (nth 2 r)
        gore  (+ *FQ-PITCH* *FQ-GAP* 0.2)
        found nil)
  (foreach x svi
    (if (and (member (car (nth 1 x)) '("ODF" "PP"))
             (= (nth 2 x) ang)
             (< (abs (- (nth 3 x) ul)) 0.05)
             (< (abs (- (nth 4 x) ur)) 0.05)
             (> (nth 6 x) (- vt 0.05))
             (< (nth 6 x) (+ vt gore)))
      (setq found T)))
  found)

;;; --- redovi konektora, procitani iz crteza -------------------------
;;;
;;;  Port i konektor su GOLA GEOMETRIJA bez zapisa, i to ostaje tako --
;;;  zapisano je u CLAUDE.md.  Do 1.0.0 se zato hvatao samo PRVI
;;;  konektor: njegov red se racuna iz rama (fq:porram), a za ostale
;;;  nije bilo odakle.  Na FDH-u sa spliterom se nov kabl bas i kaci na
;;;  izlaze splitera, dakle na portove 47, 46, ... , pa je prvi konektor
;;;  bio jedini na koji se nije kacilo.
;;;
;;;  Red se cita po BROJU PORTA.  Sva tri crtaca ga ispisuju kao TEXT na
;;;  lejeru svog rama, u redu porta i malo levo od kolone konektora:
;;;  ormar na 1.375 (fq:port), razdelnik i kutija na 1.50
;;;  (*FQ-ODF-NUMX*, *FQ-ZOK-NUMX*).  Trazi se po TACNOM mestu, isti
;;;  obrazac po kome fq:nasttekst trazi natpise nastavka.
;;;
;;;  Sam simbol se namerno NE gleda.  fq:port i fq:kon crtaju vodoravnu
;;;  liniju koja se zavrsava tacno na koloni, ali takvu liniju crta i
;;;  fq:visi za vlakno koje u ormaru visi bez porta, i to gotovo iste
;;;  duzine -- 0.92 naspram 0.924 kod ODF-a.  Broj ima samo port.
;;;
;;;  Pojas po duzini kabla nije ukras: prazan model ormara se u ram
;;;  ispisuje kao go kapacitet ("48"), a to je isto tako broj.  Stoji na
;;;  levoj pregradi, deset jedinica od kolone, pa ispada sam.

;; Svi brojevi konektora u crtezu, kao (broj . svetska-tacka).
;; JEDAN prolaz za sve ramove, iz istog razloga koji stoji uz fq:kucsvi:
;; ssget unutar petlje po ramovima se ponovi onoliko puta koliko ima
;; ramova, a ovo se gradi pred svaki pregled uz mis.
(defun fq:konbrojevi ( / ss i e d n out)
  (setq ss  (fq:ssx (list '(0 . "TEXT") (cons 8 *FQ-SNAP-RAM*)))
        i   0
        out nil)
  (if ss
    (while (< i (sslength ss))
      (setq e (ssname ss i)
            d (entget e)
            n (atoi (cdr (assoc 1 d))))
      (if (> n 0) (setq out (cons (cons n (fq:txtpt d)) out)))
      (setq i (1+ i))))
  out)

;; Oni od njih koji pripadaju ramu (u0 vt vb), kao (broj . red).
;; *fq-a* postavlja pozivalac, kao i svuda oko rama.
(defun fq:konredovi (kons u0 vt vb / p out)
  (setq out nil)
  (foreach kr kons
    (setq p (fq:loc (cdr kr)))
    (if (and (< (car p) (- u0 1.0)) (> (car p) (- u0 2.0))
             (< (cadr p) vt) (> (cadr p) vb))
      (setq out (cons (cons (car kr) (cadr p)) out))))
  out)

(defun fq:snapmete ( / ss i e d ang por sa sm svi out x kons u0 oz ori)
  (setq out nil svi nil sa *fq-a* sm *fq-m*)
  (if (and *FQ-SNAP* *fq-dragsnap*
           (= (getvar "WORLDUCS") 1)
           (car (atoms-family 1 (list "FQ:PORRAM"))))
    (progn
      ;; Prvi prolaz: svi upotrebljivi ramovi, sa svojim okvirom.
      ;; Ugao i broj temena se proveravaju OVDE, pre fq:porram: ona na
      ;; tim granama ispisuje poruku, pa bi se ta poruka ponovila za
      ;; svaki los ram pre svakog pregleda.
      (setq ss (fq:ssx (list '(0 . "LWPOLYLINE")
                             (cons 8 *FQ-SNAP-RAM*)
                             '(-3 ("FIBERQ"))))
            i  0)
      (while (and ss (< i (sslength ss)))
        (setq e (ssname ss i)
              d (fq:xdget e))
        ;; fq:kucori umesto fq:kucugao: ang mora da bude ugao KABLA, jer
        ;; ga fq:snapuzmi daje kablu koji se crta.  Ogledalo se nosi kao
        ;; osmi clan zapisa, dopisan na kraj -- fq:snapmodul cita clanove
        ;; 2 do 6 i taj raspored se ne sme pomeriti.
        ;;
        ;; Obe funkcije stizu iz fq-kucista.lsp, koga sme da nema; strazu
        ;; nad celom granom drzi provera FQ:PORRAM na ulazu u fq:snapmete.
        (if (and d
                 (member (car d) '("ODF" "PP" "ODO" "IPAN" "ZOK"))
                 (>= (length (fq:pl10 e)) 4)
                 (fq:snapvidljiv e)
                 (setq ori (fq:kucori e)))
          (progn
            (setq ang (car ori))
            (setq svi (cons (append (list e d ang)
                                    (fq:snaprect e ang (cadr ori))
                                    (list (cadr ori)))
                            svi))))
        (setq i (1+ i)))
      ;; Drugi prolaz: ciljevi.  fq:porram zna i za nastavak, ali nastavak
      ;; nema kolonu konektora pa vraca cetvrti clan nil; takav cilj se
      ;; preskace jer iz njega ne ispada tacka, samo red.
      (setq kons (if svi (fq:konbrojevi) nil))
      (foreach x svi
        (setq e   (nth 0 x)
              d   (nth 1 x)
              ang (nth 2 x)
              por (vl-catch-all-apply 'fq:porram (list e d)))
        (if (and (not (vl-catch-all-error-p por)) por (cadddr por))
          (progn
            (fq:sistem (cadr por) (nth 4 por))
            (setq u0     (cadddr por)
                  ;; Samo oznaka, bez kljuca vrste.  Oznaka VEC nosi
                  ;; prefiks vrste (fq:kucoz: "OR 1", "MDU 1", "ZOK 1"),
                  ;; pa je (strcat (car d) " " oz) davalo "ZOK ZOK 1",
                  ;; "PP PP 1", "ODO ODO 1" -- i "IPAN MDU 1", jedini put
                  ;; kojim je povuceno ime jos izlazilo na ekran.
                  ;; Svaka druga poruka u projektu ram zove samo oznakom.
                  oz     (fq:f 1 d))
            ;; RACUNAT prvi red vazi samo za prvi modul razdelnika, pa se
            ;; kod drugog i daljeg preskace -- vidi fq:snapmodul.
            (if (not (and (member (car d) '("ODF" "PP"))
                          (fq:snapmodul (cdddr x) ang svi)))
              (setq out (cons (list (fq:w u0 (car por)) (cadr por) oz) out)))
            ;; PROCITANI portovi vaze uvek, i bas zato i kod modula koji
            ;; je gore preskocen: oni su izmereni iz crteza, pa ih
            ;; margina drugog modula ne pomera.  Idu POSLE racunatog:
            ;; fq:snapnaj na jednakom rastojanju zadrzava prvi u listi, a
            ;; lista je obrnuta od redosleda dodavanja, pa port pobedjuje
            ;; i prvi konektor se javi svojim brojem, ne samo oznakom.
            (foreach kr (fq:konredovi kons u0 (nth 5 x) (nth 6 x))
              (setq out (cons (list (fq:w u0 (cdr kr))
                                    (cadr por)
                                    (strcat oz "/" (itoa (car kr))))
                              out))))))))
  (setq *fq-a* sa *fq-m* sm)
  out)

;; Najblizi cilj unutar polja hvatanja, ili nil.  Poredi se KVADRAT
;; rastojanja, bez korena, jer se zove na svaki pomeraj misa.
(defun fq:snapnaj (p r / best bd d2 dx dy r2)
  (setq r2 (* r r) best nil bd nil)
  (foreach c *fq-snapkes*
    (setq dx (- (car (car c)) (car p))
          dy (- (cadr (car c)) (cadr p)))
    (if (and (< (abs dx) r) (< (abs dy) r))
      (progn
        (setq d2 (+ (* dx dx) (* dy dy)))
        (if (and (<= d2 r2) (or (not bd) (< d2 bd)))
          (setq bd d2 best c)))))
  best)

;; Marker uhvacene tacke: kvadratic oko nje.  Tacke su vec svetske, pa
;; grvecs ide bez matrice.
(defun fq:snapmk (p r / a x1 x2 y1 y2)
  (setq a  (* 0.7 r)
        x1 (- (car p) a)  x2 (+ (car p) a)
        y1 (- (cadr p) a) y2 (+ (cadr p) a))
  (list *FQ-SNAP-ACI* (list x1 y1 0.0) (list x2 y1 0.0)
        *FQ-SNAP-ACI* (list x2 y1 0.0) (list x2 y2 0.0)
        *FQ-SNAP-ACI* (list x2 y2 0.0) (list x1 y2 0.0)
        *FQ-SNAP-ACI* (list x1 y2 0.0) (list x1 y1 0.0)))

;; Ugao poslednjeg uhvacenog rama, ili zatecen ugao ako nista nije
;; uhvaceno.  Zove se ODMAH posle pokazivanja tacke i prazni pogodak,
;; da ga sledeca komanda ne pokupi kao svoj.
(defun fq:snapuzmi (ang / h)
  (setq h *fq-snaphit* *fq-snaphit* nil)
  (if h
    (progn
      (princ (fq:tf "kabl.uhvacen" (list (caddr h) (itoa (cadr h)))))
      (cadr h))
    ang))

;; Silueta pregradjena za dati ugao.
;;
;; Pregled se gradi PRE nego sto se zna sta ce se uhvatiti, sa tekucom
;; orijentacijom, a hvatanje moze da donese ugao rama koji je drugaciji.
;; Bez ovoga bi mis pokazivao vodoravan spliter a nacrtao bi se uspravan
;; — pregled bi lagao bas u slucaju zbog koga hvatanje i postoji.
;;
;; *fq-dragre* je opis siluete koji postavlja pozivalac, oblika
;; ("spl" k), ("ont") ili ("kabl" nt nf lg rows).  Kada je nil, silueta
;; se ne pregradjuje i pregled crta ono sto mu je dato.
;;
;; ONT nema nijedan parametar u opisu -- silueta mu zavisi samo od ugla
;; -- ali opis svejedno mora da postoji, jer se po njegovom prvom clanu
;; bira grana.
(defun fq:dragvec (a / r)
  (setq r *fq-dragre*)
  (cond ((not r) nil)
        ((= (car r) "spl")  (fq:splvecs (nth 1 r) a *fq-splul*))
        ((= (car r) "ont")  (fq:ontvecs a))
        ((= (car r) "kabl") (fq:kablvecs (nth 1 r) (nth 2 r) (nth 3 r)
                                         a (nth 4 r)))
        (T nil)))

;; Petlja pregleda. Vraca pokazanu tacku, ili nil ako se odustane.
;; lockv je zakljucan red kada je poravnanje ukljuceno, inace nil.
;;
;; Kada je red zakljucan, uhvacen ram sme da pomeri samo polozaj DUZ
;; kabla; red ostaje onaj iz poravnanja, inace bi hvatanje tiho ponistilo
;; ono sto je korisnik svesno zadao preko FQPORAVNAJ.  Iz istog razloga
;; se u tom slucaju ne preuzima ni ugao.
;; Brava stoji OVDE, a ne u komandama: kroz fq:dragpt prolazi glavni put
;; svih crtackih komandi, jer je *FQ-DRAG* podrazumevano T.  Provera u
;; pojedinacnoj komandi bi se za kucano FQKABL nikad ne bi ni okinula.
(defun fq:dragpt (msg vecs ang lockv / sa g p pt hit rr cv ca res)
  (setq sa *fq-a* res nil *fq-snaphit* nil ca nil cv nil)
  ;; Odustajanje zbog UCS-a se prijavljuje kao obican prekid, pa svaki
  ;; pozivalac vec zna sta sa njim -- svi granaju na nil.  Poruku je
  ;; fq:ucsok vec ispisao.
  (if (not (fq:ucsok)) (setq res (list "prekid" nil)))
  (setq *fq-a* (fq:deg ang))
  ;; Kes ciljeva i poziv za tacku samo ako se uopste crta.  Inace bi
  ;; posle poruke o UCS-u jos stajalo i "pokazi tacku", pa bi izgledalo
  ;; da komanda ipak ceka klik.
  (if (not res)
    (progn
      (setq *fq-snapkes* (fq:snapmete)
            rr           (fq:snapr))
      (princ (fq:tf "opste.drag.hint" (list msg)))
      (if *fq-snapkes*
        (princ (fq:tf "opste.snap.ramova" (list (itoa (length *fq-snapkes*))))))))
  (while (not res)
    (setq g (grread T 15 0))
    (cond
      ;; mis se pomera
      ((= (car g) 5)
       (setq p   (cadr g)
             rr  (fq:snapr)
             hit (if *fq-snapkes* (fq:snapnaj p rr) nil)
             pt  (cond ((and hit lockv) (fq:w (car (fq:loc (car hit))) lockv))
                       (hit             (car hit))
                       (lockv           (fq:w (car (fq:loc p)) lockv))
                       (T               p)))
       ;; Uhvacen ram pod drugim uglom: silueta mora da se okrene kako ce
       ;; se i nacrtati.  Pregradjuje se samo kad se ugao STVARNO promeni;
       ;; inace bi se cela silueta kabla (do *FQ-DRAG-MAX* linija) gradila
       ;; iznova na svaki pomeraj misa, u istoj petlji zbog koje se i kes
       ;; ciljeva pravi samo jednom.
       (if (and hit (not lockv) (/= (cadr hit) ang))
         (progn (if (or (not ca) (/= ca (cadr hit)))
                  (setq ca (cadr hit)
                        cv (fq:dragvec ca))))
         (setq ca nil cv nil))
       (redraw)
       (grvecs (if cv cv vecs) (fq:mtrans pt))
       (if hit (grvecs (fq:snapmk pt rr))))
      ;; Klik.  Vraca se ZAKLJUCANA, po potrebi uhvacena tacka, a ne
      ;; sirov polozaj misa: inace bi klik bacio bas ono sto je pregled
      ;; celo vreme pokazivao.
      ((= (car g) 3)
       (setq p   (cadr g)
             rr  (fq:snapr)
             hit (if *fq-snapkes* (fq:snapnaj p rr) nil)
             pt  (cond ((and hit lockv) (fq:w (car (fq:loc (car hit))) lockv))
                       (hit             (car hit))
                       (lockv           (fq:w (car (fq:loc p)) lockv))
                       (T               p)))
       (if (and hit (not lockv)) (setq *fq-snaphit* hit))
       (setq res (list "ok" pt)))
      ;; O prelazi na klasican unos tacke, samo za ovaj jedan klik.
      ;; Hvatanje pokriva prvi konektor rama; za sve ostalo, podlogu i
      ;; tudju geometriju, ovo je i dalje jedini nacin, a da se pregled
      ;; ne gasi trajno (to radi FQDRAG).
      ((and (= (car g) 2) (member (cadr g) '(79 111)))
       (redraw)
       (setq res (list "ok" (getpoint (fq:t "opste.osnap.tacka")))))
      ;; I prebacuje hvataljku splitera sa kraja prvog izlaza na kraj
      ;; ulaza i natrag.  Uslov nije samo taster nego i *fq-dragre*:
      ;; za svaki drugi pregled I pada na granu ispod i otkazuje potez,
      ;; tacno kao pre ove izmene.  Bez tog uslova bi jedan taster tiho
      ;; promenio ponasanje sva cetiri pregleda.
      ;;
      ;; ca/cv se PREGRADJUJU, ne ponistavaju.  cv je silueta okrenuta
      ;; po uglu uhvacenog rama, gradjena od STARE hvataljke.  Da se
      ;; samo ponisti, klik koji odmah sledi -- bez ijednog pomeraja
      ;; misa -- i dalje bi nasao isti ram i uzeo njegov ugao kroz
      ;; fq:snapuzmi: nacrtalo bi se pod jednim uglom, a poslednja
      ;; silueta bila pod drugim.  Nacrtano bi bilo ispravno, ali bi
      ;; pregled lagao -- a to pravilo parnosti zabranjuje isto koliko
      ;; i obrnut slucaj.
      ;;
      ;; fq:dragvec cita *fq-splul*, pa je dovoljno pozvati je POSLE
      ;; prebacivanja: gradi siluetu za novu hvataljku i stari ugao.
      ((and (= (car g) 2) (member (cadr g) '(73 105))
            *fq-dragre* (= (car *fq-dragre*) "spl"))
       (setq *fq-splul* (not *fq-splul*)
             vecs       (fq:splvecs (cadr *fq-dragre*) ang *fq-splul*)
             cv         (if ca (fq:dragvec ca) nil))
       ;; Kljuc mora da bude doslovan odmah iza fq:t, pa dve grane
       ;; umesto (fq:t (if ...)) -- vidi CLAUDE.md, racunat kljuc.
       (if *fq-splul*
         (princ (fq:t "spl.hvat.ulaz"))
         (princ (fq:t "spl.hvat.izlaz")))
       ;; Isti par poteza kao u grani pomeranja misa, i istim redom:
       ;; bez markera bi kvadratic pogotka nestao do sledeceg pomeraja
       ;; misa, pa bi izgledalo da je I ugasio hvatanje.
       (redraw)
       (if pt (grvecs (if cv cv vecs) (fq:mtrans pt)))
       (if (and pt hit) (grvecs (fq:snapmk pt rr))))
      ;; sve ostalo prekida
      (T (setq res (list "prekid" nil)))))
  (redraw)
  (setq *fq-snapkes* nil)
  (setq *fq-a* sa)
  (if (= (car res) "ok") (cadr res) nil))

;;; --- samostalni ODF i ODO -----------------------------------------
;;;
;;;  ODF i ODO su se do sada mogli postaviti samo na postojeci kabl,
;;;  jer se raspored portova cita iz snopa vlakana. Pri projektovanju
;;;  je prirodnije krenuti od ormara, pa tek onda povuci kabl.
;;;
;;;  Zato se pravi virtuelna lista redova, istim racunom kojim bi ih
;;;  crtao kabl. Elementi te liste nemaju entitet vlakna, pa ostaje
;;;  isti oblik (broj tacka entitet) samo je entitet nil.
;;;
;;;  Posle crtanja se ti redovi upisu u *fq-por*, zajedno sa polozajem
;;;  duz kabla, pa sledeci kabl krece tacno iz prvog konektora.

(defun fq:virtfl (u0 v0 nt nf k ang / rr i out)
  (setq *fq-a* (fq:deg ang)
        rr     (fq:redovi nt nf v0 nil)
        i      1
        out    nil)
  (while (and (<= i k) rr)
    (setq out (cons (list i (fq:w u0 (car rr)) nil) out)
          rr  (cdr rr)
          i   (1+ i)))
  (reverse out))

;; Vektori pregleda samostalnog ormara: ram i crtice konektora.
;; rows su redovi u odnosu na prvi konektor, w sirina rama.
;;
;;  Ram se racuna iz NAJVISEG i NAJNIZEG reda, ne iz prvog i poslednjeg
;;  clana liste.  Za svako kuciste koje raste nanize to je isto, jer je
;;  lista opadajuca; ormar sa spliterom medjutim raste NAVISE od
;;  dolaznog vlakna (vidi odeljak 3c u fq-kucista.lsp), pa bi car/last
;;  dali ram naopako, visine nula.
;;
;;  Iz istog razloga se crveni red trazi po vrednosti 0.0, a ne kao prvi
;;  clan: nula je pokazana tacka, i to vazi u oba smera.
(defun fq:boxvecs (rows w dx ang marg / sa sm out vt vb ul ur v)
  ;;  *fq-m* se pamti i vraca zajedno sa *fq-a*, i ulazi se kroz
  ;;  fq:sistem sa NIL ogledalom.  Ogledalo se ne cisti nigde posle
  ;;  uspesno zavrsene komande -- fq:cisti zove samo fq:err -- pa
  ;;  nacrtano ogledalno kuciste ostavlja *fq-m* na -1.0 do sledeceg
  ;;  fq:init.  A fq:init je UNUTAR crtaca, dakle posle pregleda: bez
  ;;  ovoga bi silueta bila preslikana, a nacrtalo bi se nepreslikano.
  (setq sa *fq-a* sm *fq-m*)
  (fq:sistem ang nil)
  ;;  Margina se PRIMA, ne kuca.  Do 23.08.2026 je ovde stajalo 2.0 za
  ;;  sve tri vrste, a crtaci koriste *FQ-ODO-MARG* 2.00, *FQ-ODF-MARG*
  ;;  1.60 i *FQ-ZOK-MARG* 1.50 -- ormar se poklapao slucajno, silueta
  ;;  razdelnika je bila 0.4 previsoka gore i dole, kutije 0.5.  Isti
  ;;  razred greske kao zakucanih 5.80 za sirinu, samo po drugoj osi i
  ;;  manjeg dometa; obe su ispravljene istog dana.
  (setq vt  (+ (apply 'max rows) marg)
        vb  (- (apply 'min rows) marg)
        ur  dx
        ul  (- dx w)
        out nil)
  (setq out (list 7 (fq:w ul vt) (fq:w ur vt)
                  7 (fq:w ur vt) (fq:w ur vb)
                  7 (fq:w ur vb) (fq:w ul vb)
                  7 (fq:w ul vb) (fq:w ul vt)))
  (foreach v rows
    (setq out (append out
                      (list (if (equal v 0.0 1e-9) 1 7)
                            (fq:w (- dx 2.0) v)
                            (fq:w dx v)))))
  (setq *fq-a* sa *fq-m* sm)
  out)

;; Tacka prvog konektora, sa pregledom rama ako je pregled ukljucen.
;;
;; Ovde se hvatanje NAMERNO gasi.  Ram se crta LEVO od pokazane tacke
;; (fq:boxvecs, ul = dx - w), pa bi hvatanje na prvi konektor nekog
;; POSTOJECEG kucista spustilo novo kuciste tacno preko njega.  Nijedan
;; koristan slucaj se tu ne vidi, a steta je tiha: tacka se pomeri za ceo
;; poluprecnik aperture, i taj pogresan polozaj zatim ide i u *fq-por*.
;;
;; Prekidaci se ZADAJU na ulazu, ne cuvaju i ne vracaju: vidi napomenu uz
;; *fq-dragsnap* na vrhu fajla.  Pogodak se prazni ovde, a ne na izlazu,
;; iz istog razloga — izlaz se posle Esc ne izvrsi.  To sto ga fq:dragpt
;; ovde ionako ne postavlja (hvatanje je ugaseno) cini praznjenje samo
;; pojasom i kada neko sutra ukljuci hvatanje nazad.
(defun fq:pickbox (msg rows w dx ang marg / vecs p)
  (setq *fq-snaphit*  nil
        *fq-dragre*   nil
        *fq-dragsnap* nil)
  (if (not *FQ-DRAG*)
    (fq:gp msg)
    (progn
      (setq vecs (fq:boxvecs rows w dx ang marg))
      (setq p (vl-catch-all-apply
                'fq:dragpt (list msg
                                 vecs ang nil)))
      (if (vl-catch-all-error-p p)
        (progn (redraw)
               (princ (fq:t "opste.pregled.ne"))
               (fq:gp msg))
        p))))

;; Struktura kabla koji ulazi u samostalni ormar.
;; Portovi moraju leci na isti raster kao buduci kabl, sa razmakom
;; izmedju cevcica, inace se posle nista ne poklapa red u red.
(defun fq:strukt (k / nf nt)
  (princ (fq:t "odo.raspored"))
  (if (not (setq nf (getint (fq:t "odo.pitaj.povlakn")))) (setq nf 12))
  (if (< nf 1) (setq nf 1))
  (if (not (setq nt (getint (fq:tf "odo.pitaj.cevcica" (list (itoa (max 1 (fix (/ (+ k nf -1) nf)))))))))
    (setq nt (max 1 (fix (/ (+ k nf -1) nf)))))
  (if (< nt 1) (setq nt 1))
  (list nt nf))

;;; --- povlacenje duzine kabla --------------------------------------
;;;
;;;  Duzina se do sada morala pogoditi unapred u dijalogu, pa ako ne
;;;  valja, brise se kabl i sve ide iz pocetka. Ovde se posle tacke
;;;  umetanja duzina povlaci misem, uz isti pregled.
;;;
;;;  Duzina se meri duz kabla, u njegovom sistemu, pa radi i za
;;;  vertikalne kablove. Smer je odredjen orijentacijom, ne smerom
;;;  povlacenja, zato se kraci od najmanje duzine odbijaju.
;;;
;;;  klik    prihvata povucenu duzinu
;;;  Enter   zadrzava duzinu upisanu u dijalogu
;;;  ostalo  odustaje od celog kabla

(defun fq:draglen (p0 nt nf ang rows lg0 / sa lc u0 rr retko g p lg res)
  (setq sa *fq-a*)
  (setq *fq-a* (fq:deg ang))
  (setq lc    (fq:loc p0)
        u0    (car lc)
        retko (> (* nt nf) *FQ-DRAG-MAX*)
        rr    (fq:relred nt nf rows)
        lg    lg0
        res   nil)
  (princ (fq:tf "kabl.povuci.duzinu" (list (rtos lg0 2 1))))
  (while (not res)
    (setq g (grread T 15 0))
    (cond
      ((= (car g) 5)
       (setq p  (fq:loc (cadr g))
             lg (max *FQ-LEN-MIN* (- (car p) u0)))
       (redraw)
       (grvecs (fq:lenvecs rr lg retko nf) (fq:mtrans p0)))
      ((= (car g) 3)
       (setq p   (fq:loc (cadr g))
             res (list "ok" (max *FQ-LEN-MIN* (- (car p) u0)))))
      ((and (= (car g) 2) (member (cadr g) '(13 32)))
       (setq res (list "ok" lg0)))
      (T (setq res (list "prekid" nil)))))
  (redraw)
  (setq *fq-a* sa)
  (if (= (car res) "ok") (cadr res) nil))

;; Duzina kabla. Vraca upisanu duzinu ako se ne povlaci, povucenu ako
;; se povlaci, ili nil ako se odustane od kabla.
(defun fq:duzina (p0 nt nf ang rows lg0 / r)
  (if (not (and *FQ-DRAG* *fq-duzmis*))
    lg0
    (progn
      (setq r (vl-catch-all-apply 'fq:draglen
                                  (list p0 nt nf ang rows lg0)))
      (if (vl-catch-all-error-p r)
        (progn (redraw)
               (princ (fq:t "kabl.povlacenje.ne"))
               lg0)
        r))))

;; Tacka umetanja kabla, sa pregledom ako je ukljucen.
;; *fq-dragre* opisuje siluetu, da pregled ume da je okrene kada hvatanje
;; uhvati ram nacrtan pod drugim uglom.
(defun fq:pickins (msg nt nf lg ang rows lockv / vecs p)
  (setq *fq-snaphit*  nil          ; vidi napomenu uz fq:pickbox
        *fq-dragre*   (list "kabl" nt nf lg rows)
        *fq-dragsnap* T)
  (if (not *FQ-DRAG*)
    (fq:gp msg)
    (progn
      (setq vecs (fq:kablvecs nt nf lg ang rows))
      (setq p (vl-catch-all-apply
                'fq:dragpt (list msg
                                 vecs ang lockv)))
      (if (vl-catch-all-error-p p)
        (progn (redraw)
               (princ (fq:t "opste.pregled.ne"))
               ;; greska je mogla da iskoci POSLE klika, kada je pogodak
               ;; vec upisan, a korisnik sada rucno pokazuje drugu tacku
               (setq *fq-snaphit* nil)
               (fq:gp msg))
        p))))


;;; --- kuciste na kraju novog kabla ---------------------------------
;;;
;;;  Kada se element (ODO, ZOK, ODF, patch panel) postavi PRE kabla,
;;;  njegov ram je visok koliko i raspored koji je tada bio poznat, a to
;;;  je samo broj zauzetih konektora.  Kabl koji posle toga krene iz tog
;;;  elementa donese ceo snop, pa vlakna preko toga vire iz rama.
;;;
;;;  Zato se odmah po crtanju kabla trazi kuciste koje stoji tacno na
;;;  kraju tog kabla i precrtava se sa punim spiskom vlakana: ram se
;;;  rasiri po snopu, portovi legnu na stvarne redove kabla, a vlaknima
;;;  koja su na portu se upise veza.
;;;
;;;  Reaktori se ovde namerno NE koriste.  Kabl nastaje samo iz ove
;;;  biblioteke, pa je dovoljno okinuti na tom jednom mestu; reaktor bi
;;;  se okidao na svaku izmenu u crtezu i usporavao rad.
;;;
;;;  Sirenje kucista ume fq-kucista.lsp, koji se ucitava POSLE ovog
;;;  fajla i sme da ga nema.  Zato se prvo proverava da li ta funkcija
;;;  uopste postoji, pa se poziva pod vl-catch-all-apply: kabl je vec
;;;  nacrtan i greska u sirenju ne sme da obori komandu.
;;;
;;;  Nastavak je u OVOM fajlu, pa mu straza ne treba; catch ostaje, iz
;;;  istog razloga.  Oba se rade, i to redom: kabl sme da ima kuciste na
;;;  jednom a nastavak na drugom kraju.
(defun fq:kablsiri (oz p0 lg ang / r)
  (if *FQ-SIRI*
    (progn
      (if (car (atoms-family 1 (list "FQ:KUCSIRIKABL")))
        (progn
          (setq r (vl-catch-all-apply 'fq:kucsirikabl (list oz p0 lg ang)))
          ;; Ovo je NAJCESCI Esc u celom dodatku, a nijedan korisnik ga
          ;; ne prepoznaje kao svoj: sirenje je automatsko, pa
          ;; fq:kucspoji sam pita "Koliko vlakana ide na konektore".
          ;; Esc na to pitanje je ispisivao "nije prosireno: Function
          ;; cancelled" uz savet da se pokrene FQDODAJ -- kao da je
          ;; nesto puklo.
          (if (fq:otkaz r)
            (princ (fq:t "kuc.sirenje.otkazano"))
            (if (fq:greska r (fq:t "kuc.nije.prosireno"))
              (princ (fq:t "kuc.ram.fqdodaj"))))))
      ;; Nastavak nista ne pita, pa ovde nema sta da se otkaze.
      (setq r (vl-catch-all-apply 'fq:nastsirikabl (list oz p0 lg ang)))
      (fq:greska r (fq:t "nast.nije.prosireno")))))


;;  rows je lista redova preuzeta sa referentnog kabla, ili nil.
;;  Kada je zadata, vlakno n lezi tacno na redu rows[n], pa spajanje
;;  legne red u red i kad dva kabla nemaju isti broj vlakana u cevcici.
;;  Kada rows nije zadata ili se potrosi, vazi prirodni raster:
;;  korak *FQ-PITCH*, a izmedju cevcica jos *FQ-GAP*.
(defun fq:drawkabl (nt nf lg oz disp lbl kat ang st p0 rows
                    / loc u0 v0 i j n v rr tv vmin vmax vc rv aci id
                      ul ur wmax dva s vt)
  (fq:init)
  (setq *fq-a* (fq:deg ang)
        loc    (fq:loc p0)
        u0     (car loc)
        v0     (cadr loc)
        n      0
        i      1)
  ;; svi redovi unapred, pa se trose vlakno po vlakno
  (setq rr (fq:redovi nt nf v0 rows))
  ;; Natpisi vlakana stoje na oba kraja kabla, odmah uz elipse cevcica,
  ;; a sredina kabla ostaje prazna. Tako nastavak moze da se postavi
  ;; bilo gde po sredini bez pomeranja teksta.
  ;;   ul  levi natpis pocinje tu, poravnat ulevo
  ;;   ur  desni natpis se tu zavrsava, poravnat udesno
  ;; najsira moguca oznaka: redni broj, tacka, naziv boje, oznaka grupe
  (setq ul   (+ u0 *FQ-CEVIN* *FQ-CEVRU* *FQ-TXTDX*)
        ur   (- (+ u0 lg) *FQ-CEVIN* *FQ-CEVRU* *FQ-TXTDX*)
        wmax (fq:txtsir nt nf))
  ;; na kratkom kablu se dva natpisa ne bi razmakla, pa ostaje samo levi
  (setq dva (and *FQ-TXT2* (> (- ur ul) (* 2.2 wmax))))
  (if (and *FQ-TXT2* (not dva))
    (princ (fq:t "kabl.kratak.natpis")))
  (while (<= i nt)
    (setq j 1 tv nil)
    (while (<= j nf)
      (setq n   (1+ n)
            v   (car rr)
            rr  (cdr rr)
            tv  (cons v tv)
            aci (fq:caci j)
            id  (strcat oz "/" (itoa i) "/" (itoa j)))
      (fq:Wpl2 (list (list u0 v) (list (+ u0 lg) v))
               *FQ-VLACI* "FQ_VLAKNO"
               ;; Namena ide kao KOD, ne kroz *FQ-NAMENE*: crtaci upisuju
               ;; pocetnu vrednost pravo u listu.  Da je ostala rec,
               ;; nov kabl i vlakno posle FQBOJA bili bi dva reda
               ;; specifikacije za istu namenu.
               ;;
               ;; kat (polje 12) je isto tako KOD, i to vec na ulazu:
               ;; prevodi ga fq:kabl.  Ovde se ne sme zvati fq:nazkod --
               ;; kroz c:FQKABL i fq:lomposao kat stize kao "" i tako i
               ;; treba da ostane, jer rucni kabl nema kategoriju.
               ;;
               ;; Dva prazna clana pred vrstom NISU popuna: to su polja 16
               ;; i 17, opis vlakna i rukohvat njegovog teksta, koje pise
               ;; FQOPIS iz fq-kucista.lsp.  Ko dopise samo jedan clan,
               ;; vrsta padne na 16 -- FQOPIS bi je onda prikazao kao opis
               ;; i pri prvom sledecem upisu tiho prepisao.
               (list "VLAKNO" id oz (itoa i) (itoa j) (itoa n)
                     (fq:cname j) st "" "" "nmFree" lbl kat
                     (itoa ang) *fq-kod* id "" "" *fq-vrs* ""))
      (setq s  (strcat (itoa n) "." (fq:cprikaz j) (fq:cring j))
            vt (+ v (* 0.18 *FQ-PITCH*)))
      (fq:Wtext ul vt *FQ-TXTH* s aci "FQ_OZNAKA" "FQ_TXT" 0 0)
      (if dva
        (fq:Wtext ur vt *FQ-TXTH* s aci "FQ_OZNAKA" "FQ_TXT" 2 0))
      (setq j (1+ j)))
    ;; cevcica, elipsa uvucena sa oba kraja, broj centriran u njoj
    ;; Racuna se iz stvarnih redova ove cevcice, pa vazi i za mrezu.
    (setq vmin (apply 'min tv)
          vmax (apply 'max tv)
          vc   (* 0.5 (+ vmin vmax))
          rv   (+ (* 0.5 (- vmax vmin)) (* 0.55 *FQ-PITCH*)))
    (fq:Well (+ u0 *FQ-CEVIN*) vc *FQ-CEVRU* rv (fq:caci i) "FQ_CEVCICA")
    (fq:Well (- (+ u0 lg) *FQ-CEVIN*) vc *FQ-CEVRU* rv
             (fq:caci i) "FQ_CEVCICA")
    (fq:Wtext (+ u0 *FQ-CEVIN*) vc (* 1.4 *FQ-TXTH*)
              (itoa i) (fq:caci i) "FQ_CEVCICA" "FQ_TXT" 1 2)
    (fq:Wtext (- (+ u0 lg) *FQ-CEVIN*) vc (* 1.4 *FQ-TXTH*)
              (itoa i) (fq:caci i) "FQ_CEVCICA" "FQ_TXT" 1 2)
    (setq i (1+ i)))
  (fq:Wtext (+ u0 *FQ-KLBLDX*) (+ v0 (* 1.3 *FQ-PITCH*))
            (* 1.4 *FQ-TXTH*) disp 7 "FQ_OZNAKA" "FQ_TXTB" 0 0)
  (princ (fq:tf "kabl.nacrtan" (list (fq:kablnat oz disp) (itoa n) (fq:stnaziv st) (itoa ang) (if rows (fq:t "kabl.redovi.mreza") ""))))
  n)


;;; --- kraj kabla: elipse cevcica, brojevi i natpisi vlakana ---------
;;;
;;;  Kod pravog kabla su oba kraja u istom sistemu, pa ih fq:drawkabl
;;;  crta u svojoj petlji.  Kabl sa lomovima i izvod iz kucista imaju
;;;  dva kraja pod razlicitim uglom, pa svaki kraj mora da se nacrta
;;;  posebno, u svom sistemu.
;;;
;;;    ends  svetske tacke krajeva vlakana, redom od prvog
;;;    ugao  ugao dela kabla koji na taj kraj dolazi
;;;    smer   1  kraj je na manjem u, uvlaci se unapred, natpis udesno
;;;          -1  kraj je na vecem u, uvlaci se unazad, natpis ulevo
;;;
;;;  Krajevi svih vlakana leze na istom u, pa je dovoljan prvi od njih.

(defun fq:lomkraj (ends ugao smer nt nf
                   / sa u0 ux i j n v tv vmin vmax vc rv aci s)
  (setq sa     *fq-a*
        *fq-a* (fq:deg ugao)
        u0     (car (fq:loc (car ends)))
        ux     (+ u0 (* smer *FQ-CEVIN*))
        n      0
        i      1)
  (while (<= i nt)
    (setq j 1 tv nil)
    (while (<= j nf)
      (setq n   (1+ n)
            v   (cadr (fq:loc (nth (1- n) ends)))
            tv  (cons v tv)
            aci (fq:caci j)
            s   (strcat (itoa n) "." (fq:cprikaz j) (fq:cring j)))
      (fq:Wtext (+ ux (* smer (+ *FQ-CEVRU* *FQ-TXTDX*)))
                (+ v (* 0.18 *FQ-PITCH*))
                *FQ-TXTH* s aci "FQ_OZNAKA" "FQ_TXT"
                (if (> smer 0) 0 2) 0)
      (setq j (1+ j)))
    (setq vmin (apply 'min tv)
          vmax (apply 'max tv)
          vc   (* 0.5 (+ vmin vmax))
          rv   (+ (* 0.5 (- vmax vmin)) (* 0.55 *FQ-PITCH*)))
    (fq:Well ux vc *FQ-CEVRU* rv (fq:caci i) "FQ_CEVCICA")
    (fq:Wtext ux vc (* 1.4 *FQ-TXTH*)
              (itoa i) (fq:caci i) "FQ_CEVCICA" "FQ_TXT" 1 2)
    (setq i (1+ i)))
  (setq *fq-a* sa)
  n)

;; Najsira moguca oznaka vlakna, mereno u jedinicama crteza.  Po njoj se
;; odlucuje da li na kraj kabla uopste staje natpis.
(defun fq:txtsir (nt nf / smax pmax c)
  (setq smax 0 pmax 0)
  (foreach c (fq:cctab) (if (> (strlen (car c)) smax) (setq smax (strlen (car c)))))
  (foreach c (fq:ccpr)  (if (> (strlen c) pmax)       (setq pmax (strlen c))))
  (* 0.78 *FQ-TXTH* (+ (strlen (itoa (* nt nf))) 1 smax pmax)))


;;; --- rucni unos, bez kataloga -------------------------------------

;; Pitanja za rucni unos kabla, izdvojena da ih dele i izvod iz kucista
;; i kabl sa lomovima.
;; Vraca (nt nf duzina oznaka natpis status).
;;
;; PRVIH SEST PITANJA SU NA SVOM MESTU, sedmo je dopisano na kraj.  Do
;; 1.0.0 je ovde stajalo da se redosled ne dira zbog skripti koje hrane
;; FQKABL -- to je i dalje razlog zasto se pitanje o vrsti dopisuje na
;; KRAJ, a ne uz "Tip kabla", gde bi po smislu pripadalo.  Zatecena
;; skripta ipak mora da dobije jedan red vise; drugog puta nema, jer
;; pogresna vrsta znaci deset puta bolji budzet nego sto jeste.
(defun fq:kablpita () (fq:kablpita2 T))

;; pitlg nil preskace duzinu: kabl sa lomovima je dobija iz putanje
(defun fq:kablpita2 (pitlg / nt nf lg oz lbl st)
  (if (not (setq nt (getint (fq:t "kabl.pitaj.cevcica"))))            (setq nt 2))
  (if (not (setq nf (getint (fq:t "kabl.pitaj.povlakn")))) (setq nf 6))
  ;; getint prima i 0 i negativan broj.  nt = 0 prodje kroz fq:velik i
  ;; nacrta kabl bez ijedne cevcice: prazan zapis koji specifikacija
  ;; broji kao stavku.  Provera ide POSLE poziva, ne kroz initget --
  ;; initget vazi za prvi sledeci get*, pa bi ovde odleteo na "Tip
  ;; kabla" i lomio skripte koje uredno salju svoje vrednosti.
  (if (< nt 1) (setq nt 1))
  (if (< nf 1) (setq nf 1))
  (if pitlg
    (setq lg (fq:pitajreal (fq:tf "kabl.pitaj.duzina" (list (rtos *FQ-LEN* 2 2))) *FQ-LEN*))
    (setq lg *FQ-LEN*))
  ;; isti clamp kao u dijalogu, iz istog razloga (vidi fq:kabl)
  (setq lg (max lg *FQ-LEN-MIN*))
  (setq lbl (getstring T (fq:t "kabl.pitaj.tip")))
  (setq oz (getstring T (fq:t "kabl.pitaj.oznaka")))
  (if (= oz "") (setq oz (fq:next "K")))
  (setq st (fq:askst))
  ;; Vrsta se ne vraca u listi nego se upisuje u *fq-vrs*, odakle je
  ;; crtaci citaju.  Zato ni jedan od tri pozivaoca ove funkcije ne mora
  ;; da se menja -- ni c:FQKABL, ni c:FQLOM, ni fq:izvodtelo.
  (fq:askvrs)
  (setq lbl (if (= lbl "")
              (strcat (itoa nt) "x" (itoa nf))
              (strcat lbl " (" (itoa nt) "x" (itoa nf) ")")))
  (list nt nf lg oz lbl st))

(defun c:FQKABL ( / *error* r nt nf lg oz st p0 lbl ang)
  (setq *error* fq:err)
  (setq r   (fq:kablpita)
        nt  (nth 0 r)  nf (nth 1 r)  lg  (nth 2 r)
        oz  (nth 3 r)  lbl (nth 4 r) st  (nth 5 r))
  (setq ang (if *fq-por* (cadr *fq-por*) *fq-ugao*))
  ;; Brava mora i OVDE, ne samo u fq:dragpt: grana ispod crta bez
  ;; ijedne pokazane tacke kada je *fq-por* postavljen, pa kroz pregled
  ;; uz mis uopste ne prodje.
  (if (and (fq:ucsok) (fq:velik nt nf))
    (if (setq p0
          (if (and *fq-por* (cadddr *fq-por*))
            ;; Tacka se NE pokazuje, pa se hvatanje ni ne desava.  Pogodak
            ;; koji je ostao iz neke ranije komande mora da se baci pre
            ;; fq:snapuzmi nize, inace bi se ovde uzeo tudj ugao i kabl bi
            ;; se nacrtao mimo ormara sa kojim je bio poravnat.
            (progn (setq *fq-a* (fq:deg ang) *fq-snaphit* nil)
                   (princ (fq:t "kabl.polozaj.ormar2"))
                   (fq:w (cadddr *fq-por*) (car *fq-por*)))
            ;; Kljuc stoji kao DOSLOVNA niska u obe grane, ne kao
            ;; (fq:t (if ...)).  Provera tabela cita samo literal odmah
            ;; iza fq:t -- racunat kljuc preskace, pa bi ova cetiri
            ;; ostala jedina neprovereni u celom projektu.
            (fq:pickins (if *fq-por*
                          (fq:t "kabl.pitaj.polozaj")
                          (fq:t "kabl.pitaj.tacka"))
                        nt nf lg ang
                        (caddr *fq-por*) (car *fq-por*))))
      (progn
        ;; Ako je tacka uhvacena na ramu, kabl preuzima ugao tog rama:
        ;; ODF nacrtan uspravno trazi i kabl uspravno.  Kada poravnanje
        ;; vec vazi, hvatanje ugao ne dira i ovo vraca zatecen ang.
        (setq ang (fq:snapuzmi ang))
        (if *fq-por*
          (progn (setq *fq-a* (fq:deg ang))
                 (setq p0 (fq:w (car (fq:loc p0)) (car *fq-por*)))))
        ;; Kabl koji krece sa nastavka pocinje na njegovoj ivici, ne
        ;; tamo gde je slucajno kliknuto.  Mora PRE fq:duzina i pre
        ;; crtanja: posle bi se pomerilo samo vlakno, a elipse cevcica i
        ;; natpisi bi ostali u ramu.
        (setq p0 (fq:nastuvod p0 ang))
        (setq lg (fq:duzina p0 nt nf ang
                            (if *fq-por* (caddr *fq-por*) nil) lg))
        (if (not lg)
          (princ (fq:t "opste.otkazano"))
          (progn
            (fq:drawkabl nt nf lg oz (strcat oz "   " lbl) lbl ""
                         ang st p0 (if *fq-por* (caddr *fq-por*) nil))
            (fq:kablsiri oz p0 lg ang)
            (if *fq-por*
              (progn (setq *fq-por* nil)
                     (princ (fq:t "opste.poravnanje.potroseno")))))))))
  (princ))


;;; ==================================================================
;;;  9b. KABL SA LOMOVIMA
;;;
;;;  Kabl ne mora da bude jedna prava.  Povuce se deo vodoravno, pa
;;;  nadole, pa opet vodoravno, i tako dok se ne potvrdi kraj.
;;;
;;;  Svako vlakno drzi ISTI bocni pomak duz cele putanje, pa se njegovo
;;;  teme u lomu dobija kao presek dve pomerene prave.  Kod pravouglih
;;;  lomova je taj presek prost zbir oba pomaka.  Iz tog jednog pravila
;;;  same od sebe ispadaju tri stvari koje bi se inace racunale posebno:
;;;
;;;    - lomovi se stepenasto razmicu, pa se vlakna nigde ne seku
;;;    - u zavoju se unutrasnje vlakno lomi ranije od spoljasnjeg, pa
;;;      redosled prati stranu na koju se skrece, bez ijednog uslova
;;;    - na drugom kraju je poredak opet ispravan, prvo vlakno najvise
;;;
;;;  Vlaknima se upisuje ugao POSLEDNJEG dela.  Tamo je onda sve
;;;  standardno: svi krajevi na istom u, prvo vlakno najvise, kabl ide u
;;;  smeru +u.  Zato na tom kraju rade ODF, ODO, ZOK, nastavak, spliter,
;;;  odvod i presecanje, bez ijedne izmene u njima.
;;;
;;;  Pocetni kraj je u odnosu na taj ugao savijen, pa se sredjuje odmah
;;;  pri crtanju: sirenje kucista se za svaki kraj radi u uglu onog dela
;;;  kabla koji na taj kraj dolazi.
;;;
;;;      1 ============\
;;;      2 ==========\ |
;;;      3 ========\ | |
;;;                | | |
;;;                | | +======== 1
;;;                | +========== 2
;;;                +============ 3
;;; ==================================================================

;; Pravci delova putanje, jedan po delu.  nil ako neki deo nema duzinu.
(defun fq:lomdirs (path / n i d out ok)
  (setq n (length path) i 0 out nil ok T)
  (while (and ok (< i (1- n)))
    (if (setq d (fq:jed (nth i path) (nth (1+ i) path)))
      (setq out (cons d out))
      (setq ok nil))
    (setq i (1+ i)))
  (if (and ok out) (reverse out) nil))

;; Putanja jednog vlakna: osnovna putanja pomerena ustranu za s.
(defun fq:lomvlakno (path dirs s / n i out)
  (setq n   (length path)
        out (list (fq:pzbir (car path) (fq:pputa (fq:levo (car dirs)) s)))
        i   1)
  (while (< i (1- n))
    (setq out (cons (fq:pzbir
                      (nth i path)
                      (fq:pzbir (fq:pputa (fq:levo (nth (1- i) dirs)) s)
                                (fq:pputa (fq:levo (nth i dirs)) s)))
                    out)
          i   (1+ i)))
  (reverse (cons (fq:pzbir (fq:last path)
                           (fq:pputa (fq:levo (fq:last dirs)) s))
                 out)))

;; Redni broj prvog dela koji je za ovo vlakno prekratak.
;;
;;  Kada se dva puta ZAREDOM skrece na istu stranu, to jest kada kabl
;;  obilazi ugao, spoljasnja vlakna dobijaju kraci srednji deo od
;;  unutrasnjih, i to za dve sirine snopa.  Ako je taj deo kraci od
;;  toga, on se preokrene i vlakna se ispreturaju, pa se takva putanja
;;  odbija umesto da se nacrta zamrsena.
;;
;;  Kada se skrece naizmenicno, levo pa desno, srednji deo je za sva
;;  vlakna jednak i nema sta da se proverava.  Krajnji delovi se menjaju
;;  za jednu sirinu snopa, na koju god stranu se skretalo.
(defun fq:lomkratak (pts dirs mind / n i a b d r)
  (setq n (length pts) i 0 r nil)
  (while (and (not r) (< i (1- n)))
    (setq a (nth i pts) b (nth (1+ i) pts) d (nth i dirs))
    (if (< (+ (* (- (car b) (car a)) (car d))
              (* (- (cadr b) (cadr a)) (cadr d)))
           mind)
      (setq r (1+ i)))
    (setq i (1+ i)))
  r)

;; Duzina dela k, mereno na onom vlaknu na kome je najkraca.
(defun fq:lomnajk (fibers dirs k / d best l a b pts)
  (setq d (nth k dirs) best nil)
  (foreach pts fibers
    (setq a (nth k pts)
          b (nth (1+ k) pts)
          l (+ (* (- (car b) (car a)) (car d))
               (* (- (cadr b) (cadr a)) (cadr d))))
    (if (or (not best) (< l best)) (setq best l)))
  best)

;; jedan lom, dva loma, pet lomova
;;
;;  PRAVILO OSTAJE U KODU, ne u tabeli niski.  Koji je oblik mnozine
;;  tacan zavisi od BROJA, a to nijedna tabela ne moze da izrazi -- i
;;  ne zavisi isto u dva jezika: srpski ima tri oblika, engleski dva.
;;  Zato funkcija bira KLJUC, a tabela nosi tekst.  Engleski oba
;;  mnozinska kljuca puni istom niskom i time je pitanje zatvoreno.
;;
;;  Bira se po POSLEDNJOJ CIFRI, ne po samom broju.  Do bloka 4 je
;;  stajalo (and (>= n 2) (<= n 4)), pa je 21 davalo "21 lomova" a 22
;;  "22 lomova" -- oboje pogresno.  Izuzetak su 11-14, koji uzimaju
;;  mnozinski oblik bez obzira na poslednju cifru.
;;
;;  Kabl sa dvadeset i jednim lomom nije cest, ali crtez sa slike ima
;;  osam, pa granica nije daleko.
;;  Tri poziva umesto (fq:tf (cond ...)): kljuc mora da stoji kao
;;  DOSLOVNA niska odmah iza fq:tf, inace ga provera tabela ne vidi.
(defun fq:lomrec (n / d s)
  (setq d (rem n 10) s (rem n 100))
  (cond ((and (>= s 11) (<= s 14)) (fq:tf "lom.broj.5" (list (itoa n))))
        ((= d 1)                   (fq:tf "lom.broj.1" (list (itoa n))))
        ((and (>= d 2) (<= d 4))   (fq:tf "lom.broj.2" (list (itoa n))))
        (T                         (fq:tf "lom.broj.5" (list (itoa n))))))

;; duzina cele putanje
(defun fq:lomduz (path / i uk)
  (setq uk 0.0 i 0)
  (while (< i (1- (length path)))
    (setq uk (+ uk (distance (nth i path) (nth (1+ i) path)))
          i  (1+ i)))
  uk)

;; Crta kabl po zadatoj putanji.  Vraca broj vlakana, ili nil ako
;; putanja nije prohodna za snop pa nista nije nacrtano.
(defun fq:drawlom (nt nf oz disp lbl kat st path rows
                   / dirs offs a1 am fibers lose kr i j n id
                     need poc kra sa lp)
  (fq:init)
  (setq dirs (fq:lomdirs path))
  (if (not dirs)
    (progn (princ (fq:t "lom.nema.duzine")) nil)
    (progn
      (setq offs   (fq:relred nt nf rows)
            a1     (fq:stepen (car dirs))
            am     (fq:stepen (fq:last dirs))
            fibers (mapcar '(lambda (s) (fq:lomvlakno path dirs s)) offs)
            lose   nil
            i      0)
      (while (and (not lose) (< i (length fibers)))
        (setq i  (1+ i)
              kr (fq:lomkratak (nth (1- i) fibers) dirs *FQ-LOM-MIN*))
        (if kr (setq lose (list i kr))))
      (if lose
        (progn
          (princ (fq:tf "lom.deo.kratak" (list (itoa (cadr lose)) (itoa (length offs)) (itoa (car lose)))))
          nil)
        (progn
          (setq n 0 i 1)
          (while (<= i nt)
            (setq j 1)
            (while (<= j nf)
              (setq n  (1+ n)
                    id (strcat oz "/" (itoa i) "/" (itoa j)))
              (fq:plsvet (nth (1- n) fibers) *FQ-VLACI* "FQ_VLAKNO"
                         ;; namena i kat idu kao kodovi, dva prazna clana
                         ;; pred vrstom su polja 16 i 17 -- vidi istu
                         ;; listu i puno obrazlozenje u fq:drawkabl
                         (list "VLAKNO" id oz (itoa i) (itoa j) (itoa n)
                               (fq:cname j) st "" "" "nmFree" lbl kat
                               (itoa am) *fq-kod* id "" "" *fq-vrs* ""))
              (setq j (1+ j)))
            (setq i (1+ i)))
          ;; Natpisi staju samo ako je krajnji deo dovoljno dug.  Meri se
          ;; na najkracem vlaknu tog dela, jer zavoj skracuje bas njega.
          (setq need (+ *FQ-CEVIN* *FQ-CEVRU* *FQ-TXTDX* (fq:txtsir nt nf))
                poc  (>= (fq:lomnajk fibers dirs 0) need)
                kra  (and *FQ-TXT2*
                          (>= (fq:lomnajk fibers dirs (1- (length dirs)))
                              need)))
          ;;  Broj ide UZ poruku.  Bez njega se ne vidi da li fali pola
          ;;  jedinice ili pedeset, a fali po pravilu mnogo: natpisi svih
          ;;  vlakana stoje u JEDNOJ koloni, pa deo mora da bude duzi od
          ;;  celog stepenastog razmicanja snopa plus duzine natpisa.
          ;;  Kod kabla od 96 vlakana je to razmicanje samo oko 82.
          (if poc
            (fq:lomkraj (mapcar 'car fibers) a1 1 nt nf)
            (princ (fq:tf "lom.prvi.kratak"
                          (list (rtos (fq:lomnajk fibers dirs 0) 2 1)
                                (rtos need 2 1)))))
          (if kra
            (fq:lomkraj (mapcar 'fq:last fibers) am -1 nt nf)
            (if *FQ-TXT2*
              (princ (fq:tf "lom.zadnji.kratak"
                            (list (rtos (fq:lomnajk fibers dirs
                                                    (1- (length dirs))) 2 1)
                                  (rtos need 2 1))))))
          (setq sa     *fq-a*
                *fq-a* (fq:deg a1)
                lp     (fq:loc (car (car fibers))))
          (fq:Wtext (+ (car lp) *FQ-KLBLDX*) (+ (cadr lp) (* 1.3 *FQ-PITCH*))
                    (* 1.4 *FQ-TXTH*) disp 7 "FQ_OZNAKA" "FQ_TXTB" 0 0)
          (setq *fq-a* sa)
          (princ (fq:tf "lom.nacrtan" (list (fq:kablnat oz disp) (itoa n) (fq:stnaziv st) (if (> (length dirs) 1) (strcat ", " (fq:lomrec (1- (length dirs)))) "") (rtos (fq:lomduz path) 2 1) (itoa am) (if rows (fq:t "kabl.redovi.mreza") ""))))
          n)))))


;;; --- povlacenje putanje -------------------------------------------
;;;
;;;  Prvi deo ide pod tekucom orijentacijom, jer kabl najcesce krece iz
;;;  kucista pa mora da legne na njegov raster.  Svaki sledeci deo je
;;;  uspravan na prethodni, a mis bira samo na koju stranu i dokle.
;;;
;;;    klik    lomi kabl na pokazanom mestu
;;;    Enter   zavrsava kabl na poslednjem lomu
;;;    U       ponistava poslednji lom
;;;    Esc     odustaje od celog kabla

;; Ceo snop po zadatoj putanji, kao vektori za grvecs.
(defun fq:lomvecs (path offs nf retko / dirs out n j aci pts i m s)
  (setq dirs (fq:lomdirs path))
  (if (not dirs)
    nil
    (progn
      (setq out nil n 0)
      (foreach s offs
        (setq n   (1+ n)
              j   (1+ (rem (1- n) nf))
              aci (if (= n 1) 1 *FQ-VLACI*))
        (if (or (not retko) (= j 1) (= j nf))
          (progn
            (setq pts (fq:lomvlakno path dirs s)
                  m   (length pts)
                  i   0)
            (while (< i (1- m))
              (setq out (cons (nth (1+ i) pts)
                              (cons (nth i pts) (cons aci out)))
                    i   (1+ i))))))
      (reverse out))))

(defun fq:lomputm (p0 nt nf ang rows / offs retko fix ax ux g b res)
  (setq offs  (fq:relred nt nf rows)
        retko (> (* nt nf) *FQ-DRAG-MAX*)
        fix   (list p0)
        ax    ang
        res   nil)
  ;; drugi ulaz u crtanje uz mis, uz fq:dragpt -- vidi fq:ucsok
  (if (not (fq:ucsok))
    (setq res (list "prekid" nil))
    (princ (fq:t "lom.povuci")))
  (while (not res)
    (setq ux (fq:uvek ax)
          g  (grread T 15 0))
    (cond
      ;; mis se pomera, sledeci deo prati osu a ne pokazanu tacku
      ((= (car g) 5)
       (setq b (fq:naosu (fq:last fix) ux (cadr g)))
       (redraw)
       (if (fq:jed (fq:last fix) b)
         (grvecs (fq:lomvecs (append fix (list b)) offs nf retko))))
      ((= (car g) 3)
       (setq b (fq:naosu (fq:last fix) ux (cadr g)))
       (if (not (fq:jed (fq:last fix) b))
         (princ (fq:t "lom.deo.bezduz"))
         (setq fix (append fix (list b))
               ax  (rem (+ ax 90) 360))))
      ;; U ponistava poslednji lom i vraca osu na prethodnu
      ((and (= (car g) 2) (member (cadr g) '(85 117)))
       (if (> (length fix) 1)
         (setq fix (reverse (cdr (reverse fix)))
               ax  (rem (+ ax 270) 360))
         (princ (fq:t "lom.nema.loma"))))
      ;; O daje jedan lom kroz klasican unos, sa object snapom.
      ;; Tacka se i dalje obara na osu tekuceg dela, jer se kabl lomi
      ;; samo pod pravim uglom.
      ((and (= (car g) 2) (member (cadr g) '(79 111)))
       (redraw)
       (setq b (getpoint (fq:last fix) (fq:t "lom.osnap.tacka")))
       (if b
         (progn
           (setq b (fq:naosu (fq:last fix) ux b))
           (if (not (fq:jed (fq:last fix) b))
             (princ (fq:t "kabl.deo.bezduz"))
             (setq fix (append fix (list b))
                   ax  (rem (+ ax 90) 360))))))
      ((or (= (car g) 25)
           (and (= (car g) 2) (member (cadr g) '(13 32))))
       (setq res (if (> (length fix) 1) (list "ok" fix) (list "prekid" nil))))
      (T (setq res (list "prekid" nil)))))
  (redraw)
  (if (= (car res) "ok") (cadr res) nil))

;; Klasican unos, bez pregleda: radi sa object snapom i kucanim
;; koordinatama, a pokazana tacka se sama obara na osu tekuceg dela.
(defun fq:lomputk (p0 ang / fix ax ux p b)
  (setq fix (list p0) ax ang)
  (princ (fq:t "lom.tacke"))
  (while (setq p (getpoint (fq:last fix)
                           (fq:tf "lom.pitaj.lom"
                                  (list (if (= (rem ax 180) 0)
                                          (fq:t "opste.vodoravno")
                                          (fq:t "opste.uspravno"))))))
    (setq ux (fq:uvek ax)
          b  (fq:naosu (fq:last fix) ux p))
    (if (not (fq:jed (fq:last fix) b))
      (princ (fq:t "kabl.deo.bezduz"))
      (setq fix (append fix (list b))
            ax  (rem (+ ax 90) 360))))
  (if (> (length fix) 1) fix nil))

(defun fq:lomput (p0 nt nf ang rows / r)
  (if (not *FQ-DRAG*)
    (fq:lomputk p0 ang)
    (progn
      (setq r (vl-catch-all-apply 'fq:lomputm (list p0 nt nf ang rows)))
      (if (vl-catch-all-error-p r)
        (progn (redraw)
               (princ (fq:t "opste.pregled.ne.vise"))
               (fq:lomputk p0 ang))
        r))))


;;; --- kucista na krajevima kabla sa lomovima ------------------------
;;;
;;;  Isti dogovor kao kod pravog kabla: sirenje ume fq-kucista.lsp, koji
;;;  se ucitava posle ovog fajla i sme da ga nema, pa se prvo proverava
;;;  da li funkcija postoji, a poziv ide pod vl-catch-all-apply.
;;;
;;;  Razlika je sto dva kraja imaju razlicit ugao, pa svaki ide sa uglom
;;;  onog dela kabla koji na njega dolazi.
;;;
;;;  Pocetak kabla sa lomovima je vec uvucen u ram pre crtanja, isto kao
;;;  kod pravog kabla: fq:lomposao pomera tacku umetanja, a putanja se
;;;  klikce tek posle nje.  KRAJ se pomera samo ovde, uvodjenjem vlakna
;;;  -- pomerena poslednja tacka putanje bi poslednji deo mogla da
;;;  skrati ispod *FQ-LOM-MIN*, i fq:drawlom bi odbio da nacrta ceo kabl.
(defun fq:lomsiri (oz path dirs / r a1 am)
  (if *FQ-SIRI*
    (progn
      (setq a1 (fq:stepen (car dirs))
            am (fq:stepen (fq:last dirs)))
      (if (car (atoms-family 1 (list "FQ:KUCSIRIEND")))
        (progn
          (setq r (vl-catch-all-apply
                    'fq:kucsiriend
                    (list oz (list (cons (car path)     a1)
                                   (cons (fq:last path) am)))))
          ;; isto kao u fq:kablsiri -- vidi obrazlozenje tamo
          (if (fq:otkaz r)
            (princ (fq:t "kuc.sirenje.otkazano"))
            (if (fq:greska r (fq:t "kuc.nije.prosireno"))
              (princ (fq:t "kuc.ram.fqdodaj"))))))
      (setq r (vl-catch-all-apply
                'fq:nastsiriend
                (list oz (list (list (car path)     a1  1)
                               (list (fq:last path) am -1)))))
      (fq:greska r (fq:t "nast.nije.prosireno")))))

;; Ceo posao, od tacke umetanja do sirenja kucista.  Dele ga rucna
;; komanda FQLOM i katalog kablova.
(defun fq:lomposao (nt nf oz disp lbl kat st / ang rows p0 path n)
  (setq ang  (if *fq-por* (cadr *fq-por*) *fq-ugao*)
        rows (if *fq-por* (caddr *fq-por*) nil))
  ;; brava i ovde, iz istog razloga kao u c:FQKABL
  (if (not (and (fq:ucsok) (fq:velik nt nf)))
    (princ (fq:t "opste.otkazano"))
    (progn
      (setq p0
        (if (and *fq-por* (cadddr *fq-por*))
          ;; tacka se ne pokazuje; vidi napomenu u c:FQKABL
          (progn (setq *fq-a* (fq:deg ang) *fq-snaphit* nil)
                 (princ (fq:t "kabl.polozaj.ormar"))
                 (fq:w (cadddr *fq-por*) (car *fq-por*)))
          (fq:pickins (if *fq-por*
                        (fq:tf "kabl.pitaj.polozaj.tip" (list disp))
                        (fq:tf "kabl.pitaj.tacka.tip"   (list disp)))
                      nt nf *FQ-LEN* ang rows (car *fq-por*))))
      (if (not p0)
        (princ (fq:t "opste.otkazano"))
        (progn
          ;; isto kao u c:FQKABL: uhvacen ram daje i ugao
          (setq ang (fq:snapuzmi ang))
          (if *fq-por*
            (progn (setq *fq-a* (fq:deg ang))
                   (setq p0 (fq:w (car (fq:loc p0)) (car *fq-por*)))))
          ;; Ivica nastavka, pre nego sto se putanja uopste klikne.
          ;; Zato se pocetak sme pomeriti a kraj ne: putanja jos ne
          ;; postoji, pa se nema sta skratiti ispod *FQ-LOM-MIN*.
          (setq p0 (fq:nastuvod p0 ang))
          (setq path (fq:lomput p0 nt nf ang rows))
          (if (not path)
            (princ (fq:t "opste.otkazano"))
            (progn
              (setq n (fq:drawlom nt nf oz disp lbl kat st path rows))
              (if n
                (progn
                  (fq:lomsiri oz path (fq:lomdirs path))
                  (if *fq-por*
                    (progn (setq *fq-por* nil)
                           (princ (fq:t "opste.poravnanje.potroseno"))))))))))))
  (princ))

(defun c:FQLOM ( / *error* r nt nf oz lbl st)
  (setq *error* fq:err)
  (fq:init)
  (princ (fq:t "lom.duzina.izputanje"))
  (setq r   (fq:kablpita2 nil)
        nt  (nth 0 r)  nf  (nth 1 r)
        oz  (nth 3 r)  lbl (nth 4 r)  st (nth 5 r))
  (fq:lomposao nt nf oz (strcat oz "   " lbl) lbl "" st)
  (princ))


;;; --- katalog kablova, dijalog sa padajucim listama ----------------

;; Redni broj tekuce orijentacije i color code standarda.
;; equal ne puca ni ako je vrednost nil, pa se uvek vrati ispravan indeks.
(defun fq:oripos ( / i r)
  (setq i 0 r 0)
  (foreach o *FQ-ORI*
    (if (equal (cadr o) *fq-ugao*) (setq r i))
    (setq i (1+ i)))
  r)

;; Naziv orijentacije za natpis dugmeta.  Bira se po UGLU, ne po prvoj
;; koloni *FQ-ORI*: ugao je ono sto ta tabela stvarno nosi -- fq:oripos
;; i sam poredi (cadr o), a prva kolona je bila iskljucivo natpis.  Zato
;; njen prevod ne dira nista drugo.
;;
;; Kljucevi su DOSLOVNI, po pravilu iz CLAUDE.md.  (fq:t (car o)) bi bio
;; kraci i radio bi, ali bi ga provera tabela videla kao racunat kljuc,
;; pa bi ova tri natpisa ostala neprovereni -- a tacno tako su u bloku 4
;; dva puta promakla.
(defun fq:orinaz (ang)
  (cond ((= ang 0)  (fq:t "dcl.ori.h"))
        ((= ang 90) (fq:t "dcl.ori.gore"))
        (T          (fq:t "dcl.ori.dole"))))

;; Vrste vlakna, ceo domen "vrs" iz *FQ-KODOVI*.  Ide kroz funkciju, ne
;; kao zasebna konstanta, da bi tabela ostala na JEDNOM mestu -- dijalog
;; i c:FQVRSTA nabrajaju iste zapise koje citaju fq:nazkod i fq:kodnaz.
(defun fq:vrstab () (cadr (assoc "vrs" *FQ-KODOVI*)))

(defun fq:vrspos ( / i r s)
  (setq i 0 r 0)
  (foreach s (fq:vrstab)
    (if (equal (car s) *fq-vrs*) (setq r i))
    (setq i (1+ i)))
  r)

(defun fq:ccpos ( / i r s)
  (setq i 0 r 0)
  (foreach s *FQ-CC*
    (if (equal (car s) *fq-kod*) (setq r i))
    (setq i (1+ i)))
  r)

;;; --- kapaciteti razvrstani po cevcicama ---------------------------
;;;
;;;  Spisak kapaciteta jednog tipa ima preko dvadeset stavki (1x2 do
;;;  36x12) i sve izgledaju isto.  Nalazenje "one sa cetiri cevcice" je
;;;  zato citanje reda po reda, a lista je visoka koliko i ceo dijalog.
;;;  Zaglavlje grupe daje oku za sta da se zakaci.
;;;
;;;  DCL popup_list NEMA nedostupan red -- svaki red se moze izabrati i
;;;  to se u samom dijalogu ne moze zabraniti.  Zato je zaglavlje obican
;;;  red, a njegov izbor se hvata u fq:kapizbor i pomera na prvi
;;;  kapacitet ispod njega.
;;;
;;;  *fq-kk* i dalje pokazuje u IZVORNU listu kapaciteta, ne u
;;;  prikazanu.  Tako fq:kabl, fq:kprev i fq:kbladdtip ostaju netaknuti,
;;;  a jedini prevod izmedju dva brojanja je *fq-kapmap*.  Da je *fq-kk*
;;;  postao red prikaza, svaki od tih citalaca bi morao da zna za
;;;  zaglavlja -- cetiri mesta umesto jednog.

;; Za svaki red PRIKAZANE liste redni broj u izvornoj listi kapaciteta,
;; ili nil ako je taj red zaglavlje grupe.
(setq *fq-kapmap* nil)

;; Kapaciteti razvrstani po broju cevcica: ((cevcica idx idx ...) ...).
;;
;;  Grupe idu redom kojim se cevcica PRVI PUT pojavi u katalogu, a ne po
;;  velicini: katalog je korisnicki podatak i njegov redosled je izbor,
;;  ne slucajnost.  Razvrstavanje samo skuplja ono sto je vec razbacano,
;;  pa isporucen katalog -- koji je i danas grupisan -- izgleda isto kao
;;  pre, samo sa zaglavljima.
(defun fq:kapgrupe (caps / i g out)
  (setq i 0 out nil)
  (foreach c caps
    (if (setq g (assoc (car c) out))
      (setq out (subst (append g (list i)) g out))
      (setq out (append out (list (list (car c) i)))))
    (setq i (1+ i)))
  out)

;; Natpis zaglavlja.  Srpski ima tri oblika mnozine (1 cevka, 2 cevke,
;; 5 cevki), engleski dva; kljuceva je troje i u obe tabele, jer ih
;; provera broji.  Odlucuje poslednja cifra, sem za 11-14.
;;
;;  Tri grane umesto jednog racunatog kljuca, iz istog razloga zbog kog
;;  ih ima i fq:orinaz: kljuc mora biti doslovna niska odmah iza fq:tf
;;  da bi ga provera tabela uopste videla.
(defun fq:kapzagl (cev / s d)
  (setq s (itoa cev) d (rem cev 10))
  (cond ((and (>= (rem cev 100) 11) (<= (rem cev 100) 14))
         (fq:tf "dcl.kap.cev5"  (list s)))
        ((= d 1)
         (fq:tf "dcl.kap.cev1"  (list s)))
        ((and (>= d 2) (<= d 4))
         (fq:tf "dcl.kap.cev24" (list s)))
        (T
         (fq:tf "dcl.kap.cev5"  (list s)))))

;; Red PRIKAZANE liste na kome stoji n-ti kapacitet izvorne liste.
(defun fq:kapred (n / i r)
  (setq i 0 r 0)
  (foreach m *fq-kapmap*
    (if (and m (= m n)) (setq r i))
    (setq i (1+ i)))
  r)

;;  Izbor iz liste; d je red PRIKAZANE liste.  Zaglavlje nema svoj
;;  kapacitet, pa izbor klizi na prvi kapacitet ispod njega.
;;
;;  set_tile ne pokrece akciju polja, pa se ovo ne vrti u krug; a i kad
;;  bi je pokretao, drugi prolaz bi zatekao pravi red i stao.
(defun fq:kapizbor (d / n)
  (setq n (nth d *fq-kapmap*))
  (if (null n)
    (progn
      ;; zaglavlje je uvek ispred bar jednog kapaciteta; ako lista ipak
      ;; zavrsi zaglavljem, ostaje zatecen izbor
      (if (null (setq n (nth (1+ d) *fq-kapmap*)))
        (setq n *fq-kk*))
      (set_tile "kap" (itoa (fq:kapred n)))))
  (setq *fq-kk* n))

(defun fq:fillkap (caps / c)
  (setq *fq-kapmap* nil)
  (start_list "kap")
  (foreach g (fq:kapgrupe caps)
    (add_list (fq:kapzagl (car g)))
    (setq *fq-kapmap* (cons nil *fq-kapmap*))
    (foreach i (cdr g)
      (setq c (nth i caps))
      ;; uvlaka nosi razliku izmedju zaglavlja i stavke; DCL nema ni
      ;; podebljan red ni razdvojnik, pa je razmak jedino sto ostaje
      (add_list (strcat "   " (itoa (car c)) "x" (itoa (cadr c))))
      (setq *fq-kapmap* (cons i *fq-kapmap*))))
  (end_list)
  (setq *fq-kapmap* (reverse *fq-kapmap*))
  T)

;; polja duzine u dijalogu kabla, ugasena kada se crta kabl sa lomovima
(defun fq:lomgasi (on)
  (mode_tile "duz" (if on 1 0))
  (mode_tile "dul" (if on 1 0))
  T)

(defun fq:kprev (tipn cap)
  (set_tile "pre" (strcat tipn " (" (itoa (car cap)) "x"
                          (itoa (cadr cap)) ")"))
  T)

(defun fq:dclkabl ( / fn f i o s)
  (setq fn (strcat (getvar "TEMPPREFIX") "fq-kabl.dcl"))
  (setq f (open fn "w"))
  (if f
    (progn
      (fq:dcll f "fqkabl : dialog { label = \"" (fq:t "dcl.naslov.kabl") "\";")
      (write-line " : text { key = \"kat\"; label = \"\"; width = 48; }" f)
      (write-line " : spacer { height = 0.4; }" f)
      (write-line " : row {" f)
      (write-line "  : column {" f)
      ;; Tip kabla je edit_box PLUS lista, isti obrazac kao Model u
      ;; FQKUC: lista nudi ono sto katalog vec ima, a upisano ime se
      ;; dopisuje u katalog te kategorije i cuva ga FQKABLSAVE.
      ;; Kapacitete nov tip nasledjuje od izabranog -- vidi fq:kbladdtip.
      (fq:dcll f "   : text { label = \"" (fq:t "dcl.kabl.tip") "\"; }")
      (write-line "   : row {" f)
      (write-line "    : edit_box   { key = \"tipn\"; edit_width = 16; }" f)
      (write-line "    : popup_list { key = \"tip\";  width = 14; }" f)
      (write-line "   }" f)
      (write-line "  }" f)
      (write-line "  : column {" f)
      (fq:dcll f "   : text { label = \"" (fq:t "dcl.kapacitet") "\"; }")
      ;; sire nego ranije: u listi sada stoje i zaglavlja grupa
      ;; ("-- 24 cevke --"), a uz njih je 12 znakova preusko
      (write-line "   : popup_list { key = \"kap\"; width = 16; }" f)
      (write-line "  }" f)
      (write-line " }" f)
      (write-line " : spacer { height = 0.4; }" f)
      ;; orijentacija kao radio dugmad, bez racunanja indeksa liste.
      ;; Natpis kroz fq:orinaz, po uglu -- vidi tamo zasto ne po (car o).
      (fq:dcll f " : boxed_row { label = \"" (fq:t "dcl.orijentacija") "\";")
      (write-line "  : radio_row {" f)
      (setq i 0)
      (foreach o *FQ-ORI*
        (fq:dcll f (strcat "   : radio_button { key = \"or" (itoa i) "\"; label = \"")
                 (fq:orinaz (cadr o)) "\"; }")
        (setq i (1+ i)))
      (write-line "  }" f)
      (write-line " }" f)
      ;; color code standard, radio dugmad; kolona kad ih ima vise.
      ;; Naziv standarda je KORISNICKI PODATAK i ne prevodi se -- TIA-598
      ;; se tako zove na svakom jeziku.  Kroz fq:dcll ide zbog navodnika:
      ;; standard nazvan `rack 19"` je do sada rusio ceo dijalog.
      (fq:dcll f " : boxed_row { label = \"" (fq:t "dcl.kabl.cc") "\";")
      (write-line (if (> (length *FQ-CC*) 3)
                    "  : radio_column {" "  : radio_row {") f)
      (setq i 0)
      (foreach s *FQ-CC*
        (fq:dcll f (strcat "   : radio_button { key = \"cc" (itoa i) "\"; label = \"")
                 (car s) "\"; }")
        (setq i (1+ i)))
      (write-line "  }" f)
      (write-line " }" f)
      ;; Vrsta vlakna.  Kljuc dugmeta se i dalje ne racuna, ali natpis
      ;; vise ne uzima (caddr s) -- to je srpska kolona domena "vrs".
      ;; fq:kodnaz bira kolonu po jeziku, pa "SM - jednomodno" postane
      ;; "SM - singlemode".  Sam kod (car s) je oznaka i ostaje.
      (fq:dcll f " : boxed_row { label = \"" (fq:t "dcl.kabl.vrsta") "\";")
      (write-line "  : radio_row {" f)
      (setq i 0)
      (foreach s (fq:vrstab)
        (fq:dcll f (strcat "   : radio_button { key = \"vr" (itoa i) "\"; label = \"")
                 (strcat (car s) " - " (fq:kodnaz "vrs" (car s))) "\"; }")
        (setq i (1+ i)))
      (write-line "  }" f)
      (write-line " }" f)
      (write-line " : spacer { height = 0.4; }" f)
      (write-line " : row {" f)
      (write-line "  : edit_box { key = \"ozn\";" f)
      (fq:dcll f "               label = \"" (fq:t "dcl.kabl.ozn") "\"; edit_width = 10; }")
      (write-line "  : edit_box { key = \"duz\";" f)
      (fq:dcll f "               label = \"" (fq:t "dcl.kabl.duz") "\"; edit_width = 8; }")
      (write-line " }" f)
      (write-line " : toggle { key = \"dul\";" f)
      (fq:dcll f "            label = \"" (fq:t "dcl.kabl.dul") "\"; }")
      (write-line " : toggle { key = \"lom\";" f)
      (fq:dcll f "            label = \"" (fq:t "dcl.kabl.lom") "\"; }")
      (write-line " : spacer { height = 0.4; }" f)
      (fq:dcll f " : boxed_column { label = \"" (fq:t "dcl.ispis") "\";")
      (write-line "  : text { key = \"pre\"; label = \"\"; width = 48; }" f)
      (write-line " }" f)
      (write-line " : spacer { height = 0.4; }" f)
      (write-line " : row {" f)
      (fq:dcll f "  : button { key = \"accept\"; label = \"" (fq:t "dcl.ok") "\";")
      (write-line "             is_default = true; width = 14; }" f)
      (fq:dcll f "  : button { key = \"cancel\"; label = \"" (fq:t "dcl.odustani") "\";")
      (write-line "             is_cancel = true; width = 14; }" f)
      (write-line " }" f)
      (write-line "}" f)
      (close f)
      fn)
    nil))

;;  katn je NAZIV kategorije -- kljuc u *FQ-KABLOVI* i ono sto pise u
;;  zaglavlju dijaloga.  katk je isto to kao KOD i ide iskljucivo u
;;  xdata.  Prevod je ovde, na jednom mestu, a ne u crtacima: fq:kabl
;;  je jedina grana koja uopste zna kategoriju, pa crtaci od nje nadalje
;;  vide samo kod i ne moraju da znaju za *FQ-KODOVI*.
;;
;;  Kategorija namerno NEMA kolonu koda u *FQ-KABLOVI*.  Ta tabela i
;;  domen "kat" nabrajali bi iste cetiri kategorije, pa bi se pre ili
;;  kasnije razisle -- a razisle bi se tiho, jer polje 12 danas nema
;;  nijednog citaoca.  Jedan izvor istine je *FQ-KODOVI*; kategorija
;;  koju tamo nema (korisnicki katalog iz bloka 9) prolazi kroz
;;  nepromenjena, isto pravilo kao za mesto nastavka.
(defun fq:kabl (katn / rec katk fn id r tipn cap lg oz disp p0 ang i tp o s)
  (fq:init)
  ;; osiguraj ispravne tekuce vrednosti pre otvaranja dijaloga
  (if (not *fq-ugao*) (setq *fq-ugao* 0))
  (if (not (assoc *fq-kod* *FQ-CC*)) (setq *fq-kod* (car (car *FQ-CC*))))
  (if (not (assoc *fq-vrs* (fq:vrstab)))
    (setq *fq-vrs* (car (car (fq:vrstab)))))
  ;;  KATALOG SE TRAZI NORMALIZOVANO, ne golim assoc-om.  Kroz ovu
  ;;  funkciju stize cetiri razlicita zapisa iste kategorije: pun srpski
  ;;  naziv sa palete i sa trake ("Podzemni mikro"), token iz c:FQKABLK
  ;;  na oba jezika ("Mikro", "Micro"), i engleski naziv.  assoc bi
  ;;  poznavao samo prvi, pa bi engleski token dao "Nepoznata kategorija"
  ;;  a paleta nastavila da radi -- kvar koji se vidi samo na engleskom.
  ;;
  ;;  Kljuc kataloga se zatim uzima IZ ZAPISA, ne iz onoga sto je stiglo:
  ;;  katn dalje ide u fq:kbladdtip, koji pod tim kljucem dopisuje tip u
  ;;  *FQ-KABLOVI*.  Engleski token kao kljuc bi tamo napravio petu
  ;;  kategoriju, i to bi FQKABLSAVE trajno upisao u korisnicki fajl.
  ;;
  ;;  Korisnicka kategorija koje u domenu "kat" nema prolazi kroz
  ;;  fq:nazkod nepromenjena, pa se poklapa sama sa sobom.
  (setq katk (fq:nazkod "kat" katn)
        rec  (vl-some '(lambda (x)
                         (if (= (strcase (fq:nazkod "kat" (car x)))
                                (strcase katk))
                           x))
                      *FQ-KABLOVI*))
  (if (not rec)
    (princ (fq:tf "kabl.nepoznata.kat" (list katn)))
    (progn
      (setq katn (car rec))
      (setq *fq-tipovi* (cadr rec)
            *fq-kt*     0
            *fq-kk*     0
            *fq-ozn*    ""
            ;; Decimale samo kad ih ima.  Ranije je stajalo (rtos ... 0):
            ;; jedini par rtos->citanje u projektu, i jedini gde
            ;; zaokruzivanje menja geometriju -- za *FQ-LEN* = 7.5 polje
            ;; je pokazivalo "8" i toliko se crtalo, jer fq:areal cita
            ;; tacno ono sto u polju pise.  Cele duzine i dalje stoje
            ;; kao "40", ne "40.00".
            *fq-duz*    (if (equal *FQ-LEN* (float (fix *FQ-LEN*)) 1e-9)
                          (itoa (fix *FQ-LEN*))
                          (rtos *FQ-LEN* 2 2))
            *fq-oi*     (fq:oripos)
            *fq-ci*     (fq:ccpos)
            *fq-vi*     (fq:vrspos)
            fn          (fq:dclkabl))
      (if (and fn
               (>= (setq id (load_dialog fn)) 0)
               (new_dialog "fqkabl" id))
        (progn
          ;; katn je do ovde vec kljuc kataloga, dakle srpski naziv
          ;; ("Podzemni mikro").  Za PRIKAZ ide kroz fq:kodnaz; korisnicka
          ;; kategorija koje u domenu "kat" nema prolazi nepromenjena.
          (set_tile "kat" (fq:tf "dcl.kabl.kategorija"
                                 (list (fq:kodnaz "kat" katn))))
          (start_list "tip")
          (foreach tp *fq-tipovi* (add_list (car tp)))
          (end_list)
          (set_tile "tip" "0")
          (set_tile "tipn" (car (nth 0 *fq-tipovi*)))
          (setq *fq-ktip* (car (nth 0 *fq-tipovi*)))
          (fq:fillkap (cadr (nth 0 *fq-tipovi*)))
          ;; red 0 prikaza je zaglavlje prve grupe, a ne prvi kapacitet
          (set_tile "kap" (itoa (fq:kapred 0)))
          (set_tile (strcat "or" (itoa *fq-oi*)) "1")
          (set_tile (strcat "cc" (itoa *fq-ci*)) "1")
          (set_tile (strcat "vr" (itoa *fq-vi*)) "1")
          (set_tile "duz" *fq-duz*)
          (set_tile "dul" (if *fq-duzmis* "1" "0"))
          (action_tile "dul" "(setq *fq-duzmis* (= $value \"1\"))")
          ;; kod kabla sa lomovima duzina dolazi iz putanje, pa se polja
          ;; za duzinu gase da se ne popunjavaju uzalud
          (set_tile "lom" (if *fq-lomkabl* "1" "0"))
          (fq:lomgasi *fq-lomkabl*)
          (action_tile "lom"
            "(setq *fq-lomkabl* (= $value \"1\")) (fq:lomgasi *fq-lomkabl*)")
          (fq:kprev (car (nth 0 *fq-tipovi*))
                    (nth 0 (cadr (nth 0 *fq-tipovi*))))

          ;; Izbor iz liste prepisuje ime u polje: lista i polje moraju da
          ;; kazu isto, inace bi se izabrao jedan tip a nacrtao drugi.
          (action_tile "tip"
            (strcat "(setq *fq-kt* (atoi $value) *fq-kk* 0)"
                    "(fq:fillkap (cadr (nth *fq-kt* *fq-tipovi*)))"
                    "(set_tile \"kap\" (itoa (fq:kapred 0)))"
                    "(set_tile \"tipn\" (car (nth *fq-kt* *fq-tipovi*)))"
                    "(setq *fq-ktip* (car (nth *fq-kt* *fq-tipovi*)))"
                    "(fq:kprev *fq-ktip*"
                    "          (nth 0 (cadr (nth *fq-kt* *fq-tipovi*))))"))
          ;; get_tile, a NE $value: $value ubacuje sadrzaj polja u izraz
          ;; kao string sa navodnicima, pa bi tip nazvan  rack 19"  razbio
          ;; izraz na tri dela i eval bi pao usred dijaloga.  Isto pravilo
          ;; vazi za polje Model u FQKUC.
          (action_tile "tipn"
            (strcat "(setq *fq-ktip* (get_tile \"tipn\"))"
                    "(fq:kprev *fq-ktip*"
                    "          (nth *fq-kk* (cadr (nth *fq-kt* *fq-tipovi*))))"))
          ;; fq:kapizbor, a ne golo (atoi $value): $value je red PRIKAZA,
          ;; a *fq-kk* mora da ostane red izvorne liste kapaciteta
          (action_tile "kap"
            (strcat "(fq:kapizbor (atoi $value))"
                    "(fq:kprev *fq-ktip*"
                    "          (nth *fq-kk* (cadr (nth *fq-kt* *fq-tipovi*))))"))
          (setq i 0)
          (foreach o *FQ-ORI*
            (action_tile (strcat "or" (itoa i))
                         (strcat "(setq *fq-oi* " (itoa i) ")"))
            (setq i (1+ i)))
          (setq i 0)
          (foreach s *FQ-CC*
            (action_tile (strcat "cc" (itoa i))
                         (strcat "(setq *fq-ci* " (itoa i) ")"))
            (setq i (1+ i)))
          (setq i 0)
          (foreach s (fq:vrstab)
            (action_tile (strcat "vr" (itoa i))
                         (strcat "(setq *fq-vi* " (itoa i) ")"))
            (setq i (1+ i)))
          (action_tile "accept"
            (strcat "(setq *fq-ozn* (get_tile \"ozn\")"
                    "      *fq-duz* (get_tile \"duz\")"
                    "      *fq-ktip* (get_tile \"tipn\"))"
                    "(done_dialog 1)"))
          (action_tile "cancel" "(done_dialog 0)")

          (setq r (start_dialog))
          (unload_dialog id)

          (if (= r 1)
            (progn
              (setq cap  (nth *fq-kk* (cadr (nth *fq-kt* *fq-tipovi*)))
                    ;; Prazno polje znaci "kao izabrano u listi", ne
                    ;; "kabl bez tipa": natpis bi inace poceo razmakom.
                    tipn (if (= *fq-ktip* "")
                           (car (nth *fq-kt* *fq-tipovi*))
                           *fq-ktip*)
                    ang  (cadr (nth *fq-oi* *FQ-ORI*))
                    *fq-ugao* ang
                    *fq-kod*  (car (nth *fq-ci* *FQ-CC*))
                    ;; Vrsta ide u globalnu, odakle je crtaci citaju --
                    ;; ista putanja kao *fq-kod*, vidi *fq-vrs*.
                    *fq-vrs*  (car (nth *fq-vi* (fq:vrstab)))
                    ;; fq:areal, ne atof: polje prima ono sto korisnik
                    ;; kuca, a na srpskom tastaturom to je "7,5".
                    ;; Clamp ide OVDE, a ne u fq:duzina: fq:pickins
                    ;; pravi siluetu preko fq:kablvecs i zove se PRE
                    ;; fq:duzina, pa bi silueta pokazivala 7 a nacrtalo
                    ;; bi se 12 -- to je tacno ono sto pravilo parnosti
                    ;; zabranjuje.
                    lg   (fq:areal *fq-duz* *FQ-LEN*)
                    lg   (if (> lg 0.0) (max lg *FQ-LEN-MIN*) *FQ-LEN*))
              ;; Upisan tip ulazi u katalog te kategorije, pa ga sledeci
              ;; put nudi lista, a FQKABLSAVE ga trajno cuva.  Ide PRE
              ;; crtanja: ako korisnik posle odustane od tacke umetanja,
              ;; ime koje je vec ukucao ne treba da se izgubi.
              (if (fq:kbladdtip katn tipn (cadr (nth *fq-kt* *fq-tipovi*)))
                (princ (fq:tf "kabl.tip.dopisan" (list tipn))))
              (setq disp (strcat tipn " (" (itoa (car cap)) "x"
                                 (itoa (cadr cap)) ")"))
              (if (= *fq-ozn* "")
                (setq oz (fq:next "K"))
                (setq oz   *fq-ozn*
                      disp (strcat *fq-ozn* "   " disp)))
              ;; ako je zadato poravnanje, ugao i red se preuzimaju,
              ;; a od pokazane tacke se koristi samo polozaj duz kabla
              (if *fq-por* (setq ang (cadr *fq-por*)))
              (cond
                ;; kabl sa lomovima: putanja se klikce, a duzina iz
                ;; dijaloga se ne koristi jer se dobija iz nje
                (*fq-lomkabl*
                   (fq:lomposao (car cap) (cadr cap) oz disp
                                (strcat tipn " (" (itoa (car cap)) "x"
                                        (itoa (cadr cap)) ")")
                                katk *fq-st*))
                ((not (fq:velik (car cap) (cadr cap)))
                   (princ (fq:t "opste.otkazano")))
                ;; obican prav kabl
                ((setq p0
                   (if (and *fq-por* (cadddr *fq-por*))
                     ;; polozaj je zadat ormarom, nista se ne pokazuje, pa
                     ;; se tudj pogodak baca; vidi napomenu u c:FQKABL
                     (progn
                       (setq *fq-a* (fq:deg ang) *fq-snaphit* nil)
                       (princ (fq:t "kabl.polozaj.ormar"))
                       (fq:w (cadddr *fq-por*) (car *fq-por*)))
                     (fq:pickins
                       (if *fq-por*
                         (fq:tf "kabl.pitaj.polozaj.tip" (list disp))
                         (fq:tf "kabl.pitaj.tacka.tip"   (list disp)))
                       (car cap) (cadr cap) lg ang
                       (caddr *fq-por*) (car *fq-por*))))
                 ;; Isto kao u c:FQKABL: uhvacen ram daje i ugao.  Bez ovoga
                 ;; bi kabl sa palete i sa trake uhvatio tacku ali ne i ugao,
                 ;; pa bi iz uspravnog ODF-a izasao vodoravno.
                 (setq ang (fq:snapuzmi ang))
                 (if *fq-por*
                   (progn
                     (setq *fq-a* (fq:deg ang))
                     (setq p0 (fq:w (car (fq:loc p0)) (car *fq-por*)))))
                 ;; ivica nastavka, isto kao u c:FQKABL -- vidi tamo
                 (setq p0 (fq:nastuvod p0 ang))
                 (setq lg (fq:duzina p0 (car cap) (cadr cap) ang
                                     (if *fq-por* (caddr *fq-por*) nil) lg))
                 (if (not lg)
                   (princ (fq:t "opste.otkazano"))
                   (progn
                     (fq:drawkabl (car cap) (cadr cap) lg oz disp
                                  (strcat tipn " (" (itoa (car cap)) "x"
                                          (itoa (cadr cap)) ")")
                                  katk ang *fq-st* p0
                                  (if *fq-por* (caddr *fq-por*) nil))
                     (fq:kablsiri oz p0 lg ang)
                     (if *fq-por*
                       (progn (setq *fq-por* nil)
                              (princ (fq:t "opste.poravnanje.potroseno")))))))
                (T (princ (fq:t "opste.otkazano")))))
            (princ (fq:t "opste.otkazano"))))
        (princ (fq:t "kabl.dijalog.ne")))))
  (princ))

;;; --- poravnanje novog kabla sa postojecim -------------------------
;;;  Klikne se vlakno sa kojim treba da se poklopi PRVO vlakno novog
;;;  kabla. Sledeci kabl preuzima ugao i redove, a pokazuje se samo
;;;  polozaj duz kabla.
;;;
;;;  Mreza    novi kabl preuzima CELU listu redova referentnog kabla,
;;;           vlakno po vlakno. Ovo je jedino sto radi kada dva kabla
;;;           nemaju isti broj vlakana u cevcici, jer se tada razmak
;;;           izmedju cevcica nakuplja i redovi se razidju.
;;;  Pocetak  preuzima se samo prvi red, dalje ide prirodni raster.
;;;
;;;  *fq-por* je (prvi-red  ugao  lista-redova-ili-nil)

;; Poravnanje po ramu ume fq-kucista.lsp, koji se ucitava posle ovog
;; fajla i sme da ga nema, pa se prvo proverava da li funkcija postoji.
(defun fq:porrampos ( / )
  (if (not (car (atoms-family 1 (list "FQ:PORRAM"))))
    (progn (princ (fq:t "por.treba.kucista")) nil)
    T))

(defun c:FQPORAVNAJ ( / *error* s d ang kw kabl n0 raw fl rows uref pts r por)
  (setq *error* fq:err)
  (fq:init)
  (if *fq-por*
    (progn (setq *fq-por* nil)
           (princ (fq:t "por.ponisteno")))
    (progn
      (setq s (entsel (fq:t "por.pitaj.izbor")))
      (if (not s)
        (princ (fq:t "opste.otkazano"))
        (progn
          (setq d (fq:xdget (car s)))
          (cond
            ((not d) (princ (fq:t "opste.nije.element")))
            ;; ram: red i kolona se citaju iz same geometrije
            ((/= (car d) "VLAKNO")
             (if (fq:porrampos)
               (if (setq por (fq:porram (car s) d))
                 ;; Ogledalno kuciste ima portove okrenute na stranu -u,
                 ;; pa bi kabl iz njih morao pod ugao + 180.  Kabl zna
                 ;; samo za 0, 90 i 270 (*FQ-ORI*), i to se ovde ne
                 ;; zaobilazi: poravnanje bi postavilo tacku i ugao po
                 ;; kojima bi kabl krenuo PRAVO U TELO kucista.
                 ;;
                 ;; Kacenje na takvo kuciste i dalje radi -- kabl mu
                 ;; dolazi spolja, kroz hvatanje na konektor.  Ne radi
                 ;; samo obrnut smer, da kabl iz njega KRECE.
                 (if (nth 4 por)
                   (princ (fq:tf "por.ogledalo" (list (fq:f 1 d))))
                   (progn
                     (setq *fq-por* por)
                     (princ (fq:tf "por.sa.rama" (list (fq:f 1 d) (itoa (cadr por)))))
                     (if (cadddr por)
                       (princ (fq:t "por.prvi.konektor"))
                       (princ (fq:t "por.prvi.red"))))))))
            (T
             (progn
              (setq ang  (fq:vl-ang d)
                    kabl (fq:vl-kabl d)
                    n0   (atoi (fq:vl-br d)))
              (setq *fq-a* (fq:deg ang))
              ;; kw je od bloka 4 LOGICKA vrednost, ne token: T znaci
              ;; Mreza (prvi token, i podrazumevano), nil znaci Pocetak.
              ;; fq:dvatok vraca T za drugi token, otud (not ...).
              (setq kw (not (fq:dvatok "por.tok.mreza" "por.tok.pocetak"
                                       "por.pitaj" nil)))
              ;; redovi referentnog kabla, od izabranog vlakna nadalje,
              ;; sa onog kraja kabla koji je korisnik pokazao
              (setq pts  (fq:orient (car s) (cadr s))
                    uref (car (last pts))
                    raw  (fq:cablefibers kabl)
                    fl   (if raw (fq:krajevi raw uref) nil)
                    rows nil)
              (foreach r fl
                (if (>= (car r) n0)
                  (setq rows (cons (cadr (fq:loc (cadr r))) rows))))
              (setq rows (reverse rows))
              (if (not rows)
                (princ (fq:t "por.redovi.ne"))
                (progn
                  ;; cetvrti clan je nil, polozaj duz kabla se pokazuje
                  (setq *fq-por* (list (car rows) ang
                                       (if kw rows nil)
                                       nil))
                  (princ (fq:tf "por.sa.vlakna" (list (fq:f 1 d) kabl (itoa n0) (itoa ang))))
                  (if kw
                    (princ (fq:tf "por.mreza" (list (itoa (length rows)))))
                    (princ (fq:t "por.samo.prvi"))))))))))))
  (princ))

;;  cond koji je token prevodio u naziv je OTISAO, i to je jedina takva
;;  brisana grana u bloku 3.  Postojao je zbog jednog jedinog para --
;;  token "Mikro", naziv "Podzemni mikro" -- jer initget ne dozvoljava
;;  razmak u tokenu.  Od bloka 3 oba stoje u istom zapisu domena "kat",
;;  pa ih fq:kabl razresava sam, kroz fq:nazkod.  Grana koja je to radila
;;  rucno bila bi drugo mesto koje mora znati da su "Mikro" i "Podzemni
;;  mikro" ista stvar.
;;
;;  Podrazumevana vrednost je KOD, ne rec.  Kod prolazi kroz fq:nazkod
;;  nepromenjen na oba jezika; "Podzemni" bi na engleskom morao natrag u
;;  kod, dakle jos jedno mesto koje zna srpski naziv.
(defun c:FQKABLK ( / *error* l kw)
  (setq *error* fq:err)
  (setq l (fq:tokovi "kat" nil))
  (initget (fq:spisak l " "))
  (setq kw (getkword (fq:tf "kabl.pitaj.kategorija"
                            (list (fq:spisak l "/")
                                  (substr (fq:tok1 "kat" "kbDuct") 1 1)))))
  (fq:kabl (if kw kw "kbDuct"))
  (princ))


;;; ==================================================================
;;;  10. NAMENA VLAKNA
;;; ==================================================================

;;  Zapis namene iz onoga sto je stiglo: kljuc, kod, token na oba jezika
;;  ili naziv na oba jezika.  Do bloka 3 je ovo bio gol (assoc kw ...),
;;  dakle poznavao je iskljucivo srpski kljuc -- a od bloka 3 c:FQBOJA
;;  predaje token, koji je na engleskom druga rec ("Working", ne "Radno").
;;
;;  Trazi se po KODU, jer je kod jedino sto obe tabele dele: *FQ-NAMENE*
;;  nosi boju i debljinu, *FQ-KODOVI* tokene i nazive.  Spajanje po reci
;;  bi znacilo da svaka od dve tabele mora znati recnik one druge.
(defun fq:namrec (kw / kod)
  (setq kod (fq:nazkod "nam" kw))
  (vl-some '(lambda (x) (if (= (fq:f 4 x) kod) x)) *FQ-NAMENE*))

;; Namena jednom vec poznatom vlaknu, bez pitanja i bez izbora.
;; Isti zapis i ista boja koje daje fq:setnam, samo za jedan entitet.
(defun fq:namena (e kw / rec)
  (if (setq rec (fq:namrec kw))
    (progn
      (fq:setcolor e (caddr rec))
      (fq:setlw    e (cadddr rec))
      ;; U xdata ide KOD, (nth 4 rec).  Do 1.0.0 je isao (cadr rec),
      ;; dakle naziv za prikaz.
      (fq:xdput    e 10 (nth 4 rec))
      T)))

(defun fq:setnam (kw / rec nam kod aci lw ss i e d n)
  (fq:init)
  (setq rec (fq:namrec kw))
  (if (not rec)
    (princ (fq:tf "nam.nepoznata" (list kw)))
    (progn
      ;; nam je za PORUKU, kod za xdata.  Do 1.0.0 je nam isao na oba
      ;; mesta, pa je u crtezu stajalo "U izgradnji" umesto "nmBuild".
      ;;
      ;; Naziv za poruku od bloka 3 dolazi iz *FQ-KODOVI*, ne iz druge
      ;; kolone *FQ-NAMENE*: samo tamo postoji engleska varijanta.  Na
      ;; srpskom su te dve kolone rec u rec iste kod svih deset unosa --
      ;; provereno pre izmene, pa ovo nista ne menja u zatecenom radu.
      (setq kod (fq:f 4 rec)
            nam (fq:kodnaz "nam" kod)
            aci (caddr rec) lw (cadddr rec))
      (fq:lwon)
      (princ (fq:tf "nam.izaberi" (list nam)))
      (setq ss (ssget '((8 . "FQ_VLAKNO") (-3 ("FIBERQ")))) i 0 n 0)
      (if ss
        (progn
          (while (< i (sslength ss))
            (setq e (ssname ss i) d (fq:xdget e))
            (if (and d (= (car d) "VLAKNO"))
              (progn
                (fq:setcolor e aci)
                (fq:setlw e lw)
                ;; Jedna grana umesto dve, i to popravlja zatecen kvar:
                ;; (append d (list v)) stavlja vrednost na indeks
                ;; (length d), a to je 10 samo kod zapisa od TACNO deset
                ;; polja.  Zapis od devet polja je namenu dobijao u
                ;; polje 9 -- dakle u prolaznost.  fq:setnthx dopunjuje
                ;; prazninama do trazenog indeksa, pa oba slucaja rade.
                (fq:xd e (fq:setnthx d 10 kod))
                (setq n (1+ n))))
            (setq i (1+ i)))
          (princ (fq:tf "nam.promenjeno" (list (itoa n) nam))))
        (princ (fq:t "opste.nista")))))
  (princ))

;;  SRPSKE SKRACENICE SE SUDARAJU, i to se odlukom od 21.08.2026 NE
;;  popravlja.  Deset tokena deli svega sest pocetnih slova, pa se za
;;  "Rezervno" mora otkucati sedam slova ("Rezervn"), za "Prolazno" tri,
;;  za "Spliter" dva.  Svaka popravka menja ono sto korisnik kuca, dakle
;;  lomi zatecene skripte i makroe -- a dobitak postoji samo na srpskom i
;;  samo u komandnoj liniji, jer se kroz paletu i traku bira klikom.
;;  Zapisano kao poznato ogranicenje, ne kao dug.
;;
;;  Engleski skup taj sudar nema: deset tokena, deset razlicitih pocetnih
;;  slova.  Zato su u tabeli "Spare" -> token "Unused" i "Through" ->
;;  token "Transit" -- naziv za prikaz ostaje tacan, a token se bira tako
;;  da nijedan ne bude prefiks drugog.
(defun c:FQBOJA ( / *error* l kw)
  (setq *error* fq:err)
  (setq l (fq:tokovi "nam" nil))
  (initget (fq:spisak l " "))
  (setq kw (getkword (fq:tf "vlakno.pitaj.namena"
                            (list (fq:spisak l "/") (fq:tok1 "nam" "nmWork")))))
  (fq:setnam (if kw kw "nmWork"))
  (princ))

;;; --- vrsta vlakna na vec nacrtanim vlaknima -----------------------
;;;
;;;  Bez ove komande bi zatecen crtez ostao "nepoznat" zauvek: crtaci
;;;  vrstu upisuju samo pri crtanju, a vlakna nacrtana pre 1.0.0 nemaju
;;;  polje 18 uopste.  fq:setnthx zapis dopunjuje prazninama do 18, pa
;;;  radi i nad zapisom od sesnaest polja.
;;;
;;;  Ne dira ni boju ni debljinu.  Vrsta vlakna nije stanje nego fizicka
;;;  osobina kabla -- isto pravilo po kome ni splajs ne dira namenu.
(defun fq:setvrs (kod / naz ss i e d n)
  (fq:init)
  (setq naz (fq:kodnaz "vrs" kod))
  (princ (fq:tf "vrs.izaberi" (list kod naz)))
  (setq ss (ssget '((8 . "FQ_VLAKNO") (-3 ("FIBERQ")))) i 0 n 0)
  (if ss
    (progn
      (while (< i (sslength ss))
        (setq e (ssname ss i) d (fq:xdget e))
        (if (and d (= (car d) "VLAKNO"))
          (if (fq:xd e (fq:setnthx d 18 kod)) (setq n (1+ n))))
        (setq i (1+ i)))
      (princ (fq:tf "vrs.promenjeno" (list (itoa n) kod))))
    (princ (fq:t "opste.nista")))
  (princ))

(defun c:FQVRSTA ( / *error* l kw)
  (setq *error* fq:err)
  (setq l (fq:tokovi "vrs" nil))
  (initget (fq:spisak l " "))
  (setq kw (getkword (fq:tf "vlakno.pitaj.vrsta"
                            (list (fq:spisak l "/") *fq-vrs*))))
  (setq kw (if kw (fq:nazkod "vrs" kw) *fq-vrs*))
  ;; Izbor vazi i za sledeci nacrtan kabl.  Ko obelezava multimode
  ;; deonicu, po pravilu je i crta.
  (setq *fq-vrs* kw)
  (fq:setvrs kw)
  (princ))

;;; --- stvarna duzina kabla na vec nacrtanim vlaknima ---------------
;;;
;;;  Ide preko CELOG crteza, ne preko izabranog skupa.  Duzina je
;;;  podatak kabla, a vlakna tog kabla leze i u kucistima i u
;;;  nastavcima, cesto van onoga sto je korisnik obuhvatio prozorom.
;;;  Delimicno upisana duzina je gori podatak od neupisane: jedan deo
;;;  vlakana bi je nosio, drugi ne, a specifikacija bi zbirala prve.
;;;
;;;  Prazno v brise unos, pa se pogresno uneta duzina ispravlja istom
;;;  komandom.  fq:xd vraca nil na zakljucanom lejeru, pa se broji samo
;;;  ono sto je stvarno upisano.
(defun fq:duzsvim (kab v / ss i e d n)
  (setq ss (fq:ssx '((8 . "FQ_VLAKNO") (-3 ("FIBERQ")))) i 0 n 0)
  (if ss
    (while (< i (sslength ss))
      (setq e (ssname ss i) d (fq:xdget e))
      (if (and d (= (car d) "VLAKNO") (member kab (fq:duzkabli d)))
        (if (fq:xd e (fq:setnthx d 19 (fq:duzupis (fq:vl-duz d) kab v)))
          (setq n (1+ n))))
      (setq i (1+ i))))
  n)

;;  Pita za SVAKI kabl kroz koji izabrano vlakno prolazi, a ne samo za
;;  onaj cija je oznaka u polju 2.  Posle spajanja identitet nosi vlakno
;;  A, pa bi se duzina kabla B inace mogla uneti samo preko nekog
;;  njegovog jos nespojenog vlakna -- a takvog ne mora da bude nijednog.
;;
;;  getreal namerno, ne fq:pitajreal: ovde prazan Enter znaci ZADRZI
;;  postojecu vrednost, a fq:pitajreal prazno i podrazumevano ne
;;  razlikuje.  Esc prekida komandu preko fq:err, kao i svuda.
(defun c:FQDUZINA ( / *error* s d kabli v n uk pis k)
  (setq *error* fq:err)
  (setq s (entsel (fq:t "duz.pitaj.vlakno")))
  (setq d (if s (fq:xdget (car s)) nil))
  (if (not (and d (= (car d) "VLAKNO")))
    (princ (fq:t "opste.nije.vlakno"))
    (progn
      (setq kabli (fq:duzkabli d) uk 0)
      (if (> (length kabli) 1)
        (princ (fq:tf "duz.prolazi" (list (fq:spisak kabli ", ")))))
      (foreach k kabli
        (setq v (fq:duzuzmi (fq:vl-duz d) k))
        (setq n (getreal (fq:tf "duz.pitaj.duzina"
                                (list k (if (= v "") (fq:t "duz.nepoznata") v)))))
        (cond
          ((not n) nil)                      ; Enter -- zadrzi zatecenu
          ;; Negativna duzina bi u specifikaciji ODUZIMALA od metraze,
          ;; isto sto fq:budzet cuva kod kilometraze: pogresan unos ne
          ;; sme da da odgovor koji je LEPSI od tacnog.
          ((< n 0.0) (princ (fq:tf "duz.negativna" (list k))))
          (T
           (setq pis (rtos n 2 2)
                 uk  (+ uk 1))
           (princ (fq:tf "duz.upisano"
                         (list k pis (itoa (fq:duzsvim k pis))))))))
      (if (= uk 0) (princ (fq:t "duz.nista")))))
  (princ))


;;; ==================================================================
;;;  11. ODO ORMAR
;;;  Ram i portovi se racunaju iz snopa kabla, u koordinatnom
;;;  sistemu kabla, pa prate ugao pod kojim je kabl nacrtan.
;;; ==================================================================

(defun fq:port (u0 v num / lay)
  (setq lay "FQ_ODO")
  (fq:Wrect (- u0 *FQ-ODO-PW*) (+ v 0.377) (- u0 0.92) (- v 0.377) 7 lay)
  (fq:Wline (- u0 1.60) (+ v 0.377) (- u0 1.60) (- v 0.377) 7 lay nil)
  (fq:Wline (- u0 1.15) (+ v 0.377) (- u0 1.15) (- v 0.377) 7 lay nil)
  (fq:Wline (- u0 0.95) (+ v 0.19)  (- u0 1.14) (- v 0.19)  7 lay nil)
  (fq:Wline (- u0 1.15) v u0 v 7 lay nil)
  (fq:Wdot u0 v 0.214 7 lay)
  (fq:Wtext (- u0 1.375) v (* 0.72 *FQ-TXTH*)
            (itoa num) 7 lay "FQ_TXTB" 1 2))

;; Vlakno koje je uslo u ormar ali nije zavrsilo na portu.  Ono fizicki
;; ostaje u ormaru, smotano u kaseti, pa se crta kao kratak zavrsetak sa
;; kolutom.  Bez toga se u crtezu ne razlikuje ormar koji je primio ceo
;; snop od onog koji je primio samo prvih nekoliko vlakana.
;;
;; Crta se na lejeru ormara, ne na lejeru vlakna, i to je namerno: sve
;; sto je nacrtano ovde brise se i ponovo crta zajedno sa ramom, pa se
;; sama linija vlakna nikada ne dira.
(defun fq:visi (u0 v / lay)
  (setq lay "FQ_ODO")
  (fq:Wline (- u0 *FQ-ODO-VISU*) v u0 v 7 lay nil)
  (fq:Well (- u0 *FQ-ODO-VISU* *FQ-ODO-VISR*) v
           *FQ-ODO-VISR* *FQ-ODO-VISR* 7 lay))

;; Da li vlakno kroz kuciste samo PROLAZI, umesto da u njemu zavrsi.
;; Takvom vlaknu kolut ne treba: ono ne visi u ormaru nego ide dalje.
;;
;; Prolazi na dva nacina, i oba se vide iz same geometrije:
;;
;;   - ima teme DESNO od kolone, dakle na strani sa koje ram ne stoji.
;;     To je kabl koji iz kucista krece dalje; sva njegova vlakna idu sa
;;     njim, i ona koja nisu na konektoru.
;;   - ima teme unutar rama, ali izvan njegove visine.  To je izvod:
;;     kabl koji se odmah uz kolonu lomi i spusta nadole.
;;
;; Sve ostalo u ram ulazi sa strane i tu se zavrsava, pa visi.
;;
;; Ranije se gledalo samo da li vlakno prelazi levo od kolone.  To je
;; tacno za izvod, ali vazi i za svaki DOLAZNI kabl, jer i on u ram
;; ulazi sa leve strane, pa kolut nije dobijalo nijedno vlakno kabla
;; koji u ormar stize, a bas njima je i bio namenjen.
;;
;; OGLEDALO obrce prvi uslov, i to je jedino mesto u crtanju kucista gde
;; se znak *fq-m* pojavljuje izricito.  Ostalo se preslika samo, jer se
;; racuna u lokalnim koordinatama; ovaj uslov ne moze, jer ne pita "gde
;; je teme" nego "na kojoj strani je STRANA SA KOJE KABL DOLAZI", a to je
;; upravo ono sto ogledalo menja.
;;
;; Kod obicnog kucista kabl dolazi sa -u, pa "ide dalje" znaci iza
;; kolone, na +u.  Kod ogledalnog dolazi sa +u, pa "ide dalje" znaci iza
;; DALEKE ivice rama, na -u.  Bez te razlike bi u ogledalnom kucistu ceo
;; dolazni snop -- koji po definiciji stoji na +u -- ispao prolazan, pa
;; nijedno vlakno ne bi dobilo kolut, a bas njima je i namenjen.
(defun fq:prolaziu (e ul u0 vt vb / r)
  (setq r nil)
  (if e
    (foreach p (fq:plpts e)
      (if (if (< *fq-m* 0.0)
            (or (< (car p) (- ul 1.0))
                (and (>= (car p) (- ul 1.0))
                     (<= (car p) (+ u0 0.5))
                     (or (> (cadr p) vt) (< (cadr p) vb))))
            (or (> (car p) (+ u0 0.5))
                (and (>= (car p) (- ul 1.0))
                     (or (> (cadr p) vt) (< (cadr p) vb)))))
        (setq r T))))
  r)

;;; --- na kojoj strani kolone stoji telo kucista ---------------------
;;;
;;;  Kuciste se crta na strani -u od kolone konektora, jer kabl iz nje
;;;  izlazi na +u.  Na DRUGOM kraju kabla je obrnuto: snop dolazi sa -u i
;;;  tu se zavrsava, pa telo mora na +u.  Bez toga ram legne preko
;;;  dolaznog kabla, a elipse cevcica i natpisi vlakana zavrse unutar
;;;  rama -- to je ono sto se na crtezu vidi kao "ormar je okrenut".
;;;
;;;  Odluka se NE PITA nego se cita iz snopa, jer se iz njega i vidi.
;;;  Merilo su temena vlakana, ne njihov kraj: kraj je po definiciji na
;;;  koloni, pa o strani ne govori nista.
;;;
;;;  Tri ishoda, i sva tri postoje u crtezima:
;;;    samo +u   kuciste je na pocetku kabla     -> obicno
;;;    samo -u   kuciste je na kraju kabla       -> OGLEDALO
;;;    oba       kabl kroz kuciste PROLAZI       -> obicno
;;;
;;;  Treci nije teorijski: ceo jedan slucaj u fq:prolaziu postoji zato
;;;  sto vlakno ume da produzi na drugu stranu kolone.  Tada nijedna
;;;  strana nije prazna, ogledalo nema smisla, i ostaje zatecen izgled.
;;;
;;;  Prag je 0.5, isti kao u fq:prolaziu i iz istog razloga: teme tacno
;;;  na koloni je kraj vlakna, ne strana.
;;;
;;;  Cita se sa *fq-m* = 1.0, i to nije kozmetika.  fq:loc pod ogledalom
;;;  vraca -u, pa bi se poredjenje sa u0 obrnulo i funkcija bi vracala
;;;  tacno suprotno od tacnog -- a pri precrtavanju je *fq-m* vec
;;;  postavljen na kuciste koje se precrtava.
(defun fq:oglfl (fl ang / des lev u0)
  (fq:sistem ang nil)
  (setq des nil lev nil)
  (if (and fl (car fl) (cadr (car fl)))
    (progn
      (setq u0 (car (fq:loc (cadr (car fl)))))
      (foreach r fl
        (if (caddr r)
          (foreach p (fq:plpts (caddr r))
            (cond ((> (car p) (+ u0 0.5)) (setq des T))
                  ((< (car p) (- u0 0.5)) (setq lev T))))))))
  (and lev (not des)))

;;;  Nametnuto ogledalo, za JEDAN crtez.  nil znaci "odluci iz snopa".
;;;
;;;  Isti obrazac kao *fq-vrs*: vrednost se ne provlaci kroz potpise
;;;  nego se ostavlja crtacu.  Ovde je razlog jaci nego tamo -- put od
;;;  fq:kucspoji do crtaca ide kroz fq:kucprecrtaj i fq:kucdraw, koji
;;;  vec nose sedamnaest odnosno cetrnaest argumenata, a oba su ceo
;;;  spisak samo prosledjuju.
;;;
;;;  Kad ram VEC postoji, merodavan je on, ne snop.  Bez toga bi svako
;;;  automatsko sirenje moglo tiho da okrene zatecen ormar u kome se kabl
;;;  zavrsava -- izgled bi se popravio, ali bi se geometrija promenila
;;;  bez ijednog korisnikovog poteza, i to na kucistu koje on u toj
;;;  komandi nije ni dotakao.
(setq *fq-ogl* nil)

;; Trosi se pri prvom citanju: nametanje vazi za jedno kuciste.
;;
;; Poruka ide samo kad je ogledalo ukljuceno, i to je jedino mesto sa
;; kog se javlja.  Tri crtaca kucista zovu ovu funkciju, pa bi poruka u
;; svakom od njih bila tri mesta koja moraju da ostanu ista.
(defun fq:oglsad (fl ang / r)
  (setq r (cond ((equal *fq-ogl* "da") T)
                ((equal *fq-ogl* "ne") nil)
                (T (fq:oglfl fl ang))))
  (setq *fq-ogl* nil)
  (if r (princ (fq:t "kuc.ogledalo")))
  r)

(defun fq:drawodo (oz adr kap tip pol k st fl ang
                   / locs u0 vt vb ur ul vtop vbot ud cu i rec v pn nv)
  (fq:init)
  (fq:sistem ang (fq:oglsad fl ang))
  (setq locs   (mapcar '(lambda (r) (fq:loc (cadr r))) fl)
        u0     (car (car locs))
        vtop   (apply 'max (mapcar 'cadr locs))
        vbot   (apply 'min (mapcar 'cadr locs))
        ur     (+ u0 *FQ-ODO-DX*)
        ul     (- ur *FQ-ODO-W*)
        vt     (+ vtop *FQ-ODO-MARG*)
        vb     (- vbot *FQ-ODO-MARG*)
        ud     (+ ul *FQ-ODO-LEV*)
        cu     (* 0.5 (+ ul ur)))
  ;; Montaza ide na DVA mesta sa dva znacenja: ovde u xdata kao KOD, a
  ;; nize u ram crteza kao PRIKAZ.  Isti obrazac kao mesto nastavka u
  ;; fq:drawnast, i iz istog razloga: pol ovamo stize kao prikaz iz
  ;; fq:odoask i iz kataloga, ali i kao KOD kad FQDODAJ precrtava vec
  ;; nacrtan ormar iz njegove xdata.  Oba citaca propustaju nepoznato,
  ;; pa oba puta rade -- kao i montaza koju korisnik sam otkuca.
  (fq:xd (fq:Wrect ul vt ur vb 7 "FQ_ODO")
         (list "ODO" oz (itoa kap) (itoa k) tip
               (fq:nazkod "mnt" pol) adr st))
  (fq:Wline ud vt ud vb 7 "FQ_ODO" nil)
  (fq:Wtext cu (+ vt *FQ-ODO-TIT1*) (* 2.2 *FQ-TXTH*)
            (strcat oz " (" (itoa kap) ")") 7 "FQ_ODO" "FQ_TXTB" 1 2)
  ;; Prazna adresa se NE crta.  fq:Wtext sa "" napravi TEXT entitet koji
  ;; se ne vidi ali ga ssget hvata -- pa bi svaki ormar bez adrese nosio
  ;; jedan takav, a fq:kucbrisi bi ga posle merio kao natpis.  Pravilo je
  ;; zapisano u CLAUDE.md, ali je ovo mesto bilo bez grane.
  (if (/= adr "")
    (fq:Wtext cu (+ vt *FQ-ODO-TIT2*) (* 2.2 *FQ-TXTH*)
              adr 7 "FQ_ODO" "FQ_TXTB" 1 2))
  ;; tip je model ormara i sme da bude prazan: katalog se od verzije 1.0
  ;; isporucuje bez ijednog modela.  Bez ove grane u ormaru bi pisalo
  ;; "-48", sto lici na gresku, a nije.
  (fq:Wtext (* 0.5 (+ ul ud)) (+ vb 1.15) (* 0.70 *FQ-TXTH*)
            (if (= tip "") (itoa kap) (strcat tip "-" (itoa kap)))
            7 "FQ_ODO" "FQ_TXT" 1 2)
  (fq:Wtext (* 0.5 (+ ul ud)) (+ vb 0.55) (* 0.70 *FQ-TXTH*)
            (fq:kodnaz "mnt" pol) 7 "FQ_ODO" "FQ_TXT" 1 2)
  (setq i 1)
  (while (<= i k)
    (setq rec (nth (1- i) fl))
    (if rec
      (progn
        (setq v  (cadr (nth (1- i) locs))
              pn (- kap (1- i)))
        (fq:port u0 v pn)
        (fq:addveza (caddr rec) (strcat oz "/" (itoa pn)))))
    (setq i (1+ i)))
  ;; ostatak snopa: u ormaru je, ali ni na jednom portu.  Vlakno koje
  ;; kroz ram samo prolazi i izlazi na drugu stranu se preskace, ono ne
  ;; visi nego ide dalje.
  (setq nv 0)
  (if *FQ-ODO-VISI*
    (progn
      (setq i (1+ k))
      (while (<= i (length locs))
        (if (not (fq:prolaziu (caddr (nth (1- i) fl)) ul u0 vt vb))
          (progn (fq:visi u0 (cadr (nth (1- i) locs)))
                 (setq nv (1+ nv))))
        (setq i (1+ i)))))
  ;; Natpis u ramu je gore vec zasticen od praznog modela; ova poruka
  ;; nije bila, pa je uz prazan model glasila "OR 1 (48) -48 zidni".
  ;;
  ;; Kad modela nema, ispada CEO segment, ne samo crta: u ramu je golo
  ;; "48" natpis u svom polju i tu je na mestu, ali u recenici bi dalo
  ;; "OR 1 (48) 48 zidni" -- kapacitet dvaput, opet nalik gresci.
  ;; Montaza i ovde kroz fq:kodnaz.  Ista vrednost se pokazuje na TRI
  ;; mesta -- u xdata kao kod, u ramu i u ovoj poruci kao prikaz -- pa
  ;; sva tri moraju kroz svog prevodioca.  Prva verzija bloka 2 je
  ;; prevela ram a poruku ne, pa je u ramu pisalo "indoor" a u istoj
  ;; sekundi u komandnoj liniji "unutrasnji".
  ;; Model i montaza kroz fq:bomd, ne kao go razmak ispred: oba smeju da
  ;; budu prazna, a "ODO 1 (48) , iskorisceno" je davalo razmak pred
  ;; zarezom.  Isti razred kvara koji fq:spoj resava unutar samog para.
  (princ (fq:tf "odo.nacrtan"
                (list oz (itoa kap)
                      (fq:bomd " "
                        (fq:spoj (if (= tip "") "" (strcat tip "-" (itoa kap)))
                                 " " (fq:kodnaz "mnt" pol)))
                      ;; k sme da bude 0: ceo snop ulazi u ormar a
                      ;; nijedno vlakno jos nije na portu
                      (if (> k 0)
                        (fq:tf "odo.portovi"
                               (list (itoa k) (itoa kap)
                                     (itoa (- kap (1- k)))))
                        (fq:t "odo.portovi.nema"))
                      (fq:stnaziv st)
                      (if (> nv 0)
                        (fq:tf "odo.visi" (list (itoa nv)))
                        "")))))

(defun fq:odoask (kap / sam pc fl ang oz adr tip pol k st mnt
                        n nn p0 lc u0 v0 rows)
  (fq:init)
  ;; Naziv elementa je UMETAK: isto pitanje postavlja i ODF, pa bi dve
  ;; recenice bile dva mesta koja moraju da ostanu iste.  Kabl je prvi
  ;; token, dakle podrazumevan, pa sam je T samo za Samostalno.
  (setq sam (fq:dvatok "opste.tok.kabl" "opste.tok.samostalno"
                       "opste.pitaj.kaci" (list (fq:t "odo.naziv"))))
  (if (and (not sam)
           (not (setq pc (fq:pickcable (fq:t "odo.pitaj.vlakno")))))
    (princ (fq:t "opste.otkazano"))
    (progn
      (if sam
        (setq ang *fq-ugao* fl nil n nil)
        (setq fl (cadr pc) ang (caddr pc) n (length fl)))
      ;; trim iz istog razloga kao u fq:kucoz: sam razmak nije prazno
      ;; polje, pa bi ormar dobio oznaku koju brojac posle ne prepoznaje
      (setq oz (fq:trim (getstring T (fq:t "odo.pitaj.oznaka"))))
      ;; Prefiks kroz fq:vrpre, ne zakucan.  Ovo i fq:kucoz su DVA mesta
      ;; koja prave oznaku ormara; da se razidju, FQODO i FQKUC bi u
      ;; istom crtezu i na istom jeziku pravili dve numeracije.
      (if (= oz "") (setq oz (fq:next (fq:vrpre "ODO"))))
      (setq adr (getstring T (fq:t "odo.pitaj.adresa")))
      (if (not kap)
        (if (not (setq kap (getint (fq:t "odo.pitaj.kapacitet")))) (setq kap 48)))
      ;; Bez podrazumevanog proizvodjaca.  Prazan odgovor znaci "ne
      ;; upisuj model", a ne "upisi onaj koji je nekome bio prvi pri
      ;; ruci" -- crtez ne sme da tvrdi cija je oprema ako niko to nije
      ;; rekao.  fq:drawodo zna da radi sa praznim modelom.
      (setq tip (getstring T (fq:t "odo.pitaj.model")))
      ;; Ormar bira samo izmedju dve montaze, iako domen "mnt" ima jos
      ;; tri.  Zid, stub i samostojeci stizu iz kataloga kucista i ovde
      ;; se ne nude -- zato podskup kodova, a ne cela domena.
      (setq mnt (fq:tokovi "mnt" (list *FQ-ODO-UNU* *FQ-ODO-SPO*)))
      (initget (fq:spisak mnt " "))
      (setq pol (getkword (fq:tf "odo.pitaj.montaza"
                                 (list (fq:spisak mnt "/")
                                       (substr (fq:f 0 mnt) 1 1)))))
      ;; Vec je KOD, jer *FQ-ODO-UNU* i *FQ-ODO-SPO* to od bloka 3 i
      ;; jesu.  fq:nazkod je ipak tu: token je ono sto se kuca, a kod ono
      ;; sto ide u xdata, i ta dva su ista samo kod ove dve vrednosti.
      (setq pol (if pol (fq:nazkod "mnt" pol) *FQ-ODO-UNU*))
      (setq nn (min (if n n kap) kap))
      (if (not (setq k (getint (fq:tf "odo.pitaj.portovi" (list (itoa (min 6 nn)))))))
        (setq k (min 6 nn)))
      (setq k (min k nn))
      (setq st (fq:askst))
      (if (not sam)
        (fq:drawodo oz adr kap tip pol k st fl ang)
        (progn
          (setq nn   (fq:strukt k)
                rows (fq:redovi (car nn) (cadr nn) 0.0 nil)
                p0   (fq:pickbox (fq:t "odo.pitaj.tacka") (fq:prvih rows k)
                                 *FQ-ODO-W* *FQ-ODO-DX* ang *FQ-ODO-MARG*))
          (if (not p0)
            (princ (fq:t "opste.otkazano"))
            (progn
              (setq *fq-a* (fq:deg ang)
                    lc     (fq:loc p0)
                    u0     (car lc)
                    v0     (cadr lc)
                    fl     (fq:virtfl u0 v0 (car nn) (cadr nn) k ang)
                    rows   (fq:redovi (car nn) (cadr nn) v0 nil))
              (fq:drawodo oz adr kap tip pol k st fl ang)
              (setq *fq-por* (list v0 ang rows u0))
              (princ (fq:tf "odo.poravnanje" (list oz)))
              (princ (fq:tf "odo.sledeci" (list (itoa (car nn)) (itoa (cadr nn)))))
              (princ (fq:t "opste.poravnanje.ponisti")))))))))

(defun c:FQODO ( / *error* )
  (setq *error* fq:err) (fq:odoask nil) (princ))
(defun fq:podo (kap)  (fq:odoask kap) (princ))


;;; ==================================================================
;;;  12. ODF MODUL
;;; ==================================================================

;;  LEJER JE ARGUMENT, ne konstanta u telu.  Do 1.0.0 je bio zakucan na
;;  "FQ_ODF", pa je legenda -- jedini pozivalac koji nije razdelnik --
;;  svoje konektore ostavljala na tudjem lejeru.  To nije kozmetika:
;;  fq:kucbrisi bira SVE entitete sa *FQ-KUC-LEJERI* bez ijednog xdata
;;  filtera i brise ono sto celo padne u prozor precrtavanja, pa je
;;  legenda nacrtana pored ormara tiho ostajala bez konektora.
;;
;;  ZOK i dalje predaje "FQ_ODF", isto kao pre.  To lici na previd i
;;  moglo bi da bude "FQ_ZOK", ali bi ta promena pomerila kutiju u
;;  odnosu na fq:kucbrisi i fq:snapmete u istoj izmeni u kojoj se
;;  popravlja legenda -- dve stvari odjednom.  Brojeve konektora ZOK
;;  kutije ionako crta pozivalac, i to vec na "FQ_ZOK".
(defun fq:kon (u0 v s lay / a b c)
  (setq a   (* 2.110 s)
        b   (* 1.602 s)
        c   (* 0.508 s))
  (fq:Wpl (list (list (- u0 a) (- v c))
                (list (- u0 b) (- v c))
                (list (- u0 b) (+ v c))
                (list (- u0 a) (+ v c)))
          7 lay nil)
  (fq:Wline (- u0 a) v u0 v 7 lay nil)
  (fq:Wline (- u0 (* 1.729 s)) (+ v (* 0.254 s))
            (- u0 (* 1.983 s)) (- v (* 0.254 s)) 7 lay nil)
  (fq:Wdot (- u0 (* 0.666 s)) v (* 0.286 s) 7 lay))

;;  Sirina rama razdelnika -- JEDNA mera za crtaca i za pregled.
;;
;;  Leva pregrada mora da primi najduzu oznaku modula, da bi svi moduli
;;  jednog razdelnika ispali iste sirine; desna kolona je uvek
;;  *FQ-ODF-DESNO*.  fq:odfsir vraca levu pregradu (po njoj ide crta ud
;;  izmedju pregrade i kolone konektora), fq:odfw punu sirinu rama --
;;  tacno ono sto fq:boxvecs ocekuje kao w, jer on racuna ul = dx - w.
;;
;;  Do 23.08.2026 je racun stajao na DVA mesta i ni na jednom kao
;;  funkcija: ovde, ugradjen u fq:drawodf, i u obliku za vise modula u
;;  fq:odfsir iz fq-kucista.lsp.  Pregled je zato predavao golo
;;  *FQ-ODF-DESNO*, dakle samo desnu kolonu: silueta je bila uza za celu
;;  levu pregradu (5.80 naspram 11.60 do 16), pa se kuciste spustalo
;;  preko levog suseda a da se pri pokazivanju nista ne vidi.  Mera zato
;;  zivi ovde, u fajlu sa svojim konstantama, i zovu je oba crtaca
;;  (fq:drawodf, fq:drawodfn) i oba pregleda (fq:odfask, fq:kucpost).
;;
;;  s u foreach se namerno ne deklarise: foreach sam vezuje svoju
;;  promenljivu (mereno u AutoCAD Map 3D 2021).  Vazi za fq:odfsir; ona
;;  ispod nema ni petlju ni lokalnu.
(defun fq:odfsir (lms / lw)
  (setq lw *FQ-ODF-DESNO*)
  (foreach s lms
    (setq lw (max lw (+ (fq:txtw s *FQ-ODF-TITH* "FQ_TXTB")
                        (* 2.0 *FQ-ODF-PAD*)))))
  lw)

;;  Puna sirina: leva pregrada plus desna kolona.  To je ono sto
;;  fq:boxvecs ocekuje kao w, jer on racuna ul = dx - w.
;;
;;  Jednomodulni razdelnik (fq:drawodf, fq:odfask) predaje (list lm), a
;;  visemodulni (fq:drawodfn, fq:kucpost) (fq:odflms lm nm).  Danas su
;;  te dve formule za nm = 1 jednake u svakoj grani fq:lmmod, ali to je
;;  POSLEDICA tekuceg fq:odflms, ne garancija: ko u nju doda pravilo --
;;  na primer da prvi modul uvek nosi ", M1" -- FQODF i FQPP se tiho
;;  razidju po sirini.  Ako se to desi, i jednomodulni put mora da ide
;;  kroz fq:odflms; fq:odflms i fq:lmmod su cist rad nad niskama i mogu
;;  da se presele ovamo bez ijedne zavisnosti.
(defun fq:odfw (lms) (+ (fq:odfsir lms) *FQ-ODF-DESNO*))

(defun fq:drawodf (oz mod lm kap k kon st fl ang
                   / locs u0 vtop vbot ur ul ud vt vb cu w i rec v kn)
  (fq:init)
  (fq:sistem ang (fq:oglsad fl ang))
  (setq locs   (mapcar '(lambda (r) (fq:loc (cadr r))) fl)
        u0     (car (car locs))
        vtop   (apply 'max (mapcar 'cadr locs))
        vbot   (apply 'min (mapcar 'cadr locs))
        ;;  Puna sirina rama kroz fq:odfw -- ISTA funkcija koju fq:odfask
        ;;  predaje fq:pickbox-u.  Dok je racun leve pregrade stajao ovde,
        ;;  pregled od njega nije znao nista i pokazivao je samo desnu
        ;;  kolonu.  FQODF ima tacno jedan modul, pa lista od jedne oznake.
        w      (fq:odfw (list lm))
        ur     (+ u0 *FQ-ODF-DX*)
        ud     (- ur *FQ-ODF-DESNO*)
        ;;  ul se meri od DESNE ivice, kao u fq:boxvecs (ul = dx - w).
        ;;  Preko ud je izlazio isti broj, ali druga formula -- i bas ta
        ;;  razlika je sakrila da pregled uzima samo desnu kolonu.
        ul     (- ur w)
        vt     (+ vtop *FQ-ODF-MARG*)
        vb     (- vbot *FQ-ODF-MARG*)
        cu     (* 0.5 (+ ul ur)))
  (fq:xd (fq:Wrect ul vt ur vb 7 "FQ_ODF")
         (list "ODF" oz mod (itoa kap) (itoa k) kon lm st))
  (fq:Wline ud vt ud vb 7 "FQ_ODF" nil)
  (fq:Wtext cu (+ vt *FQ-ODF-TIT1*) *FQ-ODF-TITH*
            (strcat *FQ-ODF-PRE* oz) 7 "FQ_ODF" "FQ_TXTB" 1 2)
  (fq:Wtext cu (+ vt *FQ-ODF-TIT2*) *FQ-ODF-TITH*
            mod 7 "FQ_ODF" "FQ_TXTB" 1 2)
  ;; Prazna oznaka letve se ne crta, isto kao u fq:odfmod: fq:Wtext bi i
  ;; za "" napravio TEXT entitet koji se ne vidi ali ga ssget hvata.
  (if (/= lm "")
    (fq:Wtext (* 0.5 (+ ul ud)) (* 0.5 (+ vt vb)) *FQ-ODF-TITH*
              lm 7 "FQ_ODF" "FQ_TXTB" 1 2))
  (setq i 1)
  (while (<= i k)
    (setq rec (nth (1- i) fl))
    (if rec
      (progn
        (setq v  (cadr (nth (1- i) locs))
              kn (car rec))
        (fq:kon u0 v *FQ-ODF-KS* "FQ_ODF")
        (fq:Wtext (- u0 *FQ-ODF-NUMX*) v *FQ-ODF-NUMH*
                  (itoa kn) 7 "FQ_ODF" "FQ_TXT" 2 2)
        ;; fq:spoj, ne go strcat -- vidi fq:kucvez, koji ovaj isti zapis
        ;; posle cita nazad.  Za nepraznu oznaku rezultat je isti kao pre.
        (fq:addveza (caddr rec) (strcat (fq:spoj oz " " lm) "/" (itoa kn)))))
    (setq i (1+ i)))
  ;; Model kroz fq:bomd: prazan je davao "ODF 1  L1, M1  , iskorisceno",
  ;; razmak pred zarezom -- isti razred kvara kao u fq:drawodo.
  (princ (fq:tf "odf.nacrtan"
                (list oz lm (fq:bomd "  " mod)
                      (itoa k) (itoa kap) (fq:stnaziv st)))))

(defun fq:odfask (kap / sam pc fl ang n oz mod lm k kon st
                        nn p0 lc u0 v0 rows)
  (fq:init)
  (setq sam (fq:dvatok "opste.tok.kabl" "opste.tok.samostalno"
                       "opste.pitaj.kaci" (list (fq:t "odf.naziv"))))
  (if (and (not sam)
           (not (setq pc (fq:pickcable (fq:t "odf.pitaj.vlakno")))))
    (princ (fq:t "opste.otkazano"))
    (progn
      (if sam
        (setq ang *fq-ugao* fl nil n nil)
        (setq fl (cadr pc) ang (caddr pc) n (length fl)))
      (if (not kap)
        (if (not (setq kap (getint (fq:tf "odf.pitaj.kapacitet" (list (itoa (if n n 48)))))))
          (setq kap (if n n 48))))
      (setq oz (getstring T (fq:t "odf.pitaj.objekat")))
      (if (= oz "") (setq oz "NAZIV"))
      (setq kon (getstring T (fq:tf "odf.pitaj.konektor" (list *FQ-ODF-KON*))))
      (if (= kon "") (setq kon *FQ-ODF-KON*))
      (setq mod (getstring T (fq:tf "odf.pitaj.model" (list (itoa kap) kon))))
      (if (= mod "") (setq mod (strcat "ODF 19\" " (itoa kap) "x" kon)))
      ;; Prazno je dozvoljen odgovor i ostaje prazno.  Ranije je Enter
      ;; upisivao "L1, M1" -- oznaku letve koju niko nije izabrao.
      (setq lm (getstring T (fq:t "odf.pitaj.letva")))
      (setq nn (if n (min n kap) kap))
      (if (not (setq k (getint (fq:tf "odf.pitaj.konektori" (list (itoa nn))))))
        (setq k nn))
      (setq k (min k nn))
      (setq st (fq:askst))
      (if (not sam)
        (fq:drawodf oz mod lm kap k kon st fl ang)
        (progn
          ;; raspored buducih vlakana, pa pregled i tacka prvog konektora
          (setq nn   (fq:strukt k)
                rows (fq:redovi (car nn) (cadr nn) 0.0 nil)
                p0   (fq:pickbox (fq:t "odf.pitaj.tacka")
                                 (fq:prvih rows k)
                                 ;; Puna sirina rama, ne samo desna
                                 ;; kolona: fq:boxvecs racuna ul = dx - w,
                                 ;; pa golo *FQ-ODF-DESNO* daje siluetu
                                 ;; uzu za celu levu pregradu.  lm je vec
                                 ;; procitan (odf.pitaj.letva) i odavde
                                 ;; nepromenjen ide u fq:drawodf.
                                 (fq:odfw (list lm)) *FQ-ODF-DX* ang
                                 *FQ-ODF-MARG*))
          (if (not p0)
            (princ (fq:t "opste.otkazano"))
            (progn
              (setq *fq-a* (fq:deg ang)
                    lc     (fq:loc p0)
                    u0     (car lc)
                    v0     (cadr lc)
                    fl     (fq:virtfl u0 v0 (car nn) (cadr nn) k ang)
                    rows   (fq:redovi (car nn) (cadr nn) v0 nil))
              (fq:drawodf oz mod lm kap k kon st fl ang)
              (setq *fq-por* (list v0 ang rows u0))
              (princ (fq:tf "odf.poravnanje" (list oz)))
              (princ (fq:tf "odf.sledeci" (list (itoa (car nn)) (itoa (cadr nn)))))
              (princ (fq:t "opste.poravnanje.ponisti")))))))))

(defun c:FQODF ( / *error* )
  (setq *error* fq:err) (fq:odfask nil) (princ))
(defun fq:podf (kap)  (fq:odfask kap) (princ))


;;; ==================================================================
;;;  13. NASTAVAK
;;;
;;;  Vezuje se za kabl, isto kao ODO i ODF. Ram obuhvata snop vlakana,
;;;  levu i desnu ivicu pokazuje projektant. Iznad rama idu oznaka pa
;;;  mesto pod njom.
;;;  Tip N je obican nastavak, NL je latentni.
;;;  U podatke se upisuje raspon rama, pa spajanje zna gde mu je sredina.
;;; ==================================================================

(defun fq:drawnast (oz tip lok br ul ur st fl ang
                    / vs vtop vbot vt vb cu mesto unutra)
  (fq:init)
  (setq *fq-a* (fq:deg ang)
        cu     (* 0.5 (+ ul ur)))
  ;;  Pojas snopa se meri na LEVOJ IVICI rama, na istoj koordinati na
  ;;  kojoj ga je merio i pregled -- pravilo parnosti.  Sredina bi bila
  ;;  primamljivija, ali ram koji predje prelom ima sredinu na drugoj
  ;;  deonici nego levu ivicu, pa bi se nacrtano i pokazano razisli bas
  ;;  u slucaju zbog kog je sve ovo i radjeno.
  ;;
  ;;  Do 22.08.2026 je ovde stajalo (fq:loc (cadr r)) -- KRAJ vlakna --
  ;;  pa je kod kabla sa lomovima ram bio ogroman i zakacen za pogresnu
  ;;  deonicu.  Vidi napomenu uz fq:vopseg.
  (setq vs (fq:vopseg fl ul))
  (if (not vs)
    (setq vs (mapcar '(lambda (r) (cadr (fq:loc (cadr r)))) fl)))
  (setq vtop   (apply 'max vs)
        vbot   (apply 'min vs)
        vt     (+ vtop *FQ-NAST-MARG*)
        vb     (- vbot *FQ-NAST-MARG*)
        ;; Ista vrednost ide na DVA mesta sa dva znacenja: u xdata kao
        ;; KOD (nize), a u ram crteza kao PRIKAZ (ovde).  Ako se promeni
        ;; samo jedno, u ramu pise "lkManhole 12" ili se specifikacija
        ;; grupise po prikazu.
        ;;
        ;; Preslikavanje mora da stoji U CRTACU, ne kod pozivaoca:
        ;; lok ovamo stize kao prikaz iz dijaloga, ali sme da stigne i
        ;; kao kod ako se ikad doda precrtavanje iz xdata.  Oba citaca
        ;; propustaju nepoznato, pa oba slucaja rade -- kao i "u
        ;; podrumu" koje korisnik otkuca u -FQNASTAVAK.
        mesto  (fq:na-mesto (fq:kodnaz "lok" lok) br))
  ;; Polja 3 do 6 su samo snimak rama u trenutku crtanja, za uvid.
  ;; Merodavna je geometrija rama, vidi fq:ramnast.
  (fq:xd (fq:Wrect ul vt ur vb 7 "FQ_NASTAVAK")
         (list "NASTAVAK" oz tip
               (rtos ul 2 4) (rtos ur 2 4)
               (rtos vt 2 4) (rtos vb 2 4)
               (itoa ang) st (fq:nazkod "lok" lok) br))
  (fq:Wtext cu (+ vt *FQ-NAST-TIT*) (* 2.0 *FQ-TXTH*)
            oz 1 "FQ_NASTAVAK" "FQ_TXTB" 1 2)
  ;; Mesto ide odmah pod oznaku, iznad rama.  Dno rama se spusta kad iz
  ;; nastavka izadje izvod, gornja ivica nikad, pa je natpis ovde uvek
  ;; uz oznaku.  Prazno se ne crta, pa nastavak bez podatka izgleda
  ;; tacno kao ranije.
  (if (/= mesto "")
    (fq:Wtext cu (+ vt *FQ-NAST-LOKH*) (* 1.2 *FQ-TXTH*)
              mesto 7 "FQ_NASTAVAK" "FQ_TXT" 1 2))
  (princ (fq:tf "nast.nacrtan" (list oz tip (rtos (- ur ul) 2 2) (fq:bomd ", " mesto) (fq:stnaziv st))))
  ;; Prijava ide ODMAH, dok je korisnik jos u komandi i dok mu je
  ;; najlakse da ivicu povuce blize kraju kabla.  Vidi fq:nastunutra.
  (setq unutra (fq:nastunutra ul ur vt vb))
  (if (> unutra 0)
    (princ (fq:tf "nast.natpisi.unutra" (list oz (itoa unutra))))))

;; Ram nastavka, procitan iz SAME GEOMETRIJE rama, ne iz podataka.
;; Ram je zatvorena polilinija sa cetiri temena, pa se ul, ur, vt i vb
;; dobijaju kao min i max njegovih temena u sistemu kabla.
;; Zbog toga MOVE i STRETCH nad ramom rade sami od sebe. Da se cita
;; iz XDATA, pomeren ram bi i dalje nosio stare brojeve i splajsevi
;; bi tiho padali na pogresno mesto.
;; Vraca (ul ur vt vb) ili nil ako entitet nema temena.
(defun fq:ramnast (e / pts us vs)
  (setq pts (fq:plpts e))
  (if (< (length pts) 2)
    nil
    (progn
      (setq us (mapcar 'car pts)
            vs (mapcar 'cadr pts))
      (list (apply 'min us) (apply 'max us)
            (apply 'max vs) (apply 'min vs)))))

;;; --- ram nastavka se siri --------------------------------------
;;;
;;;  Dva posla dolaze ovamo, i oba iz istog razloga:
;;;
;;;    izvod iz nastavka  dodaje snop ISPOD svega sto je u ramu, a drugi
;;;                       izvod jos i LEVO od prvog, da mu se uspravne
;;;                       linije ne poklope
;;;    nov kabl na kraju  donosi ceo svoj snop, po pravilu veceg
;;;                       kapaciteta od zatecenog -- 48 vlakana u ramu,
;;;                       96 u novom kablu
;;;
;;;  Kuciste se u toj situaciji precrtava iz spiska vlakana, ali
;;;  nastavak nema sta da precrtava: ram je obican pravougaonik koji je
;;;  projektant povukao rukom.  Zato se ne brise nego mu se pomere
;;;  ivice, a natpisi idu za njima.
;;;
;;;  Ivica se pomera samo NAVEN.  Ram se nikad ne skuplja, i to je
;;;  jedini razlog sto zateceni crtezi ovo prezive: skupljanje bi
;;;  odseklo snop koji je vec u ramu, a niko ga ne bi vratio.

;; Natpisi nastavka nemaju svoj zapis, pa se traze po lejeru i mestu:
;; oznaka i mesto stoje iznad gornje ivice, po sredini rama.  Vodoravno
;; idu za sredinom rama, uspravno za onom ivicom uz koju stoje.
;; Vraca koliko ih je pomereno.
;; Natpisi se traze po TACNOM mestu na koje ih fq:drawnast i postavlja:
;; po sredini rama, oznaka *FQ-NAST-TIT* iznad gornje ivice, mesto
;; *FQ-NAST-LOKH* iznad nje.  Sirok pojas ovde ne valja — dva
;; nastavka jedan iznad drugog stoje blizu, pa se lako pokupi tudji
;; natpis i odvuce u stranu.
;;
;; Crtezi nacrtani ranijim verzijama nose oznaku nize (*FQ-NAST-TIT0*),
;; a mesto ISPOD rama; ta dva mesta se i dalje prepoznaju, da stariji
;; nastavak ne ostane sa natpisima na starom mestu kad ram naraste.
;; Staro mesto prati dno, sva ostala gornju ivicu.
;;
;; dvt je pomeraj GORNJE ivice, dvb DONJE.  Do sirenja za nov kabl je
;; gornja stajala u mestu pa je ovde bila nula; nov kabl sme da izadje i
;; iznad rama, i tada natpisi moraju da idu s njom -- inace oznaka
;; nastavka zavrsi unutar rama, preko snopa.
;;
;; Natpisi su poravnati po sredini, pa se cita fq:txtpt a ne grupa 10:
;; nju je AutoCAD prepisao na donji levi ugao ispisa, pa se natpis po
;; njoj promasi za pola svoje sirine i nikad se ne bi ni nasao.
(defun fq:nasttekst (ul ur vt vb du dvt dvb / ss i e lc cu n)
  (setq ss (fq:ssx '((0 . "TEXT") (8 . "FQ_NASTAVAK")))
        i  0
        n  0
        cu (* 0.5 (+ ul ur)))
  (if ss
    (while (< i (sslength ss))
      (setq e  (ssname ss i)
            lc (fq:loc (fq:txtpt (entget e))))
      (if (< (abs (- (car lc) cu)) 0.5)
        (cond
          ((or (< (abs (- (cadr lc) (+ vt *FQ-NAST-TIT*)))  0.25)
               (< (abs (- (cadr lc) (+ vt *FQ-NAST-TIT0*))) 0.25)
               (< (abs (- (cadr lc) (+ vt *FQ-NAST-LOKH*))) 0.25))
           (fq:txtpom e du dvt) (setq n (1+ n)))
          ((< (abs (- (cadr lc) (- vb *FQ-NAST-LOKH*))) 0.25)
           (fq:txtpom e du dvb) (setq n (1+ n)))))
      (setq i (1+ i))))
  n)

;; Pomeri ivice rama na zadate vrednosti, ali samo NAVEN: ram se nikad
;; ne skuplja.  Svaka od cetiri sme da bude nil i tada se ne dira.
;; Vraca T ako je ram promenjen.
;;
;;  Do sirenja za nov kabl su ovde bile samo leva i donja ivica, jer je
;;  izvod jedini pozivalac i uvek ide dole-levo.  Nov kabl sme da dodje
;;  sa bilo koje strane i sa vise vlakana nego sto ih je u ramu, pa mu
;;  treba i desna i gornja.  Cetvrta ivica nije visak: kraj koji se nije
;;  dao uvesti u ram (uspravan je) ostaje van njega, i tada ram mora da
;;  dodje do njega -- vidi fq:nastsiriend.
(defun fq:nastsiri (e ulnew urnew vtnew vbnew
                    / pts uu vv ul ur vt vb nul nur nvt nvb du dvt dvb novi)
  (setq pts (fq:plpts e)
        uu  (mapcar 'car  pts)
        vv  (mapcar 'cadr pts)
        ul  (apply 'min uu)  ur (apply 'max uu)
        vt  (apply 'max vv)  vb (apply 'min vv)
        nul (if ulnew (min ul ulnew) ul)
        nur (if urnew (max ur urnew) ur)
        nvt (if vtnew (max vt vtnew) vt)
        nvb (if vbnew (min vb vbnew) vb))
  (if (and (< (abs (- nul ul)) 0.01) (< (abs (- nur ur)) 0.01)
           (< (abs (- nvt vt)) 0.01) (< (abs (- nvb vb)) 0.01))
    nil
    (progn
      (setq novi (mapcar
                   '(lambda (p)
                      (list (cond ((< (abs (- (car  p) ul)) 0.01) nul)
                                  ((< (abs (- (car  p) ur)) 0.01) nur)
                                  (T (car p)))
                            (cond ((< (abs (- (cadr p) vb)) 0.01) nvb)
                                  ((< (abs (- (cadr p) vt)) 0.01) nvt)
                                  (T (cadr p)))))
                   pts))
      (fq:plsetpts e novi)
      ;; natpisi stoje po sredini rama, pa prate pomeranje SREDINE, a
      ;; ne jedne ivice: kad se pomere obe, pola zbira je jedino tacno
      (setq du  (- (* 0.5 (+ nul nur)) (* 0.5 (+ ul ur)))
            dvt (- nvt vt)
            dvb (- nvb vb))
      (fq:nasttekst ul ur vt vb du dvt dvb)
      T)))


;;; --- nov kabl na kraju nastavka -----------------------------------
;;;
;;;  Nastavak stoji na kraju kabla, i posle FQPORAVNAJ se sa DRUGE
;;;  strane polaze nov kabl, po pravilu veceg kapaciteta.  Do 1.0.0 se
;;;  tu nije desavalo nista: fq:kablsiri je trazio samo kucista, pa je
;;;  ram ostajao onakav kakav je bio, snop je virio ispod njega, a
;;;  vlakna su ili prolazila kroz ram ili visila pored njega.
;;;
;;;  Posao je podeljen na dva mesta u toku komande, i podela nije
;;;  proizvoljna:
;;;
;;;    PRE crtanja   pocetak kabla se pomeri na ivicu rama
;;;                  (fq:nastuvod).  Tek tako elipse cevcica, nazivi
;;;                  vlakana i naziv kabla nastanu VAN rama.  Da se
;;;                  pomera posle crtanja, vlakno bi se skratilo a
;;;                  natpisi bi ostali tamo gde su nacrtani -- kroz ram
;;;                  bi i dalje prolazile boje cevcica i naziv kabla, a
;;;                  to je i bila prijava zbog koje je ovo radjeno.
;;;
;;;    POSLE crtanja ram se prosiri po snopu i vlakna koja jos ne
;;;                  dosezu do njega se uvedu (fq:nastsiriend).  Tek
;;;                  tada se zna gde su vlakna stvarno zavrsila.
;;;
;;;  Kraj kabla se posle crtanja pomera najvise za fq:nastdomet, jer se
;;;  natpisi tada vise ne crtaju ponovo.  Pocetak pre crtanja nema to
;;;  ogranicenje: tamo se pomera CEO kabl, natpisi zajedno sa njim.

;; Koliko vlakno ulazi u ram nastavka.
;;
;;  Nije nova mera.  *FQ-PRS-ULAZ* je vec pravilo celog projekta --
;;  "svaki kraj vlakna se prekida *FQ-PRS-ULAZ* unutar svoje ivice
;;  rama" (vidi fq:kutza) -- pa nov kabl ulazi tacno onoliko koliko i
;;  krak koji je u tom istom nastavku presecen.  Sabijanje za uzak ram
;;  je isto: kraj nikad ne prelazi sredinu, pa se i u ramu sirine
;;  *FQ-NAST-MINW* vidi da vlakno u njega ULAZI a ne kroz njega prolazi.
(defun fq:nastulaz (ul ur) (min *FQ-PRS-ULAZ* (* 0.5 (- ur ul))))

;; Dokle sme da se pomeri kraj VEC NACRTANOG vlakna.
;;
;;  Elipsa cevcice je uvucena *FQ-CEVIN* od kraja i siroka *FQ-CEVRU* u
;;  polupreciku, pa je gola duzina vlakna pred njom tacno tolika.
;;  Pomeri li se kraj vise od toga, elipsa ostane iza novog kraja i visi
;;  u praznom: natpisi se ne crtaju ponovo, oni stoje tamo gde ih je
;;  fq:drawkabl ostavio.  Ista mera vazi i za promasaj pored rama --
;;  kraj koji je dalje od toga nije promasen nego je tamo gde jeste.
(defun fq:nastdomet () (- *FQ-CEVIN* *FQ-CEVRU*))

;; Koliko oznaka cevcica je ostalo UNUTAR rama.
;;
;;  Broji se elipsa cevcice, jer je ona jedini natpis kraja kabla koji
;;  ima svoju geometriju i svoj lejer; nazivi vlakana i naziv kabla stoje
;;  uz nju i dele njenu sudbinu, pa je dovoljno prebrojati nju.
;;
;;  Ram nastavka projektant povlaci rukom i sme da bude sirok nekoliko
;;  desetina jedinica.  Prodje li mu ivica preko kraja kabla za vise nego
;;  sto je natpis dugacak (*FQ-CEVIN* + *FQ-CEVRU* + *FQ-TXTDX* pa jos
;;  sirina teksta), kroz ram prolaze boje cevcica i nazivi vlakana i sema
;;  se tu ne cita.  Geometrija to ne moze da popravi: natpisi stoje na
;;  apsolutnim tackama i skracivanje vlakna ih ne pomera, a ram se ne sme
;;  skupljati.  Zato se samo prijavljuje, dok je korisnik jos tu.
;;
;;  KUCISTE ovo ne moze da ima, i to nije slucajno: njegov ram se
;;  PRECRTAVA iz spiska vlakana, a kolona konektora stoji fq:kucdx
;;  (0.50 do 1.00) od desne ivice, pa natpisi uvek ispadnu izvan rama.
;;  Jedini ram koji korisnik crta rukom je ram nastavka.
(defun fq:nastunutra (ul ur vt vb / ss i e p n)
  (setq ss (fq:ssx '((0 . "ELLIPSE") (8 . "FQ_CEVCICA")))
        i  0
        n  0)
  (if ss
    (while (< i (sslength ss))
      (setq e (ssname ss i)
            p (fq:loc (cdr (assoc 10 (entget e)))))
      (if (and (> (car p) ul) (< (car p) ur)
               (> (cadr p) vb) (< (cadr p) vt))
        (setq n (1+ n)))
      (setq i (1+ i))))
  n)

;; Nastavak na cijem ramu stoji kraj kabla, ili nil.
;;
;;  Merilo je isto koje kuciste koristi u fq:kucnakraju: red PRVOG
;;  vlakna mora da upadne u raspon rama po visini.  Duz kabla je
;;  dozvoljen promasaj do fq:nastdomet -- toliko se kraj i sme pomeriti.
;;  Klik UNUTAR rama uvek prolazi, koliko god ram bio sirok: nastavak je
;;  cesto sirok nekoliko desetina jedinica i tada se ne pogadja ivica
;;  nego se klikne na sam ram.
;;
;;  Ugao nastavka NE mora da se poklopi sa uglom kabla, samo da se od
;;  njega razlikuje za umnozak od 90.  Uspravan kabl iz vodoravnog
;;  nastavka je stvaran slucaj -- kabl skrece iz okna nadole -- i plan
;;  ga izricito trazi ("bez obzira dolazi li kabl vodoravno ili
;;  uspravno").  Merilo je jedino da li se ram u sistemu kabla i dalje
;;  cita TACNO: fq:ramnast uzima min i max temena, pa za pravougaonik
;;  okrenut za 90 daje bas njegove ivice, a za bilo koji drugi ugao daje
;;  okvir oko njega i sva cetiri broja su izmisljena.  Zato ostaje uslov
;;  na umnozak od 90, a ne puko poklapanje.
;;
;;  Ugao se provlaci kroz fq:uvek pa fq:stepen iz istog razloga iz kog to
;;  radi i fq:kucspoji: bez toga bi -90 i 270 bili razliciti brojevi, a
;;  to je isti pravac.
;;
;;  *fq-a* POSTAVLJA POZIVALAC, isto kao kod fq:najnast i fq:kucnakraju:
;;  ram se cita u sistemu kabla, a ne u svom.
(defun fq:nastnakraju (u v ang / ss i e d g ca du best bd)
  (setq ss (fq:ssx '((8 . "FQ_NASTAVAK") (-3 ("FIBERQ"))))
        i  0
        ca (fq:stepen (fq:uvek ang))
        best nil
        bd   nil)
  (if ss
    (while (< i (sslength ss))
      (setq e (ssname ss i)
            d (fq:xdget e))
      (if (and d (= (car d) "NASTAVAK")
               (= 0 (rem (abs (- (fq:na-ang d) ca)) 90))
               (setq g (fq:ramnast e)))
        (progn
          (setq du (cond ((< u (nth 0 g)) (- (nth 0 g) u))
                         ((> u (nth 1 g)) (- u (nth 1 g)))
                         (T 0.0)))
          (if (and (<= v (+ (nth 2 g) 0.01))
                   (>= v (- (nth 3 g) 0.01))
                   (<= du (fq:nastdomet))
                   (or (not bd) (< du bd)))
            (setq bd du best e))))
      (setq i (1+ i))))
  best)

;; Pocetak kabla, uvucen u ram nastavka ako kabl bas odatle krece.
;;
;;  Vraca tacku UVEK -- kada nastavka nema, onu koja je i dosla.  Zove
;;  se odmah po pokazivanju tacke, pre nego sto se izracuna duzina ili
;;  klikne putanja, pa ceo kabl nastane na pravom mestu: i vlakna, i
;;  elipse cevcica, i natpisi.
;;
;;  Poravnanje sa KUCISTA se ne dira: tamo je polozaj duz kabla vec
;;  odredjen kolonom konektora i tacka se uopste ne pokazuje.  Nastavak
;;  kolonu nema, pa fq:porram za njega vraca cetvrti clan nil i bas zato
;;  se ovde ima sta da uradi.
(defun fq:nastuvod (p0 ang / lc u0 v0 e g us)
  (fq:sistem ang nil)
  (setq lc     (fq:loc p0)
        u0     (car lc)
        v0     (cadr lc))
  (if (and *FQ-SIRI*
           (not (and *fq-por* (cadddr *fq-por*)))
           (setq e (fq:nastnakraju u0 v0 ang))
           (setq g (fq:ramnast e)))
    (progn
      (setq us (- (nth 1 g) (fq:nastulaz (nth 0 g) (nth 1 g))))
      (if (< (abs (- us u0)) 1e-6)
        p0
        (progn
          (princ (fq:tf "nast.kabl.uvod"
                        (list (fq:na-oz (fq:xdget e)) (rtos (- us u0) 2 2))))
          (fq:w us v0))))
    p0))

;; Uvedi u ram onaj kraj vlakna koji je blizi tacki p, do koordinate us
;; duz kabla.  Vraca T ako je putanja promenjena.
;;
;;  fq:trimto radi nad POSLEDNJIM temenom, pa se putanja po potrebi
;;  okrene i vrati.  fq:ravna posle njega vraca broj temena na stari:
;;  produzavanje dopisuje teme koje lezi na pravoj sa prethodnim, a
;;  fq:plsetpts prepisuje samo grupe 10 koje vec postoje i nijednu ne
;;  dodaje ni brise.  Ako broj ipak ne ispadne isti, putanja se NE dira:
;;  pola prepisane putanje je gore od neuvedenog vlakna, a ram ce ionako
;;  doci do tog kraja.
;;
;;  Kraj koji nije vodoravan u sistemu kabla fq:trimto ne dira (vlakno
;;  izvoda je bas takvo), pa se to proverava PRE njega, a ne po tome sto
;;  putanja izgleda nepromenjeno: fq:plsetpts bi je uredno prepisao
;;  starim vrednostima i ovo bi vratilo T, pa bi pozivalac mislio da je
;;  kraj na us -- a ram bi onda ostao kratak bas za taj kraj.  Isto
;;  pravilo fq:spoj1 vec primenjuje na mesto spoja.
;;
;;  Kraj se ne sme povuci pre svog loma.  Poslednji vodoravni deo sme da
;;  bude kratak koliko i *FQ-LOM-MIN*, a uvodjenje ide do fq:nastdomet
;;  (4.05), pa bi bez ovoga vlakno kabla sa lomovima sislo nanize na
;;  jednoj koordinati a zavrsilo LEVO od nje -- putanja koja se vraca
;;  unazad, i to bez ijedne poruke.
(defun fq:vluvedi (e p us / pts a b rev orij kraj pred d s novi)
  (setq pts (fq:plpts e))
  (if (< (length pts) 2)
    nil
    (progn
      (setq a    (car pts)
            b    (fq:last pts)
            rev  (< (distance (fq:w (car a) (cadr a)) p)
                    (distance (fq:w (car b) (cadr b)) p))
            orij (if rev (reverse pts) pts)
            kraj (fq:last orij)
            pred (nth (- (length orij) 2) orij)
            d    (- us (car kraj))
            s    (if (> (car kraj) (car pred)) 1.0 -1.0))
      (cond
        ;; dalje od ovoga kraj nije promasen nego je tamo gde jeste
        ((> (abs d) (fq:nastdomet)) nil)
        ;; vec je tu -- pocetak kabla je uvucen jos pre crtanja
        ((< (abs d) 1e-9) nil)
        ((not (fq:vodoravan orij)) nil)
        ((< (* s (- us (car pred))) *FQ-LOM-MIN*) nil)
        (T
         (setq novi (fq:ravna (fq:trimto orij us)))
         (if rev (setq novi (reverse novi)))
         (if (/= (length novi) (length pts))
           nil
           (progn (fq:plsetpts e novi) T)))))))

;; Nastavak na kraju kabla: ram se prosiri po snopu, vlakna se uvedu.
;;
;;  krajevi je lista (svetska-tacka ugao smer), istog smisla kao kod
;;  kucista: tacka je mesto na kome PRVO vlakno tu zavrsava, ugao je
;;  ugao onog dela kabla koji na taj kraj dolazi.  smer je isti koji
;;  fq:lomkraj vec koristi za uvlacenje elipsi:
;;     1  kraj je na manjem u -- kabl odatle KRECE, ram mu je levo, pa
;;        vlakno ulazi kroz DESNU ivicu
;;    -1  kraj je na vecem u -- kabl tu ZAVRSAVA, vlakno ulazi kroz levu
;;
;;  Vraca broj prosirenih nastavaka.
(defun fq:nastsiriend (oz krajevi / n raw kr ang smer lc u0 v0 e d g
                                    ul ur ulaz us fl k vs uu p c1 c2 sir)
  (setq n 0 raw nil)
  (foreach kr krajevi
    (setq ang  (cadr kr)
          smer (caddr kr))
    (fq:sistem ang nil)
    (setq lc     (fq:loc (car kr))
          u0     (car lc)
          v0     (cadr lc)
          e      (fq:nastnakraju u0 v0 ang))
    ;; Spisak vlakana kabla se cita tek kada se nastavak nadje, i to
    ;; jednom za oba kraja: prolaz kroz sve FIBERQ zapise na lejeru
    ;; vlakana u velikom projektu nije besplatan, a nastavka na kraju
    ;; kabla najcesce nema.  Isti razlog stoji uz fq:kucsiriend.
    (if (and e
             (setq g (fq:ramnast e))
             (or raw (setq raw (fq:cablefibers oz))))
      (progn
        (setq ul   (nth 0 g)
              ur   (nth 1 g)
              d    (fq:xdget e)
              ulaz (fq:nastulaz ul ur)
              us   (if (> smer 0) (- ur ulaz) (+ ul ulaz))
              fl   (fq:krajevi raw u0)
              k    0
              vs   nil
              uu   nil)
        ;;  Red se cita PRE uvodjenja, koordinata duz kabla posle:
        ;;  uvodjenje pomera kraj samo duz kabla, red mu ostaje isti.
        (foreach r fl
          (setq p  (fq:loc (cadr r))
                vs (cons (cadr p) vs))
          (if (fq:vluvedi (caddr r) (cadr r) us)
            (setq k (1+ k) uu (cons us uu))
            (setq uu (cons (car p) uu))))
        ;;  Ram ide preko snopa sa istom marginom sa kojom ga crta i
        ;;  fq:drawnast, a duz kabla samo dotle da svaki kraj ostane
        ;;  UNUTAR njega.  Kad je vlakno uvedeno to je vec tacno, pa se
        ;;  duz kabla nista i ne pomeri; ivica se makne jedino za vlakno
        ;;  koje se nije dalo uvesti.
        ;;
        ;;  Okvir se racuna u sistemu KABLA, a predaje u sistemu
        ;;  NASTAVKA.  Uspravan kabl iz vodoravnog nastavka ima "gore" na
        ;;  sasvim drugoj strani, a fq:nasttekst trazi oznaku i mesto
        ;;  iznad gornje ivice u sistemu nastavka -- racunato u sistemu
        ;;  kabla, nijedan natpis se ne bi nasao i ram bi narastao ispod
        ;;  njih.  Dovoljne su dve suprotne temene tacke: oba sistema su
        ;;  pod pravim uglom jedan na drugi, pa pravougaonik ostaje
        ;;  pravougaonik.
        (setq c1 (fq:w (- (apply 'min uu) ulaz)
                       (+ (apply 'max vs) *FQ-NAST-MARG*))
              c2 (fq:w (+ (apply 'max uu) ulaz)
                       (- (apply 'min vs) *FQ-NAST-MARG*)))
        (setq *fq-a* (fq:deg (fq:na-ang d))
              c1     (fq:loc c1)
              c2     (fq:loc c2))
        (setq sir (fq:nastsiri e
                               (min (car  c1) (car  c2))
                               (max (car  c1) (car  c2))
                               (max (cadr c1) (cadr c2))
                               (min (cadr c1) (cadr c2))))
        (if sir (setq n (1+ n)))
        (if (or sir (> k 0))
          (princ (fq:tf "nast.siri"
                        (list (fq:na-oz d) (itoa (length fl))
                              (if sir (fq:t "nast.siri.ram") "")))))
        ;; Ram je mozda pomeren, pa se cita ponovo; *fq-a* je posle
        ;; fq:nastsiri vec u sistemu nastavka.  Vidi fq:nastunutra.
        (if (and sir (setq g (fq:ramnast e)))
          (progn
            (setq k (fq:nastunutra (nth 0 g) (nth 1 g) (nth 2 g) (nth 3 g)))
            (if (> k 0)
              (princ (fq:tf "nast.natpisi.unutra"
                            (list (fq:na-oz d) (itoa k))))))))))
  n)

;; Prav kabl: oba kraja pod istim uglom, drugi je za lg dalje duz kabla.
;; fq:sistem, ne golo *fq-a*: sirenje nastavka ide POSLE sirenja
;; kucista, koje *fq-m* ostavlja postavljen na poslednje precrtano
;; kuciste.  Nastavak ogledalo ne poznaje i mora da meri po kablu.
(defun fq:nastsirikabl (oz p0 lg ang / lc)
  (fq:sistem ang nil)
  (setq lc (fq:loc p0))
  (fq:nastsiriend oz (list (list p0 ang 1)
                           (list (fq:w (+ (car lc) lg) (cadr lc)) ang -1))))

;; Nadji nastavak u kome se vrsi spajanje.
;; Gledaju se samo nastavci nacrtani pod istim uglom kao vlakno.
;; Bira se onaj kome je red vlakna unutar rama, pa medju njima
;; najblizi po duzini kabla. Kraj vlakna sme da bude izvan rama.
;; Vraca (ul ur vt vb oznaka status du dv) ili nil.
(defun fq:najnast (u v ang / ss i e d r ul ur vt vb du dv sc best bs)
  (setq ss (fq:ssx '((8 . "FQ_NASTAVAK") (-3 ("FIBERQ"))))
        i 0 best nil bs nil)
  (if ss
    (while (< i (sslength ss))
      (setq e (ssname ss i) d (fq:xdget e))
      (if (and d (= (car d) "NASTAVAK")
               (or (not ang) (= (fq:na-ang d) ang))
               (setq r (fq:ramnast e)))
        (progn
          (setq ul (car r) ur (cadr r) vt (caddr r) vb (cadddr r))
          ;; du je promasaj po duzini kabla, dv po visini
          (setq du (cond ((< u ul) (- ul u)) ((> u ur) (- u ur)) (T 0.0))
                dv (cond ((< v vb) (- vb v)) ((> v vt) (- v vt)) (T 0.0))
                sc (+ (* 1000.0 dv) du))
          ;; dv ima hiljadu puta vecu tezinu, pa nastavak koji obuhvata
          ;; red vlakna uvek pobedjuje onaj koji ga ne obuhvata
          (if (or (not bs) (< sc bs))
            (setq bs   sc
                  best (list ul ur vt vb (fq:na-oz d) (fq:na-st d) du dv)))))
      (setq i (1+ i))))
  best)

;; sredina nastavka, ili pitanje korisniku ako nastavka uopste nema
(defun fq:usnast (u v ang tekst / nast p)
  (setq nast (fq:najnast u v ang))
  (if nast
    (progn
      (princ (fq:tf "nast.info" (list (nth 4 nast) (rtos (car nast) 2 2) (rtos (cadr nast) 2 2) (rtos (* 0.5 (+ (car nast) (cadr nast))) 2 2) (if (> (nth 6 nast) 0.001) (fq:tf "nast.info.izvan" (list (rtos (nth 6 nast) 2 2))) ""))))
      (if (> (nth 7 nast) 0.001)
        (princ (fq:tf "nast.paznja.red" (list (rtos (nth 7 nast) 2 2)))))
      (list (* 0.5 (+ (car nast) (cadr nast))) (nth 4 nast)))
    (progn
      (princ (fq:t "nast.nema.pod.uglom"))
      (setq p (fq:gp tekst))
      (if p (list (car (fq:loc p)) "") nil))))

;;; --- pregled rama nastavka uz mis ---------------------------------
;;;
;;;  Ram nastavka je do sada bio dve tacke na slepo: klikne se leva pa
;;;  desna ivica, a koliko je to visoko i da li obuhvata ceo snop vidi
;;;  se tek kad je nacrtano.  Ovde se, istom masinom kojom se pokazuje
;;;  kabl, ram prikazuje dok se ivice biraju.
;;;
;;;  Visina rama ne zavisi od misa nego od snopa, pa se pregled
;;;  ZAKLJUCAVA na sredinu snopa i prati mis samo duz kabla.

;; Vektori rama u odnosu na levu ivicu.  dvt i dvb su gornja i donja
;; ivica u odnosu na tacku za koju se pregled kaci.
(defun fq:nastvecs (w dvt dvb ang / sa out)
  (setq sa *fq-a*)
  (setq *fq-a* (fq:deg ang))
  (setq out (list 7 (fq:w 0.0 dvt) (fq:w w   dvt)
                  7 (fq:w w   dvt) (fq:w w   dvb)
                  7 (fq:w w   dvb) (fq:w 0.0 dvb)
                  7 (fq:w 0.0 dvb) (fq:w 0.0 dvt)))
  (setq *fq-a* sa)
  out)

;; Leva ivica.  Pregled visi na sredini snopa, pa se pomera samo duz
;; kabla; od pokazane tacke se koristi jedino koordinata duz kabla.
;;
;; Hvatanje se i ovde gasi, iz istog razloga kao u fq:pickbox: nastavak
;; nema sta da trazi na koloni konektora tudjeg kucista, a leva ivica bi
;; se tu tiho odbijala cim se kursor primakne.
(defun fq:nastp1 (vtop vbot ang / msg vc vecs p)
  (setq msg           (fq:t "nast.pitaj.leva")
        vc            (* 0.5 (+ vtop vbot))
        *fq-snaphit*  nil          ; vidi napomenu uz fq:pickbox
        *fq-dragre*   nil
        *fq-dragsnap* nil)
  (if (not *FQ-DRAG*)
    (fq:gp msg)
    (progn
      (setq vecs (fq:nastvecs *FQ-NAST-W*
                              (- (+ vtop *FQ-NAST-MARG*) vc)
                              (- (- vbot *FQ-NAST-MARG*) vc)
                              ang))
      (setq p (vl-catch-all-apply
                'fq:dragpt (list msg
                                 vecs ang vc)))
      (if (vl-catch-all-error-p p)
        (progn (redraw)
               (princ (fq:t "opste.pregled.ne"))
               (fq:gp msg))
        p))))

;; Povlacenje desne ivice.  Vraca koordinatu duz kabla, ili nil.
;;   klik    prihvata povucenu sirinu
;;   Enter   uzima podrazumevanu sirinu *FQ-NAST-W*
;;   ostalo  odustaje
(defun fq:dragnast (p1 dvt dvb ang / sa lc u1 g p w res)
  (setq sa *fq-a*)
  (setq *fq-a* (fq:deg ang))
  (setq lc  (fq:loc p1)
        u1  (car lc)
        w   *FQ-NAST-W*
        res nil)
  (princ (fq:tf "nast.povuci.ivicu" (list (rtos *FQ-NAST-W* 2 1))))
  (while (not res)
    (setq g (grread T 15 0))
    (cond
      ((= (car g) 5)
       (setq p (fq:loc (cadr g))
             w (max *FQ-NAST-MINW* (- (car p) u1)))
       (redraw)
       (grvecs (fq:nastvecs w dvt dvb ang) (fq:mtrans p1)))
      ((= (car g) 3)
       (setq p   (fq:loc (cadr g))
             res (list "ok" (max *FQ-NAST-MINW* (- (car p) u1)))))
      ((and (= (car g) 2) (member (cadr g) '(13 32)))
       (setq res (list "ok" *FQ-NAST-W*)))
      (T (setq res (list "prekid" nil)))))
  (redraw)
  (setq *fq-a* sa)
  (if (= (car res) "ok") (+ u1 (cadr res)) nil))

(defun fq:nastp2 (p1 vtop vbot ang / lc dvt dvb r p)
  (setq *fq-a* (fq:deg ang)
        lc     (fq:loc p1)
        dvt    (- (+ vtop *FQ-NAST-MARG*) (cadr lc))
        dvb    (- (- vbot *FQ-NAST-MARG*) (cadr lc)))
  (if (not *FQ-DRAG*)
    (progn (setq p (getpoint p1 (fq:t "nast.pitaj.ivica")))
           (if p (car (fq:loc p)) nil))
    (progn
      (setq r (vl-catch-all-apply 'fq:dragnast (list p1 dvt dvb ang)))
      (if (vl-catch-all-error-p r)
        (progn (redraw)
               (princ (fq:t "opste.pregled.ne"))
               (setq p (getpoint p1 (fq:t "nast.pitaj.ivica")))
               (if p (car (fq:loc p)) nil))
        r))))

;;; --- crtanje nastavka ---------------------------------------------
;;;
;;;  Podaci su vec prikupljeni, ovde se samo bira kabl i ram.  Isti
;;;  posao radi i dijalog i komandna linija, pa se crtez ne moze
;;;  razlikovati po tome kako je pokrenut.
;;;
;;;  pc je vec izabran kabl, (oznaka vlakna ugao), ili nil da se pita.
;;;  U seriji se isti kabl ne bira ponovo za svaki nastavak.
;;;  Vraca upotrebljen pc ako je nastavak nacrtan, inace nil, pa
;;;  odustajanje prekida seriju.
(defun fq:nastcrt (tip oz lok br st pc / fl ang uk pts vs vtop vbot don
                                         p1 ul ur ok)
  (fq:init)
  (setq ok nil)
  (if pc
    (princ (fq:tf "nast.isti.kabl" (list (car pc))))
    (setq pc (fq:pickcable (fq:t "nast.pitaj.vlakno"))))
  (if (not pc)
    (princ (fq:t "opste.otkazano"))
    (progn
      (setq fl  (cadr pc)
            ang (caddr pc)
            uk  (nth 3 pc)
            pts (nth 4 pc))
      (setq *fq-a* (fq:deg ang))
      ;;  Pojas se meri NA koordinati klika, ne na krajevima vlakana --
      ;;  vidi napomenu uz fq:vopseg.  Rezerva na stari racun postoji
      ;;  zato sto fq:vopseg vrati prazno ako nijedno vlakno nema
      ;;  upotrebljivu putanju; tada je stari racun i dalje bolji od
      ;;  pada na (apply 'max nil).
      ;;  Ovaj pojas je samo POCETNA procena, za pregled leve ivice.
      ;;  Meri se na tacki klika, a u seriji je to klik PRVOG nastavka
      ;;  -- zato se posle izbora leve ivice preracunava.
      (setq vs (if uk (fq:vopseg fl uk) nil))
      (if (not vs)
        (setq vs (mapcar '(lambda (r) (cadr (fq:loc (cadr r)))) fl)))
      (setq vtop (apply 'max vs)
            vbot (apply 'min vs)
            p1   (fq:nastp1 vtop vbot ang))
      (if (not p1)
        (princ (fq:t "opste.otkazano"))
        (progn
          (setq *fq-a* (fq:deg ang)
                ul     (car (fq:loc p1)))
          ;;  Tek sada se zna gde nastavak STVARNO ide, pa se pojas
          ;;  preracunava bas tu.  U seriji se vlakno ne bira ponovo,
          ;;  pa bi bez ovoga klik prvog nastavka odredjivao pojas svih
          ;;  narednih -- a oni po pravilu idu na druge deonice.  Bas
          ;;  to je 22.08.2026 davalo ram do gornje linije kabla kad je
          ;;  "nastavi u seriji" bilo ukljuceno.
          (setq vs (fq:vopseg fl ul))
          (if vs (setq vtop (apply 'max vs) vbot (apply 'min vs)))
          (setq ur (fq:nastp2 p1 vtop vbot ang))
          (if (not ur)
            (princ (fq:t "opste.otkazano"))
            (progn
              ;;  Sirina se NE skracuje na deonicu.  Prvi pokusaj je to
              ;;  radio i pucao je bas tamo gde nastavci i idu -- na
              ;;  kraju deonice: povuces udesno, izadjes iz nje, i ram
              ;;  ostane uzan koliko god ga vukao.  Prelom se zato samo
              ;;  prijavi; ram ostaje tamo gde je povucen, a pojas je
              ;;  ionako izmeren na levoj ivici.
              (setq don (if pts (fq:deonica pts ul) nil))
              (if (and don (> (max ul ur) (+ (cadr don) 1e-6)))
                (princ (fq:t "nast.prelom")))
              (fq:drawnast oz tip lok br (min ul ur) (max ul ur) st fl ang)
              (setq ok T)))))))
  (if ok pc nil))


;;; --- oznaka nastavka ----------------------------------------------
;;;
;;;  N i NL su se u crtezu razlikovali samo dok se oznaka pusta na
;;;  <auto>, jer se tek tada dopisivao prefiks.  Cim se rucno ukuca
;;;  broj, oba tipa su davala isti ispis.  Zato se prefiks dopisuje i
;;;  rucnom broju: u polje Oznaka se kuca 5, u crtez ide NL 5.
;;;  Oznaka koja sadrzi slovo ide u crtez tacno kako je otkucana, pa
;;;  se i dalje moze upisati bilo kakvo ime.

;; T ako je u polju samo redni broj, npr "5", "12" ili "3/1"
(defun fq:brojoz (s / i c ok cif)
  (setq i 1 ok T cif nil)
  (while (and ok (<= i (strlen s)))
    (setq c (substr s i 1))
    (cond
      ((member c '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9")) (setq cif T))
      ((member c '("/" "-" "." " ")) nil)
      (T (setq ok nil)))
    (setq i (1+ i)))
  (and ok cif))

;;  PREFIKS OZNAKE NIJE KOD TIPA, ma koliko danas izgledao isto.
;;
;;  "N" i "NL" su zamrznuti kodovi: stoje u polju 2 zapisa NASTAVAK u
;;  svakom vec nacrtanom crtezu i navedeni su u tabeli zamrznutog u
;;  CLAUDE.md.  Prefiks oznake je, naprotiv, prikaz -- odlukom od
;;  21.08.2026 prati jezik, isto kao "ODO " / "FDH ".
;;
;;  Do ove izmene su to bile bukvalno iste niske, (strcat tip " ") na dva
;;  mesta.  Ko bi u bloku 7 dao prefiksu engleski oblik, promenio bi i
;;  ono sto stoji u xdata -- jedini prefiks u projektu kod koga prevod
;;  dodiruje zamrznuto.  Zato jedna funkcija: blok 7 menja NJU, a kod
;;  tipa ostaje netaknut.
;;
;;  Danas vraca isto na oba jezika.  To nije previd nego stanje: engleski
;;  prefiks nastavka jos nije izabran, a lazna dvojezicnost bi bila gora
;;  od nikakve.
(defun fq:napre (tip) (strcat tip " "))

;;; --- prefiks i naziv vrste kucista, blok 7 -------------------------
;;;
;;;  ODO se na engleskom zove FDH, ZOK je FAT.  Kljuc u xdata ostaje
;;;  "ODO" i "ZOK" zauvek -- menja se samo prikaz, po istom pravilu po
;;;  kom se "IPAN" nije menjao kad se ormar preimenovao u MDU.
;;;
;;;  ZASTO NE IZ KATALOGA.  Prefiks i naziv danas stoje u *FQ-KUCISTA*,
;;;  a fq:katspoj pri ucitavanju dopisuje samo ono cega nema i NE DIRA
;;;  postojece zapise.  Ko je jednom snimio fq-kucista.dat, zadrzao bi
;;;  srpski prefiks zauvek, bez obzira na jezik -- i to tiho.
;;;
;;;  ZASTO IPAK KROZ KATALOG, KAD GA JE KORISNIK MENJAO.  Uslov gleda da
;;;  li u katalogu i dalje stoji isporucena vrednost.  Ako stoji, prikaz
;;;  ide iz tabele niski; ako ne stoji, korisnik je to svesno promenio i
;;;  njegova vrednost se postuje.  Tako nijedan zatecen katalog ne gubi
;;;  svoje izmene, a nijedan neizmenjen ne ostaje zakljucan na srpskom.
;;;
;;;  Vrsta koju je korisnik sam dodao prolazi kroz poslednju granu,
;;;  nepromenjena -- isto pravilo kao kod montaze i mesta nastavka.
;;;
;;;  Prefiksi ODF ("OR "), PP i MDU se NE menjaju: to su vec
;;;  medjunarodne skracenice.  Zato ih ovde nema.

;; Prefiks oznake.  Vraca string i kad vrste u katalogu nema -- prazan,
;; nikad nil: (fq:next nil) bi puklo u strcat-u.
(defun fq:vrpre (tip / kat)
  (setq kat (if (car (atoms-family 1 (list "FQ:KC-PRE"))) (fq:kc-pre tip)))
  (cond ((not kat) "")
        ((and (= tip "ODO") (= kat "ODO ")) (fq:t "vrsta.pre.odo"))
        ((and (= tip "ZOK") (= kat "ZOK ")) (fq:t "vrsta.pre.zok"))
        (T kat)))

;; Naziv vrste za prikaz, isto pravilo.
(defun fq:vrime (tip / kat)
  (setq kat (if (car (atoms-family 1 (list "FQ:KC-IME"))) (fq:kc-ime tip)))
  (cond ((not kat) "")
        ((and (= tip "ODF")  (= kat "ODF modul"))  (fq:t "vrsta.ime.odf"))
        ((and (= tip "PP")   (= kat "Patch panel")) (fq:t "vrsta.ime.pp"))
        ((and (= tip "ODO")  (= kat "ODO ormar"))  (fq:t "vrsta.ime.odo"))
        ((and (= tip "IPAN") (= kat "MDU ormar"))  (fq:t "vrsta.ime.mdu"))
        ((and (= tip "ZOK")  (= kat "ZOK kutija")) (fq:t "vrsta.ime.zok"))
        (T kat)))

;;  Naziv vrste zapisa za prikaz, za svih sesnaest kljuceva.
;;
;;  Pet vrsta kucista ide NAJPRE kroz fq:vrime, da bi se postovao
;;  korisnik koji je vrstu u svom katalogu preimenovao.  Ostalih jedanaest
;;  fq:vrime ne poznaje i vraca "" -- isto sto vraca i kad fq-kucista.lsp
;;  uopste nije ucitan, pa jedna grana pokriva oba slucaja.
;;
;;  Nepoznata vrsta prolazi kroz, nepromenjena: crtez iz buduce verzije
;;  sme da nosi kljuc koji ova verzija ne poznaje, i bolje ga je pokazati
;;  sirovog nego pretvoriti u prazno.  Isto merilo kao (T tip) u
;;  fq:tallytxt.
(defun fq:vrnaziv (tip / n rec)
  (setq n (fq:vrime tip))
  (cond ((and n (/= n "")) n)
        ((setq rec (assoc (strcase tip) *FQ-POLJA*))
           (if (= *fq-jezik* "EN") (caddr rec) (cadr rec)))
        (T tip)))

;; Konacna oznaka.  Prazno polje znaci sledeci slobodan broj uz tip.
(defun fq:naoz (s tip / w)
  (setq w (fq:trim s))
  (cond ((= w "")      (fq:next (fq:napre tip)))
        ((fq:brojoz w) (strcat (fq:napre tip) w))
        (T             w)))

;; Ista racunica, samo bez trosenja broja, za pregled u dijalogu.
;; Auto oznaka je vec procitana iz crteza pre otvaranja prozora.
(defun fq:naozp (s tip / w a)
  (setq w (fq:trim s)
        a (if (= tip "NL") *fq-tmp-nautl* *fq-tmp-nautn*))
  (cond ((= w "")      (if a a (strcat (fq:napre tip) "<auto>")))
        ((fq:brojoz w) (strcat (fq:napre tip) w))
        (T             w)))

;;; --- dijalog nastavka ---------------------------------------------
;;;
;;;  Podataka je sada pet: tip, oznaka, mesto, broj i status.  U
;;;  komandnoj liniji se pogresno otkucan broj okna vidi tek kad je sve
;;;  gotovo, pa je za rucni rad prirodniji jedan prozor, isto kao kod
;;;  kucista.  Komandna linija ostaje kao -FQNASTAVAK, za skripte.
;;;
;;;  Kvacica Nastavi drzi dijalog u seriji: cim je nastavak nacrtan,
;;;  prozor se sam vraca za sledeci.  Druga kvacica kaze da je kabl
;;;  isti, pa se u seriji preskace i biranje vlakna i ostaju samo dve
;;;  ivice rama po nastavku.

(defun fq:dclnast ( / fn f)
  (setq fn (strcat (getvar "TEMPPREFIX") "fq-nast.dcl"))
  (setq f (open fn "w"))
  (if f
    (progn
      (fq:dcll f "fqnast : dialog { label = \"" (fq:t "dcl.naslov.nast") "\";")
      (fq:dcll f " : boxed_row { label = \""      (fq:t "dcl.nast.tip") "\";")
      (write-line "  : radio_row {" f)
      (fq:dcll f "   : radio_button { key = \"tn\"; label = \"" (fq:t "dcl.nast.tn") "\"; }")
      (fq:dcll f "   : radio_button { key = \"tl\"; label = \"" (fq:t "dcl.nast.tl") "\"; }")
      (write-line "  }" f)
      (write-line " }" f)
      (write-line " : edit_box { key = \"ozn\";" f)
      (fq:dcll f "              label = \"" (fq:t "dcl.nast.ozn") "\";")
      (write-line "              edit_width = 16; }" f)
      (fq:dcll f " : boxed_row { label = \"" (fq:t "dcl.nast.gde") "\";")
      (write-line "  : popup_list { key = \"lok\"; width = 14; }" f)
      (fq:dcll f "  : edit_box { key = \"br\"; label = \"" (fq:t "dcl.nast.broj") "\";")
      (write-line "               edit_width = 10; }" f)
      (write-line " }" f)
      (fq:dcll f " : boxed_row { label = \"" (fq:t "dcl.status") "\";")
      (write-line "  : radio_row {" f)
      (fq:dcll f "   : radio_button { key = \"stp\"; label = \"" (fq:t "dcl.status.proj") "\"; }")
      (fq:dcll f "   : radio_button { key = \"stz\"; label = \"" (fq:t "dcl.status.izv") "\"; }")
      (write-line "  }" f)
      (write-line " }" f)
      (fq:dcll f " : boxed_column { label = \"" (fq:t "dcl.nast.serija") "\";")
      (write-line "  : toggle { key = \"vise\";" f)
      (fq:dcll f "             label = \"" (fq:t "dcl.nast.vise") "\"; }")
      (write-line "  : toggle { key = \"isti\";" f)
      (fq:dcll f "             label = \"" (fq:t "dcl.nast.isti") "\"; }")
      (write-line " }" f)
      (fq:dcll f " : boxed_column { label = \"" (fq:t "dcl.ispis") "\";")
      (write-line "  : text { key = \"pre\"; label = \"\"; width = 44; }" f)
      (write-line "  : text { key = \"kbl\"; label = \"\"; width = 44; }" f)
      (write-line " }" f)
      (write-line " : spacer { height = 0.3; }" f)
      (write-line " : row {" f)
      (fq:dcll f "  : button { key = \"accept\"; label = \"" (fq:t "dcl.ok") "\";")
      (write-line "             is_default = true; width = 14; }" f)
      (fq:dcll f "  : button { key = \"cancel\"; label = \"" (fq:t "dcl.odustani") "\";")
      (write-line "             is_cancel = true; width = 14; }" f)
      (write-line " }" f)
      (write-line "}" f)
      (close f)
      fn)
    nil))

;; Red koji pokazuje sta ce tacno pisati u crtezu, isto kao u dijalogu
;; kucista: oznaka iznad rama, mesto u redu pod njom.
(defun fq:nastprev ( / m)
  (setq m (fq:na-mesto *fq-na-lok* (fq:trim (get_tile "br"))))
  (set_tile "pre"
            (strcat (fq:naozp (get_tile "ozn") *fq-na-tip*)
                    (if (= m "") "" (strcat "        " m))))
  T)

;; Drugi red pregleda: iz kog kabla se vadi ram.
(defun fq:nastkbl ( / )
  (set_tile "kbl"
            (if (and *fq-tmp-nakbl* *fq-na-isti*)
              (fq:tf "dcl.nast.kbl.isti" (list *fq-tmp-nakbl*))
              (fq:t "dcl.nast.kbl.novi")))
  T)

;; Jedan prolaz kroz prozor.  Vraca 1 za OK, 0 za odustajanje.
;; pon je T kad je ovo sledeci nastavak u seriji: tada je polje Broj
;; vec u fokusu i oznaceno, jer se broj okna po pravilu menja.
(defun fq:nastdlg1 (tip pon kabl / fn id r au)
  (if (not *fq-st*) (setq *fq-st* "stProjektovano"))
  (if (not (member *fq-na-lok* *FQ-NAST-LOK*))
    (setq *fq-na-lok* (car *FQ-NAST-LOK*)))
  ;; Obe auto oznake se citaju PRE otvaranja prozora, jednim prolazom
  ;; kroz crtez, jer se tip u prozoru moze promeniti a pretraga crteza
  ;; u toku dijaloga nije za oslanjanje.
  (setq au (fq:peek2 "N " "NL "))
  (setq *fq-na-tip*   (if (= tip "NL") "NL" "N")
        *fq-tmp-nakbl* kabl
        *fq-tmp-nozn*  ""
        *fq-tmp-nautn* (car  au)
        *fq-tmp-nautl* (cadr au))
  (setq r 0)
  (if (setq fn (fq:dclnast))
    (progn
      (setq id (load_dialog fn))
      (if (or (not id) (< id 0) (not (new_dialog "fqnast" id)))
        (princ (fq:t "nast.dijalog.ne"))
        (progn
          (set_tile (if (= *fq-na-tip* "NL") "tl" "tn") "1")
          (action_tile "tn" "(setq *fq-na-tip* \"N\")(fq:nastprev)")
          (action_tile "tl" "(setq *fq-na-tip* \"NL\")(fq:nastprev)")
          ;; Spisak se PRIKAZUJE prevedeno, a pamti se srpski naziv iz
          ;; *FQ-NAST-LOK*: action_tile ispod uzima (nth idx *FQ-NAST-LOK*),
          ;; dakle iz same tabele, pa prevod dira jedino ono sto se vidi.
          ;; Redosled mora da ostane isti -- na njemu pociva indeks.
          (start_list "lok")
          (foreach x *FQ-NAST-LOK* (add_list (fq:kodnaz "lok" x)))
          (end_list)
          (set_tile "lok" (itoa (fq:poz *fq-na-lok* *FQ-NAST-LOK*)))
          (action_tile "lok"
            "(setq *fq-na-lok* (nth (atoi $value) *FQ-NAST-LOK*))(fq:nastprev)")
          (set_tile "br"  *fq-na-br*)
          (set_tile "ozn" "")
          (action_tile "br"  "(fq:nastprev)")
          (action_tile "ozn" "(fq:nastprev)")
          (set_tile (if (= *fq-st* "stIzvedeno") "stz" "stp") "1")
          (action_tile "stp" "(setq *fq-st* \"stProjektovano\")")
          (action_tile "stz" "(setq *fq-st* \"stIzvedeno\")")
          (set_tile "vise" (if *fq-na-vise* "1" "0"))
          (action_tile "vise" "(setq *fq-na-vise* (= $value \"1\"))")
          ;; u prvom prolazu jos nema prethodnog kabla, pa je kvacica
          ;; ugasena i nedostupna
          (set_tile "isti" (if (and pon *fq-na-isti*) "1" "0"))
          (action_tile "isti"
            "(setq *fq-na-isti* (= $value \"1\"))(fq:nastkbl)")
          (if (not pon) (mode_tile "isti" 1))
          (fq:nastprev)
          (fq:nastkbl)
          (action_tile "accept"
            (strcat "(setq *fq-tmp-nozn* (get_tile \"ozn\")"
                    "      *fq-na-br*  (get_tile \"br\"))"
                    "(done_dialog 1)"))
          (action_tile "cancel" "(done_dialog 0)")
          (if pon (progn (mode_tile "br" 2) (mode_tile "br" 3)))
          (setq r (start_dialog))
          (unload_dialog id))))
    (princ (fq:t "opste.dcl.ne")))
  r)

;;;  Serija.  Bez kvacice je ovo jedan prozor i jedan nastavak, tacno
;;;  kao ranije.  Sa kvacicom se posle svakog nacrtanog nastavka prozor
;;;  odmah vraca, pa pet latentnih nastavaka na istom kablu ide bez
;;;  ijednog ponovnog pokretanja komande.  Odustajanje u prozoru ili
;;;  pri povlacenju rama prekida seriju.
(defun fq:nastdlg (tip / pc pon dalje oz)
  (fq:init)
  (setq dalje T pon nil pc nil)
  (while dalje
    (setq dalje nil)
    (if (= 1 (fq:nastdlg1 tip pon (if pc (car pc) nil)))
      (progn
        ;; prazna oznaka znaci sledeci slobodan broj uz taj tip,
        ;; isto pravilo koje vec vazi za kablove i kucista
        (setq tip *fq-na-tip*
              oz  (fq:naoz *fq-tmp-nozn* tip)
              pc  (fq:nastcrt tip oz *fq-na-lok* *fq-na-br* *fq-st*
                              (if (and pon *fq-na-isti*) pc nil)))
        (if pc (setq pon T dalje *fq-na-vise*)))))
  (princ))

;;; --- komandna linija ----------------------------------------------
;;;  Prazan odgovor na mesto i broj zadrzava zapamcenu vrednost.
;;;  Da bi broj ostao prazan, ostavi polje prazno u dijalogu.
(defun fq:nastask (tip / oz lok br st)
  (fq:init)
  ;; sam broj dobija prefiks tipa, isto kao u dijalogu
  (setq oz (fq:naoz (getstring T (fq:t "nast.pitaj.oznaka")) tip))
  (setq lok (getstring T (fq:tf "nast.pitaj.mesto" (list (fq:kodnaz "lok" *fq-na-lok*)))))
  (if (= lok "") (setq lok *fq-na-lok*))
  (setq br (getstring T (fq:tf "nast.pitaj.broj" (list (if (= *fq-na-br* "") "" (strcat " <" *fq-na-br* ">"))))))
  (if (= br "") (setq br *fq-na-br*))
  (setq *fq-na-lok* lok
        *fq-na-br*  br
        *fq-na-tip* tip
        st            (fq:askst))
  (fq:nastcrt tip oz lok br st nil)
  (princ))

(defun c:FQNASTAVAK ( / *error* )
  (setq *error* fq:err) (fq:nastdlg *fq-na-tip*) (princ))

;;  Izvedena vrednost je KOD, ne token -- kanonski obrazac iz CLAUDE.md.
;;  Ovde ga radi fq:nazkod umesto rucnog cond-a, jer domen "nas" nosi oba
;;  tokena; "N" i "NL" kroz njega prolaze nepromenjeni, pa zatecena
;;  skripta koja salje sam kod i dalje radi.
(defun c:-FQNASTAVAK ( / *error* l kw)
  (setq *error* fq:err)
  (setq l (fq:tokovi "nas" nil))
  (initget (fq:spisak l " "))
  (setq kw (getkword (fq:tf "nast.pitaj.tip"
                            (list (fq:spisak l "/")
                                  (substr (fq:f 0 l) 1 1)))))
  (fq:nastask (if kw (fq:nazkod "nas" kw) "N"))
  (princ))

(defun fq:pnast (tip) (fq:nastdlg tip) (princ))


;;; ==================================================================
;;;  14. SPLITER
;;;
;;;  Telo splitera je iste velicine kao ono u ZOK kutiji, pa spliter
;;;  moze da se postavi i UNUTAR kucista, izmedju pregrade i kolone
;;;  portova.  Sve mere idu iz *FQ-SPL-...*, a lepeza korak po korak
;;;  prati *FQ-PITCH*, isti raster na kome leze vlakna i portovi.
;;;
;;;  Tacka umetanja je KRAJ PRVOG IZLAZA, dakle krajnja desna tacka
;;;  gornjeg izlaznog patrljka.  Ranije je to bio cvor na KOLONI, pa je
;;;  patrljak od *FQ-SPL-OUT* virio jos toliko udesno: da bi izlaz pao
;;;  na konektor, moralo se nisaniti tacno toliko LEVO od njega, na
;;;  prazno.  Sada se pokazuje bas ono cime se spliter spaja, pa izlaz
;;;  legne na konektor tamo gde se klikne.
;;;
;;;  Ostali izlazi padnu na sledece redove rastera *FQ-PITCH*.  PAZNJA:
;;;  lepeza ne zna za *FQ-GAP*, dodatni razmak koji fq:redovi ubacuje na
;;;  prelazu cevcice, pa kod kabla sa vise cevcica izlazi preko prve
;;;  cevcice ne prate vlakna.  Za takav slucaj se izlazi razvlace rukom.
;;; ==================================================================

;; Razmak tela od kolone izlaza.  Kod velikog odnosa lepeza je visoka
;; nekoliko desetina jedinica, pa bi se pri stalnom razmaku slila u
;; trougao; zato se telo blago odmakne.
(defun fq:spldx (k) (max *FQ-SPL-DX* (* 0.12 *FQ-PITCH* (1- (max k 1)))))

;; Kolona izlaza iz pokazane tacke.  Pokazuje se KRAJ prvog izlaza, a
;; cela geometrija se i dalje racuna od kolone, pa je ovo jedino mesto
;; na kome se te dve tacke razlikuju.  Zovu je i crtac i pregled, pa se
;; nacrtan spliter i njegova silueta ne mogu razici.
(defun fq:splkol (u) (- u *FQ-SPL-OUT*))

;; Kolona izlaza i red PRVOG IZLAZA iz pokazane tacke, za obe
;; hvataljke.  Vraca (u0 v0).
;;
;; Hvataljka je do sada bila samo kraj prvog izlaza, jer se spliter
;; najcesce spusta na portove kucista.  Ali spliter koji sedi na
;; vlaknu kabla se spaja ULAZOM, a ulaz je od te tacke udaljen za
;; celu sirinu splitera i za POLA visine lepeze -- pa se nisanilo na
;; prazno, tacno onaj problem zbog kog je hvataljka jednom vec
;; pomerena sa kolone na kraj izlaza.  Zato dve, a ne druga.
;;
;; Pomera se i v, ne samo u: ulaz stoji na sredini lepeze, pa je red
;; prvog izlaza za 0.5*PITCH*(k-1) IZNAD pokazane tacke.  Kod izlazne
;; hvataljke se v ne dira, jer se pokazuje bas taj red.
;;
;; Zovu je i crtac i pregled, kao fq:splkol pre nje: ako se racun
;; promeni, nacrtan spliter i njegova silueta pomere se zajedno.
;;
;; k se NE svodi ovde, iako ovo izgleda kao mesto za to.  Funkcija je
;; algebarski inverz fq:splgeo, a fq:splgeo racuna sa GOLIM k -- pa bi
;; (max k 1) samo ovde razisao par: za k = 0 bi kraj ulaza pao 0.40
;; iznad pokazane tacke, i to bez ijednog znaka, jer i crtac i pregled
;; idu kroz ISTU ovu funkciju pa se medjusobno i dalje poklapaju.
;; Svodjenje stoji u komandi, gde je za fq:splgeo oduvek i stajalo.
(defun fq:splanch (u v k ul)
  (if ul
    (list (+ u (fq:spldx k) *FQ-SPL-W* *FQ-SPL-IN*)
          (+ v (* 0.5 *FQ-PITCH* (1- k))))
    (list (fq:splkol u) v)))

;; Geometrija splitera u odnosu na KOLONU izlaza, u sistemu (u,v).
;; Vraca (su1 su2 sv1 sv2 vmid ux), gde je su2 desna ivica tela.
(defun fq:splgeo (u0 v0 k / dx vmid su1 su2)
  (setq dx   (fq:spldx k)
        vmid (- v0 (* 0.5 *FQ-PITCH* (1- k)))
        su2  (- u0 dx)
        su1  (- su2 *FQ-SPL-W*))
  (list su1 su2
        (+ vmid (* 0.5 *FQ-SPL-H*))
        (- vmid (* 0.5 *FQ-SPL-H*))
        vmid
        (- su1 *FQ-SPL-VX*)))

;; ang je ugao pod kojim se crta.  Do sada se uzimao iz *fq-ugao*, a
;; sada se zadaje, pa spliter koji ide u kuciste moze da preuzme ugao
;; tog kucista umesto tekuce orijentacije.
(defun fq:drawspl (oz k st ang p0 ul / loc an u0 v0 g gm su1 su2 sv1 sv2
                                       vmid i v)
  (fq:init)
  ;; p0 je HVATALJKA -- kraj prvog izlaza, ili kraj ulaza kada je ul.
  ;; Obe se na kolonu i red prvog izlaza svode kroz fq:splanch, pa
  ;; ispod ove linije nema nijedne grane po hvataljci.
  ;;
  ;; k se svodi PRE fq:splanch, jer racun ulazne hvataljke zavisi od
  ;; njega (i razmak tela i pola visine lepeze).
  (setq *fq-a* (fq:deg ang)
        loc    (fq:loc p0)
        k      (max 1 k)
        an     (fq:splanch (car loc) (cadr loc) k ul)
        u0     (nth 0 an)
        v0     (nth 1 an)
        g      (fq:splgub k)
        gm     (fq:splgeo u0 v0 k)
        su1    (nth 0 gm)  su2  (nth 1 gm)
        sv1    (nth 2 gm)  sv2  (nth 3 gm)
        vmid   (nth 4 gm))
  (fq:xd (fq:Wrect su1 sv1 su2 sv2 5 "FQ_SPLITER")
         (list "SPLITER" oz (strcat "1:" (itoa k)) (rtos g 2 1) st))
  (fq:Wtext (* 0.5 (+ su1 su2)) vmid (* 0.62 *FQ-SPL-TITH*)
            (strcat "1:" (itoa k)) 5 "FQ_SPLITER" "FQ_TXTB" 1 2)
  (fq:Wtext su1 (- sv2 (* 0.55 *FQ-SPL-TITH*)) (* 0.55 *FQ-SPL-TITH*)
            (strcat (rtos g 2 1) " dB") 5 "FQ_SPLITER" "FQ_TXT" 0 0)
  (fq:Wtext su1 (+ sv1 (* 0.30 *FQ-SPL-TITH*)) (* 0.55 *FQ-SPL-TITH*)
            oz 5 "FQ_SPLITER" "FQ_TXT" 0 0)
  (fq:Wline (- su1 *FQ-SPL-IN*) vmid su1 vmid 5 "FQ_SPLITER"
            (list "ULAZ" oz st))
  (setq i 1)
  (while (<= i k)
    (setq v (- v0 (* *FQ-PITCH* (1- i))))
    (fq:Wline su2 vmid u0 v 5 "FQ_SPLITER" nil)
    (fq:Wline u0 v (+ u0 *FQ-SPL-OUT*) v 5 "FQ_SPLITER"
              (list "IZLAZ" oz (itoa i) st))
    (setq i (1+ i)))
  (princ (fq:tf "spl.nacrtan" (list oz (itoa k) (rtos g 2 1) (fq:stnaziv st))))
  ;; Spliter spusten tacno na kolonu konektora nekog kucista je skoro
  ;; uvek promasena komanda.  Rezultat izgleda skoro ispravno -- prvih
  ;; nekoliko izlaza padne na zatecene portove i lepeza se lepo nasloni
  ;; -- ali ostali ostanu bez konektora, ram ne poraste jer ga niko ne
  ;; precrtava, a specifikacija spliter broji kao zaseban element van
  ;; ormara.  Ono sto se htelo radi FQSPLKUC.
  ;;
  ;; Meri se na KRAJU prvog izlaza, ne na koloni splitera niti na
  ;; pokazanoj tacki: kolona je za *FQ-SPL-OUT* levo od tog kraja, a
  ;; pokazana tacka kod ulazne hvataljke nije ni blizu njega.  Racuna
  ;; se iz u0/v0 pa vazi za obe hvataljke.
  ;;
  ;; Samo se JAVLJA, ne odbija se.  Spliter pored ormara je legitiman --
  ;; tako se crta spliter u susednom ormanu ili na patch panelu -- pa
  ;; komanda ne sme da pretpostavi sta je htelo da se uradi.
  (if (and (car (atoms-family 1 (list "FQ:KUCNAKRAJU")))
           (fq:kucnakraju (+ u0 *FQ-SPL-OUT*) v0))
    (princ (fq:t "spl.u.kucistu"))))

;;; --- pregled splitera uz mis --------------------------------------
;;;
;;;  Ista masina kojom se pokazuje kabl i ram kucista: grread i grvecs,
;;;  bez ijednog entiteta u crtezu.  Vektori su u odnosu na tacku prvog
;;;  izlaza, pa se pri pomeranju misa samo prevode.
;;;
;;;  Prvi izlaz je crven, kao i prvo vlakno u pregledu kabla, da se
;;;  vidi koji red je referentni i na koje vlakno ili konektor pada.
;;;
;;;  Nula je HVATALJKA, ista tacka koju ocekuje fq:drawspl -- kraj
;;;  prvog izlaza, ili kraj ulaza kada je ul.  Oba mesta je svode na
;;;  kolonu i red prvog izlaza kroz istu fq:splanch; ako se taj racun
;;;  promeni, pregled i nacrtan spliter se pomere zajedno.
;;;
;;;  Kod ulazne hvataljke v0 vise NIJE nula, pa svaki red mora da se
;;;  meri od njega.  Ranije je stajalo golo (- (* *FQ-PITCH* (1- i))),
;;;  sto je isto samo dok je v0 nula.

(defun fq:splvecs (k ang ul / sa sm an u0 v0 gm su1 su2 sv1 sv2 vmid out i v
                              aci retko)
  ;;  *fq-m* se pamti i vraca zajedno sa *fq-a*, i ulazi se kroz
  ;;  fq:sistem sa NIL ogledalom.  Ogledalo se ne cisti nigde posle
  ;;  uspesno zavrsene komande -- fq:cisti zove samo fq:err -- pa
  ;;  nacrtano ogledalno kuciste ostavlja *fq-m* na -1.0 do sledeceg
  ;;  fq:init.  A fq:init je UNUTAR crtaca, dakle posle pregleda: bez
  ;;  ovoga bi silueta bila preslikana, a nacrtalo bi se nepreslikano.
  (setq sa *fq-a* sm *fq-m*)
  (fq:sistem ang nil)
  (setq k     (max 1 k)
        an    (fq:splanch 0.0 0.0 k ul)
        u0    (nth 0 an)
        v0    (nth 1 an)
        gm    (fq:splgeo u0 v0 k)
        su1   (nth 0 gm)  su2  (nth 1 gm)
        sv1   (nth 2 gm)  sv2  (nth 3 gm)
        vmid  (nth 4 gm)
        retko (> k *FQ-DRAG-MAX*)
        out   (list 5 (fq:w su1 sv1) (fq:w su2 sv1)
                    5 (fq:w su2 sv1) (fq:w su2 sv2)
                    5 (fq:w su2 sv2) (fq:w su1 sv2)
                    5 (fq:w su1 sv2) (fq:w su1 sv1)
                    5 (fq:w (- su1 *FQ-SPL-IN*) vmid) (fq:w su1 vmid))
        i     1)
  (while (<= i k)
    (setq v   (- v0 (* *FQ-PITCH* (1- i)))
          aci (if (= i 1) 1 5))
    (if (or (not retko) (= i 1) (= i k))
      (setq out (append out
                        (list aci (fq:w su2 vmid) (fq:w u0 v)
                              aci (fq:w u0 v) (fq:w (+ u0 *FQ-SPL-OUT*) v)))))
    (setq i (1+ i)))
  (setq *fq-a* sa *fq-m* sm)
  out)

;; Kraj prvog izlaza, sa pregledom ako je pregled ukljucen.
;; *fq-dragre* opisuje siluetu, da pregled ume da okrene spliter kada
;; hvatanje uhvati ram nacrtan pod drugim uglom — a to je bas ono zbog
;; cega c:FQSPLITER i fq:pspl uzimaju ugao kroz fq:snapuzmi.
(defun fq:pickspl (msg k ang / vecs p)
  ;; Hvataljka uvek krece od IZLAZA.  Da se pamti kroz sesiju, sledeci
  ;; spliter bi se spustio na drugu tacku nego sto pise u pitanju --
  ;; ista vrsta kvara kao *fq-por* koji ostane da visi.
  (setq *fq-snaphit*  nil          ; vidi napomenu uz fq:pickbox
        *fq-dragre*   (list "spl" k)
        *fq-dragsnap* T
        *fq-splul*    nil)
  ;; Bez pregleda nema ni tastera, pa hvataljka ostaje na izlazu i
  ;; napomena bi lagala.  Zato je unutar grane sa pregledom.
  (if (not *FQ-DRAG*)
    (fq:gp msg)
    (progn
      (princ (fq:t "spl.hvat.izlaz"))
      (setq vecs (fq:splvecs k ang *fq-splul*))
      (setq p (vl-catch-all-apply
                'fq:dragpt (list msg
                                 vecs ang nil)))
      (if (vl-catch-all-error-p p)
        ;; Hvataljka se vraca na izlaz i OVDE.  Ako je pregled pao
        ;; POSLE pritiska na I, *fq-splul* je ostajalo T, a pitanje
        ;; koje fq:gp ispisuje i dalje glasi "kraj prvog izlaza" -- pa
        ;; bi se pokazana tacka tiho uzela kao ULAZ i spliter bi sleteo
        ;; celu svoju sirinu dalje, bez ijedne poruke.
        (progn (redraw)
               (princ (fq:t "opste.pregled.ne"))
               (princ (fq:tf "opste.pregled.zasto"
                             (list (vl-catch-all-error-message p))))
               (setq *fq-snaphit* nil    ; vidi napomenu uz fq:pickins
                     *fq-splul*   nil)
               (fq:gp msg))
        p))))

;; Ugao se ne uzima iz *fq-ugao* nego kroz fq:snapuzmi: ako je kraj
;; prvog izlaza uhvacen na ramu, spliter se okrece kako je okrenut i taj
;; ram.  Inace bi spliter spusten na konektor uspravnog ODF-a legao
;; vodoravno, preko postojece geometrije, i to bas kada je hvatanje
;; uradilo svoj posao.
(defun c:FQSPLITER ( / *error* k oz st p0 ang)
  (setq *error* fq:err)
  (if (not (setq k (getint (fq:t "spl.pitaj.k")))) (setq k 32))
  (setq k (max 1 k))
  (setq oz (fq:trim (getstring T (fq:t "spl.pitaj.oznaka"))))
  (if (= oz "") (setq oz (fq:next "SP")))
  (setq st (fq:askst))
  (if (setq p0 (fq:pickspl (fq:t "spl.pitaj.kraj") k *fq-ugao*))
    (progn (setq ang (fq:snapuzmi *fq-ugao*))
           (fq:drawspl oz k st ang p0 *fq-splul*))
    (princ (fq:t "opste.otkazano")))
  (princ))

(defun fq:pspl (k / oz p0 ang)
  (setq oz (fq:next "SP"))
  (if (setq p0 (fq:pickspl (fq:tf "spl.pitaj.kraj.oz" (list oz (itoa k)))
                           k *fq-ugao*))
    (progn (setq ang (fq:snapuzmi *fq-ugao*))
           (fq:drawspl oz k *fq-st* ang p0 *fq-splul*))
    (princ (fq:t "opste.otkazano"))))

;; Spliter unutar vec nacrtanog kucista ume fq-kucista.lsp, koji se
;; ucitava POSLE ovog fajla i sme da ga nema.  Isti obrazac kao
;; fq:kablsiri: prvo se proveri da li komanda uopste postoji.
(defun fq:splkuc ( / )
  (if (car (atoms-family 1 (list "C:FQSPLKUC")))
    (c:FQSPLKUC)
    (princ (fq:t "spl.treba.kucista")))
  (princ))


;;; ==================================================================
;;;  15. OLT, ONT, REZERVA
;;; ==================================================================

;;; --- mere OLT-a i ONT-a, zajednicki racun -------------------------
;;;
;;;  Isti obrazac kao fq:splkol i fq:splgeo kod splitera: pokazana
;;;  tacka je ono cime se element SPAJA, a geometrija se i dalje racuna
;;;  od temena tela.  Prevod izmedju te dve tacke stoji na JEDNOM mestu,
;;;  pa se nacrtan element i njegova silueta ne mogu razici.
;;;
;;;  Do sada se pokazivalo teme, dakle gornji levi ugao kutije.  Kod
;;;  OLT-a je to 18.0 jedinica levo i 1.60 iznad prvog PON porta, kod
;;;  ONT-a 4.0 levo i 1.30 iznad kraja privoda -- oba puta nisan pada u
;;;  prazno, pa se mesto spoja pogadja merom.  Sada se pokazuje bas ono
;;;  cime se element kaci, isto kao kod splitera.
;;;
;;;  Pokazana tacka NE ide ni u jedan zapis, pa zatecen crtez ovo ne
;;;  oseca: nema je u xdata OLT-a, PON-a, ONT-a ni PRIVOD-a, a nijedna
;;;  komanda OLT ili ONT ne precrtava iz zapisa (fq:drawolt i fq:drawont
;;;  zovu samo svoje cetiri komande).  Menja se gde element padne u
;;;  odnosu na nisan, nista drugo.

;; Teme tela OLT-a iz pokazane tacke.  Pokazuje se KRAJ PRVOG PON
;; PORTA, krajnja desna tacka gornjeg patrljka.
(defun fq:oltteme (u v)
  (list (- u *FQ-OLT-W* *FQ-OLT-PON*)
        (+ v (* *FQ-OLT-GORE* *FQ-PITCH*))))

;; Geometrija OLT-a u odnosu na TEME, u sistemu (u,v).
;; Vraca (u1 v1 u2 v2 vtop): (u1 v1) je teme, (u2 v2) donji desni ugao
;; tela, vtop red prvog PON porta.  np se svodi na najmanje 1 i ovde, ne
;; samo u petljama koje ga broje, da kutija ne ispadne visine nula.
(defun fq:oltgeo (u0 v0 np)
  (list u0 v0
        (+ u0 *FQ-OLT-W*)
        (- v0 (* *FQ-PITCH* (+ (max np 1) *FQ-OLT-DNO*)))
        (- v0 (* *FQ-OLT-GORE* *FQ-PITCH*))))

;; Teme tela ONT-a iz pokazane tacke.  Pokazuje se KRAJ PRIVODA,
;; slobodan levi kraj linije koja nosi zapis "PRIVOD".
(defun fq:ontteme (u v)
  (list (+ u *FQ-ONT-PRI*)
        (+ v (* 0.5 *FQ-ONT-H*))))

;; Geometrija ONT-a u odnosu na TEME, u sistemu (u,v).
;; Vraca (u1 v1 u2 v2 vmid), gde je vmid red privoda -- sredina leve
;; ivice, racunata iz visine, pa kutija sme da se promeni sama.
(defun fq:ontgeo (u0 v0)
  (list u0 v0
        (+ u0 *FQ-ONT-W*)
        (- v0 *FQ-ONT-H*)
        (- v0 (* 0.5 *FQ-ONT-H*))))

(defun fq:drawolt (oz np st p0 / loc tm gm u0 v0 u2 v2 vtop i v)
  (fq:init)
  ;; p0 je KRAJ PRVOG PON PORTA, ne teme tela.  Prevod radi fq:oltteme,
  ;; koju zove i pregled -- vidi fq:oltvecs.
  (setq *fq-a* (fq:deg *fq-ugao*)
        np     (max 1 np)
        loc    (fq:loc p0)
        tm     (fq:oltteme (car loc) (cadr loc))
        gm     (fq:oltgeo (car tm) (cadr tm) np)
        u0     (nth 0 gm)  v0   (nth 1 gm)
        u2     (nth 2 gm)  v2   (nth 3 gm)
        vtop   (nth 4 gm))
  (fq:xd (fq:Wrect u0 v0 u2 v2 6 "FQ_OLT")
         (list "OLT" oz (itoa np) st))
  (fq:Wtext u0 (+ v0 (* 0.7 *FQ-PITCH*)) (* 1.8 *FQ-TXTH*)
            oz 6 "FQ_OLT" "FQ_TXTB" 0 0)
  (setq i 1)
  (while (<= i np)
    (setq v (- vtop (* *FQ-PITCH* (1- i))))
    ;; u2 je desna ivica tela; patrljak ide odatle udesno, pa se prvi
    ;; zavrsava tacno na pokazanoj tacki.
    (fq:Wline u2 v (+ u2 *FQ-OLT-PON*) v 6 "FQ_OLT"
              (list "PON" oz (itoa i) st))
    (fq:Wtext (+ u2 0.4) (+ v (* 0.2 *FQ-TXTH*)) *FQ-TXTH*
              (strcat "PON " (itoa i)) 6 "FQ_OLT" "FQ_TXT" 0 0)
    (setq i (1+ i)))
  (princ (fq:tf "olt.nacrtan" (list oz (itoa np) (fq:stnaziv st)))))

;;; --- pregled OLT-a uz mis -----------------------------------------
;;;
;;;  Ista masina kojom se pokazuje kabl, ram kucista i spliter: grread
;;;  i grvecs, bez ijednog entiteta u crtezu.  Ako se odustane, u crtezu
;;;  ne ostaje nista.
;;;
;;;  Nula je KRAJ PRVOG PON PORTA, ista tacka koju ocekuje fq:drawolt,
;;;  pa cela silueta pada LEVO od nisana.  Obe strane racunaju kroz
;;;  fq:oltteme i fq:oltgeo; ako se one promene, pregled i nacrtan OLT
;;;  se pomere zajedno.
;;;
;;;  Prvi PON je crven, kao prvo vlakno u pregledu kabla, da se vidi
;;;  koji red je referentni i na sta ce pasti.  Retko crtanje preko
;;;  *FQ-DRAG-MAX* je isto kao kod splitera: np dolazi iz getint-a i
;;;  nije ogranicen odozgo.

(defun fq:oltvecs (np ang / sa sm tm gm u1 v1 u2 v2 vtop out i v aci retko)
  ;;  *fq-m* se pamti i vraca zajedno sa *fq-a*, i ulazi se kroz
  ;;  fq:sistem sa NIL ogledalom.  Ogledalo se ne cisti nigde posle
  ;;  uspesno zavrsene komande -- fq:cisti zove samo fq:err -- pa
  ;;  nacrtano ogledalno kuciste ostavlja *fq-m* na -1.0 do sledeceg
  ;;  fq:init.  A fq:init je UNUTAR crtaca, dakle posle pregleda: bez
  ;;  ovoga bi silueta bila preslikana, a nacrtalo bi se nepreslikano.
  (setq sa *fq-a* sm *fq-m*)
  (fq:sistem ang nil)
  (setq np    (max 1 np)
        tm    (fq:oltteme 0.0 0.0)
        gm    (fq:oltgeo (car tm) (cadr tm) np)
        u1    (nth 0 gm)  v1 (nth 1 gm)
        u2    (nth 2 gm)  v2 (nth 3 gm)
        vtop  (nth 4 gm)
        retko (> np *FQ-DRAG-MAX*)
        out   (list 6 (fq:w u1 v1) (fq:w u2 v1)
                    6 (fq:w u2 v1) (fq:w u2 v2)
                    6 (fq:w u2 v2) (fq:w u1 v2)
                    6 (fq:w u1 v2) (fq:w u1 v1))
        i     1)
  (while (<= i np)
    (setq v   (- vtop (* *FQ-PITCH* (1- i)))
          aci (if (= i 1) 1 6))
    (if (or (not retko) (= i 1) (= i np))
      (setq out (append out
                        (list aci (fq:w u2 v)
                                  (fq:w (+ u2 *FQ-OLT-PON*) v)))))
    (setq i (1+ i)))
  (setq *fq-a* sa *fq-m* sm)
  out)

;; Kraj prvog PON porta, sa pregledom ako je pregled ukljucen.
;;
;; Hvatanje se NAMERNO gasi, iz istog razloga koji stoji uz fq:pickbox:
;; telo OLT-a je celo LEVO od pokazane tacke, a i ram kucista se crta
;; levo od svog prvog konektora, pa bi hvatanje spustilo kutiju tacno
;; preko zatecenog rama.  Spliter to sme, jer mu telo staje izmedju
;; pregrade i kolone portova; OLT je kutija siroka *FQ-OLT-W* i u
;; kuciste ne ide nikad.  Bez hvatanja se ugao ne moze ni promeniti, pa
;; *fq-dragre* nema sta da nosi i silueta se ne pregradjuje.
(defun fq:pickolt (msg np ang / vecs p)
  (setq *fq-snaphit*  nil          ; vidi napomenu uz fq:pickbox
        *fq-dragre*   nil
        *fq-dragsnap* nil)
  (if (not *FQ-DRAG*)
    (fq:gp msg)
    (progn
      (setq vecs (fq:oltvecs np ang))
      (setq p (vl-catch-all-apply
                'fq:dragpt (list msg
                                 vecs ang nil)))
      (if (vl-catch-all-error-p p)
        (progn (redraw)
               (princ (fq:t "opste.pregled.ne"))
               (fq:gp msg))
        p))))

(defun c:FQOLT ( / *error* oz np st p0 auto)
  (setq *error* fq:err)
  ;; Podrazumevana oznaka je bila ime jedne platforme.  Sada je to
  ;; sledeci slobodan broj, isto kao u fq:polt sa trake.
  (setq oz (fq:trim (getstring T (fq:t "olt.pitaj.oznaka"))))
  (if (= oz "") (setq oz (fq:next "OLT")))
  (if (not (setq np (getint (fq:t "olt.pitaj.portovi")))) (setq np 16))
  (if (< np 1) (setq np 16))
  (setq st (fq:askst))
  ;; Kroz fq:pickolt, ne kroz golo fq:gp.  Brava fq:ucsok NIJE dobitak
  ;; -- fq:gp je i sam nosi, i OLT ju je oduvek imao; dobitak je pregled
  ;; uz mis, da se ne polaze na slepo pa popravlja MOVE-om.
  ;;
  ;; Cena je stvarna i placa se svesno: grread ne prolazi kroz object
  ;; snap, a otkucana koordinata je nepoznat taster, pa je fq:dragpt
  ;; tumaci kao prekid i otkazuje komandu.  Ko hoce staro ponasanje,
  ;; gasi Pregled na paleti (*FQ-DRAG*) ili u toku pokazivanja pritisne
  ;; O.  Ista razmena vec vazi za kabl, kuciste, nastavak i spliter.
  ;;
  ;; Ista niska kao u fq:polt: pitanje sada imenuje bas onu tacku koja
  ;; se pokazuje, pa nema razloga da se OLT javlja opstim
  ;; "kabl.pitaj.tacka".
  (if (setq p0 (fq:pickolt (fq:tf "olt.pitaj.tacka" (list oz (itoa np)))
                           np *fq-ugao*))
    (fq:drawolt oz np st p0)
    (princ (fq:t "opste.otkazano")))
  (princ))

(defun fq:polt (np / oz p0)
  (setq oz (fq:next "OLT"))
  (if (setq p0 (fq:pickolt (fq:tf "olt.pitaj.tacka" (list oz (itoa np)))
                           np *fq-ugao*))
    (fq:drawolt oz np *fq-st* p0)
    (princ (fq:t "opste.otkazano"))))

;; ang je ugao pod kojim se crta.  Do sada se uzimao iz *fq-ugao*, a
;; sada se zadaje, iz istog razloga zbog koga ga zadaje i fq:drawspl:
;; ONT spusten hvatanjem na konektor rama nacrtanog pod drugim uglom
;; mora da legne kako je okrenut TAJ ram, inace privod ide poprecno na
;; kolonu iz koje izlazi -- i to bas kad je hvatanje uradilo svoj posao.
(defun fq:drawont (oz adr st ang p0 / loc tm gm u0 v0 u2 v2 vmid)
  (fq:init)
  ;; p0 je KRAJ PRIVODA, ne teme tela.  Prevod radi fq:ontteme, koju
  ;; zove i pregled -- vidi fq:ontvecs.
  (setq *fq-a* (fq:deg ang)
        loc    (fq:loc p0)
        tm     (fq:ontteme (car loc) (cadr loc))
        gm     (fq:ontgeo (car tm) (cadr tm))
        u0     (nth 0 gm)  v0   (nth 1 gm)
        u2     (nth 2 gm)  v2   (nth 3 gm)
        vmid   (nth 4 gm))
  (fq:xd (fq:Wrect u0 v0 u2 v2 2 "FQ_ONT")
         (list "ONT" oz adr st))
  (fq:Wtext (+ u0 0.5) (- v0 1.1) (* 1.2 *FQ-TXTH*)
            oz 2 "FQ_ONT" "FQ_TXTB" 0 0)
  (fq:Wtext (+ u0 0.5) (- v0 2.2) *FQ-TXTH* adr 2 "FQ_ONT" "FQ_TXT" 0 0)
  ;; vmid je sredina leve ivice; privod ide odatle nalevo, pa mu
  ;; slobodan kraj pada tacno na pokazanu tacku.
  (fq:Wline (- u0 *FQ-ONT-PRI*) vmid u0 vmid 2 "FQ_ONT"
            (list "PRIVOD" oz adr st))
  (princ (fq:tf "ont.nacrtan" (list oz adr (fq:stnaziv st)))))

;;; --- pregled ONT-a uz mis -----------------------------------------
;;;
;;;  Nula je KRAJ PRIVODA, ista tacka koju ocekuje fq:drawont, pa cela
;;;  silueta pada DESNO od nisana.  Obe strane racunaju kroz fq:ontteme
;;;  i fq:ontgeo, pa se ne mogu razici.
;;;
;;;  Privod je crven, jer je on ono cime se ONT kaci -- isto merilo po
;;;  kome je crven prvi izlaz splitera i prvo vlakno kabla.

(defun fq:ontvecs (ang / sa sm tm gm u1 v1 u2 v2 vmid out)
  ;;  *fq-m* se pamti i vraca zajedno sa *fq-a*, i ulazi se kroz
  ;;  fq:sistem sa NIL ogledalom.  Ogledalo se ne cisti nigde posle
  ;;  uspesno zavrsene komande -- fq:cisti zove samo fq:err -- pa
  ;;  nacrtano ogledalno kuciste ostavlja *fq-m* na -1.0 do sledeceg
  ;;  fq:init.  A fq:init je UNUTAR crtaca, dakle posle pregleda: bez
  ;;  ovoga bi silueta bila preslikana, a nacrtalo bi se nepreslikano.
  (setq sa *fq-a* sm *fq-m*)
  (fq:sistem ang nil)
  (setq tm   (fq:ontteme 0.0 0.0)
        gm   (fq:ontgeo (car tm) (cadr tm))
        u1   (nth 0 gm)  v1 (nth 1 gm)
        u2   (nth 2 gm)  v2 (nth 3 gm)
        vmid (nth 4 gm)
        out  (list 2 (fq:w u1 v1) (fq:w u2 v1)
                   2 (fq:w u2 v1) (fq:w u2 v2)
                   2 (fq:w u2 v2) (fq:w u1 v2)
                   2 (fq:w u1 v2) (fq:w u1 v1)
                   1 (fq:w (- u1 *FQ-ONT-PRI*) vmid) (fq:w u1 vmid)))
  (setq *fq-a* sa *fq-m* sm)
  out)

;; Kraj privoda, sa pregledom i hvatanjem.
;;
;; Hvatanje ovde OSTAJE, za razliku od fq:pickolt: telo ONT-a je celo
;; DESNO od pokazane tacke, pa privod spusten na konektor kucista
;; ostavlja kutiju PORED rama, a ne preko njega.  To je uz to i najcesci
;; potez -- korisnik visi sa izlaza FDH-a ili ZOK kutije.
;;
;; *fq-dragre* opisuje siluetu, da pregled ume da okrene ONT kada
;; hvatanje uhvati ram nacrtan pod drugim uglom; ugao se zato u komandi
;; uzima kroz fq:snapuzmi, isto kao kod splitera.
;;  Hvatanje na konektor ostaje UKLJUCENO, za razliku od fq:pickbox.
;;  Telo ONT-a je na +u od pokazane tacke, a kuciste se crta na -u od
;;  svoje kolone, pa se ta dva ne preklapaju: privod spusten na konektor
;;  odvodi ONT od kucista, ne preko njega.
;;
;;  Jedan slucaj ipak izmice, i prihvacen je: OGLEDALNO kuciste telo drzi
;;  na +u (vidi odeljak o *fq-m*), pa ONT spusten na njegov konektor
;;  padne tacno preko rama.  fq:snapuzmi vraca samo ugao, ogledalo se
;;  baca, a fq:drawont nema gde da ga primi.  Isto ogranicenje ima i
;;  spliter; resenje trazi da ogledalo prodje kroz oba crtaca, i to je
;;  zaseban posao.
(defun fq:pickont (msg ang / vecs p)
  (setq *fq-snaphit*  nil          ; vidi napomenu uz fq:pickbox
        *fq-dragre*   (list "ont")
        *fq-dragsnap* T)
  (if (not *FQ-DRAG*)
    (fq:gp msg)
    (progn
      (setq vecs (fq:ontvecs ang))
      (setq p (vl-catch-all-apply
                'fq:dragpt (list msg
                                 vecs ang nil)))
      (if (vl-catch-all-error-p p)
        (progn (redraw)
               (princ (fq:t "opste.pregled.ne"))
               ;; greska je mogla da iskoci POSLE klika, kada je pogodak
               ;; vec upisan -- vidi napomenu uz fq:pickins
               (setq *fq-snaphit* nil)
               (fq:gp msg))
        p))))

(defun c:FQONT ( / *error* oz adr st p0 ang)
  (setq *error* fq:err)
  (setq oz (getstring T (fq:t "ont.pitaj.oznaka")))
  (if (= oz "") (setq oz "ONT"))
  (setq adr (getstring T (fq:t "ont.pitaj.korisnik")))
  (setq st (fq:askst))
  ;; Otkazivanje se sada i javlja.  Do sada je ova jedina komanda u
  ;; odeljku cutala na Esc, pa se nije razlikovalo odustajanje od
  ;; komande koja je nesto nacrtala van pogleda.
  (if (setq p0 (fq:pickont (fq:t "ont.pitaj.tacka") *fq-ugao*))
    (progn (setq ang (fq:snapuzmi *fq-ugao*))
           (fq:drawont oz adr st ang p0))
    (princ (fq:t "opste.otkazano")))
  (princ))

(defun fq:pont ( / adr p0 ang)
  (setq adr (getstring T (fq:t "ont.pitaj.korisnik")))
  (if (setq p0 (fq:pickont (fq:t "ont.pitaj.tacka") *fq-ugao*))
    (progn (setq ang (fq:snapuzmi *fq-ugao*))
           (fq:drawont "ONT" adr *fq-st* ang p0))
    (princ (fq:t "opste.otkazano"))))

;; Metri rezerve kao string, na JEDNOM mestu.
;;
;; Isti izraz je stajao cetiri puta u fq:drawrez i peti put u fq:prez.
;; Preciznost je 0, pa rtos zaokruzuje: 12.5 postane "13".  To samo po
;; sebi nije greska -- rezerva se i pise u celim metrima -- ali je bilo
;; tiho: korisnik upise 12.5, u crtezu i u specifikaciji stoji 13, i
;; nigde ne pise da je zaokruzeno.  Sada se racuna jednom i kaze se.
;;
;; Format ostaje isti ("15"), da se rezerve iz starijih crteza i nove
;; i dalje grupisu u isti red specifikacije.
(defun fq:rezm (dz) (rtos dz 2 0))

(defun fq:drawrez (dz st p0 / loc u0 v0 i m)
  (fq:init)
  (setq m (fq:rezm dz))
  (setq *fq-a* (fq:deg *fq-ugao*)
        loc    (fq:loc p0)
        u0     (car loc)
        v0     (cadr loc)
        i      0)
  (while (< i 3)
    (fq:Well (+ u0 (* 0.6 i)) v0 1.2 0.7 30 "FQ_REZERVA")
    (setq i (1+ i)))
  ;; Zapis ide na NATPIS, ne na koture: kotura ima tri i nijedna nije
  ;; "ta prava".  Dok je stajalo (fq:xd (entlast) ...) to se videlo samo
  ;; iz redosleda poziva; ovako pise u samom izrazu.
  (fq:xd (fq:Wtext u0 (+ v0 1.2) *FQ-TXTH*
                   (strcat "R = " m " m") 30 "FQ_REZERVA" "FQ_TXT" 0 0)
         (list "REZERVA" m st))
  (princ (fq:tf "rez.nacrtan" (list m (fq:stnaziv st))))
  (if (> (abs (- dz (atof m))) 1e-9)
    (princ (fq:tf "rez.zaokruzeno" (list (rtos dz 2 2))))))

(defun c:FQREZERVA ( / *error* dz st p0)
  (setq *error* fq:err)
  (setq dz (fq:pitajreal (fq:t "rez.pitaj.duzina") 15.0))
  ;; negativna rezerva bi u FQBUDZET usla kao odbitak
  (if (<= dz 0.0) (setq dz 15.0))
  (setq st (fq:askst))
  (if (setq p0 (fq:gp (fq:t "opste.pitaj.tacka"))) (fq:drawrez dz st p0))
  (princ))

(defun fq:prez (dz / p0)
  (if (setq p0 (fq:gp (fq:tf "rez.pitaj.tacka" (list (fq:rezm dz)))))
    (fq:drawrez dz *fq-st* p0)
    (princ (fq:t "opste.otkazano"))))


;;; ==================================================================
;;;  16. SPAJANJE VLAKANA
;;;
;;;  Spajanje uzima dva vlakna, skraduje ih do mesta spoja, spaja ih
;;;  u jednu poliliniju i ostavlja crnu punu tacku na lomu.
;;;  Mesto spoja je sredina nastavka koji obuhvata red vlakna.
;;;  Ako u crtezu nema nijednog nastavka, trazi se rucno pokazivanje.
;;; ==================================================================

;; izmena jednog polja u listi podataka, lista se po potrebi dopuni
(defun fq:setnthx (lst n v / i tmp out)
  (setq tmp lst)
  (while (<= (length tmp) n) (setq tmp (append tmp (list ""))))
  (setq i 0 out nil)
  (foreach x tmp (setq out (cons (if (= i n) v x) out) i (1+ i)))
  (reverse out))

;; podaci spojenog vlakna: zadrzava se identitet A, lanac se prosiruje
(defun fq:lanac (d1 d2)
  (fq:spoji2 (if (= (fq:vl-lan d1) "") (fq:vl-id d1) (fq:vl-lan d1))
             (if (= (fq:vl-lan d2) "") (fq:vl-id d2) (fq:vl-lan d2))))

;; Zavrseci spojenog vlakna. Ranije je ostajao samo zavrsetak vlakna A,
;; pa se pri spajanju gubilo na kom portu ODF-a stoji drugi kraj.
;; Bez oba kraja nema trase, a bez trase nema ni broja konektora.
(defun fq:vezaspoj (d1 d2)
  (fq:spoji2 (fq:vl-veza d1) (fq:vl-veza d2)))

;;; --- razmicanje uspravnih prelaza spoja ---------------------------
;;;
;;;  Do sada je svaki spoj pravio uspravni prelaz na ISTOJ koordinati
;;;  duz kabla -- na sredini nastavka.  Dok se spaja red u red to se ne
;;;  vidi, jer prelaz nema visinu: oba kraja su u istom redu i linija je
;;;  prava.  Cim se vlakna izmesaju (3 na 7, 4 na 2), prelazi postanu
;;;  duge uspravne linije na jednoj te istoj koloni i legnu jedna preko
;;;  druge.  Dva spoja, jedna vidljiva linija.
;;;
;;;  Crtez i dalje NOSI oba vlakna, xdata je citava i specifikacija je
;;;  tacna -- ne moze se procitati samo ono zbog cega se sema i crta:
;;;  koje vlakno ide na koje.  To je tiho pogresan crtez, ne pogresan
;;;  podatak, i zato se ne vidi ni u jednoj proveri.
;;;
;;;  Zato svaki prelaz dobija svoju kolonu: sredina ako je slobodna, pa
;;;  redom levo i desno u koracima *FQ-SPOJ-KOR*.  Uzima se prva kolona
;;;  na kojoj se raspon prelaza ne dodiruje ni sa jednim vec nacrtanim.
;;;  Dodir se broji kao zauzece: prelaz 1-2 i prelaz 2-3 u istoj koloni
;;;  spajaju se u jednu neprekidnu liniju od 1 do 3, sto je isto toliko
;;;  neprocitljivo kao i preklapanje.
;;;
;;;  Kada slobodne kolone nema, ostaje sredina i to se PRIJAVLJUJE.
;;;  Nacrtan spoj sa preklapanjem je bolji od nenacrtanog, ali korisnik
;;;  koji je bas ovo trazio mora da zna da mu ram nastavka nije dovoljno
;;;  sirok -- inace bi zakljucio da razmicanje ne radi.

;;;  --- i vodoravni delovi, ne samo uspravni ---
;;;
;;;  Razmicanje kolona resava samo POLA posla.  Spoj vodi vlakno A po
;;;  NJEGOVOM redu do kolone, pa vlakno B po SVOM redu od kolone dalje.
;;;  Red je zato podeljen na dva poteza koja pripadaju razlicitim
;;;  spojevima -- levi deo jednom, desni drugom -- i oni se preklapaju
;;;  cim je leva kolona desno od desne.
;;;
;;;  To se ne vidi kao kvar nego kao jedna linija umesto dve, isto kao
;;;  kod uspravnih prelaza, samo lezi vodoravno.  Zato kolona mora da
;;;  zadovolji OBA uslova: da uspravni prelaz ne padne preko tudjeg, i
;;;  da nijedan od dva vodoravna poteza ne gazi tudji potez na istom
;;;  redu.
;;;
;;;  Postoji raspored koji se ne moze razdvojiti, i to nije propust
;;;  algoritma nego geometrije: kad dva vlakna ZAMENE redove (levo 4 na
;;;  desno 8 i levo 8 na desno 4), na jednom od ta dva reda preklapanje
;;;  ostaje ma gde se kolone stavile.  Da bi prvi spoj napustio red 4
;;;  pre nego sto drugi na njega stigne, njegova kolona mora biti levo
;;;  od druge; na redu 8 isti racun trazi obrnuto.  Oba uslova zajedno
;;;  se ne mogu ispuniti.  Razdvojio bi ih jedino obilazak kroz TRECI,
;;;  slobodan red -- posao pravog rutera, koji ovde nije uradjen.
;;;  Takvi spojevi se prijavljuju.

;; Segmenti vec nacrtanih vlakana oko koordinate us:
;;   ("U" u  v1 v2 entitet)   uspravan, samo ako je kolona u pojasu
;;   ("H" v  u1 u2 entitet)   vodoravan, u punoj duzini, ako preseca pojas
;;
;;  Vodoravan se pamti CEO, a ne odsecen na pojas: preklapanje se meri
;;  po stvarnom potezu, a on ide sve do kabla.
(defun fq:spseg (us gr / ss i e d pts n j a b out)
  (setq ss (fq:ssx '((8 . "FQ_VLAKNO") (-3 ("FIBERQ")))) i 0 out nil)
  (if ss
    (while (< i (sslength ss))
      (setq e   (ssname ss i)
            d   (fq:xdget e)
            pts (if (and d (= (car d) "VLAKNO")) (fq:plpts e) nil)
            n   (if pts (length pts) 0)
            j   0)
      (while (< j (1- n))
        (setq a (nth j pts) b (nth (1+ j) pts))
        (cond
          ((and (< (abs (- (car  a) (car  b))) 1e-6)
                (> (abs (- (cadr a) (cadr b))) 1e-6)
                (<= (abs (- (car a) us)) gr))
           (setq out (cons (list "U" (car a)
                                 (min (cadr a) (cadr b))
                                 (max (cadr a) (cadr b)) e)
                           out)))
          ((and (< (abs (- (cadr a) (cadr b))) 1e-6)
                (> (max (car a) (car b)) (- us gr))
                (< (min (car a) (car b)) (+ us gr)))
           (setq out (cons (list "H" (cadr a)
                                 (min (car a) (car b))
                                 (max (car a) (car b)) e)
                           out))))
        (setq j (1+ j)))
      (setq i (1+ i))))
  out)

;;  Kes zauzeca: (us granica segment ...).  Vazi za JEDNU komandu --
;;  brise ga fq:init -- a svaki nov potez se u njega dopisuje.  Bez toga
;;  bi grupno spajanje od 96 parova prescaniralo ceo crtez 96 puta, a i
;;  dalje ne bi videlo poteze koje je samo nacrtalo.
(setq *fq-spkol* nil)

;;  Koliko prelaza nije naslo slobodnu kolonu.  Broji se po komandi, pa
;;  grupno spajanje javlja jednom umesto 96 puta.
(setq *fq-spgust* 0)

;;  Koliko se sme odstupiti od sredine.  Meri se od rama nastavka, jer
;;  prelaz izvan rama vise ne izgleda kao spoj u tom nastavku nego kao
;;  lom na kablu.  Uzan ram sam sebe ogranici na nulu i sve ostaje na
;;  sredini, sto je tacno -- tamo prostora ni nema.
;;
;;  Od pola sirine se oduzima *FQ-PRS-ULAZ*, i to nije opreznost nego
;;  uslov.  Crna tacka splajsa lezi na samom prelazu, a presecanje brise
;;  samo one tacke koje padnu u ZEV -- a zev je bas ram uvucen za
;;  *FQ-PRS-ULAZ* sa obe strane (fq:kutza).  Prelaz izvan tog pojasa bi
;;  posle FQPRESECI ostavio crnu tacku koja tvrdi da tu ima varenja, a
;;  varenja vise nema.  Jos jedan korak razmaka drzi tacku strogo unutar
;;  zeva, jer fq:prsvar poredi ostro.
;;
;;  fq:najnast NIKAD ne vraca nil dok u crtezu ima ijednog nastavka --
;;  bira najblizi, ma koliko dalek bio.  Zato se gleda njegovo promasenje
;;  po duzini (clan 6): tek kad je nula, us stvarno lezi u tom ramu i ram
;;  sme da odredjuje granicu.  Bez tog uslova bi spoj pokazan misem
;;  nasred crteza merio sirinu po nastavku sa druge strane sela, dobio
;;  negativnu granicu i tiho ostao bez razmicanja.  Tada, kao i kad
;;  nastavka uopste nema, vazi *FQ-SPOJ-MAX*.
(defun fq:spgran (us va ag / n)
  (if (and (setq n (fq:najnast us va ag)) (< (nth 6 n) 0.001))
    (max 0.0 (min *FQ-SPOJ-MAX*
                  (- (min (- us (car n)) (- (cadr n) us))
                     *FQ-PRS-ULAZ* *FQ-SPOJ-KOR*)))
    *FQ-SPOJ-MAX*))

(defun fq:spzauz (us va ag / gr)
  (if (not (and *fq-spkol* (equal (car *fq-spkol*) us 1e-6)))
    (setq gr        (fq:spgran us va ag)
          ;; pojas je za jedan korak siri od granice: uspravnu liniju
          ;; kabla tik uz poslednju kolonu treba videti, a fq:sppun je
          ;; trazi u prozoru od pola koraka
          *fq-spkol* (cons us (cons gr (fq:spseg us (+ gr *FQ-SPOJ-KOR*))))))
  *fq-spkol*)

;;  Kes bez segmenata dva vlakna koja upravo nestaju.  Njihova stara
;;  geometrija je u trenutku skeniranja jos u crtezu, a posle spajanja je
;;  nema; bez ovoga bi sledeci par u istoj komandi merio preklapanje po
;;  potezima kojih vise nema, i redom odbijao svaku kolonu.
;;
;;  Poredjenje ide kroz equal, ne eq.  Rukohvat u kesu dolazi iz ssname,
;;  a e1 i e2 iz entsel ili iz spiska vlakana -- dva razlicita objekta sa
;;  istom vrednoscu.  eq bi rekao "nije isto", vlakno koje nestaje ostalo
;;  bi u kesu, i svaka kolona bi ispala zauzeta.  Isti razlog zbog kog
;;  fq:spoj1 dva izabrana vlakna poredi sa equal.
(defun fq:spbez (kes e1 e2 / out)
  (setq out nil)
  (foreach z (cddr kes)
    (if (not (or (equal (nth 4 z) e1) (equal (nth 4 z) e2)))
      (setq out (cons z out))))
  (cons (car kes) (cons (cadr kes) (reverse out))))

;; Da li se uspravni raspon (v1 v2) na koloni u dodiruje sa vec zauzetim.
(defun fq:sppun (u v1 v2 zau / r)
  (setq r nil)
  (foreach z zau
    (if (and (= (car z) "U")
             (< (abs (- (cadr z) u)) (* 0.5 *FQ-SPOJ-KOR*))
             (<= v1 (+ (cadddr z) 0.05))
             (>= v2 (- (caddr  z) 0.05)))
      (setq r T)))
  r)

;;  Da li vodoravan potez [u1 u2] na redu v gazi tudji potez na istom
;;  redu.  Dodir je dozvoljen (0.05), preklapanje nije: dva poteza koja
;;  se sastavljaju u tacki i dalje izgledaju kao dva.
(defun fq:sphpun (v u1 u2 zau e1 e2 / r)
  (setq r nil)
  (foreach z zau
    (if (and (= (car z) "H")
             ;; equal, ne eq -- vidi fq:spbez
             (not (equal (nth 4 z) e1))
             (not (equal (nth 4 z) e2))
             (< (abs (- (cadr z) v)) (* 0.5 *FQ-PITCH*))
             (> (min u2 (cadddr z)) (+ (max u1 (caddr z)) 0.05)))
      (setq r T)))
  r)

;; Kolona c prolazi samo ako su sva tri poteza spoja slobodna.
(defun fq:spslobodna (c v1 v2 va vb ua ub zau e1 e2)
  (and (not (fq:sppun  c v1 v2 zau))
       (not (fq:sphpun va (min ua c) (max ua c) zau e1 e2))
       (not (fq:sphpun vb (min ub c) (max ub c) zau e1 e2))))

;;  Kolona spoja.  va i vb su redovi krajeva, ua i ub pocetci njihovih
;;  poslednjih vodoravnih deonica, e1 i e2 vlakna koja spajanjem nestaju.
;;
;;  Kada prelaza nema (oba kraja u istom redu) vraca sredinu i ne trazi
;;  nista: nulta visina se ni sa cim ne moze preklopiti, a red koji taj
;;  spoj zauzima s obe strane nema drugog vlasnika.  To je najcesci
;;  slucaj -- spajanje red u red -- i on se ovim ne sme pomeriti.
(defun fq:spojkol (us va vb ag ua ub e1 e2 / zau gr v1 v2 k u nadj)
  (setq v1  (min va vb)
        v2  (max va vb)
        zau (fq:spzauz us va ag)
        gr  (cadr zau)
        u   nil)
  (if (< (- v2 v1) (* 0.5 *FQ-PITCH*))
    (setq u us)
    (progn
      (setq k 0)
      (while (and (not u) (<= (* k *FQ-SPOJ-KOR*) gr))
        (setq nadj (list (+ us (* k *FQ-SPOJ-KOR*))
                         (- us (* k *FQ-SPOJ-KOR*))))
        (foreach c nadj
          (if (and (not u)
                   (fq:spslobodna c v1 v2 va vb ua ub (cddr zau) e1 e2))
            (setq u c)))
        (setq k (1+ k)))
      ;;  Drugi prolaz: kad se sva tri uslova ne mogu zadovoljiti,
      ;;  popusta se onaj koji se ionako ne moze izbeci -- vodoravni --
      ;;  a uspravni prelaz se i dalje trazi slobodan.
      ;;
      ;;  Bez ovoga bi svaki nemoguc spoj zavrsio na sredini, pa bi se
      ;;  kod potpuno obrnutog snopa svih sest nemogucih spojeva
      ;;  naslagalo u JEDNU kolonu i dodalo petnaest uspravnih
      ;;  preklapanja preko onih sest koja su stvarno neizbezna.  Cena
      ;;  neizbezne greske ne sme da bude veca od nje same.
      (if (not u)
        (progn
          (setq *fq-spgust* (1+ *fq-spgust*) k 0)
          (while (and (not u) (<= (* k *FQ-SPOJ-KOR*) gr))
            (setq nadj (list (+ us (* k *FQ-SPOJ-KOR*))
                             (- us (* k *FQ-SPOJ-KOR*))))
            (foreach c nadj
              (if (and (not u) (not (fq:sppun c v1 v2 (cddr zau))))
                (setq u c)))
            (setq k (1+ k)))))
      (if (not u) (setq u us))))
  ;;  Sva tri poteza idu u kes i kad kolona NIJE nadjena: nacrtani su
  ;;  svejedno, pa sledeci spoj mora da racuna sa njima.  Istim potezom
  ;;  ispadaju segmenti dva vlakna koja upravo nestaju.
  (setq *fq-spkol*
        (append (fq:spbez *fq-spkol* e1 e2)
                (if (>= (- v2 v1) (* 0.5 *FQ-PITCH*))
                  (list (list "U" u v1 v2 nil))
                  nil)
                (list (list "H" va (min ua u) (max ua u) nil)
                      (list "H" vb (min ub u) (max ub u) nil))))
  u)

;; jedno spajanje. e1 e2 entiteti, p1 p2 tacke izbora
;; us je mesto spoja, oz oznaka nastavka; ako je us nil, racuna se ovde
(defun fq:spoj1 (e1 e2 p1 p2 us oz / d1 d2 ag a b va vb uk ku pts un new)
  (setq d1 (fq:xdget e1) d2 (fq:xdget e2))
  (cond
    ((equal e1 e2)
     (princ (fq:t "spoj.presk.isto")) nil)
    ((not (and d1 d2 (= (car d1) "VLAKNO") (= (car d2) "VLAKNO")))
     (princ (fq:t "spoj.presk.nijevlakno")) nil)
    (T
    (progn
      (setq ag (if (= (fq:f 13 d1) "") 0 (atoi (fq:f 13 d1))))
      (setq *fq-a* (fq:deg ag))
      (setq a  (fq:orient e1 p1)
            b  (fq:orient e2 p2)
            va (cadr (last a)))
      (if (not us)
        (progn
          (setq un (fq:usnast (car (last a)) va ag
                              (fq:t "spoj.pitaj.mesto")))
          (if un (setq us (car un) oz (cadr un)))))
      (if (not us)
        (progn (princ (fq:t "spoj.red.otkazano")) nil)
        (progn
          ;; Oba kraja se skracuju na mesto spoja, ali samo ako su
          ;; vodoravni.  Vlakno izvoda bez lakta zavrsava USPRAVNO, pa
          ;; fq:trimto nema sta da skrati i njegov kraj ostaje na svojoj
          ;; koloni.  Tada mesto spoja odredjuje BAS taj kraj i drugo
          ;; vlakno se vodi do njega; inace bi otislo do sredine
          ;; nastavka pa se vratilo nazad, i na crtezu bi ispala
          ;; stepenasta petlja.  Svejedno je koje je izabrano prvo.
          (setq a (fq:trimto a us)
                b (fq:trimto b us))
          (cond
            ((and (fq:vodoravan a) (not (fq:vodoravan b)))
             (setq a (fq:trimto a (car (fq:last b)))))
            ((and (fq:vodoravan b) (not (fq:vodoravan a)))
             (setq b (fq:trimto b (car (fq:last a)))))
            ;;  Oba kraja vodoravna -- tek tada prelaz uopste ima svoju
            ;;  kolonu, pa se pomera na slobodnu.  Uspravan kraj je
            ;;  vezan za kolonu izvoda i ne sme se pomeriti; tamo je
            ;;  preklapanje cena koju placa izvod, ne spoj.
            ;;
            ;;  Skracuju se OBA, na istu kolonu.  Da se skratilo samo
            ;;  jedno, prelaz vise ne bi bio uspravan nego kos -- a kosa
            ;;  linija u semi znaci lom kabla, ne spoj.
            ;;  ua i ub su pocetci poslednjih vodoravnih deonica, ne
            ;;  daleki krajevi vlakana: kod kabla sa lomovima red vazi
            ;;  tek od preloma, pa bi dalek kraj prijavio zauzece na
            ;;  delu reda kroz koji vlakno uopste ne prolazi.
            ((and (fq:vodoravan a) (fq:vodoravan b))
             (setq ku (fq:spojkol us (cadr (last a)) (cadr (last b)) ag
                                  (car (nth (- (length a) 2) a))
                                  (car (nth (- (length b) 2) b))
                                  e1 e2))
             (if (> (abs (- ku us)) 1e-6)
               (setq a (fq:trimto a ku)
                     b (fq:trimto b ku)))))
          (setq va (cadr (last a))
                vb (cadr (last b)))
          ;; uk je koordinata loma. Kada su oba vlakna skracena na us
          ;; to je bas us, pa tacka splajsa lezi na lomu L.
          ;; Ako A nije mogao da se skrati, prelaz je pravougaoni:
          ;; vodoravno do kraja B, pa uspravno na njegov red.
          (setq uk (if (> (abs (- (car (last a)) (car (last b)))) 1e-6)
                     (car (last b))
                     (car (last a))))
          ;; fq:ravna kao i kod prolaznog vlakna: na mestu spoja inace
          ;; ostane teme koje lezi na pravoj izmedju suseda.  Vlakno
          ;; izgleda pravo, ali bi ga svaki STRETCH prelomio bas na
          ;; splajsu, a vlakno spojeno kroz pet nastavaka nosi pet
          ;; takvih zamki.
          (setq pts (fq:ravna
                      (append a
                              (if (/= uk (car (last a)))
                                (list (list uk va))
                                nil)
                              (reverse b))))
          ;;  Polje 19 se spaja iz istog razloga iz kog i 8 i 15: zapis
          ;;  spojenog vlakna je zapis vlakna A, pa bi duzina vlakna B
          ;;  ovde nestala bez ijednog znaka da je nestala.
          (setq new (fq:mkfiber pts e1
                                (fq:setnthx
                                  (fq:setnthx
                                    (fq:setnthx d1 8 (fq:vezaspoj d1 d2))
                                    15 (fq:lanac d1 d2))
                                  19 (fq:duzspoj (fq:vl-duz d1)
                                                 (fq:vl-duz d2)))))
          (entdel e1)
          (entdel e2)
          (fq:xd (fq:Wdot uk va *FQ-SPD* 7 "FQ_VARENJE")
                 (list "VARENJE" (fq:f 1 d1) (fq:f 1 d2) "FUSION"
                       (fq:f 7 d1) (if oz oz "")))
          new))))))

(defun c:FQSPOJ ( / *error* s1 s2)
  (setq *error* fq:err)
  (fq:init)
  (setq s1 (entsel (fq:t "spoj.pitaj.prvo")))
  (if s1 (setq s2 (entsel (fq:t "spoj.pitaj.drugo"))))
  (if (and s1 s2)
    (if (fq:spoj1 (car s1) (car s2) (cadr s1) (cadr s2) nil nil)
      (princ (fq:t "spoj.gotovo")))
    (princ (fq:t "opste.otkazano")))
  (if (> *fq-spgust* 0)
    (princ (fq:tf "spoj.gusto" (list (itoa *fq-spgust*)))))
  (princ))

;; stara komanda ostaje kao sinonim
(defun c:FQVAR ( / *error* )
  (setq *error* fq:err) (c:FQSPOJ))


;;; --- splajs na jednom vlaknu --------------------------------------
;;;
;;;  Do sada je crna tacka mogla da nastane samo kao posledica spajanja
;;;  dva vlakna.  Vlakno koje kroz nastavak PROLAZI nije imalo nacina da
;;;  dobije splajs, iako se u praksi bas tako i radi: pravo vlakno se
;;;  preseca i zavari nazad, ili se u kaseti ostavi spoj na rezervi.
;;;
;;;  Zato ovde tacka nije posledica nego sam posao: klikne se vlakno i
;;;  splajs legne na sredinu elementa u kome vlakno lezi.  Geometrija
;;;  vlakna se NE dira, tacka se samo postavi na njega.

;; Sve tacke varenja koje leze na datoj putanji.  Merilo je isto koje
;; koristi i presecanje: tacka mora da bude u rasponu vlakna po duzini
;; i na njegovom redu, u granicama pola koraka.
(defun fq:varnavl (pts / ss i e d p c ua ub tv out)
  (setq ss  (fq:ssx '((8 . "FQ_VARENJE") (-3 ("FIBERQ"))))
        i   0
        out nil
        ua  (apply 'min (mapcar 'car pts))
        ub  (apply 'max (mapcar 'car pts)))
  (if ss
    (while (< i (sslength ss))
      (setq e (ssname ss i) d (fq:xdget e) p (fq:plpts e))
      (if (and d (= (car d) "VARENJE") p)
        (progn
          (setq c (list (/ (apply '+ (mapcar 'car  p)) (float (length p)))
                        (/ (apply '+ (mapcar 'cadr p)) (float (length p)))))
          (if (and (>= (car c) (- ua 0.01)) (<= (car c) (+ ub 0.01)))
            (progn
              (setq tv (cadr (fq:tackana pts (car c))))
              (if (< (abs (- (cadr c) tv)) (* 0.5 *FQ-PITCH*))
                (setq out (cons e out)))))))
      (setq i (1+ i))))
  (reverse out))

;; Jedan splajs.  p je tacka klika, sam znaci da mesto pokazuje korisnik.
(defun fq:splajs1 (e p sam / d ag pts u v r tp oz q)
  (setq d (fq:xdget e))
  (if (not (and d (= (car d) "VLAKNO")))
    (progn (princ (fq:t "spoj.red.nijevlakno")) nil)
    (progn
      (setq ag (fq:vl-ang d))
      (setq *fq-a* (fq:deg ag))
      (setq pts (fq:plpts e) oz "")
      (if (< (length pts) 2)
        (princ (fq:t "spl2.nema.putanje"))
        (progn
          (setq u (car (fq:loc p))
                v (cadr (fq:tackana pts u)))
          (if sam
            (progn
              (setq q (fq:gp (fq:t "spl2.pitaj.mesto")))
              (setq u (if q (car (fq:loc q)) nil)))
            (progn
              (setq r (fq:najkut u v))
              (if r
                (setq u  (* 0.5 (+ (car r) (cadr r)))
                      oz (nth 4 r))
                (progn
                  (princ (fq:t "spl2.nema.elementa"))
                  (setq q (fq:gp (fq:t "spl2.pitaj.mesto")))
                  (setq u (if q (car (fq:loc q)) nil))))))))
      (if (not (and pts (>= (length pts) 2) u))
        (progn (princ (fq:t "spoj.red.otkazano")) nil)
        (progn
          (setq tp (fq:tackana pts u))
          ;; Vlakno je samo sebi i A i B kraj: splajs je na njemu, a ne
          ;; izmedju dva razlicita vlakna.  FQBOM broji tacke varenja,
          ;; pa se ovaj racuna isto kao i svaki drugi.
          (fq:xd (fq:Wdot (car tp) (cadr tp) *FQ-SPD* 7 "FQ_VARENJE")
                 (list "VARENJE" (fq:vl-id d) (fq:vl-id d) "FUSION"
                       (fq:vl-st d) oz))
          ;; Vlakno sa splajsom vise nije prolazno.
          ;;
          ;; Poredjenje ide kroz fq:nazkod, ne golo.  Ovo je jedina
          ;; grana koja oznaku prolaznosti SKIDA; da je ostalo golo
          ;; poredjenje sa "prolazno", vlakno bi posle splajsa ostalo
          ;; i prolazno i zavareno -- tiho pogresna sema.  Zatecen
          ;; crtez nosi rec, nov nosi kod, a ovo mora da vidi oba.
          (if (= (fq:nazkod "pro" (fq:vl-pro d)) "prThru")
            (fq:xdput e 9 ""))
          ;; Namena se NE dira.  Namena oznacava stanje vlakna -- radno,
          ;; planirano, rezervisano -- a splajs nije stanje nego nacin
          ;; spajanja.  Sam splajs je vec zapisan kao zaseban entitet
          ;; VARENJE, plus tacka u crtezu; to je dovoljno i tako broje
          ;; FQTRASA, FQBOM i FQBUDZET.  Tanka crna linija ostaje.
          (princ (fq:tf "spl2.postavljen" (list (fq:vl-id d) (if (= oz "") "" (fq:tf "spl2.umestu" (list oz))))))
          T)))))

;;;  Prozor.  Isti obrazac i isti razlog kao kod presecanja: u jednom
;;;  nastavku se retko splajsuje jedno vlakno, obicno ide cela cevcica
;;;  ili ceo snop.  Presecajuci prozor, pa je dovoljno da ga vlakno
;;;  preseca -- ne mora celo da bude unutra.
;;;
;;;  Mesto se NE pita po vlaknu, ni kada je ukljucen rezim "Tacka":
;;;  pitanje po vlaknu bi ponistilo ceo smisao prozora.  Svako uhvaceno
;;;  vlakno dobija splajs po pravilu sredine elementa, a prvi ugao
;;;  prozora sluzi kao tacka klika -- isto sto fq:presprozor radi sa p1.
;;;
;;;  Poruke prozora se pozajmljuju od presecanja (prs.pitaj.ugao1 i
;;;  dalje).  One nigde ne pominju rezanje, a osam novih niski po
;;;  jeziku bi bilo osam mesta koja se mogu razici sa ovima.
(defun fq:splprozor ( / p1 p2 ss i n)
  (setq n 0)
  (if (setq p1 (fq:gp (fq:t "prs.pitaj.ugao1")))
    (if (setq p2 (getcorner p1 (fq:t "prs.pitaj.ugao2")))
      (if (setq ss (ssget "_C" p1 p2
                          '((8 . "FQ_VLAKNO") (-3 ("FIBERQ")))))
        (progn
          (princ (fq:tf "prs.uprozoru" (list (itoa (sslength ss)))))
          (setq i 0)
          (while (< i (sslength ss))
            (if (fq:splajs1 (ssname ss i) p1 nil) (setq n (1+ n)))
            (setq i (1+ i))))
        (princ (fq:t "prs.prazan.prozor")))))
  n)

;;  Tokeni se uzimaju iz tabele niski, ne kucaju.  Do 22.08.2026 su
;;  ovde stajali zakucani srpski tokeni, a prompt je preveden u bloku 4
;;  Faze 5 -- pa je engleski korisnik citao [Point/Middle], kucao P, i
;;  dobijao odbijanje.  Ista lista se koristi DVAPUT, za initget i za
;;  prompt, po pravilu iz CLAUDE.md; poredjenje nize ide na isti token.
(defun c:FQSPLAJS ( / *error* s sam n tt ts tp)
  (setq *error* fq:err)
  (fq:init)
  (setq n   0
        sam nil
        tt  (fq:t "spl2.tok.tacka")
        ts  (fq:t "spl2.tok.sredina")
        tp  (fq:t "spl2.tok.prozor"))
  (while
    (progn
      (initget (fq:spisak (list tt ts tp) " "))
      (setq s (entsel (fq:tf "spl2.pitaj.vlakno" (list tt ts tp))))
      s)
    ;; kljucna rec dolazi kao string, izabran entitet kao par
    (cond
      ((/= (type s) 'STR)
       (if (fq:splajs1 (car s) (cadr s) sam) (setq n (1+ n))))
      ((= s tt)
       (setq sam T)   (princ (fq:t "spl2.misem")))
      ((= s tp)
       (setq n (+ n (fq:splprozor))))
      (T
       (setq sam nil) (princ (fq:t "spl2.sredina")))))
  (princ (fq:tf "spl2.ukupno" (list (itoa n))))
  (princ))


;;; --- grupno spajanje ----------------------------------------------
;;;  Bira se prvo vlakno kabla A, prvo vlakno kabla B, broj komada
;;;  i korak. Korak 1 je jedan na jedan, korak 2 preskace svako drugo.

(defun c:FQSPOJG ( / *error* s1 s2 d1 d2 ka kb fa fb na nb n kor i ra rb us un oz
                     pa va sp ag ua ub kriv uspr dv kw)
  (setq *error* fq:err)
  (fq:init)
  (setq s1 (entsel (fq:t "grp.pitaj.a")))
  (if (not s1)
    (princ (fq:t "opste.otkazano"))
    (progn
      (setq d1 (fq:xdget (car s1)))
      (if (not (and d1 (= (car d1) "VLAKNO")))
        (princ (fq:t "opste.nije.vlakno"))
        (progn
          (setq s2 (entsel (fq:t "grp.pitaj.b")))
          (setq d2 (if s2 (fq:xdget (car s2)) nil))
          (if (not (and d2 (= (car d2) "VLAKNO")))
            (princ (fq:t "opste.nije.vlakno"))
            (progn
              (setq ag (fq:vl-ang d1))
              (setq *fq-a* (fq:deg ag))
              (setq ka (fq:vl-kabl d1) kb (fq:vl-kabl d2)
                    na (atoi (fq:vl-br d1)) nb (atoi (fq:vl-br d2))
                    ua (car (last (fq:orient (car s1) (cadr s1))))
                    ub (car (last (fq:orient (car s2) (cadr s2))))
                    fa (fq:krajevi (fq:cablefibers ka) ua)
                    fb (fq:krajevi (fq:cablefibers kb) ub))
              (princ (fq:tf "grp.kabl.a" (list ka (itoa (length fa)) (itoa na))))
              (princ (fq:tf "grp.kabl.b" (list kb (itoa (length fb)) (itoa nb))))
              (if (not (setq n (getint (fq:t "grp.pitaj.koliko"))))
                (setq n 12))
              (if (not (setq kor (getint (fq:t "grp.pitaj.korak"))))
                (setq kor 1))
              ;; mesto spoja se odredi jednom i vazi za celu grupu
              (setq pa (fq:orient (car s1) (cadr s1))
                    va (cadr (last pa))
                    un (fq:usnast (car (last pa)) va ag
                                  (fq:t "spoj.pitaj.mesto")))
              ;; Provera pre crtanja: koliko parova ne lezi u istom redu.
              ;;
              ;; Meri se SAMO tamo gde oba kraja dolaze vodoravno.  Vlakno
              ;; izvoda iz nastavka zavrsava uspravno i njegov red se
              ;; namerno razlikuje od reda dolaznog vlakna: izvod krece
              ;; ispod svega sto je vec u ramu.  fq:spoj1 takav par vodi
              ;; do kolone izvoda pa pravim uglom nadole, i stepenika tu
              ;; nema.  Da se i to meri, svaki par bi ispao kriv, pa bi
              ;; grupno spajanje ka izvodu redovno zavrsavalo na pitanju
              ;; ciji je podrazumevani odgovor Ne — i ne bi spojilo nista.
              (setq us   (if un (car un) nil)
                    kriv 0  uspr 0  i 0)
              (while (and un (< i n))
                (setq ra (assoc (+ na (* i kor)) fa)
                      rb (assoc (+ nb (* i kor)) fb))
                (if (and ra rb)
                  (if (and (fq:sporav (caddr ra) us)
                           (fq:sporav (caddr rb) us))
                    (progn
                      (setq dv (abs (- (cadr (fq:loc (cadr ra)))
                                       (cadr (fq:loc (cadr rb))))))
                      (if (> dv (* 0.1 *FQ-PITCH*)) (setq kriv (1+ kriv))))
                    (setq uspr (1+ uspr))))
                (setq i (1+ i)))
              (if (> uspr 0)
                (princ (fq:tf "grp.uspravni" (list (itoa uspr)))))
              (if (> kriv 0)
                (progn
                  (princ (fq:tf "grp.paznja.redovi" (list (itoa kriv) (itoa n))))
                  (princ (fq:t "grp.raspored"))
                  (princ (fq:t "grp.savet1"))
                  (princ (fq:t "grp.savet2"))
                  ;; NE JE PRVO, i to je jedina takva zamena reda u
                  ;; bloku 4.  fq:dvatok po ugovoru podrazumeva PRVI
                  ;; token, a ovde podrazumevano mora ostati "Ne":
                  ;; pitanje se postavlja tek kad se parovi ne poklapaju,
                  ;; pa prazan Enter ne sme da spoji krive parove.
                  ;; Zamena reda je jeftinija od zastavice "podrazumevan
                  ;; je drugi", koja bi vazila za sva buduca pitanja.
                  (if (not (fq:dvatok "opste.tok.ne" "opste.tok.da"
                                      "grp.pitaj.svejedno" nil))
                    (setq un nil))))
              (if (not un)
                (princ (fq:t "grp.otkazano"))
                (progn
                  (setq us (car un) oz (cadr un) i 0 sp 0)
                  (while (< i n)
                    (setq ra (assoc (+ na (* i kor)) fa)
                          rb (assoc (+ nb (* i kor)) fb))
                    (if (and ra rb)
                      (if (fq:spoj1 (caddr ra) (caddr rb)
                                    (fq:sporend (caddr ra) us)
                                    (fq:sporend (caddr rb) us)
                                    us oz)
                        (setq sp (1+ sp)))
                      (princ (fq:tf "grp.nema.para" (list (itoa (+ na (* i kor)))))))
                    (setq i (1+ i)))
                  (princ (fq:tf "grp.spojeno" (list (itoa sp) (itoa kor) (if (= oz "") "" (fq:tf "grp.unastavku" (list oz))) (if (> kriv 0) (fq:tf "grp.stepenik" (list (itoa kriv))) ""))))))))))))
  ;; Jednom po komandi, ne po paru: kod grupe od 96 parova poruka po
  ;; paru bi bila 96 redova o istoj stvari -- preuzak ram.
  (if (> *fq-spgust* 0)
    (princ (fq:tf "spoj.gusto" (list (itoa *fq-spgust*)))))
  (princ))

;; tacka na kraju vlakna koji je blizi koordinati us
(defun fq:sporend (e us / pts a b)
  (setq pts (fq:plpts e) a (car pts) b (last pts))
  (if (not us)
    (fq:w (car b) (cadr b))
    (if (< (abs (- (car a) us)) (abs (- (car b) us)))
      (fq:w (car a) (cadr a))
      (fq:w (car b) (cadr b)))))

;; Da li vlakno na kraj kod us dolazi VODORAVNO, u tekucem sistemu
;; crtanja.  Isto merilo koje i fq:spoj1 koristi kad bira kako ce spoj
;; da izvede, pa ono sto ovde ispadne uspravno tamo dobija pravi ugao.
(defun fq:sporav (e us)
  (fq:vodoravan (fq:orient e (fq:sporend e us))))


;;; --- vertikalni odvod ---------------------------------------------
;;;
;;;  Snop vlakana se skrece sa magistrale ka manjem nastavku ili
;;;  privodu. Mesto loma program racuna sam, kako je i dogovoreno.
;;;
;;;  Lomovi se stepenasto razmicu za *FQ-ODV-DX*, i to tako da se
;;;  uspravni delovi ne seku medjusobno:
;;;    odvod nanize  - donje vlakno snopa lomi prvo, gornje poslednje
;;;    odvod nagore  - obrnuto
;;;  Redosled vlakana se cuva, prvo vlakno snopa stize u pokazani red.
;;;
;;;      ====================\            <- prvo vlakno, lomi zadnje
;;;      ==================\ |
;;;      ================\ | |
;;;                      | | |
;;;                      | | +-------->   <- prvo vlakno
;;;                      | +---------->
;;;                      +------------>

(defun c:FQODVOD ( / *error* s d ka na ang raw fa m p pd ut vt pts ue uo sgn
                     dole i k rec e ep ubk w n)
  (setq *error* fq:err)
  (fq:init)
  (setq s (entsel (fq:t "odv.pitaj.prvo")))
  (if (not s)
    (princ (fq:t "opste.otkazano"))
    (progn
      (setq d (fq:xdget (car s)))
      (if (not (and d (= (car d) "VLAKNO")))
        (princ (fq:t "opste.nije.vlakno"))
        (progn
          (setq ka  (fq:vl-kabl d)
                na  (atoi (fq:vl-br d))
                ang (fq:vl-ang d))
          (setq *fq-a* (fq:deg ang))
          (setq pts (fq:orient (car s) (cadr s))
                ue  (car (last pts))
                uo  (car (car pts))
                sgn (if (>= ue uo) 1.0 -1.0))
          (setq raw (fq:cablefibers ka)
                fa  (if raw (fq:krajevi raw ue) nil))
          (if (not fa)
            (princ (fq:t "kabl.nema.vlakana"))
            (progn
              (if (not (setq m (getint (fq:t "odv.pitaj.koliko"))))
                (setq m 6))
              (setq p (fq:gp (fq:t "odv.pitaj.gde")))
              (if (not p)
                (princ (fq:t "opste.otkazano"))
                (progn
                  (setq pd   (fq:loc p)
                        ut   (car pd)
                        vt   (cadr pd)
                        dole (< vt (cadr (last pts)))
                        i    0
                        n    0)
                  (princ (fq:tf "odv.smer" (list (if dole (fq:t "opste.nanize") (fq:t "opste.nagore")) (rtos *FQ-ODV-DX* 2 2) (rtos ue 2 2))))
                  (while (< i m)
                    (setq k   (1+ i)
                          rec (assoc (+ na i) fa))
                    (if (not rec)
                      (princ (fq:tf "odv.nema.vlakna" (list (itoa (+ na i)))))
                      (progn
                        (setq e  (caddr rec)
                              ep (fq:orient e (fq:sporend e ue)))
                        (if (not (fq:vodoravan ep))
                          (princ (fq:tf "odv.presk.uspravno" (list (itoa (+ na i)))))
                          (progn
                            (setq ubk (+ ue (* sgn *FQ-ODV-DX*
                                               (if dole (- m k) (1- k))))
                                  w   (- vt (* *FQ-PITCH* (1- k))))
                            (setq ep (append (fq:trimto ep ubk)
                                             (list (list ubk w)
                                                   (list ut   w))))
                            (fq:mkfiber ep e (fq:xdget e))
                            ;; novo vlakno je vec nacrtano (entmake
                            ;; prolazi i na zakljucanom lejeru); ako
                            ;; staro ne ode, u crtezu su DVA vlakna na
                            ;; istom mestu i broj u poruci to mora da
                            ;; kaze
                            (if (fq:brisi e) (setq n (1+ n)))))))
                    (setq i (1+ i)))
                  (princ (fq:tf "odv.ukupno" (list (itoa n))))
                  (princ (fq:t "odv.dalje"))))))))))
  (princ))


;;; --- carski rez, vlakno se preseca a oba kraja ostaju --------------
;;;
;;;  Rez se radi UNUTAR elementa: u nastavku, ali isto tako i u ODO
;;;  ormaru, ODF-u, patch panelu, MDU ormaru i ZOK kutiji.  Element se
;;;  prepoznaje po samoj geometriji rama, pa se ne pita nista.
;;;
;;;  Ranije se od vlakna pravio jedan entitet, onaj do reza, a ceo krak
;;;  na koji se kliknulo je nestajao iz crteza.  To je bilo tacno samo
;;;  kada se taj krak zaista uklanja sa terena; u projektu se vlakno
;;;  preseca a oba kraja ostaju u kaseti, pa se posle jedan od njih
;;;  zavaruje na drugo vlakno.
;;;
;;;  Pravilo je jedno: SVAKI KRAJ VLAKNA SE PREKIDA *FQ-PRS-ULAZ*
;;;  UNUTAR SVOJE IVICE RAMA.  Iz njega same ispadaju obe situacije iz
;;;  prakse, bez ijednog dodatnog uslova:
;;;
;;;    vlakno prolazi kroz element     dva kraka, oba zavrsavaju unutra
;;;      =========================      =====+=            =+=========
;;;              +--- ram ---+               +--- ram ---+
;;;
;;;    vlakno se u elementu zavrsava   jedan krak, uveden u ram
;;;      ========+                      =========+
;;;              +--- ram ---+               +--- ram ---+
;;;
;;;  Uvlacenje ide od IVICA, ne od sredine.  Nastavak je cesto sirok
;;;  nekoliko desetina jedinica, pa bi se zev od jedne jedinice u
;;;  sredini jedva video i izgledalo bi kao da se nista nije desilo.
;;;
;;;  Kada vlakno kroz element PROLAZI, krak na cijoj strani je kliknuto
;;;  je onaj koji se ukida: dobija namenu Slobodno, crnu tanku liniju,
;;;  prazne zavrsetke i nastavak *FQ-PRS-UKI* u id-u, da FQPROVERA dva
;;;  kraka ne prijavi kao dupliran id vlakna.

;; Da li su temena rama pravougaonik poravnat sa osama TEKUCEG sistema
;; crtanja.  Ovo zamenjuje poredjenje uglova: kuciste ugao ne pamti, a
;; ram nacrtan pod drugim uglom se u sistemu ovog vlakna procita kao
;; kosi cetvorougao, pa ovde ispadne.
(defun fq:ramosen (pts / us vs u1 u2 v1 v2 ok)
  (if (/= (length pts) 4)
    nil
    (progn
      (setq us (mapcar 'car pts)
            vs (mapcar 'cadr pts)
            u1 (apply 'min us)  u2 (apply 'max us)
            v1 (apply 'min vs)  v2 (apply 'max vs)
            ok (and (> (- u2 u1) 0.01) (> (- v2 v1) 0.01)))
      (foreach p pts
        (if (not (and (or (< (abs (- (car  p) u1)) 0.01)
                          (< (abs (- (car  p) u2)) 0.01))
                      (or (< (abs (- (cadr p) v1)) 0.01)
                          (< (abs (- (cadr p) v2)) 0.01))))
          (setq ok nil)))
      ok)))

;; Element u kome se vlakno preseca: nastavak ili kuciste.
;; Bira se onaj kome red vlakna upada u ram, pa medju njima najblizi po
;; duzini kabla.  Isto merilo koje koristi fq:najnast: dv ima hiljadu
;; puta vecu tezinu od du.
;; Vraca (ul ur vt vb oznaka vrsta du dv) ili nil.
(defun fq:najkut (u v / ss i e d pts ul ur vt vb du dv sc best bs)
  (setq ss   (fq:ssx (list (cons 8 *FQ-KUT-LEJERI*) '(-3 ("FIBERQ"))))
        i    0
        best nil
        bs   nil)
  (if ss
    (while (< i (sslength ss))
      (setq e (ssname ss i) d (fq:xdget e))
      (if (and d
               (member (car d)
                       '("NASTAVAK" "ODF" "PP" "ODO" "IPAN" "ZOK"))
               (= (cdr (assoc 0 (entget e))) "LWPOLYLINE")
               (setq pts (fq:plpts e))
               (fq:ramosen pts))
        (progn
          (setq ul (apply 'min (mapcar 'car  pts))
                ur (apply 'max (mapcar 'car  pts))
                vb (apply 'min (mapcar 'cadr pts))
                vt (apply 'max (mapcar 'cadr pts))
                du (cond ((< u ul) (- ul u)) ((> u ur) (- u ur)) (T 0.0))
                dv (cond ((< v vb) (- vb v)) ((> v vt) (- v vt)) (T 0.0))
                sc (+ (* 1000.0 dv) du))
          (if (or (not bs) (< sc bs))
            (setq bs   sc
                  best (list ul ur vt vb (fq:f 1 d) (car d) du dv)))))
      (setq i (1+ i))))
  best)

;; Gde se vlakno preseca: (uL uR oznaka), dve koordinate reza duz
;; kabla, uL uvek manja.  Krajevi se uvlace *FQ-PRS-ULAZ* od ivica
;; rama, pa se u sirokom nastavku odmah vidi da je vlakno preseceno.
;; Kod uskog rama se uvlacenje sabija tako da zev nikad ne nestane.
;;
;; u je koordinata KLIKA duz kabla, ne kraja vlakna.  Kada u crtezu
;; stoje dva nastavka jedan do drugog, kraj vlakna je za oba isti pa je
;; biran onaj koji je slucajno blizi; klik je nedvosmislen — sece se u
;; onom elementu u koji si kliknuo.  Na koju stranu ide krak koji se
;; ukida to ne menja: svaki kraj se prekida na SVOJOJ strani rama.
(defun fq:kutza (pts u / v r ul ur w ulaz zev p)
  (setq v (cadr (fq:last pts))
        r (fq:najkut u v))
  (if r
    (progn
      (setq ul   (car r)
            ur   (cadr r)
            w    (- ur ul)
            zev  (min *FQ-PRS-ZEV* (* 0.5 w))
            ulaz (min *FQ-PRS-ULAZ* (* 0.5 (- w zev))))
      (princ (fq:tf "prs.element" (list (nth 5 r) (nth 4 r) (rtos ul 2 2) (rtos ur 2 2))))
      (if (> (nth 7 r) 0.001)
        (princ (fq:tf "prs.paznja.red" (list (rtos (nth 7 r) 2 2)))))
      (list (+ ul ulaz) (- ur ulaz) (nth 4 r)))
    (progn
      (princ (fq:t "prs.nema.elementa"))
      (setq p (fq:gp (fq:t "prs.pitaj.gde")))
      (if p
        (progn
          (setq u (car (fq:loc p)))
          (list (- u (* 0.5 *FQ-PRS-ZEV*))
                (+ u (* 0.5 *FQ-PRS-ZEV*))
                ""))
        nil))))

;; Varenje koje je ostalo u zevu, na redu tog vlakna.
;;
;; Kada se preseca vlakno koje je pre toga SPOJENO, tacka splajsa lezi
;; tacno tamo gde sada ide rez.  Da se ne brise, u praznom delu
;; nastavka bi ostala crna tacka koja ne dodiruje nijedno vlakno, a
;; splajsa vise nema.  Vraca koliko ih je obrisano.
(defun fq:prsvar (u1 u2 v / ss i e d pts c n)
  (setq ss (fq:ssx '((8 . "FQ_VARENJE") (-3 ("FIBERQ"))))
        i  0
        n  0)
  (if ss
    (while (< i (sslength ss))
      (setq e   (ssname ss i)
            d   (fq:xdget e)
            pts (fq:plpts e))
      (if (and d (= (car d) "VARENJE") pts)
        (progn
          (setq c (list (/ (apply '+ (mapcar 'car  pts)) (float (length pts)))
                        (/ (apply '+ (mapcar 'cadr pts)) (float (length pts)))))
          (if (and (> (car c) (min u1 u2))
                   (< (car c) (max u1 u2))
                   (< (abs (- (cadr c) v)) (* 0.5 *FQ-PITCH*)))
            ;; broji se samo ono sto je STVARNO nestalo iz crteza: broj
            ;; ide u poruku "skinuto varenja", a na zakljucanom lejeru
            ;; entdel tiho ne uradi nista
            (if (fq:brisi e) (setq n (1+ n))))))
      (setq i (1+ i))))
  n)

;; Delovi vlakna posle reza: (deo-koji-ostaje  deo-koji-se-ukida).
;; Drugi sme da bude nil.
;;
;; Svaki KRAJ vlakna se prekida na svojoj strani rama: kraj levo od
;; sredine na uL, kraj desno od nje na uR.  Ako oba kraja padnu na istu
;; stranu, vlakno kroz element ne prolazi nego se u njemu zavrsava — a
;; to je najcesci slucaj u praksi, kabl dolazi do nastavka i tu staje.
;; Tada nema sta da se ukine, nego se vlakno samo UVODI u ram.
;;
;; Uvodjenje radi fq:trimto, koji poslednji vodoravni deo skracuje ili
;; PRODUZAVA do zadate koordinate.  Bez toga vlakno koje zavrsava tacno
;; na ivici rama ne bi imalo sta da se preseca i komanda bi cutala, a
;; bas ono treba da udje unutra.
(defun fq:prsdel (pts uL uR / ua ub uc ca cb r pp)
  (setq ua (car (car pts))          ; prvi kraj
        ub (car (fq:last pts))      ; kliknuti kraj, on se ukida
        uc (* 0.5 (+ uL uR))
        ca (if (< ua uc) uL uR)
        cb (if (< ub uc) uL uR))
  (if (equal ca cb 1e-9)
    ;; ne prolazi kroz element: kraj blizi ramu se uvodi u njega
    (progn
      (setq pp (if (<= (abs (- ub ca)) (abs (- ua ca))) pts (reverse pts)))
      (list (fq:trimto pp ca) nil))
    (progn
      (setq r (fq:podeli pts ca))
      (list (if r (car r) (fq:trimto pts ca))
            (cadr (fq:podeli pts cb))))))

;; Jedan krak presecenog vlakna.  Oba kraka su preseceni i slobodni.
;;
;; Krak koji se ukida dobija jos dve izmene:
;;   - drugi id, da FQPROVERA dva kraka ne prijavi kao dupliran id;
;;   - prazne zavrsetke, jer bi inace oba kraka tvrdila da stoje na
;;     istom portu, pa bi FQPROVERA prijavila port zauzet dva puta.
;;     Zavrseci ostaju na kraku koji ostaje, isto kao i do sada.
;; Redni broj (polje 5) se NE menja ni na jednom kraku -- oba kraka su
;; isto vlakno.  Zato FQPROVERA mora da izuzme ukinut krak iz provere
;; duplih rednih brojeva; vidi tacku [2] tamo.
(defun fq:prskrak (pts uzor d ukida / dd e)
  ;; polja 9 i 10 idu kao KODOVI
  (setq dd (fq:setnthx (fq:setnthx d 9 "prCut") 10 "nmFree"))
  (if ukida
    (setq dd (fq:setnthx
               (fq:setnthx dd 1 (strcat (fq:vl-id d) *FQ-PRS-UKI*))
               8 "")))
  (setq e (fq:mkfiber pts uzor dd))
  (fq:setcolor e 7)
  (fq:setlw e -1)
  e)

;; Jedno vlakno.  pref je SVETSKA tacka po kojoj se bira element i
;; strana: kod pojedinacnog izbora sama tacka klika, kod prozora njegov
;; PRVI ugao.  Zato prozor povucen levo od sredine rama ukida levi krak,
;; isto kao da je tu kliknuto, pa se ponasanje ne menja sa nacinom
;; izbora.  Vraca (preseceno oba-kraka obrisanih-varenja).
(defun fq:preseci1 (e pref / d pts ag kut uL uR oz dl da db uk nv)
  (setq d (fq:xdget e) uk 0 nv 0)
  (if (not (and d (= (car d) "VLAKNO")))
    (progn (princ (fq:t "spoj.presk.nijevlakno")) (list 0 0 0))
    (progn
      (setq ag (fq:vl-ang d))
      (setq *fq-a* (fq:deg ag))
      (setq pts (fq:orient e pref)
            kut (fq:kutza pts (car (fq:loc pref))))
      (if (not kut)
        (progn (princ (fq:t "spoj.red.otkazano")) (list 0 0 0))
        (progn
          (setq uL (car kut)
                uR (cadr kut)
                oz (caddr kut)
                dl (fq:prsdel pts uL uR)
                da (car dl)
                db (cadr dl))
          (if (or (not da) (< (length da) 2))
            (progn
              (princ (fq:tf "prs.ne.mogu" (list (fq:vl-id d) (if (= oz "") (fq:t "prs.tom.mestu") oz))))
              (list 0 0 0))
            (progn
              (fq:prskrak da e d nil)
              ;; Krak koji se ukida ostaje u crtezu, uvucen od svoje
              ;; ivice rama.  Ako vlakno kroz element ne prolazi, njega
              ;; nema: vlakno se samo uvodi u ram i tu prestaje.
              (if (and db (>= (length db) 2))
                (progn (fq:prskrak db e d T) (setq uk 1)))
              (entdel e)
              ;; splajs koji je ostao u zevu vise ne postoji
              (setq nv (fq:prsvar uL uR (cadr (fq:last da))))
              (princ (fq:tf "prs.jedno" (list (fq:vl-id d) (if (= uk 1) (fq:t "prs.preseceno") (fq:t "prs.uvedeno")) (if (= oz "") "" (fq:tf "prs.umestu" (list oz))))))
              (list 1 uk nv))))))))

;;;  Prozor.  U jednom nastavku se retko preseca jedno vlakno: obicno
;;;  ide cela cevcica ili ceo snop.  Klik po klik je za to prespor, pa
;;;  postoji i izbor prozorom: prvi ugao unutar rama, pa se mis povuce
;;;  navise ili nanize preko redova.  Uzima se PRESECAJUCI prozor, pa
;;;  je dovoljno da ga vlakno preseca, ne mora celo da bude u njemu.
(defun fq:presprozor ( / p1 p2 ss i r n uk nv)
  (setq n 0 uk 0 nv 0)
  (if (setq p1 (fq:gp (fq:t "prs.pitaj.ugao1")))
    (if (setq p2 (getcorner p1 (fq:t "prs.pitaj.ugao2")))
      (if (setq ss (ssget "_C" p1 p2
                          '((8 . "FQ_VLAKNO") (-3 ("FIBERQ")))))
        (progn
          (princ (fq:tf "prs.uprozoru" (list (itoa (sslength ss)))))
          (setq i 0)
          (while (< i (sslength ss))
            (setq r  (fq:preseci1 (ssname ss i) p1)
                  n  (+ n  (car r))
                  uk (+ uk (cadr r))
                  nv (+ nv (caddr r))
                  i  (1+ i))))
        (princ (fq:t "prs.prazan.prozor")))))
  (list n uk nv))

(defun c:FQPRESECI ( / *error* s r n uk nv tp)
  (setq *error* fq:err)
  (fq:init)
  ;; Token iz tabele, ne zakucan -- vidi napomenu uz c:FQSPLAJS.
  (setq n 0 uk 0 nv 0 tp (fq:t "prs.tok.prozor"))
  (while
    (progn
      (initget tp)
      (setq s (entsel (fq:tf "prs.pitaj.vlakno" (list tp))))
      s)
    ;; Kada se otkuca kljucna rec, entsel vraca STRING umesto para
    ;; (entitet tacka), pa se grana bira po tipu odgovora.
    (setq r (if (= (type s) 'STR)
              (fq:presprozor)
              (fq:preseci1 (car s) (cadr s))))
    (setq n  (+ n  (car r))
          uk (+ uk (cadr r))
          nv (+ nv (caddr r))))
  (princ (fq:tf "prs.ukupno" (list (itoa n) (if (> uk 0) (fq:tf "prs.oba.kraka" (list (itoa uk))) "") (if (> nv 0) (fq:tf "prs.obrisano.var" (list (itoa nv))) ""))))
  (princ))


;;; --- prolazno vlakno ----------------------------------------------
;;;
;;;  Dugme je do sada samo upisivalo rec "prolazno" u podatke, a u
;;;  crtezu se nije menjalo nista, pa je delovalo kao da ne radi.
;;;  Prolazno vlakno je ono koje kroz nastavak IDE DALJE, bez spoja, i
;;;  tako i treba da izgleda.  Dve situacije, obe se prepoznaju same:
;;;
;;;    1. vlakno ima crnu tacku       tacka se skida, vlakno ostaje celo
;;;         =========o=========          ===================
;;;
;;;    2. vlakno je preseceno         dva kraka se spajaju u jedno pravo
;;;         =====+     +=======          ===================
;;;
;;;  U drugom slucaju identitet nosi krak koji NIJE ukinut, pa se vlakno
;;;  vraca pod svojim starim id-em, a suvisna temena na mestu spoja se
;;;  uklanjaju, da ga STRETCH ne bi lomio bas tamo gde je bio rez.

;; Krajevi dva kraka koji se spajaju: par koji gleda jedan u drugi, to
;; jest onaj sa najmanjim razmakom.  Vraca (svetska-tacka1 svetska-tacka2).
;;
;; Kraj se NE bira po kliku, kao kod FQSPOJ.  Tamo klik ima smisla: kabl
;; se zaista sme spojiti na bilo koji svoj kraj, pa mora neko da kaze na
;; koji.  Ovde ga nema — dva kraka se spajaju jedino preko reza — a mis
;; pada tamo gde je vlakno vidljivo, po pravilu daleko od zeva, koji je
;; sirok svega nekoliko jedinica.  Po kliku bi se tada spojili SPOLJNI
;; krajevi: oba kraka nestanu, a u zevu ostane patrljak duzine zeva.
(defun fq:parkraj (e1 e2 / k1 k2 best bd d q1 q2)
  (setq k1 (fq:plpts e1)
        k2 (fq:plpts e2)
        k1 (list (car k1) (fq:last k1))
        k2 (list (car k2) (fq:last k2))
        bd nil)
  (foreach q1 k1
    (foreach q2 k2
      (setq d (distance (list (car q1) (cadr q1)) (list (car q2) (cadr q2))))
      (if (or (not bd) (< d bd))
        (setq bd d best (list q1 q2)))))
  (list (fq:w (car (car  best)) (cadr (car  best)))
        (fq:w (car (cadr best)) (cadr (cadr best)))))

(defun fq:pravospoj (e1 e2 / d1 d2 ag a b baz uz dr pts new dv kr nb)
  (setq d1 (fq:xdget e1) d2 (fq:xdget e2))
  (cond
    ((equal e1 e2)
     (princ (fq:t "spoj.presk.isto")) nil)
    ((not (and d1 d2 (= (car d1) "VLAKNO") (= (car d2) "VLAKNO")))
     (princ (fq:t "spoj.presk.nijevlakno")) nil)
    (T
     (setq ag (fq:vl-ang d1))
     (setq *fq-a* (fq:deg ag))
     (setq kr (fq:parkraj e1 e2)
           a  (fq:orient e1 (car  kr))
           b  (fq:orient e2 (cadr kr))
           dv (abs (- (cadr (fq:last a)) (cadr (fq:last b)))))
     (if (> dv (* 0.1 *FQ-PITCH*))
       (princ (fq:t "spoj.paznja.stepenik")))
     ;; identitet i zavrsetke nosi krak koji nije ukinut
     (setq baz (if (fq:ukinut d1) d2 d1)
           uz  (if (fq:ukinut d1) e2 e1)
           dr  (fq:setnthx (fq:setnthx baz 9 "prThru")
                           8 (fq:spoji2 (fq:vl-veza d1) (fq:vl-veza d2))))
     ;; Dva kraka istog vlakna nisu lanac nego jedno vlakno, pa se lanac
     ;; dopunjuje samo kada se spajaju dva zaista razlicita vlakna.
     (if (/= (fq:osnovid d1) (fq:osnovid d2))
       (setq dr (fq:setnthx dr 15 (fq:lanac d1 d2))))
     ;; Duzina se spaja BEZUSLOVNO, i kad su kraci istog vlakna: tada
     ;; oba nose isti unos, a fq:duzspoj po oznaci kabla ne udvaja, pa
     ;; je posao prazan.  Uslov bi ovde bio suvisan, a jednog dana i
     ;; pogresan -- ukinut krak sme da nosi duzinu koju drugi nema.
     (setq dr (fq:setnthx dr 19 (fq:duzspoj (fq:vl-duz d1) (fq:vl-duz d2))))
     (setq pts (fq:ravna (append a (reverse b)))
           new (fq:mkfiber pts uz dr))
     ;; Crna tacka izmedju krakova se SKIDA.  Prolazno vlakno po
     ;; definiciji nema splajs, a druga grana iste FQPROLAZ ga vec skida
     ;; (pro.skinuto) -- ova ga je tiho ostavljala i time protivrecila
     ;; polju 9 koje sama upisuje kao prThru.
     ;;
     ;; Gore od protivrecnog crteza je trag koji ostaje.  Zapis varenja
     ;; pominje UKINUT krak (K1/1/1-U), a spojeno vlakno zadrzi samo
     ;; zivi id -- lanac se za dva kraka istog vlakna namerno ne
     ;; dopunjuje (uslov fq:osnovid iznad).  Oznaka -U time nestane iz
     ;; OBA mesta na kojima je FQPROVERA trazi, pa provera 5 prijavi
     ;; "varenje bez vlakna" nad crtezom koji je korisnik napravio
     ;; ispravnim potezima.  Nadjeno 25.08.2026, pri testiranju 1.0.0.
     ;;
     ;; Broji se po USPEHU, ne po duzini liste: na zakljucanom lejeru
     ;; FQ_VARENJE entdel tiho ne uradi nista -- isto pravilo kao u
     ;; grani iznad.
     (setq nb 0)
     (foreach x (fq:varnavl pts) (if (fq:brisi x) (setq nb (1+ nb))))
     (if (> nb 0)
       (princ (fq:tf "pro.skinuto" (list (fq:vl-id dr) (itoa nb)))))
     (entdel e1)
     (entdel e2)
     ;; Namena se NE dira.  Do 1.0.0 je ovde stajalo
     ;; (fq:namena new "Prolazno"), pa je prolaznost pisala na DVA
     ;; mesta: u polju 9 kao prThru i u polju 10 kao namena.  Kad bi
     ;; FQSPLAJS posle toga ispraznio polje 9, polje 10 bi i dalje
     ;; tvrdilo "Prolazno" -- zapis bi sam sebi protivrecio, a bas to
     ;; je korisnik procitao u FQINFO.
     ;;
     ;; Prolaznost sada zivi samo u polju 9, gde joj je i mesto.
     ;; Namena oznacava stanje vlakna i ostaje ono sto je bila.
     ;;
     ;; Zamena nije potrebna: fq:mkfiber kopira boju i debljinu sa
     ;; kraka koji ostaje, a dr nasledjuje njegovu namenu iz baz --
     ;; sve troje se poklapa samo od sebe.  Uz to su Slobodno i
     ;; Prolazno ionako ista boja (7) i ista debljina (-1), pa se
     ;; vizuelno ne menja nista.
     new)))

(defun c:FQPROLAZ ( / *error* s e d ag pts var s2 n sp sk x nb)
  (setq *error* fq:err)
  (fq:init)
  (setq n 0 sp 0 sk 0)
  (while (setq s (entsel (fq:t "pro.pitaj.vlakno")))
    (setq e (car s) d (fq:xdget e) pts nil)
    (if (and d (= (car d) "VLAKNO"))
      (progn (setq *fq-a* (fq:deg (setq ag (fq:vl-ang d))))
             (setq pts (fq:plpts e))))
    (if (or (not pts) (< (length pts) 2))
      (princ (fq:t "spoj.red.nijevlakno"))
      (progn
        (setq var (fq:varnavl pts))
        (cond
          ;; ima crnu tacku: skida se, vlakno ostaje celo
          (var
           ;; "skinuto" mora da znaci skinuto.  Broji se po uspehu, ne
           ;; po duzini liste kandidata: na zakljucanom lejeru FQ_VARENJE
           ;; entdel tiho ne uradi nista, a poruka je i dalje tvrdila da
           ;; su tacke skinute -- pa bi korisnik iz specifikacije citao
           ;; varenja koja je "obrisao".
           (setq nb 0)
           (foreach x var (if (fq:brisi x) (setq nb (1+ nb))))
           (fq:xdput e 9 "prThru")
           (setq n  (1+ n)
                 sk (+ sk nb))
           (princ (fq:tf "pro.skinuto" (list (fq:vl-id d) (itoa nb)))))
          ;; nema tacke: mozda su ovo dva kraka presecenog vlakna
          (T
           (setq s2 (entsel (fq:t "pro.pitaj.krak")))
           (if (not s2)
             (progn (fq:xdput e 9 "prThru")
                    (setq n (1+ n))
                    (princ (fq:tf "pro.upisano" (list (fq:vl-id d)))))
             (if (fq:pravospoj e (car s2))
               (progn (setq n (1+ n) sp (1+ sp))
                      (princ (fq:t "pro.spojeno"))))))))))
  (princ (fq:tf "pro.ukupno" (list (itoa n) (if (> sk 0) (fq:tf "pro.ukupno.tacke" (list (itoa sk))) "") (if (> sp 0) (fq:tf "pro.ukupno.krakovi" (list (itoa sp))) ""))))
  (princ))


;;; ==================================================================
;;;  17. TRASA VLAKNA
;;;
;;;  Posle spajanja je jedno vlakno jedan entitet od kraja do kraja,
;;;  a polje 15 nosi lanac deonica kroz koje prolazi. Broj varenja je
;;;  zato broj deonica minus jedan, a zavrseci stoje u polju 8.
;;;  Ovi podaci su se do sada upisivali a nisu se nigde citali.
;;; ==================================================================

;; (deonice zavrseci broj-varenja broj-konektorskih-parova)
(defun fq:trasa (d / ids vez)
  (setq ids (fq:delovi (if (= (fq:vl-lan d) "") (fq:vl-id d) (fq:vl-lan d)))
        vez (fq:delovi (fq:vl-veza d)))
  ;;  Varenja se BROJE, ne izvode iz duzine lanca.
  ;;
  ;;  Do 25.08.2026 je ovde stajalo (max 0 (1- (length ids))) -- "koliko
  ;;  segmenata, toliko minus jedan spoj".  Gresilo je u dva slucaja, a
  ;;  oba su svakodnevna:
  ;;
  ;;  1. Preseci vlakno pa spoji krakove u istom nastavku.  Lanac se ne
  ;;     produzi, jer fq:prskrak menja id kraka u "K1/1/1-U" a polje 15
  ;;     ostavlja na "K1/1/1", pa oba kraka daju istu nisku i fq:spoji2
  ;;     ih sazme u jednu.  Duzina lanca ostane 1, formula da 0.
  ;;  2. FQSPLAJS na neprekinuto vlakno.  Nikakvog spajanja nema, lanac
  ;;     je i dalje jedan clan, a crna tacka postoji.  Opet 0.
  ;;
  ;;  Posledica nije bila kozmeticka: c:FQBUDZET ovaj broj mnozi sa
  ;;  *FQ-G-VAR*, pa je opticki budzet tiho prijavljivao manji gubitak
  ;;  od stvarnog -- a to je najgori nacin da podatak bude pogresan.
  (list ids vez (fq:varbroj ids) (length vez)))

;;  Zapisi varenja koja leze na toj trasi.  Jedno mesto skenira, dvoje
;;  citaju: koliko ih ima i u kojim su nastavcima.
(defun fq:varsvi (ids / ss i d out)
  (setq ss (fq:ssx '((8 . "FQ_VARENJE") (-3 ("FIBERQ")))) i 0 out nil)
  (if ss
    (while (< i (sslength ss))
      (setq d (fq:xdget (ssname ss i)))
      (if (and d (= (car d) "VARENJE")
               (or (member (fq:va-a d) ids) (member (fq:va-b d) ids)))
        (setq out (cons d out)))
      (setq i (1+ i))))
  (reverse out))

;; koliko varenja lezi na toj trasi
(defun fq:varbroj (ids) (length (fq:varsvi ids)))

;; u kojim nastavcima leze varenja te trase
(defun fq:varnast (ids / out oz)
  (setq out nil)
  (foreach d (fq:varsvi ids)
    (setq oz (fq:va-oz d))
    (if (= oz "") (setq oz (fq:t "opste.bez.oznake")))
    (if (not (member oz out)) (setq out (cons oz out))))
  (reverse out))

;; Bez (fq:init).  FQTRASA samo cita: nista ne crta i nista ne upisuje,
;; pa nema razloga da u tudji crtez uvede 15 lejera i dva stila teksta
;; samo zato sto je neko hteo da vidi kuda ide jedno vlakno.  FQINFO,
;; FQBOM i FQBUDZET tako rade od pocetka.
;;
;; Crtez ipak NE ostaje netaknut: fq:ssx radi regapp "FIBERQ", pa se
;; prijava aplikacije upise i ovde.  Razlika je jedna stavka umesto
;; sedamnaest, i to je jedini tacan opis ove izmene.
;; Skida oznaku sa vlakna koje je FQTRASA poslednji put obelezila.
;;
;;  (redraw e 3) je ekranski efekat, ne izmena entiteta: ne prolazi kroz
;;  undo, ne gasi ga Esc, ne gasi ga ni obican redraw celog ekrana.  Bez
;;  ovoga je oznaka ostajala na vlaknu do kraja sesije -- jedino sto ju
;;  je skidalo bilo je precrtavanje samog vlakna, dakle tek kad se na
;;  njega nakaci kuciste ili element.
;;
;;  Ime entiteta vazi samo u crtezu u kome je uzeto, a ova promenljiva
;;  prezivljava prelazak na drugi crtez.  Zato entget pod vl-catch-all:
;;  za obrisan entitet vraca nil, a za ime iz tudjeg crteza ume i da
;;  padne.
(defun fq:trskini ( / r)
  (if *fq-tr-ozn*
    (progn
      (setq r (vl-catch-all-apply 'entget (list *fq-tr-ozn*)))
      (if (and r (not (vl-catch-all-error-p r)))
        (vl-catch-all-apply 'redraw (list *fq-tr-ozn* 4)))
      (setq *fq-tr-ozn* nil))))

(defun c:FQTRASA ( / *error* s e d tr ids vez naz x)
  (setq *error* fq:err)
  ;; Oznaka sa proslog poziva se skida PRE pitanja, pa Esc na izboru
  ;; ostaje pun nacin da se crtez ocisti, bez nove komande.
  (fq:trskini)
  (if (not (setq s (entsel (fq:t "tras.pitaj.vlakno"))))
    (princ (fq:t "opste.nista"))
    (progn
      (setq e (car s) d (fq:xdget e))
      (if (not (and d (= (car d) "VLAKNO")))
        (princ (fq:t "opste.nije.vlakno"))
        (progn
          (setq tr  (fq:trasa d)
                ids (car tr)
                vez (cadr tr)
                naz (fq:varnast ids))
          ;;  Uvlaka natpisa je 14 znakova u oba jezika, isto pravilo kao
          ;;  u FQBUDZET: natpis je unutar niske, pa poravnanje ostaje
          ;;  posao prevodioca a ne slucajan zbir fragmenata.
          (princ (fq:t "tras.naslov"))
          (princ (fq:tf "tras.kabl"
                        (list (fq:vl-kabl d) (fq:bomd "   " (fq:vl-lbl d)))))
          ;; Boja kroz fq:bojrec: polje 6 nosi REC iz standarda, a ona
          ;; je na jeziku na kom je crtez nastao.  Zatecen crtez se ne
          ;; prepisuje, pa se prevodi pri citanju.
          (princ (fq:tf "tras.vlakno"
                        (list (fq:vl-id d) (fq:vl-cev d)
                              (fq:bojrec (fq:vl-boja d)) (fq:vl-br d))))
          (princ (fq:tf "tras.namena"
                        (list (fq:kodnaz "nam" (fq:vl-nam d))
                              (fq:stnaziv (fq:vl-st d))
                              (fq:bomd ",  " (fq:kodnaz "pro" (fq:vl-pro d))))))
          (princ (fq:t "tras.deonice"))
          (foreach x ids (princ (strcat x "   ")))
          (princ (fq:tf "tras.varenja" (list (itoa (caddr tr)))))
          (if naz
            (progn (princ (fq:t "tras.unastavcima"))
                   (foreach x naz (princ (strcat x "   ")))))
          (if vez
            (progn (princ (fq:t "tras.zavrseci"))
                   (foreach x vez (princ (strcat x "   "))))
            (princ (fq:t "tras.zavrseci.nema")))
          (princ (fq:tf "tras.konektori" (list (itoa (cadddr tr)))))
          (redraw e 3)
          (setq *fq-tr-ozn* e)
          (princ (fq:t "tras.oznaka")))))
    )
  (princ))


;;; ==================================================================
;;;  17b. PROVERA CRTEZA
;;;
;;;  Crtez je ovde ujedno i baza, a DWG nema referencijalni integritet.
;;;  Obicno COPY vlakna napravi drugo vlakno sa istim id-om i niko to
;;;  ne primeti. Ova komanda trazi takve stvari pre predaje projekta.
;;; ==================================================================

;; skupi sve FIBERQ zapise kao (tip podaci entitet)
(defun fq:svizapisi ( / ss i e d out)
  (setq ss (fq:ssx '((-3 ("FIBERQ")))) i 0 out nil)
  (if ss
    (while (< i (sslength ss))
      (setq e (ssname ss i) d (fq:xdget e))
      (if d (setq out (cons (list (car d) d e) out)))
      (setq i (1+ i))))
  (reverse out))

;; kljucevi koji se ponavljaju u listi nizova
(defun fq:duplikati (lst / vid dup x)
  (setq vid nil dup nil)
  (foreach x lst
    (if (member x vid)
      (if (not (member x dup)) (setq dup (cons x dup)))
      (setq vid (cons x vid))))
  (reverse dup))

;; Bez (fq:init), iz istog razloga kao FQTRASA.  Provera se najcesce i
;; pokrece nad tudjim crtezom, gde je uvodjenje FQ_ lejera bas ono sto
;; korisnik ne ocekuje od komande koja "samo proverava".
(defun c:FQPROVERA ( / *error* zap vl na va ids vez kabli gr br svi nuki
                       d1 nn nl ok uk lst tmp x r w kb)
  (setq *error* fq:err)
  (setq zap (fq:svizapisi))
  (if (not zap)
    (princ (fq:t "opste.nema.elemenata"))
    (progn
      (setq vl (vl-remove-if-not '(lambda (r) (= (car r) "VLAKNO"))   zap)
            na (vl-remove-if-not '(lambda (r) (= (car r) "NASTAVAK")) zap)
            va (vl-remove-if-not '(lambda (r) (= (car r) "VARENJE"))  zap)
            uk 0)
      (princ (fq:t "prov.naslov"))
      (princ (fq:tf "prov.zaglavlje"
                    (list (itoa (length vl)) (itoa (length na))
                          (itoa (length va)))))

      ;; 1. dupli id vlakna, tipicno od COPY
      (setq ids (mapcar '(lambda (r) (fq:vl-id (cadr r))) vl)
            lst (fq:duplikati ids))
      (if lst
        (progn
          (setq uk (+ uk (length lst)))
          (princ (fq:tf "prov.1.ima" (list (itoa (length lst)))))
          (foreach x lst (princ (fq:tf "prov.stavka" (list x))))
          (princ (fq:t "prov.1.savet")))
        (princ (fq:t "prov.1.nema")))

      ;; 2. dupli redni broj u istom kablu
      ;;
      ;; PAZNJA: rupa u numeraciji NIJE greska. Kada se dva vlakna
      ;; spoje, ostaje jedan entitet sa identitetom kabla A, pa kabl B
      ;; posle spajanja legitimno ima manje vlakana. Zato se rupe ne
      ;; prijavljuju kao nalaz, nego se broji koliko je vlakana preslo
      ;; u druge kablove, sto se vidi iz lanaca.
      (setq kabli nil)
      (foreach r vl
        (setq d1 (cadr r))
        (if (not (member (fq:vl-kabl d1) kabli))
          (setq kabli (cons (fq:vl-kabl d1) kabli))))
      (setq kabli (reverse kabli) nn 0)
      (foreach kb kabli
        ;; Krak ukinut presecanjem NIJE zasebno vlakno: nosi isti redni
        ;; broj kao krak koji je ostao, jer su oba isto vlakno.  Bez ovog
        ;; filtera je SVAKO presecanje davalo lazan nalaz -- id je vec
        ;; zasticen nastavkom *FQ-PRS-UKI* (vidi fq:prskrak), redni broj
        ;; nije i ne sme da bude, jer ga cita specifikacija.
        ;;
        ;; Lazna uzbuna je ovde skuplja nego propusten nalaz: komanda
        ;; koja pri svakom presecanju prijavi gresku prestane da se cita.
        (setq svi  (vl-remove-if-not
                     '(lambda (r) (= (fq:vl-kabl (cadr r)) kb)) vl)
              nuki (length (vl-remove-if-not
                             '(lambda (r) (fq:ukinut (cadr r))) svi))
              br   (mapcar '(lambda (r) (atoi (fq:vl-br (cadr r))))
                           (vl-remove-if-not
                             '(lambda (r) (not (fq:ukinut (cadr r)))) svi)))
        (setq tmp (fq:duplikati br))
        (if tmp
          (progn
            (setq nn (+ nn (length tmp)))
            (princ (fq:tf "prov.2.ima" (list kb)))
            (foreach x tmp (princ (strcat (itoa x) " ")))))
        ;; koliko je vlakana ovog kabla upijeno u druge kablove
        (setq gr 0)
        (foreach r vl
          (if (/= (fq:vl-kabl (cadr r)) kb)
            (foreach x (fq:delovi (fq:vl-lan (cadr r)))
              (if (fq:posle2 x (strcat kb "/")) (setq gr (1+ gr))))))
        ;; Presecena vlakna su UNUTAR gornjeg broja -- broji se vlakno,
        ;; ne krak.  Zbir po kablovima je zato za toliko manji od
        ;; ukupnog broja zapisa u zaglavlju, gde se broje entiteti.
        (princ (fq:tf "prov.2.kabl"
                      (list kb (itoa (length br))
                            (if (> nuki 0)
                              (fq:tf "prov.2.presecenih" (list (itoa nuki)))
                              "")
                            (if (> gr 0)
                              (fq:tf "prov.2.spojeno" (list (itoa gr)))
                              "")))))
      (setq uk (+ uk nn))
      (if (= nn 0) (princ (fq:t "prov.2.nema")))

      ;; 3. dva vlakna na istom portu ODF-a ili ODO-a
      (setq vez nil)
      (foreach r vl
        (foreach x (fq:delovi (fq:vl-veza (cadr r)))
          (setq vez (cons x vez))))
      (setq lst (fq:duplikati vez))
      (if lst
        (progn
          (setq uk (+ uk (length lst)))
          (princ (fq:tf "prov.3.ima" (list (itoa (length lst)))))
          (foreach x lst (princ (fq:tf "prov.stavka" (list x)))))
        (princ (fq:t "prov.3.nema")))

      ;; 4. nastavak bez ijednog varenja
      ;;
      ;; LATENTNI nastavak se ne racuna.  On i postoji zato da kroz
      ;; njega vlakna samo prodju, sa rezervom kabla, dok se jednom ne
      ;; ukaze potreba za odvajanjem; varenja u njemu NEMA i to nije
      ;; greska.  Dok su se i NL brojali, na dugom kablu sa pet
      ;; latentnih nastavaka provera nikad nije mogla da kaze da je
      ;; crtez cist, pa se prestala i citati.
      (setq nn 0 nl 0)
      (foreach r na
        (if (= (fq:na-tip (cadr r)) "NL")
          (setq nl (1+ nl))
          (progn
            (setq ok nil)
            (foreach w va
              (if (= (fq:va-oz (cadr w)) (fq:na-oz (cadr r))) (setq ok T)))
            (if (not ok)
              (progn
                (setq nn (1+ nn))
                (princ (fq:tf "prov.4.ima"
                              (list (fq:na-oz (cadr r))))))))))
      (setq uk (+ uk nn))
      (if (> nn 0) (princ (fq:t "prov.4.savet")))
      (if (= nn 0) (princ (fq:t "prov.4.nema")))
      (if (> nl 0) (princ (fq:tf "prov.4.latentni" (list (itoa nl)))))

      ;; 5. varenje koje pominje vlakno kog vise nema
      ;; Skupljaju se OBA: sopstveni id vlakna I svi delovi lanca.
      ;;
      ;; Do 25.08.2026 je stajalo "lanac ako ga ima, inace id", a lanac
      ;; ga UVEK ima -- svako vlakno se stvara sa poljem 15 jednakim
      ;; svom id-u.  Sopstveni id se zato nije prikupljao nikada kada se
      ;; od lanca razlikuje, a razlikuje se kod ukinutog kraka:
      ;; fq:prskrak menja polje 1 u "K1/1/1-U" a polje 15 ostavlja na
      ;; "K1/1/1".  Oba kraka onda daju istu nisku, fq:spoji2 ih sazme u
      ;; jednu, i oznaka -U ne udje u lanac ni posle spajanja.
      ;;
      ;; Posledica je bila lazan nalaz "varenje bez vlakna" nad crtezom
      ;; napravljenim ispravnim potezima: preseci vlakno pa spoji krakove.
      ;;
      ;; Polje 15 se NE dira.  Lanac znaci "od kojih izvornih vlakana je
      ;; ovo sastavljeno", a oba kraka jesu izvorno K1/1/1 -- tako da je
      ;; tamo vrednost tacna.  Netacna je bila samo ova pretpostavka da
      ;; lanac pokriva i tekuci id.
      (setq ids nil)
      (foreach r vl
        (setq ids (cons (fq:vl-id (cadr r)) ids))
        (foreach x (fq:delovi (fq:vl-lan (cadr r)))
          (setq ids (cons x ids))))
      (setq nn 0)
      (foreach w va
        (if (or (not (member (fq:va-a (cadr w)) ids))
                (not (member (fq:va-b (cadr w)) ids)))
          (progn
            (setq nn (1+ nn))
            (if (<= nn 10)
              (princ (fq:tf "prov.5.ima"
                            (list (fq:va-a (cadr w)) (fq:va-b (cadr w))
                                  (if (= (fq:va-oz (cadr w)) "")
                                    ""
                                    (fq:tf "prov.5.mesto"
                                           (list (fq:va-oz (cadr w))))))))))))
      (if (> nn 10) (princ (fq:tf "prov.jos" (list (itoa (- nn 10))))))
      (setq uk (+ uk nn))
      (if (= nn 0) (princ (fq:t "prov.5.nema")))

      ;; 6. radno vlakno bez ijednog zavrsetka
      (setq nn 0)
      (foreach r vl
        ;; Kroz fq:nazkod, ne golo poredjenje: zatecen crtez nosi rec
        ;; "Radno", nov nosi kod "nmWork", a nalaz mora da vidi oba.
        ;; Da je ostalo golo poredjenje sa "Radno", ova provera bi od
        ;; bloka 4 UVEK prijavljivala nulu -- kvar koji izgleda kao
        ;; dobra vest, pa se ne primeti.
        (if (and (= (fq:nazkod "nam" (fq:vl-nam (cadr r))) "nmWork")
                 (= (fq:vl-veza (cadr r)) ""))
          (setq nn (1+ nn))))
      (setq uk (+ uk nn))
      (princ (fq:tf "prov.6"
                    (list (itoa nn)
                          (if (> nn 0) (fq:t "prov.6.napomena") ""))))

      (princ (fq:tf "prov.ukupno" (list (itoa uk))))
      (if (= uk 0) (princ (fq:t "prov.cist")))
      (princ "\n")))
  (princ))


;;; ==================================================================
;;;  17a. PODACI
;;; ==================================================================

;;  Jedno polje -> gotov red, ili nil kad polja u zapisu nema.
;;
;;  PRAZNO POLJE SE NE ISPISUJE.  Zatecen crtez nema nova polja uopste,
;;  a fq:f na njima vraca "" -- ispisan red bez vrednosti bi na svakom
;;  starijem vlaknu dao desetak praznih redova umesto podatka.  Nista se
;;  time ne krije: sirov zapis se ispisuje kao poslednji red, pa se prazna
;;  polja u njemu i dalje broje.
;;
;;  Kljuc natpisa je RACUNAT -- stize iz *FQ-POLJA* kao promenljiva.
;;  Dozvoljen je samo zato sto ima svoju proveru, koja gleda samu tabelu;
;;  vidi komentar uz *FQ-POLJA*.
(defun fq:infored (d p / v n)
  (setq v (fq:f (car p) d)
        n (caddr p))
  (if (= v "")
    nil
    (fq:tf (cadr p)
           (list (cond ((= n "")     v)
                       ((= n "st")   (fq:stnaziv v))
                       ((= n "boja") (fq:bojrec v))
                       ;; fq:kodnaz sam normalizuje, pa zatecen crtez sa
                       ;; srpskom recju u polju i nov sa kodom daju isti
                       ;; red.  Zaseban fq:nazkod se NE zove.
                       (T            (fq:kodnaz n v)))))))

;;;  Podaci o elementu, u dva sloja.
;;;
;;;  Gornji sloj je citljiv: po jedan red na polje, natpis preveden,
;;;  kodovi razlozeni u nazive.  Do 1.0.0 ga nije bilo -- komanda je
;;;  ispisivala samo zapis, pa je korisnik sa engleskim interfejsom
;;;  dobijao [stProjektovano] i [lkManhole] i imao pravo da to shvati kao
;;;  neprevedeno.
;;;
;;;  DONJI SLOJ, SIROV ZAPIS, OSTAJE NEPROMENJEN i ispisuje se uvek.  On
;;;  je jedino mesto koje pokazuje TACAN redosled i tacan broj polja, i o
;;;  njemu visi ceo korpus rucnih provera prijema; uz to je jedini nacin
;;;  da se vidi polje kome mapa ne daje red (3-6 nastavka, 17 vlakna) i
;;;  polje iz verzije koja jos ne postoji.  Zato prefiks "\nFIBERQ: "
;;;  ostaje doslovan i i dalje stoji na spisku izuzetaka u test-lisp.ps1.
(defun c:FQINFO ( / *error* s e d rec r)
  (setq *error* fq:err)
  (if (setq s (entsel (fq:t "info.pitaj.element")))
    (progn
      (setq e (car s) d (fq:xdget e))
      (if d
        (progn
          (princ (fq:tf "info.zaglavlje" (list (fq:vrnaziv (car d)))))
          (if (setq rec (assoc (strcase (car d)) *FQ-POLJA*))
            (foreach p (cadddr rec)
              (if (setq r (fq:infored d p)) (princ r))))
          ;;  Natpis pre zapisa, jer bez njega poslednji red izgleda kao
          ;;  zaostao prevod.  Sam prefiks "\nFIBERQ: " se NE dira: on je
          ;;  na spisku izuzetaka u test-lisp.ps1 i po njemu se ispis
          ;;  prepoznaje u zatecenim beleskama i postupcima prijema.
          (princ (fq:t "info.zapis"))
          (princ "\nFIBERQ: ")
          (foreach v d (princ (strcat "[" v "] "))))
        (princ (fq:t "info.nema"))))
    (princ (fq:t "opste.nista")))
  (princ))

;;; --- specifikacija: struktura, pa tek onda tekst -------------------
;;;
;;;  Do 1.0.0 je fq:tally lepila vidljiv SRPSKI red i po njemu grupisala.
;;;  Dve posledice, obe lose:
;;;
;;;  1. Kljuc grupisanja je sadrzao slobodan tekst iz edit_box-a -- i
;;;     model, i etiketu, i adresu.  Razdvojnik " | " je u takvom kljucu
;;;     bio pretpostavka, ne cinjenica: rack 19" je legitimna vrednost.
;;;  2. Svaki srpski literal specifikacije je bio razasut po granama, pa
;;;     bi ih Faza 5 morala loviti jedan po jedan.
;;;
;;;  Sada su to tri funkcije:
;;;    fq:tallyst   zapis -> STRUKTURA, lista neutralnih atoma
;;;    fq:tallytxt  struktura -> vidljiv red   <- JEDINO mesto sa srpskim
;;;    fq:tally     grupise po strukturi, vraca ((struktura . broj) ...)
;;;
;;;  Raspored strukture je (vrsta status . polja).  Status je na FIKSNOM
;;;  drugom mestu namerno: strukture su razlicite duzine, pa bi citanje
;;;  sa kraja ponovilo tacno onu zamku koju fq:vstat vec mora da zaobilazi.
;;;
;;;  Struktura se PISE u kodovima (fq:nazkod), pa citac radi isto i sa
;;;  danasnjim srpskim vrednostima u xdata i sa kodovima koje ce upisati
;;;  blokovi 4-7.  Zato ovaj blok ide PRE njih: nema trenutka u kome je
;;;  specifikacija pokvarena.

;; Zapis -> struktura.  nil znaci "nije stavka specifikacije".
(defun fq:tallyst (d / tip)
  (setq tip (car d))
  (cond
    ;; Ulaz i izlaz splitera nisu stavke -- spliter jeste.  Do sada su
    ;; padali na (T tip) i davali po jedan red ULAZ i po jedan red IZLAZ
    ;; ZA SVAKU granu lepeze svakog splitera.  Zatecen kvar, nije jezicki.
    ((member tip '("ULAZ" "IZLAZ")) nil)
    ((= tip "VLAKNO")
       (list tip (fq:vstat d) (fq:f 2 d) (fq:f 11 d)
             (fq:nazkod "nam" (fq:f 10 d))
             (fq:nazkod "pro" (fq:f  9 d))))
    ((= tip "VARENJE")  (list tip (fq:vstat d) (fq:f 5 d)))
    ;; Mesto se grupise po vrsti, BEZ broja: "u oknu" i "na stubu" su
    ;; razlicite stavke, okno 12 i okno 13 nisu.
    ((= tip "NASTAVAK") (list tip (fq:vstat d) (fq:f 2 d)
                              (fq:nazkod "lok" (fq:na-lok d))))
    ((= tip "SPLITER")  (list tip (fq:vstat d) (fq:f 2 d)))
    ;; Patch panel se crta kao ODF, MDU kao ODO, pa im je i raspored
    ;; polja isti -- samo je vrsta druga.
    ((member tip '("ODF" "PP"))
       (list tip (fq:vstat d) (fq:f 2 d) (fq:f 4 d) (fq:f 3 d)))
    ;; Montaza kroz fq:nazkod, ne golo: ormar nacrtan pre ove verzije
    ;; nosi rec "unutrasnji", nov nosi "mtIndoor".  Bez normalizacije bi
    ;; ta dva bila dva reda specifikacije za istu stvar -- isto sto se
    ;; desavalo mestu nastavka pre nego sto je dobilo domen.
    ((member tip '("ODO" "IPAN"))
       (list tip (fq:vstat d) (fq:f 4 d) (fq:f 2 d)
             (fq:nazkod "mnt" (fq:f 5 d)) (fq:f 3 d)))
    ((= tip "ZOK")
       (list tip (fq:vstat d) (fq:f 2 d) (fq:f 3 d) (fq:f 5 d)
             (fq:nazkod "mnt" (fq:f 6 d)) (fq:f 7 d)))
    ((= tip "OLT")      (list tip (fq:vstat d) (fq:f 2 d)))
    ((= tip "REZERVA")  (list tip (fq:vstat d) (fq:f 1 d)))
    ;; ONT, PON, PRIVOD -- i svaka vrsta iz buduce verzije.  Mora da se
    ;; pojavi pod svojim kljucem, ne da nestane iz specifikacije.
    (T (list tip (fq:vstat d)))))

;; Struktura -> vidljiv red.  JEDINO mesto sa srpskim tekstom
;; specifikacije; Faza 5 dira samo ovu funkciju.
;;
;;  Model (nth 2 kod ODF/PP/ZOK, nth 2 kod ODO/MDU) sme da bude prazan,
;;  pa svako spajanje sa njim ide kroz fq:spoj -- inace stavka pocinje
;;  razdvojnikom: "ODO -48", "Patch panel , zauzeto 12".
;;  Neobavezan deo se predaje kao UMETAK, ne kao zasebna grana.  Zato
;;  fq:bomd: vraca "" ili razdvojnik pa vrednost, pa recenica u tabeli
;;  ostaje jedna ("ODO %1%2, zauzeto %3") umesto da se lomi na dve.
;;  Prevodilac tako sme da pomeri i sam neobavezan deo.
;;
;;  Usput popravlja zatecen dvostruki razmak: montaza sme da bude prazna
;;  (katalosko kuciste bez nje), a "ODO 48 " + "" + ", zauzeto" je davalo
;;  "ODO 48 , zauzeto".  Isti razred kvara koji fq:spoj resava za model.
(defun fq:bomd (raz v)
  (if (or (not v) (= v "")) "" (strcat raz v)))

(defun fq:tallytxt (s / tip)
  (setq tip (car s))
  (strcat
    (cond
      ;; PROLAZNOST NE IDE KROZ fq:kodnaz, i to je jedino takvo mesto.
      ;; Tabela nosi "prolazno" (srednji rod, uz "vlakno"), a ovde stoji
      ;; uz "vlakna" -- treba "prolazna".  Rod se iz tabele ne moze
      ;; izvesti, pa bi jedini drugi izlaz bila druga kolona samo za
      ;; ovaj jedan spoj.  Engleski razliku nema, pa su kljucevi ipak
      ;; dva: srpski nosi oblik, engleski isti tekst kao naziv.
      ((= tip "VLAKNO")
         (fq:tf "bom.vlakno"
                (list (nth 2 s)
                      (fq:bomd "  " (nth 3 s))
                      (fq:bomd ", " (fq:kodnaz "nam" (nth 4 s)))
                      (cond ((= (nth 5 s) "prThru") (fq:t "bom.vlakno.prolazna"))
                            ((= (nth 5 s) "prCut")  (fq:t "bom.vlakno.presecena"))
                            (T "")))))
      ;; Dva kljuca, ne jedan sa praznim umetkom: "Varenja u " bez mesta
      ;; ostavlja predlog koji visi, a predlog nije isti u dva jezika.
      ((= tip "VARENJE")
         (if (= (nth 2 s) "")
           (fq:t "bom.varenje")
           (fq:tf "bom.varenje.u" (list (nth 2 s)))))
      ((= tip "NASTAVAK")
         (fq:tf "bom.nastavak"
                (list (nth 2 s)
                      (fq:bomd ", " (fq:kodnaz "lok" (nth 3 s))))))
      ((= tip "SPLITER")  (fq:tf "bom.spliter" (list (nth 2 s))))
      ((= tip "ODF")      (fq:tf "bom.odf"
                                 (list (fq:bomd " " (nth 2 s))
                                       (nth 3 s) (nth 4 s))))
      ((= tip "PP")       (fq:tf "bom.pp"
                                 (list (fq:bomd " " (nth 2 s))
                                       (nth 3 s) (nth 4 s))))
      ;; ODO se na engleskom zove FDH (Fiber Distribution Hub), ZOK FAT
      ;; (Fiber Access Terminal) -- odluka od 21.08.2026.  Kljuc u xdata
      ;; ostaje "ODO" odnosno "ZOK" zauvek; menja se samo ovaj ispis.
      ((= tip "ODO")      (fq:tf "bom.odo"
                                 (list (fq:spoj (nth 2 s) "-" (nth 3 s))
                                       (fq:bomd " " (fq:kodnaz "mnt" (nth 4 s)))
                                       (nth 5 s))))
      ;; Kljuc je i dalje "IPAN": tako pise u xdata svakog vec nacrtanog
      ;; ormara.  Menja se samo ono sto se ispisuje.
      ((= tip "IPAN")     (fq:tf "bom.mdu"
                                 (list (fq:spoj (nth 2 s) "-" (nth 3 s))
                                       (fq:bomd " " (fq:kodnaz "mnt" (nth 4 s)))
                                       (nth 5 s))))
      ((= tip "ZOK")      (fq:tf "bom.zok"
                                 (list (fq:bomd " " (nth 2 s))
                                       (nth 3 s) (nth 4 s)
                                       (fq:bomd " " (fq:kodnaz "mnt" (nth 5 s)))
                                       ;; NE kroz fq:bomd: fq:tf uvek vrati
                                       ;; nepraznu recenicu, pa bi razdvojnik
                                       ;; isao i kad splitera nema.  Prazno se
                                       ;; mora proveriti PRE prevoda.
                                       (if (= (nth 6 s) "")
                                         ""
                                         (strcat ", "
                                                 (fq:tf "bom.zok.spliter"
                                                        (list (nth 6 s))))))))
      ((= tip "OLT")      (fq:tf "bom.olt" (list (nth 2 s))))
      ((= tip "ONT")      (fq:t "bom.ont"))
      ((= tip "PON")      (fq:t "bom.pon"))
      ((= tip "PRIVOD")   (fq:t "bom.privod"))
      ((= tip "REZERVA")  (fq:tf "bom.rezerva" (list (nth 2 s))))
      (T tip))
    " | " (fq:stnaziv (cadr s))))

;; Struktura u vec skupljenoj tabeli, ili nil.
;;
;;  Namerno NE assoc.  assoc nad kljucem koji je lista nije nedvosmisleno
;;  dokumentovan u AutoLISP-u, a ovde je kljuc uvek lista.  vl-some sa
;;  izricitim equal radi isti posao bez ijedne pretpostavke.  (subst
;;  nize je bezbedan: dokumentovano poredi preko equal, i vec se u
;;  projektu koristi nad listama -- fq:kc-addmod.)
(defun fq:tallynadji (s tbl)
  (vl-some '(lambda (x) (if (equal (car x) s) x)) tbl))

(defun fq:tally ( / ss i e d st tbl rec)
  (setq ss (fq:ssx '((-3 ("FIBERQ")))) tbl nil i 0)
  (if ss
    (while (< i (sslength ss))
      (setq e (ssname ss i) d (fq:xdget e))
      (if (and d (setq st (fq:tallyst d)))
        (if (setq rec (fq:tallynadji st tbl))
          (setq tbl (subst (cons st (1+ (cdr rec))) rec tbl))
          (setq tbl (cons (cons st 1) tbl))))
      (setq i (1+ i))))
  (reverse tbl))

(defun c:FQBOM ( / *error* tbl)
  (setq *error* fq:err)
  (setq tbl (fq:tally))
  (if tbl
    (progn
      (princ (fq:t "bom.naslov"))
      (foreach r tbl
        (princ (strcat "\n" (fq:tallytxt (car r)) " : " (itoa (cdr r)))))
      (princ "\n"))
    (princ (fq:t "opste.nema.elemenata")))
  (princ))

(defun c:FQTABELA ( / *error* tbl p0 x0 y0 i)
  (setq *error* fq:err)
  (fq:init)
  (setq tbl (fq:tally))
  (if tbl
    (if (setq p0 (fq:gp (fq:t "bom.pitaj.tacka")))
      (progn
        (setq *fq-a* 0.0 x0 (car p0) y0 (cadr p0) i 0)
        ;; Naslov TABELE U CRTEZU, ne poruke -- zato bez \n i bez crta.
        ;; Nacrtan tekst prati jezik u trenutku crtanja (odluka od
        ;; 21.08.2026); vec nacrtana tabela se ne prepisuje.
        (fq:Wtext x0 y0 (* 1.6 *FQ-TXTH*)
                  (fq:t "bom.tabela.naslov") 7 "FQ_TABELA" "FQ_TXTB" 0 0)
        (foreach r tbl
          (setq i (1+ i))
          (fq:Wtext x0 (- y0 (* 1.6 *FQ-TXTH* (1+ i))) *FQ-TXTH*
                    (fq:tallytxt (car r)) 7 "FQ_TABELA" "FQ_TXT" 0 0)
          (fq:Wtext (+ x0 50.0) (- y0 (* 1.6 *FQ-TXTH* (1+ i))) *FQ-TXTH*
                    (itoa (cdr r)) 7 "FQ_TABELA" "FQ_TXT" 0 0))
        (princ (fq:tf "bom.upisano" (list (itoa i))))))
    (princ (fq:t "opste.nema.elemenata")))
  (princ))

;; Tabela slabljenja za vrstu.  Kroz fq:nazkod, ne golo poredjenje: u
;; polju 18 sme da stoji "SM", "sm" ili "singlemode", zavisno od toga da
;; li je upisano crtacem, komandom FQVRSTA ili rukom.
(defun fq:attab (vrs)
  (if (= (fq:nazkod "vrs" vrs) "MM") *FQ-ATT-MM* *FQ-ATT-SM*))

;; Talasne duzine iz tabele kao jedan string; sep je " " za initget,
;; "/" za prompt.  Jedna funkcija, da se dva spiska ne raziju.
(defun fq:attspis (tb sep / s x)
  (setq s "")
  (foreach x tb (setq s (strcat s (if (= s "") "" sep) (itoa (car x)))))
  s)

;; Podrazumevana talasna duzina po vrsti.  Ne izvodi se iz tabele -- kod
;; singlemode-a to nije ni prva ni poslednja stavka: 1490 nm je GPON
;; nizvodno, a 850 nm je ono na cemu multimode veza po pravilu radi.
(defun fq:attdef (vrs) (if (= (fq:nazkod "vrs" vrs) "MM") "850" "1490"))

(defun fq:budzet (crtez / km nv nk s1 s2 tal a g1 g2 gv gk gd uk s d tr
                    vrs vrl tb out)
  ;; Racun i gotovi redovi ispisa, kao LISTA NISKI.  Izdvojeno iz
  ;; c:FQBUDZET da bi isti redovi mogli i u konzolu i u crtez --
  ;; isti odnos koji vec postoji izmedju c:FQBOM i c:FQTABELA.
  ;;
  ;; crtez je T kad se pise u crtez.  Menja SAMO naslovni red:
  ;; konzolni nosi crte i prelom, a nacrtan ne sme nijedno od
  ;; toga.  Oba kljuca su doslovna, u dve grane -- (fq:tf (if ...))
  ;; bi postao racunat kljuc, koji provera ne vidi.
  ;; Varenja i konektore zna crtez, ne treba ih kucati napamet.
  ;; Vlakno je podrazumevano; fq:dvatok vraca T samo za drugi token.
  (if (not (fq:dvatok "budz.tok.vlakno" "budz.tok.rucno" "budz.pitaj.izvor" nil))
    (progn
      (setq s (entsel (fq:t "budz.pitaj.vlakno")))
      (setq d (if s (fq:xdget (car s)) nil))
      (if (and d (= (car d) "VLAKNO"))
        (progn
          (setq tr  (fq:trasa d) nv (caddr tr) nk (cadddr tr)
                vrs (fq:vl-vrsta d))
          (princ (fq:tf "budz.izcrteza"
                        (list (fq:vl-id d) (itoa nv) (itoa nk)
                              (fq:bomd ", " (fq:kodnaz "vrs" vrs)))))
          (if (= nk 0) (princ (fq:t "budz.bez.zavrsetka")))
          (if (= vrs "") (princ (fq:t "budz.bez.vrste"))))
        (princ (fq:t "budz.rucno")))))
  ;; Vrsta odredjuje i tabelu slabljenja i ponudjene talasne duzine, pa
  ;; mora biti poznata pre oba.  Ovde se NE zove fq:askvrs: ona postavlja
  ;; *fq-vrs*, dakle vrstu sledeceg nacrtanog kabla, a ova komanda nista
  ;; ne crta i ne sme da menja stanje sesije.
  (if (or (not vrs) (= vrs ""))
    (progn
      (setq vrl (fq:tokovi "vrs" nil))
      (initget (fq:spisak vrl " "))
      (setq vrs (getkword (fq:tf "vlakno.pitaj.vrsta"
                                 (list (fq:spisak vrl "/") "SM"))))
      (setq vrs (if vrs (fq:nazkod "vrs" vrs) "SM"))))
  (setq tb (fq:attab vrs))
  (setq km (fq:pitajreal (fq:t "budz.pitaj.km") 2.0))
  (if (not nv)
    (if (not (setq nv (getint (fq:t "budz.pitaj.varenja")))) (setq nv 8)))
  (if (not nk)
    (if (not (setq nk (getint (fq:t "budz.pitaj.konektori")))) (setq nk 4)))
  ;; Negativan broj ovde ne pada -- ODUZIMA od gubitka, pa budzet izadje
  ;; bolji nego sto jeste.  Rezultat te komande ide u projekat kao dokaz
  ;; da veza radi, i to je jedino mesto u dodatku gde pogresan unos daje
  ;; odgovor koji je LEPSI od tacnog.
  (if (< km 0.0) (setq km 0.0))
  (if (< nv 0)   (setq nv 0))
  (if (< nk 0)   (setq nk 0))
  (if (not (setq s1 (getint (fq:t "budz.pitaj.spl1")))) (setq s1 4))
  (if (not (setq s2 (getint (fq:t "budz.pitaj.spl2")))) (setq s2 8))
  ;; Spisak talasnih duzina se gradi iz tabele te vrste.  Nabrojane
  ;; napamet bi multimode vlakno nudilo 1310/1490/1550, gde assoc ne
  ;; nalazi nista, pa bi a bilo nil -- a nil u (* km a) obara komandu.
  (initget (fq:attspis tb " "))
  (setq tal (getkword (fq:tf "budz.pitaj.talasna"
                             (list (fq:attspis tb "/") (fq:attdef vrs)))))
  (if (not tal) (setq tal (fq:attdef vrs)))
  (setq a  (cdr (assoc (atoi tal) tb))
        gd (* km a) gv (* nv *FQ-G-VAR*) gk (* nk *FQ-G-KON*)
        g1 (if (> s1 1) (fq:splgub s1) 0.0)
        g2 (if (> s2 1) (fq:splgub s2) 0.0)
        uk (+ gd gv gk g1 g2 *FQ-MARGIN*))
  ;;  Svaki red je JEDNA niska, sa natpisom unutra.  Poravnanje kolone
  ;;  "=" zavisi od duzine natpisa, a ta duzina nije ista u dva jezika
  ;;  ("konektori" 9, "connectors" 10).  Da natpis ostane fragment pored
  ;;  strcat-a, prevod bi razbio tabelu i to bi se videlo tek u ispisu.
  ;; Redosled je redosled ispisa.  Splitera moze da nema, pa se lista
  ;; sklapa reverse-om umesto jednim (list ...): grana koja izostane ne
  ;; sme da ostavi nil u sredini, jer bi ga crtac predao fq:Wtext-u.
  (setq out (list (if crtez
                    (fq:tf "budz.tabela.naslov" (list (fq:kodnaz "vrs" vrs) tal))
                    (fq:tf "budz.naslov"        (list (fq:kodnaz "vrs" vrs) tal)))
                  (fq:tf "budz.red.vlakno"
                         (list (rtos km 2 2) (rtos a 2 2) (rtos gd 2 2)))
                  (fq:tf "budz.red.varenja"
                         (list (itoa nv) (rtos *FQ-G-VAR* 2 2) (rtos gv 2 2)))
                  (fq:tf "budz.red.konektori"
                         (list (itoa nk) (rtos *FQ-G-KON* 2 2) (rtos gk 2 2)))))
  (if (> s1 1)
    (setq out (append out (list (fq:tf "budz.red.spliter"
                                       (list (itoa s1) (rtos g1 2 2)))))))
  (if (> s2 1)
    (setq out (append out (list (fq:tf "budz.red.spliter"
                                       (list (itoa s2) (rtos g2 2 2)))))))
  (append out
          (list (fq:tf "budz.red.rezerva" (list (rtos *FQ-MARGIN* 2 2)))
                (fq:tf "budz.red.ukupno"  (list (rtos uk 2 2)))
                (fq:tf "budz.klasa"
                       (list "B+" "28" (if (<= uk 28.0)
                                         (fq:t "budz.prolazi")
                                         (fq:t "budz.neprolazi"))))
                (fq:tf "budz.klasa"
                       (list "C+" "32" (if (<= uk 32.0)
                                         (fq:t "budz.prolazi")
                                         (fq:t "budz.neprolazi")))))))

;;  Niska bez pocetnog preloma reda.  Redovi budzeta su PORUKE, pa svaka
;;  pocinje sa \n; u crtezu bi taj znak zavrsio u TEXT entitetu.
(defun fq:bezpreloma (s)
  (if (and (= (type s) 'STR) (> (strlen s) 0) (= (substr s 1 1) "\n"))
    (substr s 2)
    s))

(defun c:FQBUDZET ( / *error* red)
  (setq *error* fq:err)
  (if (setq red (fq:budzet nil))
    (progn (foreach s red (princ s)) (princ "\n")))
  (princ))

;;;  Isti budzet, ali u crtez -- odnos c:FQBOM prema c:FQTABELA.
;;;
;;;  Racun se NE ponavlja i ne pamti: fq:budzet iznova postavi ista
;;;  pitanja.  To je namerno.  Zapamcen rezultat bi znacio da tabela u
;;;  crtezu sme da bude starija od pitanja na koja je odgovoreno, a taj
;;;  broj ide u projekat kao dokaz da veza radi.
;;;
;;;  Svi ulazi (km, slabljenje po km, broj varenja i konektora, odnosi
;;;  splitera, rezerva) stoje u samim redovima, pa je nacrtana tabela
;;;  proverljiva, a ne gola cifra.
;;;
;;;  Lejer je FQ_TABELA, isti koji koristi specifikacija: to je lejer za
;;;  tekstualne tabele u crtezu, ne za jednu komandu.  Nov lejer bi bio
;;;  jos jedno zamrznuto ime bez razloga.
(defun c:FQBUDZETT ( / *error* red p0 x0 y0 i)
  (setq *error* fq:err)
  (fq:init)
  (if (setq red (fq:budzet T))
    (if (setq p0 (fq:gp (fq:t "bom.pitaj.tacka")))
      (progn
        (setq *fq-a* 0.0 x0 (car p0) y0 (cadr p0) i 0)
        (foreach s red
          (fq:Wtext x0 (- y0 (* 1.6 *FQ-TXTH* i))
                    (if (= i 0) (* 1.6 *FQ-TXTH*) *FQ-TXTH*)
                    (fq:bezpreloma s) 7 "FQ_TABELA"
                    (if (= i 0) "FQ_TXTB" "FQ_TXT") 0 0)
          (setq i (1+ i)))
        (princ (fq:t "budz.upisano")))))
  (princ))


;;; ==================================================================
;;;  18. LEGENDA   (uvek horizontalna)
;;; ==================================================================

(defun fq:legrow (x y opis)
  (fq:Wtext (+ x 14.0) (- y (* 0.4 *FQ-TXTH*)) *FQ-TXTH*
            opis 7 "FQ_LEGENDA" "FQ_TXT" 0 0))

(defun c:FQLEGENDA ( / *error* p0 x y d i e nm bn)
  (setq *error* fq:err)
  (fq:init)
  (fq:lwon)
  (if (setq p0 (fq:gp (fq:t "leg.pitaj.tacka")))
    (progn
      (setq *fq-a* 0.0 x (car p0) y (cadr p0) d 3.2)
      (fq:Wtext x (+ y 2.0) (* 1.8 *FQ-TXTH*)
                (fq:t "leg.naslov") 7 "FQ_LEGENDA" "FQ_TXTB" 0 0)

      ;;  BOJA PRVOG VLAKNA SE CITA IZ AKTIVNOG STANDARDA, ne zakucava.
      ;;
      ;;  Do 1.0.0 je ovde stajalo (fq:bojnaz 5) uz boju 5, dakle
      ;;  "1.Plava" plavim slovima -- tacno pod TIA-598, a netacno pod
      ;;  IEC 60304, gde je prvo vlakno CRVENO.  Legenda je time
      ;;  protivrecila samoj sebi: donji color-code odeljak cita istu
      ;;  tabelu kroz fq:cctab i pod IEC ispisuje "1. Crvena" crvenom
      ;;  linijom, dva pedlja ispod.
      ;;
      ;;  Ide kroz fq:cprikaz, ne kroz (fq:bojnaz (fq:caci 1)):
      ;;  fq:bojnaz je cond BEZ T grane i vraca nil za ACI koji nije
      ;;  medju dvanaest poznatih, a korisnicka boja iz FQCC to sme da
      ;;  bude -- (strcat "1." nil) bi oborio komandu.  fq:cprikaz na
      ;;  nepoznat ACI pada na fq:cname, dakle na rec iz samog standarda.
      (fq:Wline x y (+ x 11.0) y 7 "FQ_LEGENDA" nil)
      (fq:Wtext (+ x 3.0) (+ y 0.2) (* 0.7 *FQ-TXTH*)
                (strcat "1." (fq:cprikaz 1)) (fq:caci 1)
                "FQ_LEGENDA" "FQ_TXT" 0 0)
      (fq:legrow x y (fq:t "leg.vlakno"))

      (setq y (- y d) i 0)
      (while (< i 3)
        (fq:Wline x (- y (* 0.6 i)) (+ x 11.0) (- y (* 0.6 i))
                  7 "FQ_LEGENDA" nil)
        (setq i (1+ i)))
      ;;  Ista ispravka kao gore: cevcica se u fq:drawkabl boji sa
      ;;  (fq:caci i), pa prva cevcica prati aktivan standard.
      (fq:Well (+ x 2.5) (- y 0.6) 0.7 1.3 (fq:caci 1) "FQ_LEGENDA")
      (fq:Wtext (+ x 2.5) (- y 0.6) (* 0.9 *FQ-TXTH*)
                "1" (fq:caci 1) "FQ_LEGENDA" "FQ_TXT" 1 2)
      (fq:Well (+ x 8.5) (- y 0.6) 0.7 1.3 (fq:caci 1) "FQ_LEGENDA")
      (fq:legrow x (- y 0.6) (fq:t "leg.kabl"))

      ;;  KASETA U RAMU NASTAVKA JE OBRISANA, i to je ispravka a ne
      ;;  osiromasenje.  Legenda je crtala tri uspravne pregrade i
      ;;  natpis ih je izricito obecavao, a fq:drawnast unutar rama ne
      ;;  crta NIJEDNU liniju -- u celoj funkciji nema nijednog fq:Wline.
      ;;  Lejer FQ_KASETA je deklarisan i nikad se ne koristi; to je bio
      ;;  jedini trag te namere u celom projektu.
      ;;
      ;;  Umesto pregrada ide ono po cemu se nastavak u crtezu STVARNO
      ;;  prepoznaje: crvena oznaka iznad rama.  Prefiks pravi fq:napre,
      ;;  nikad zakucana niska -- prefiks prati jezik, a druga kopija
      ;;  istog pravila bi se razisla tiho.
      ;;
      ;;  Natpis leg.nastavak je skracen u OBE tabele niski, jer bi
      ;;  inace legenda pisala "sa kasetama" uz prazan ram -- gore nego
      ;;  pre ispravke.
      (setq y (- y d 1.0))
      (fq:Wrect x (+ y 1.2) (+ x 11.0) (- y 1.6) 7 "FQ_LEGENDA")
      ;;  y+1.7, ne y+1.5: natpis je centriran po visini (poslednji 2), pa
      ;;  se pri visini 1.2*TXTH = 0.648 prostire od y+1.376 do y+2.024.
      ;;  Na y+1.5 bi donja ivica slova sela tacno na gornju ivicu rama
      ;;  (y+1.2).  Gore ima mesta: najnizi deo reda kabla je na y+3.0.
      (fq:Wtext (+ x 5.5) (+ y 1.7) (* 1.2 *FQ-TXTH*)
                (strcat (fq:napre "N") "1") 1 "FQ_LEGENDA" "FQ_TXTB" 1 2)
      (fq:legrow x y (fq:t "leg.nastavak"))

      ;;  VARENJE JE CRNA PUNA TACKA NA NEPREKINUTOM VLAKNU.
      ;;
      ;;  Do 1.0.0 je legenda crtala CRVENU SUPLJU elipsu 1.2 x 0.48 na
      ;;  prekinutom vlaknu -- pogresna boja, pogresan oblik i pogresna
      ;;  predstava o tome sta spoj radi.  Crvena je boja LEJERA
      ;;  FQ_VARENJE (vidi *FQ-LAYERS*), a fq:Wdot dobija izricitu boju
      ;;  7, pa se boja lejera nikad i ne vidi; legenda je uzela broj iz
      ;;  tabele lejera umesto iz crtaca.
      ;;
      ;;  Prekid je bio druga greska iste vrste: fq:spoj1 dva vlakna
      ;;  spaja u JEDNU poliliniju kroz fq:mkfiber i tek onda na nju
      ;;  stavlja tacku.  Prekinuto vlakno u legendi je govorilo da spoj
      ;;  ostavlja rupu.
      ;;
      ;;  Precnik je stvarni *FQ-SPD*, ne uvecan.  Tacka porta ormara
      ;;  dva reda nize je 0.214, dakle upola manja -- razlika se vidi, a
      ;;  legenda ostaje merilo za ono sto je u crtezu.
      (setq y (- y d 0.6))
      (fq:Wline x y (+ x 11.0) y 7 "FQ_LEGENDA" nil)
      (fq:Wdot (+ x 5.5) y *FQ-SPD* 7 "FQ_LEGENDA")
      (fq:legrow x y (fq:t "leg.varenje"))

      (setq y (- y d 0.6))
      (fq:Wrect x (+ y 1.2) (+ x 5.0) (- y 1.2) 5 "FQ_LEGENDA")
      (fq:Wtext (+ x 0.6) (- y 0.2) *FQ-TXTH* "1:K" 5 "FQ_LEGENDA" "FQ_TXT" 0 0)
      (setq i 0)
      (while (< i 3)
        (fq:Wline (+ x 5.0) y (+ x 11.0) (+ y 1.0 (* -1.0 i))
                  5 "FQ_LEGENDA" nil)
        (setq i (1+ i)))
      (fq:legrow x y (fq:t "leg.spliter"))

      (setq y (- y d 0.8))
      (fq:Wrect x (+ y 1.6) (+ x 11.0) (- y 1.6) 7 "FQ_LEGENDA")
      (fq:Wline (+ x 2.8) (+ y 1.6) (+ x 2.8) (- y 1.6) 7 "FQ_LEGENDA" nil)
      (setq i 0)
      (while (< i 2)
        (fq:Wrect (+ x 8.2) (+ y 0.9 (* -0.8 i))
                  (+ x 9.1) (+ y 0.2 (* -0.8 i)) 7 "FQ_LEGENDA")
        (fq:Wline (+ x 9.1) (+ y 0.55 (* -0.8 i))
                  (+ x 11.0) (+ y 0.55 (* -0.8 i)) 7 "FQ_LEGENDA" nil)
        (fq:Wdot (+ x 11.0) (+ y 0.55 (* -0.8 i)) 0.214 7 "FQ_LEGENDA")
        (setq i (1+ i)))
      ;;  SIMBOL VLAKNA KOJE VISI U ORMARU JE OBRISAN.
      ;;
      ;;  Crtao ga je fq:visi pod granom (if *FQ-ODO-VISI* ...), a ta
      ;;  globalna je nil i NIGDE se ne postavlja na T: u sva tri .lsp
      ;;  fajla postoje tacno tri pomena -- postavljanje na nil, i dva
      ;;  if-a koja ga citaju.  Nema komande, nema dijaloga, nema stavke
      ;;  na paleti ni dugmeta na traci.  Legenda ga je crtala
      ;;  bezuslovno, pa je obecavala simbol koji se u isporucenoj
      ;;  instalaciji ne moze pojaviti nikako.
      ;;
      ;;  Grana pod if-om bi bila mrtav kod uz mrtvu globalnu; ako se
      ;;  prekidac ikad doda, vraca se i ovaj red, zajedno sa svojim
      ;;  natpisom.  Natpis leg.odo je skracen u obe tabele niski.
      (fq:legrow x y
                 (fq:t "leg.odo"))

      ;;  Konektori se BROJE, kao u fq:drawodfn.  Natpis leg.odf je i do
      ;;  sada tvrdio "konektori numerisani 1..N", a legenda je crtala
      ;;  tri gola konektora bez ijednog broja -- sesto mesto na kome je
      ;;  legenda obecavala nesto sto ne pokazuje.
      ;;
      ;;  Lejer ide kao argument u fq:kon, vidi komentar uz nju: bez toga
      ;;  ova tri konektora zavrsavaju na FQ_ODF i brise ih precrtavanje
      ;;  bilo kog kucista u ciji prozor legenda upadne.
      (setq y (- y d 0.8))
      (fq:Wrect x (+ y 1.6) (+ x 11.0) (- y 1.6) 7 "FQ_LEGENDA")
      (fq:Wline (+ x 5.5) (+ y 1.6) (+ x 5.5) (- y 1.6) 7 "FQ_LEGENDA" nil)
      (setq i 0)
      (while (< i 3)
        (fq:kon (+ x 11.0) (+ y 0.8 (* -0.8 i)) *FQ-ODF-KS* "FQ_LEGENDA")
        (fq:Wtext (- (+ x 11.0) *FQ-ODF-NUMX*) (+ y 0.8 (* -0.8 i))
                  *FQ-ODF-NUMH* (itoa (1+ i)) 7 "FQ_LEGENDA" "FQ_TXT" 2 2)
        (setq i (1+ i)))
      (fq:legrow x y (fq:t "leg.odf"))

      (setq y (- y d 0.8))
      (fq:Wrect x (+ y 1.2) (+ x 8.0) (- y 1.2) 6 "FQ_LEGENDA")
      (fq:Wtext (+ x 0.6) (- y 0.2) *FQ-TXTH* "OLT" 6 "FQ_LEGENDA" "FQ_TXT" 0 0)
      (fq:Wline (+ x 8.0) y (+ x 11.0) y 6 "FQ_LEGENDA" nil)
      (fq:legrow x y (fq:t "leg.olt"))

      (setq y (- y d 0.6))
      (fq:Wrect (+ x 3.0) (+ y 1.0) (+ x 11.0) (- y 1.0) 2 "FQ_LEGENDA")
      (fq:Wline x y (+ x 3.0) y 2 "FQ_LEGENDA" nil)
      (fq:Wtext (+ x 3.6) (- y 0.2) *FQ-TXTH* "ONT" 2 "FQ_LEGENDA" "FQ_TXT" 0 0)
      (fq:legrow x y (fq:t "leg.ont"))

      (setq y (- y d 0.6) i 0)
      (while (< i 3)
        (fq:Well (+ x 3.0 (* 0.6 i)) y 1.2 0.7 30 "FQ_LEGENDA")
        (setq i (1+ i)))
      (fq:legrow x y (fq:t "leg.rezerva"))

      ;; namena vlakna, boja i debljina
      (setq y (- y d 1.6))
      (fq:Wtext x y (* 1.2 *FQ-TXTH*)
                (fq:t "leg.namena") 7 "FQ_LEGENDA" "FQ_TXTB" 0 0)
      ;; Naziv namene kroz fq:kodnaz, po KODU iz polja 4 -- ne (cadr nm),
      ;; koja je srpska kolona *FQ-NAMENE*.  Isto pravilo kao u fq:setnam
      ;; i u specifikaciji: engleski naziv postoji samo u *FQ-KODOVI*.
      (foreach nm *FQ-NAMENE*
        (setq y (- y 1.5))
        (setq e (fq:Wline x y (+ x 11.0) y (caddr nm) "FQ_LEGENDA" nil))
        (fq:setlw e (cadddr nm))
        (fq:legrow x y (fq:kodnaz "nam" (fq:f 4 nm))))

      ;; color code
      (setq y (- y d))
      (fq:Wtext x y (* 1.2 *FQ-TXTH*)
                (fq:tf "leg.colorcode" (list *fq-kod*)) 7 "FQ_LEGENDA" "FQ_TXTB" 0 0)
      ;; Naziv boje kroz fq:bojnaz, po ACI-ju koji stoji u samom
      ;; standardu -- isto kao natpis uz vlakno.  Korisnikova boja,
      ;; ciji ACI nije medju poznatima, pada na svoju rec.
      (setq i 1)
      (foreach c (fq:cctab)
        (setq y (- y 1.2))
        (fq:Wline x y (+ x 11.0) y (cdr c) "FQ_LEGENDA" nil)
        ;; bn, ne nm: nm je gore vec iskorisceno kao brojac foreach-a po
        ;; *FQ-NAMENE*, u istoj funkciji.
        (fq:legrow x y (strcat (itoa i) ". "
                               (if (setq bn (fq:bojnaz (cdr c))) bn (car c))))
        (setq i (1+ i)))

      (princ (fq:t "leg.upisana"))))
  (princ))


;;; ==================================================================
;;;  19. PALETA
;;; ==================================================================

;;;  Zapis stavke je (kljucDugmeta kljucNatpisa izraz), a natpis grupe je
;;;  takodje KLJUC tabele niski, ne tekst.  Do bloka 6 Faze 5 je na oba
;;;  mesta stajao srpski tekst.
;;;
;;;  Kljuc dugmeta ("kvaz") i kljuc natpisa ("menu.kabl.vazdusni") su dve
;;;  razlicite stvari i ne smeju da se pomesaju: prvi ide u DCL kao
;;;  `key =` i po njemu fq:actions vezuje akciju, drugi se prevodi.
;;;
;;;  Izraz je NAVEDENA lista koju fq:actions tek kasnije provuce kroz
;;;  eval.  Zato ovde stoji (c:FQINFO), a ne poziv -- i zato promasen
;;;  naziv komande ne postoji kao greska dok neko ne klikne bas to
;;;  dugme.  test-lisp.ps1 zato proverava svaki (c:...) poziv.
;;;
;;;  Natpisi namene i kategorije NAMERNO ponavljaju nazive iz
;;;  *FQ-KODOVI*, umesto da se odatle citaju.  Meni ih ukrasava -- tri
;;;  tacke, "(vrati crno)" -- pa bi citanje iz tabele ionako trazilo
;;;  ukras po stavci.  Cena je poznata: preimenovanje namene u
;;;  *FQ-KODOVI* ne menja meni.  To je prikaz i nigde se ne poredi.
(setq *FQ-MENU*
 '(
   (
    ("menu.grupa.kablovi"
      ;; Kategorija kodom, iz istog razloga kao na traci: naziv radi, ali
      ;; bi srpsku kolonu *FQ-KODOVI* ucinio nosivom za engleski izbor.
      (("kvaz" "menu.kabl.vazdusni"     (fq:kabl "kbAerial"))
       ("kpod" "menu.kabl.podzemni"     (fq:kabl "kbDuct"))
       ("kmik" "menu.kabl.mikro"        (fq:kabl "kbMicro"))
       ("kins" "menu.kabl.instalacioni" (fq:kabl "kbIndoor"))
       ("kruc" "menu.kabl.rucni"        (c:FQKABL))
       ("kpor" "menu.kabl.poravnaj"     (c:FQPORAVNAJ))
       ("kcc"  "menu.kabl.cc"           (c:FQCC))
       ;; Vrsta stoji uz kablove, ne uz namenu: namena je stanje vlakna,
       ;; vrsta je fizicka osobina kabla i vazi za sva njegova vlakna.
       ("kvrs" "menu.kabl.vrsta"        (c:FQVRSTA))
       ("kbls" "menu.kabl.katalog"      (c:FQKABLSAVE))))
    ("menu.grupa.nastavci"
      (("nas"  "menu.nast.n"        (fq:pnast "N"))
       ("nal"  "menu.nast.nl"       (fq:pnast "NL"))
       ("nak"  "menu.nast.cmd"      (c:-FQNASTAVAK))
       ("sp1"  "menu.spoj.dva"      (c:FQSPOJ))
       ("spg"  "menu.spoj.grupa"    (c:FQSPOJG))
       ("spj"  "menu.spoj.splajs"   (c:FQSPLAJS))
       ("odv"  "menu.spoj.odvod"    (c:FQODVOD))
       ("prs"  "menu.spoj.preseci"  (c:FQPRESECI))
       ("pro"  "menu.spoj.prolaz"   (c:FQPROLAZ))
       ("rez"  "menu.spoj.rezerva"  (fq:prez 15.0))))
    ;; Odnosi splitera su isti na oba jezika, ali i oni idu kroz kljuc:
    ;; "neki natpisi su kljucevi, neki nisu" je pravilo koje provera ne
    ;; moze da razlikuje, pa bi promasen kljuc prosao kao doslovan tekst.
    ("menu.grupa.spliteri"
      (("s2"  "menu.spl.2"  (fq:pspl 2))
       ("s4"  "menu.spl.4"  (fq:pspl 4))
       ("s8"  "menu.spl.8"  (fq:pspl 8))
       ("s16" "menu.spl.16" (fq:pspl 16))
       ("s32" "menu.spl.32" (fq:pspl 32))
       ("s64" "menu.spl.64" (fq:pspl 64))
       ("sx"  "menu.spl.ostalo"  (c:FQSPLITER))
       ("sxk" "menu.spl.kuciste" (fq:splkuc))))
   )
   (
    ("menu.grupa.odf"
      (("odf144" "menu.odf.144" (fq:podf 144))
       ("odf96"  "menu.odf.96"  (fq:podf 96))
       ("odf72"  "menu.odf.72"  (fq:podf 72))
       ("odf48"  "menu.odf.48"  (fq:podf 48))
       ("odf24"  "menu.odf.24"  (fq:podf 24))
       ("odf12"  "menu.odf.12"  (fq:podf 12))
       ("odfx"   "menu.odf.ostalo" (c:FQODF))))
    ("menu.grupa.odo"
      (("odo24" "menu.odo.24" (fq:podo 24))
       ("odo48" "menu.odo.48" (fq:podo 48))
       ("odo96" "menu.odo.96" (fq:podo 96))
       ("odox"  "menu.odo.ostalo" (c:FQODO))))
    ("menu.grupa.oltont"
      (("olt8"  "menu.olt.8"  (fq:polt 8))
       ("olt16" "menu.olt.16" (fq:polt 16))
       ("ont"   "menu.ont"    (fq:pont))))
   )
   (
    ;; Namena kodom, isto kao kategorija iznad i kao FQNM* na traci.
    ("menu.grupa.namena"
      (("nm1"  "menu.nam.radno"       (fq:setnam "nmWork"))
       ("nm2"  "menu.nam.planirano"   (fq:setnam "nmPlan"))
       ("nm3"  "menu.nam.izgradnja"   (fq:setnam "nmBuild"))
       ("nm4"  "menu.nam.primljeno"   (fq:setnam "nmAcc"))
       ("nm5"  "menu.nam.rezervisano" (fq:setnam "nmRsvd"))
       ("nm6"  "menu.nam.osteceno"    (fq:setnam "nmDmg"))
       ("nm7"  "menu.nam.spliter"     (fq:setnam "nmSpl"))
       ("nm8"  "menu.nam.rezervno"    (fq:setnam "nmSpare"))
       ("nm9"  "menu.nam.prolazno"    (fq:setnam "nmThru"))
       ("nm10" "menu.nam.slobodno"    (fq:setnam "nmFree"))))
    ("menu.grupa.podaci"
      (("inf" "menu.pod.info"     (c:FQINFO))
       ("tra" "menu.pod.trasa"    (c:FQTRASA))
       ("bom" "menu.pod.bom"      (c:FQBOM))
       ("tab" "menu.pod.tabela"   (c:FQTABELA))
       ("bud" "menu.pod.budzet"   (c:FQBUDZET))
       ("bdt" "menu.pod.budzettab" (c:FQBUDZETT))
       ("prv" "menu.pod.provera"  (c:FQPROVERA))
       ("leg" "menu.pod.legenda"  (c:FQLEGENDA))
       ("stl" "menu.pod.stil"     (c:FQSTIL))
       ("ver" "menu.pod.verzija"  (c:FQVERZIJA))
       ("pom" "menu.pod.pomoc"    (c:FQPOMOC))))
   )
  ))

(defun fq:actions ( / out)
  (setq out nil)
  (foreach rw *FQ-MENU*
    (foreach gr rw
      (foreach b (cadr gr)
        (setq out (cons (cons (car b) (caddr b)) out)))))
  (reverse out))

(defun fq:dclfile ( / fn f)
  (setq fn (strcat (getvar "TEMPPREFIX") "fq-paleta.dcl"))
  (setq f (open fn "w"))
  (if f
    (progn
      (fq:dcll f "fqpal : dialog { label = \"" (fq:t "dcl.naslov.pal") "\";")
      ;; Natpis grupe i natpis dugmeta su KLJUCEVI tabele niski -- vidi
      ;; *FQ-MENU*.  Kljuc je ovde promenljiva, dakle "racunat kljuc",
      ;; koji provera tabela po sopstvenom ugovoru ne vidi; zato ima
      ;; svoju proveru, koja cita bas *FQ-MENU*.
      ;;  fixed_height i alignment na SAMOJ KOLONI, ne dopunski spacer.
      ;;
      ;;  Visinu reda odredjuje najvisa grupa (ODF ih ima sedam, ODO
      ;;  cetiri, OLT tri).  Bez ovoga se kraca kolona razvuce na tu
      ;;  visinu i DCL visak podeli IZMEDJU dugmadi -- fixed_height na
      ;;  dugmetu cuva njegovu visinu, ali ne i razmak oko njega, pa su
      ;;  cetiri dugmeta stajala razmaknuta preko cele visine reda.
      ;;
      ;;  Racunanje spacer-a iz razlike u broju dugmadi bi radilo isto,
      ;;  ali trazi visinu dugmeta kao broj -- a to je mera koju DCL ne
      ;;  daje i koja se razlikuje po temi i po DPI-ju.  Ovako se ne
      ;;  racuna nista.
      (foreach rw *FQ-MENU*
        (write-line " : row {" f)
        (foreach gr rw
          (fq:dcll f "  : boxed_column { alignment = top; fixed_height = true; label = \""
                   (fq:t (car gr)) "\";")
          (foreach b (cadr gr)
            (fq:dcll f (strcat "   : button { key = \"" (car b) "\"; label = \"")
                     (fq:t (cadr b)) "\"; fixed_height = true; }"))
          (write-line "   : spacer { height = 0.3; }" f)
          (write-line "  }" f))
        (write-line " }" f))
      (write-line " : row {" f)
      (fq:dcll f "  : boxed_row { label = \"" (fq:t "dcl.pal.status") "\";")
      (write-line "   : radio_row {" f)
      (fq:dcll f "    : radio_button { key = \"stp\"; label = \"" (fq:t "dcl.status.proj") "\"; }")
      (fq:dcll f "    : radio_button { key = \"stz\"; label = \"" (fq:t "dcl.status.izv") "\"; }")
      (write-line "   }" f)
      (write-line "  }" f)
      ;; Paleta nudi DVE orijentacije, ne tri kao dijalog kabla: ovde se
      ;; bira samo osa, a smer nagore/nadole nema gde da se pokaze.
      ;; Zato dcl.ori.v, a ne dcl.ori.gore.
      (fq:dcll f "  : boxed_row { label = \"" (fq:t "dcl.orijentacija") "\";")
      (write-line "   : radio_row {" f)
      (fq:dcll f "    : radio_button { key = \"orh\"; label = \"" (fq:t "dcl.ori.h") "\"; }")
      (fq:dcll f "    : radio_button { key = \"orv\"; label = \"" (fq:t "dcl.ori.v") "\"; }")
      (write-line "   }" f)
      (write-line "  }" f)
      (write-line " }" f)
      (write-line " : row {" f)
      (write-line "  : toggle { key = \"keep\";" f)
      (fq:dcll f "             label = \"" (fq:t "dcl.pal.keep") "\"; }")
      (write-line "  : toggle { key = \"drag\";" f)
      (fq:dcll f "             label = \"" (fq:t "dcl.pal.drag") "\"; }")
      (write-line "  : toggle { key = \"siri\";" f)
      (fq:dcll f "             label = \"" (fq:t "dcl.pal.siri") "\"; }")
      (write-line " }" f)
      (write-line " : row {" f)
      (write-line "  : toggle { key = \"snap\";" f)
      (fq:dcll f "             label = \"" (fq:t "dcl.pal.snap") "\"; }")
      (write-line " }" f)
      (write-line " : row {" f)
      (write-line "  : text { key = \"info\"; label = \"\"; width = 52; }" f)
      (fq:dcll f "  : button { key = \"cancel\"; label = \"" (fq:t "dcl.zatvori") "\";")
      (write-line "             is_cancel = true; is_default = true; width = 14; }" f)
      (write-line " }" f)
      (write-line "}" f)
      (close f)
      fn)
    nil))

(defun c:FQ ( / *error* fn id r acts er a)
  (setq *error* fq:err)
  (fq:init)
  (if (not *fq-st*) (setq *fq-st* "stProjektovano"))
  (setq acts (fq:actions) r 1)
  (if (setq fn (fq:dclfile))
    (while (= r 1)
      (setq *fq-act* nil)
      (setq id (load_dialog fn))
      (if (or (not id) (< id 0) (not (new_dialog "fqpal" id)))
        (progn (princ (fq:t "pal.ne.mogu")) (setq r 0))
        (progn
          (foreach a acts
            (action_tile (car a)
              (strcat "(setq *fq-act* \"" (car a) "\")(done_dialog 1)")))
          (set_tile (if (= *fq-st* "stIzvedeno") "stz" "stp") "1")
          (action_tile "stp" "(setq *fq-st* \"stProjektovano\")")
          (action_tile "stz" "(setq *fq-st* \"stIzvedeno\")")
          (set_tile (if (= *fq-ugao* 0) "orh" "orv") "1")
          (action_tile "orh" "(setq *fq-ugao* 0)")
          (action_tile "orv" "(setq *fq-ugao* 90)")
          (set_tile "keep" (if *fq-keep* "1" "0"))
          (action_tile "keep" "(setq *fq-keep* (= $value \"1\"))")
          (set_tile "drag" (if *FQ-DRAG* "1" "0"))
          (action_tile "drag" "(setq *FQ-DRAG* (= $value \"1\"))")
          (set_tile "siri" (if *FQ-SIRI* "1" "0"))
          (action_tile "siri" "(setq *FQ-SIRI* (= $value \"1\"))")
          (set_tile "snap" (if *FQ-SNAP* "1" "0"))
          (action_tile "snap" "(setq *FQ-SNAP* (= $value \"1\"))")
          (action_tile "cancel" "(done_dialog 0)")
          (set_tile "info"
                    (fq:tf "dcl.pal.info"
                           (list (fq:stnaziv *fq-st*)
                                 *fq-kod*
                                 (cond ((not *fq-por*) "")
                                       ((cadddr *fq-por*)
                                        (fq:t "dcl.pal.info.ormar"))
                                       (T (fq:t "dcl.pal.info.kabl"))))))
          (setq r (start_dialog))
          (unload_dialog id)
          (if (and (= r 1) *fq-act*)
            (progn
              ;; jedan element = jedan undo korak
              (vl-catch-all-apply 'fq:undo-poc nil)
              (setq er (vl-catch-all-apply
                         'eval (list (cdr (assoc *fq-act* acts)))))
              (vl-catch-all-apply 'fq:undo-kraj nil)
              ;; Esc nije greska.  Tok se NE menja: fq:upd i provera
              ;; *fq-keep* moraju ostati dostizni, jer je *fq-keep*
              ;; podrazumevano T -- kad bi otkaz iskakao ranije, paleta
              ;; bi se zatvarala na svaki Esc.
              (if (and (vl-catch-all-error-p er) (not (fq:otkaz er)))
                (progn
                  (princ (fq:tf "pal.greska" (list *fq-act* (vl-catch-all-error-message er))))
                  (alert (fq:tf "pal.greska.alert" (list *fq-act* (vl-catch-all-error-message er))))))
              (fq:upd)
              (if (not *fq-keep*) (setq r 0)))))))
    (princ (fq:t "opste.dcl.ne")))
  (princ))

;;  Puno ime komande.  FQ ostaje zauvek: stoji u tudjim skriptama, u
;;  makroima na traci i u navici, a dve komande za istu paletu ne kostaju
;;  nista.  Novo ime je ono koje ide u dokumentaciju i na App Store.
(defun c:FIBERQ ( / *error*)
  (setq *error* fq:err) (c:FQ))


;;; ------------------------------------------------------------------
;;;  VERZIJA I OKRUZENJE
;;;
;;;  Prvo pitanje na svakoj prijavi greske je "koja verzija".  Ovo je
;;;  odgovor koji korisnik moze da nalepi u poruku, bez trazenja po
;;;  fajlovima.  Namerno pokazuje i sta NIJE ucitano: pola prijava je
;;;  o komandama iz fq-kucista.lsp koji nije stigao da se ucita.
;;; ------------------------------------------------------------------

;;  PRODUCT postoji u AutoCAD-u, ali nije zagarantovan u svakom klonu;
;;  getvar tamo vrati nil, a nil u strcat prekida ceo ispis.  Zato oba
;;  citanja idu kroz istu rezervu.
(defun fq:sysv (im rez / v)
  (setq v (vl-catch-all-apply 'getvar (list im)))
  (if (and v (not (vl-catch-all-error-p v)) (= (type v) 'STR)) v rez))

(defun c:FQVERZIJA ( / *error* )
  (setq *error* fq:err)
  (princ (strcat "\nFiberQ CAD " *FQ-VERZIJA*))
  (princ (fq:t "info.sema"))
  (princ (fq:tf "info.kucista" (list (if (car (atoms-family 1 (list "FQ:PKUC"))) (fq:t "info.ucitan") (fq:t "info.kucista.nema")))))
  (princ (fq:tf "info.traka" (list (if (car (atoms-family 1 (list "C:FQRIBBON"))) (fq:t "info.ucitana") (fq:t "info.nije.ucitana")))))
  (princ (fq:tf "info.cad" (list (fq:sysv "ACADVER" "?") (fq:sysv "PRODUCT" ""))))
  (princ (fq:tf "info.cc" (list *fq-kod*)))
  ;; Odakle je STVARNO citano, ne gde bi trebalo da stoji.  Bez ovoga se
  ;; na prijavu "izgubio mi se katalog" ne moze odgovoriti nista pametno.
  (if (and (boundp '*fq-kat-ucit*) *fq-kat-ucit*)
    (princ (fq:tf "info.katalog" (list *fq-kat-ucit*)))
    (princ (fq:t "info.katalog.podr")))
  (if *fq-kbl-ucit*
    (princ (fq:tf "info.kbl" (list *fq-kbl-ucit*)))
    (princ (fq:t "info.kbl.podr")))
  (if (and *fq-ucit* (cadr *fq-ucit*))
    (princ (fq:tf "info.ccfajl" (list (cadr *fq-ucit*))))
    (princ (fq:t "info.ccfajl.nema")))
  ;;  Tri fajla, DVA foldera: boje idu u <profil>\, a oba kataloga u
  ;;  <profil>\Support\.  Jedan red ih zato ne moze pokriti, i bas to je
  ;;  bio kvar do 22.08.2026 -- red je glasio "podaci se pisu u %1" i
  ;;  pokazivao samo putanju za boje, dakle pogresan folder za onoga ko
  ;;  je i pitao, jer se katalog gubi cesce od boja.
  ;;
  ;;  Putanje se uzimaju iz istih funkcija koje i pisu.  Sklopljene
  ;;  ovde po treci put bi se pre ili kasnije razisle sa upisom, i to
  ;;  tiho -- ispis bi i dalje izgledao uverljivo.
  (princ (fq:tf "info.pisu" (list (car (fq:ccwpaths)))))
  (princ (fq:tf "info.pisukbl" (list (car (fq:kblpaths)))))
  ;;  fq:katpaths je u fq-kucista.lsp, a taj fajl sme da nedostaje.
  (if (car (atoms-family 1 (list "FQ:KATPATHS")))
    (princ (fq:tf "info.pisukat" (list (car (fq:katpaths))))))
  (princ))

;;; ------------------------------------------------------------------
;;;  UPUTSTVO
;;;
;;;  PDF se isporucuje u KORENU bundle-a, pored LICENSE, a NE u
;;;  Contents -- namerno, jer je Contents na AutoCAD-ovoj putanji za
;;;  podrsku i PDF tamo nema sta da se pretrazuje.  Cena te odluke je
;;;  bas ova funkcija: golo (findfile "FiberQ-Help-EN.pdf") ga ne nadje,
;;;  jer SupportPath pokazuje na Contents a ne na koren.  Kandidati se
;;;  zato grade rucno.
;;;
;;;  Do 1.0.0 komande nije bilo i uputstvo se iz AutoCAD-a nije moglo
;;;  otvoriti nikako: da bi korisnik nasao putanju treba mu FQVERZIJA, a
;;;  da bi znao za FQVERZIJA treba mu uputstvo.  Nijedna provera to nije
;;;  mogla da prijavi -- PDF JESTE u paketu, kao sto listing i tvrdi;
;;;  falio je samo put do njega.
;;; ------------------------------------------------------------------

(defun fq:pdfime ()
  (if (= *fq-jezik* "EN") "FiberQ-Help-EN.pdf" "FiberQ-Uputstvo-SR.pdf"))

;;  Vraca punu putanju do uputstva, ili nil.
;;
;;  DVA PRAVILA SU PREPISANA IZ fq:find (fq-ribbon.lsp) i vaze iz istog
;;  razloga:
;;
;;  1. Golo ime ide POSLEDNJE.  findfile pretrazuje i folder tekuceg
;;     crteza, pa bi stara raspakovana kopija pored tudjeg crteza
;;     otvorila uputstvo za NEKU DRUGU verziju.  To se ne vidi kao
;;     greska nego kao uputstvo koje "ne odgovara programu", sto je
;;     gore: trazi se u programu, a nije u njemu.
;;
;;  2. Kandidati se grade USLOVNO.  (strcat (getenv "APPDATA") ...) puca
;;     ako getenv vrati nil, a ova komanda se poziva i sa palete, gde
;;     greska obara ceo dijalog, ne samo jedno dugme.
(defun fq:pdfnadji (ime / l e p)
  (setq l nil)
  (foreach v '("APPDATA" "ProgramData")
    (if (and (setq e (getenv v)) (= (type e) 'STR))
      (setq l (cons (strcat e "\\Autodesk\\ApplicationPlugins"
                            "\\FiberQ.bundle\\" ime)
                    l))))
  ;;  Koren izveden iz mesta sa koga je fq-sema.lsp STVARNO ucitan:
  ;;    ...\FiberQ.bundle\Contents\fq-sema.lsp  ->  dva foldera nagore.
  ;;  Pokriva rucnu instalaciju i bundle na mreznom disku, gde nijedna
  ;;  od dve promenljive okruzenja ne pogadja.  Isti razlog zbog kog
  ;;  FQVERZIJA ispisuje odakle je STVARNO citano, a ne gde bi trebalo
  ;;  da stoji.
  (if (and (setq e (findfile "fq-sema.lsp"))
           (setq e (vl-filename-directory e))
           (setq e (vl-filename-directory e)))
    (setq l (cons (strcat e "\\" ime) l)))
  (setq l (reverse l))
  (setq p nil)
  (foreach k (append l (list ime))
    (if (not p) (setq p (findfile k))))
  p)

(defun c:FQPOMOC ( / *error* p r)
  (setq *error* fq:err)
  (setq p (fq:pdfnadji (fq:pdfime)))
  ;;  Kad uputstva na tekucem jeziku nema, otvara se ono drugo.
  ;;  Uputstvo na pogresnom jeziku je bolje od nikakvog, a jedini nacin
  ;;  da nedostaje bas jedno je da ga je korisnik sam obrisao.
  (if (not p)
    (setq p (fq:pdfnadji (if (= *fq-jezik* "EN")
                           "FiberQ-Uputstvo-SR.pdf"
                           "FiberQ-Help-EN.pdf"))))
  (if p
    (progn
      (princ (fq:tf "pomoc.otvaram" (list p)))
      ;;  explorer, a ne (command "_BROWSER"): BROWSER otvara URL u
      ;;  citacu, pa bi PDF zavrsio u pregledacu citaca umesto u
      ;;  podrazumevanom programu za PDF.  Navodnici su obavezni --
      ;;  putanja skoro uvek nosi razmak, i u "Application Plugins" i u
      ;;  imenu korisnickog foldera.
      ;;  Kroz vl-catch-all-apply i uz proveru povratne vrednosti:
      ;;  startapp vraca nil kad ne uspe, a poruka iznad je vec
      ;;  rekla "otvaram".  Bez ove grane bi ta poruka lagala --
      ;;  korisnik bi gledao red koji tvrdi da se uputstvo otvara,
      ;;  a ne bi se otvorilo nista.  Putanja je ipak ispisana, pa
      ;;  fajl moze da se otvori rucno.
      (setq r (vl-catch-all-apply 'startapp
                                  (list "explorer"
                                        (strcat "\"" p "\""))))
      (if (or (vl-catch-all-error-p r) (not r))
        (princ (fq:t "pomoc.nesme"))))
    (princ (fq:t "pomoc.nema")))
  (princ))


;;; --- ucitaj sacuvane color code standarde, ako fajl postoji -------
(setq *fq-ucit* (vl-catch-all-apply 'fq:ccload nil))
(if (or (vl-catch-all-error-p *fq-ucit*) (not *fq-ucit*))
  (setq *fq-ucit* nil))

;;; --- ucitaj sacuvan katalog kablova, ako fajl postoji -------------
;;;  Kroz vl-catch-all-apply, isto kao gore i kao fq:katload: greska u
;;;  korisnickom fajlu ne sme da prekine ucitavanje biblioteke, jer bi
;;;  nijedan defun ispod te linije vise ne postojao -- i to tiho.
(setq *fq-kbl-ucit* (vl-catch-all-apply 'fq:kblload nil))
(if (vl-catch-all-error-p *fq-kbl-ucit*) (setq *fq-kbl-ucit* nil))

;;; --- baner ---------------------------------------------------------
;;;
;;;  Ovo je JEDINI tekst ovog fajla koji se izvrsava na nivou fajla, i
;;;  zato jedini koji izostanak fq-jezik.lsp moze da obori.  Greska na
;;;  nivou fajla zaustavlja ucitavanje: nijedan defun ispod nje vise ne
;;;  postoji, a AutoCAD to ne prijavi kao gresku nego samo stane.
;;;
;;;  Straza je isti obrazac kojim ovaj fajl vec proverava postoji li
;;;  fq:porram iz fq-kucista.lsp.  Ako fq:t nema, ispisuje se engleski
;;;  minimum i ucitavanje ide dalje -- biblioteka radi, samo bez prevoda.
;;;  Sve ostale poruke su unutar defun tela i strazu ne traze: dok
;;;  komanda moze da se pozove, biblioteka je vec cela ucitana.
(if (car (atoms-family 1 (list "FQ:T")))
  (progn
    (princ (strcat "\nFiberQ CAD " *FQ-VERZIJA* (fq:t "start.sema")))
    (if *fq-ucit*
      (princ (fq:tf "start.cc.ucitano"
                    (list (itoa (car *fq-ucit*)) (cadr *fq-ucit*))))
      ;; Nazivi se sklapaju IZ *FQ-CC*, ne kucaju.  Do 1.0.0 je ovde
      ;; stajalo "samo TIA-598", napisano dok je ugradjen standard bio
      ;; jedan; IEC 60304 je dodat u tabelu a poruka je ostala da laze,
      ;; i to bas novom korisniku -- grana se pali samo kad fajla nema.
      (princ (fq:tf "start.cc.samo"
                    (list (fq:spisak (mapcar 'car *FQ-CC*) ", ")))))
    (if *fq-kbl-ucit*
      (princ (fq:tf "start.kbl.ucitan" (list *fq-kbl-ucit*))))
    ;; Dopisani tipovi se prijavljuju izricito -- tiho spajanje bi znacilo
    ;; da se katalog promenio a korisnik ne zna zasto.
    (if (and *fq-kbl-dop* (> *fq-kbl-dop* 0))
      (princ (fq:tf "start.kbl.dopisano" (list (itoa *fq-kbl-dop*)))))
    (princ (fq:tf "start.cc.aktivan" (list *fq-kod*)))
    (princ (fq:t "start.orijentacija")))
  (princ (strcat "\nFiberQ CAD " *FQ-VERZIJA*
                 " -- fq-sema.lsp loaded.  fq-jezik.lsp not found,"
                 " messages stay in English.\n")))
(princ)
