ModuleTarget.xml

<?xml version="1.0" ?>

<TranscendenceModule>

  <Globals>
    (block (module)

    (setq module (list
      '((weight     6)
        (title      "Target")
        ; (subtitle   "Do various things to your current target")
        (hide       (not (objGetTarget gPlayerShip)))
        (on-select  (block nil
          (dsf/add-action 'select '('Select 'S) (lambda nil
            (god/target-screen)
          ))
          (dsf/set-default-action 'select)
        ))
      )
    ))

    (setq god/modules (if (iserror god/modules)
      module
      (append god/modules module)
    ))

    (setq god/target-screen (lambda nil (block nil
      (dsf/new-screen 'target-screen "Target Actions")

      (dsf/add-list-entries (list
        '((title      "Restore Target")
          (subtitle   "Completely restore target")
          (on-select  (block (target)
            (if (setq target (objGetTarget gPlayerShip)) (block nil
              (dsf/add-action 'select '("Select" 'S) (lambda nil (block nil
                (god/restore-target target)
                (dsf/notify "Restored target")
              )))
              (dsf/set-default-action 'select)
              (dsf/set-no-save 'select)
            ))
          ))
        )
        '((title      "Inspect Target")
          (subtitle   "Inspect what your target is equipped with and has in it's cargo hold")
          (on-select  (block (target)
            (if (setq target (objGetTarget gPlayerShip)) (block nil
              (dsf/add-action 'select '('Select 'S) (lambda nil (block nil
                (dsf/new-screen 'target-inspector "Object Inspector")
                (god/object-inspector target)
                (dsf/show-screen)
              )))
              (dsf/set-default-action 'select)
            ))
          ))
        )
        ;'((title      "Install Device")
        ;  (subtitle   "...")
        ;  (on-select  (block (target)
        ;    (if (setq target (objGetTarget gPlayerShip)) (block nil
        ;    ))
        ;  ))
        ;)
        ;'((title      "Remove Device")
        ;  (subtitle   "...")
        ;  (on-select  (block (target)
        ;    (if (setq target (objGetTarget gPlayerShip)) (block nil
        ;    ))
        ;  ))
        ;)
        ;'((title      "Repair or Replace Armor")
        ;  (subtitle   "...")
        ;  (on-select  (block (target)
        ;    (if (setq target (objGetTarget gPlayerShip)) (block nil
        ;    ))
        ;  ))
        ;)
        ;'((title      "Duplicate")
        ;  (subtitle   "Create more of the same")
        ;  (on-select  (block (target)
        ;    (if (setq target (objGetTarget gPlayerShip)) (block nil
        ;      (god/duplicate-target target)
        ;    ))
        ;  ))
        ;)
        '((title      "Set as Wingman")
          (subtitle   "Make your target work for you")
          (on-select  (block (target)
            (if (setq target (objGetTarget gPlayerShip)) (block nil
              (dsf/add-action 'select '("Select" 'S) (lambda nil (block nil
                (shpCancelOrders target)
                (objSetSovereign target &svIndependent;)
                (objSetEventHandler target &baStdWingmanBase;)
                (objFireEvent target "OrderJoinPlayer")
                (dsf/notify "Ordered ship to join as Wingman")
              )))
              (dsf/set-default-action 'select)
            ))
          ))
          (hide       (not (objIsShip (objGetTarget gPlayerShip))))
        )
        '((title      "Change Orders")
          (subtitle   "Change the mision of your target")
          (on-select  (block (target)
            (if (setq target (objGetTarget gPlayerShip)) (block nil
              (dsf/add-action 'select '("Select" 'S) (lambda nil
                (god/target-orders target)
              ))
              (dsf/set-default-action 'select)
            ))
          ))
          (hide       (not (objIsShip (objGetTarget gPlayerShip))))
        )
        ;'((title      "Change Sovereign")
        ;  (subtitle   "...")
        ;  (on-select  (block (target)
        ;    (if (setq target (objGetTarget gPlayerShip)) (block nil
        ;    ))
        ;  ))
        ;)
        ;'((title      "Change Name")
        ;  (subtitle   "...")
        ;  (on-select  (block (target)
        ;    (if (setq target (objGetTarget gPlayerShip)) (block nil
        ;    ))
        ;  ))
        ;)
        '((title      "Destroy")
          (subtitle   "Just get rid of it")
          (on-select  (block (target)
            (if (setq target (objGetTarget gPlayerShip)) (block nil
              (dsf/add-action 'select '("Select" 'S) (lambda nil (block nil
                (objDestroy target)
                (dsf/screen-delete 'initial-item)
                (dsf/back)
                (dsf/notify "Destroyed target. You have to target a new ship before you can return to the menu.")
              )))
              (dsf/set-default-action 'select)
              (dsf/set-no-save 'select)
            ))
          ))
        )
      ))

      (dsf/filter-screen)
      (dsf/set-type 'custompicker-small)
      (dsf/show-screen)
    )))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; HELPERS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

    ;; TODO: add posibility of making an order queue
    (setq god/target-orders (lambda (obj)
      (block nil
        (dsf/new-screen 'target-orders "Target Orders")

        (dsf/set-description (lambda (desc) (block (order target)
          (setq order (shpGetOrder obj))
          (setq desc (shpGetOrderDesc obj))
          (setq target (shpGetOrderTarget obj))
          (cat "Current Order: \"" order "\"\n"
            (if target (cat "Target: \"" (objGetName target) "\"\n") "")
            (if (and desc (not (or (eq desc "Nil") (eq desc "")))) desc "")
          )
        )))

        (dsf/add-list-entries (list
          '((title      "Attack")
            (subtitle   "Order ship to attack a target you designate")
            (run        (block nil
              (dsf/new-screen 'target-order-attack "Order Attack")
              (dsf/screen-set 'filter-source (objGetTarget gPlayerShip))
              (dsf/screen-set 'default-filter-term "/sTE")
              (dsf/object-browser)
              ;; add a list filter to show distance and order by distance
              (dsf/add-list-filter (lambda (entries)
                (block nil
                  (enum entries entry (block (dist)
                    (setq dist (objGetDistance gPlayerShip (fn/get entry 'obj)))
                    (fn/set entry 'dist dist)
                    (fn/set entry 'subtitle (cat "Distance: " dist " ls"))
                  ))
                  (fn/sort entries a b (ls (fn/get a 'dist) (fn/get b 'dist)))
                )
              ))
              (dsf/set-description (lambda (desc)
                (cat desc ", ordered by distance.")
              ))
              (dsf/add-action 'attack '("Attack" 'A) (lambda nil
                (block (t)
                  (setq t (objGetTarget gPlayerShip))
                  (shpCancelOrders t)
                  (shpOrder t 'attack (dsf/get-list-entry 'obj))
                  (dsf/notify "Ordered Attack")
                  (dsf/show-screen 'target-orders)
                )
              ))
              (dsf/set-default-action 'attack)
              (dsf/show-screen)
            ))
          )
          '((title      "Cancel")
            (subtitle   "Cancel ships current orders")
            (run        (block nil
              (shpCancelOrders (objGetTarget gPlayerShip))
              (dsf/notify "Cancelled Orders")
              (dsf/show-screen)
            ))
          )
          ;'((title      "Orbit")
          ;  (subtitle   "Order ship to orbit a target you designate at a certain distace")
          ;  (run        (block nil
          ;    (dsf/screen 'tmp "Order Orbit")
          ;  ))
          ;)
          ;'((title      "Escort")
          ;  (subtitle   "Order ship to escort a target you designate")
          ;  (run        (block nil
          ;    (dsf/screen 'tmp "Order Escort")
          ;  ))
          ;)
          ;'((title      "Follow")
          ;  (subtitle   "Order ship to follow a target you designate")
          ;  (run        (block nil
          ;    (dsf/screen 'tmp "Order Follow")
          ;  ))
          ;)
          ;'((title      "Gate")
          ;  (subtitle   "Order ship to gate")
          ;  (run        (block nil
          ;    (dsf/screen 'tmp "Order Gate")
          ;  ))
          ;)
          ;'((title      "Goto")
          ;  (subtitle   "Order ships to go to a position you designate")
          ;  (run        (block nil
          ;    (dsf/screen 'tmp "Order Goto")
          ;  ))
          ;)
          ;'((title      "Guard")
          ;  (subtitle   "Order ship to guard a target you designate")
          ;  (run        (block nil
          ;    (dsf/screen 'tmp "Order Guard")
          ;  ))
          ;)
          ;'((title      "Hold")
          ;  (subtitle   "Order ship to hold position, optionally for a specified amount of time")
          ;  (run        (block nil
          ;    (dsf/screen 'tmp "Order Hold")
          ;  ))
          ;)
          ;'((title      "Dock")
          ;  (subtitle   "Order ship to dock with a target you designate")
          ;  (run        (block nil
          ;    (dsf/screen 'tmp "Order Dock")
          ;  ))
          ;)
          ;'((title      "Loot")
          ;  (subtitle   "Order ship to loot a target you designate")
          ;  (run        (block nil
          ;    (dsf/screen 'tmp "Order Loot")
          ;  ))
          ;)
          ;'((title      "Patrol")
          ;  (subtitle   "Order ship to patrol a target you designate")
          ;  (run        (block nil
          ;    (dsf/screen 'tmp "Order Patrol")
          ;  ))
          ;)
          ;'((title      "Wait")
          ;  (subtitle   "Order ship to wait for a specified amount of time")
          ;  (run        (block nil
          ;    (dsf/screen 'tmp "Order Wait")
          ;  ))
          ;)
        ))

        (dsf/add-action 'select '("Select" 'S) (lambda nil
          (block nil
            (dsf/eval (dsf/get-list-entry 'run))
          )
        ))
        (dsf/set-default-action 'select)
        (dsf/set-disable-action 'select (lambda nil (not (objGetTarget gPlayerShip))))
        (dsf/set-no-save 'select)

        ;(dsf/screen 'order-target "Set Order Target" 'custompicker)

        ;(dsf/screen 'order-time "Set Order Time")
        ;(dsf/pane 'counter)

        ;(dsf/screen 'order-distance "Set Order Distance")
        ;(dsf/pane 'counter)

        (dsf/filter-screen)
        (dsf/set-type 'custompicker-small)
        (dsf/show-screen 'target-orders)
      )
    ))

    (setq god/object-inspector (lambda (obj)
      (block (get-criteria)

        (dsf/set-data-from obj)

        (dsf/set-type 'itempicker)

        (dsf/on-run-action (lambda nil (block (itm)
          (if (setq itm (dsf/item))
            (dsf/screen-set 'initial-item itm)
            (dsf/screen-delete 'initial-item)
          )
        )))

        (dsf/on-initial-item (lambda nil (block (itm)
          (if (setq itm (dsf/screen-get 'initial-item))
            (eq (dsf/get-item) itm)
            True
          )
        )))

        (dsf/add-action 'install '("Install Device" 'I) (lambda nil
          (block nil
            (dsf/new-screen 'install-device "Install Device")
            (dsf/item-browser (map (itmGetTypes "d") itm (itmCreate itm 1)))
            (dsf/add-action 'select '("Install" 'I) (lambda nil
              (block (itm result)
                (setq itm (dsf/get-item))
                ;; if it is not identified, then do so now
                (if (not (itmIsKnown itm))
                  (itmSetKnown itm)
                )
                (setq result (god/install-item itm nil nil obj))
                (dsf/notify (item result 1))
              )
            ))
            (dsf/set-no-save 'select)
            (dsf/show-screen)
          )
        ))

        (dsf/add-action 'additem '("Add to Cargo Hold" 'A) (lambda nil
          (block nil
            (dsf/new-screen 'add-to-cargo-hold "Add to Cargo Hold")
            (dsf/item-browser (map (itmGetTypes "*") itm (itmCreate itm 1)))
            (god/add-to-cargo-action 'add-to-cargo obj)
            (dsf/show-screen)
          )
        ))

        (dsf/add-action 'remove (lambda nil
          (block nil
          )
        ))
        (dsf/set-action-handle 'remove (lambda nil
          (block (itm)
            (setq itm (dsf/get-item))
            (switch
              (and (itmMatches itm "d") (itmIsInstalled itm))
                '("Remove Device" 'R)
              (and (itmMatches itm "a") (itmIsInstalled itm))
                '("Replace Armor" 'R)
              '("Remove Item" 'R)
            )
          )
        ))
        (dsf/set-no-save 'remove)


      )
    ))

    )
  </Globals>
</TranscendenceModule>
<!--
vim:ts=2:sw=2:sts=2:ft=tlisp:
-->