(in-package :custom)
(use-package :oli)


(sd-defdialog                'am-txt-search
 :dialog-title               (sd-multi-lang-string "Search text" :german "Text suche")
 :toolbox-button             :force
	:variables 
 '(

   (search-string
    :title                   (sd-multi-lang-string "Text" :german "Text")
    :value-type              :string
    :after-input             (progn
                              (search-init search-string hit-list balloon-frame case-sensitive highlight-color)
                              (highlight-txt hit-list :next zoom-factor))
    :initial-value           nil)

   (preselected-text
    :selection               *sd-anno-text-seltype*
    :after-input             (sd-set-variable-status 'search-string 
                              :value (format nil "~{~a~}" (sd-am-inq-text-strings preselected-text)))
    :toggle-type             :invisible)
    
   (parameters 
    :title                   (sd-multi-lang-string "Parameter" :german "Einstellungen")
    :expand-shrink           (balloon-frame case-sensitive highlight-color color-reset zoom-factor))
    		
   (balloon-frame
    :title                   (sd-multi-lang-string "Balloon frame" :german "Nur Text mit Ballon")
    :value-type              :boolean
    :toggle-type             :wide-toggle
    :initial-value           t
    :persistent-data-storage t)
    
   (case-sensitive
    :title                   (sd-multi-lang-string "Case sensitive" :german "Groß-und Kleinschr. beachten")
    :value-type              :boolean
    :toggle-type             :wide-toggle
    :initial-value           t
    :persistent-data-storage t)
    
   (highlight-color
    :title                   (sd-multi-lang-string "Highlight color" :german "Highlight Farbe")
    :value-type              :rgb-color
    :persistent-data-storage t)
    
   (color-reset
    :value-type :boolean
    :toggle-type :wide-toggle
    :title (sd-multi-lang-string "Reset color" :german "Farbe zurücksetzen")
    :prompt-text (sd-multi-lang-string "Reset color"
                 	:german "Farbe zurücksetzen")
    :initial-value t)	
	
   (zoom-factor
    :title                   (sd-multi-lang-string "Zoom" :german "Zoom")
    :value-type              :scale
    :minimum                 1
    :maximum                 100
    :initial-value           100
    :persistent-data-storage t)

   ("-")
   
   (hits
    :title                   (sd-multi-lang-string "Hits found" :german "Gefundene Treffer")
    :value-type              :display-only)
   
   (prev-text
    :title                   "<<<"       
    :push-action             (highlight-txt hit-list :prev zoom-factor)
    :toggle-type             :grouped-toggle
    :initial-enable          nil)

   (next-text
    :title ">>>"       
    :push-action             (highlight-txt hit-list :next zoom-factor)
    :toggle-type             :grouped-toggle
    :initial-enable          nil)
    
   (hit-list
     :value-type             :list
     :toggle-type            :invisible)
     
   ("-")
  
   (search-button
    :title                   (sd-multi-lang-string "search" :german "Suchen")
    :toggle-type             :wide-toggle
    :push-action             (progn 
                              (search-init search-string hit-list balloon-frame case-sensitive highlight-color)
                              (highlight-txt hit-list :next zoom-factor)))							  
	)
                                  
 :ok-action
 '(reset-all-text-colors hit-list)
     
 :cancel-action 
 '(reset-all-text-colors hit-list)
  
 :local-functions
 '(

   (search-init (search-string hit-list balloon-frame case-sensitive highlight-color)
    (reset-all-text-colors hit-list)
    (let ((all-matching-texts (search-for-string-in-anno search-string balloon-frame case-sensitive highlight-color)))
     (if all-matching-texts
      (progn
       (sd-set-variable-status 'hit-list :value all-matching-texts)
       (sd-set-variable-status 'hits :value (length all-matching-texts))
       (sd-set-variable-status 'prev-text :enable t)
       (sd-set-variable-status 'next-text :enable t))
      (progn
       (sd-set-variable-status 'hit-list :value (list))
       (sd-set-variable-status 'hits :value 0)
       (sd-set-variable-status 'prev-text :enable nil)
       (sd-set-variable-status 'next-text :enable nil)))))


   (search-for-string-in-anno (search-string balloon-frame case-sensitive highlight-color)
    (when search-string
     (let (
      (all-matching-txt-strings (list))
      (all-texts
       (sd-call-cmds
         (get_selection 
           :focus_type *sd-anno-text-seltype*
           :select :docu_text
           :by_drawing_docu_rest))))

       (dolist (txt all-texts)
        (dolist (txt-line (sd-am-inq-text-strings txt))
         (let (
          (txt-line-cc (if case-sensitive txt-line (string-downcase txt-line)))
          (search-string-cc (if case-sensitive search-string (string-downcase search-string))))

           (when (sd-string-match-pattern-p search-string-cc txt-line-cc)
            (let* (
             (txt-attributes (sd-am-inq-text-attributes txt))
             (frame-type (sd-am-text-attributes-struct-frame txt-attributes))
             (txt-color (sd-rgb-to-color (sd-am-text-attributes-struct-color txt-attributes))))
              
              (when
               (or
                (null balloon-frame)            
                (and balloon-frame (equal frame-type :balloon)))
                
                 (sd-call-cmds
                  (am_text_modify
                   :sel_list txt
                   :color highlight-color))
                 
                 (push (list txt txt-color) all-matching-txt-strings)))))))

      all-matching-txt-strings)))


   (highlight-txt (hit-list direction zoom-factor)
    (when hit-list
     (let* (
      (item (first (first hit-list)))
      (zoom-out-value-pos (+ 50 (+ zoom-factor)))
      (zoom-out-value-neg (+ 50 (+ zoom-factor)))
      (zoom-pos-start (sd-get-annotator-position :object item))
      (zoom-pos-start-list (sd-string-split zoom-pos-start ","))
      (zoom-start-org-x (read-from-string (first zoom-pos-start-list)))
      (zoom-start-x (- zoom-start-org-x zoom-out-value-neg))
      (zoom-end-x (+ zoom-start-org-x zoom-out-value-pos))
      (zoom-start-org-y (read-from-string (second zoom-pos-start-list)))
      (zoom-start-y (- zoom-start-org-y zoom-out-value-neg))
      (zoom-end-y (+ zoom-start-org-y zoom-out-value-pos)))

       (if item
        (progn
         (sd-put-buffer 
          (format nil 
           "docu_generic_window_vp ~a,~a ~a,~a" 
           zoom-start-x
           zoom-start-y
           zoom-end-x
           zoom-end-y))
         (if (equal direction :prev)
          (sd-set-variable-status 'hit-list :value (left-rotate hit-list))
          (sd-set-variable-status 'hit-list :value (right-rotate hit-list))))
        (sd-set-variable-status 'hit-list :value (rest hit-list))))))
       
   
   (reset-all-text-colors (hit-list)
    (if (equal color-reset t)
    (progn(dolist (icl hit-list)
     (let (
      (txt (first icl))
      (txt-color (second icl)))
       (sd-call-cmds
        (am_text_modify
         :sel_list txt
         :color txt-color)))))))


   (left-rotate (list)
    (append (rest list) (list (first list))))


   (right-rotate (list)
    (append (last list) (butlast list)))))