; Generic LHA extractor, by Neil Mohr
; $VER: Amiga Computing lha Extractor v0.55ß (14:52 30 June 95)
(complete 0)
(set requiredKick 33)
(set arcSize 25000)
(set @default-dest "RAM:")
(set level @user-level)
(set finished 0)
(set totalMem (+(dataBase "total-mem"))) ;get total free memory, AND, convert into a integer
(set @app-name (substr (fileonly @icon) 0 (- (strlen (fileonly @icon)) 4)) ) ;get icon(archive) name minus the ".lha"

(if (= @app-name "DFA") ((set requiredKick 37) (set arcSize 850000)) )
(if (= @app-name "TextDTpatch") ((set requiredKick 39) (set arcSize 25000)) )
(if (= @app-name "TIFFDT40.1") ((set requiredKick 39) (set arcSize 35000)) )

(if (OR (= (getDevice @icon) "DF0") (= (getDevice @icon) "DF1") (= (getDevice @icon) "DF2"))
    (set originalDisc (getAssign (getDevice @icon) "d")) )

(if (= requiredKick 37) (set Kickversion "2.04"))
(if (= requiredKick 39) (set Kickversion "3.0"))
(if (= requiredKick 40) (set Kickversion "3.1"))

(set hello            (cat "\n\n\nThis will extract the " @app-name" archive\nto your chosen location.\n\n\nSelect NOVICE to simply extract\n to RAM: or a floppy drive."))
(set noDiscSpace      (cat "\n\n" @default-dest " has not enought space on it."))
(set extractionError  (cat "\n\nOh dear something went wrong with lha.\n\nSource archive " ))
(set lowMem           (cat "\nSorry you only have " totalMem " bytes of RAM,\nand you need " arcSize " bytes, to be able\nto extract " @app-name " into RAM:.\n\n\nTry removing some other applications,\nor use a blank floppy disc."))
(set discRequest      (cat "\n\n\n\n\nPlease insert a (blank) disc into "))
(set lowDiskSpace     (cat ": does not have enought room for " @app-name " to fit. You can either replace the current disk with another or I will format the current one."))
(set removeCoverDisc  (cat "\n\n\n\n\nPlease remove the cover disc,\n\nand insert a (blank) disc in "))
(set formatCheck      (cat  ", does not have enough room. You will have to format it.\n\nTo do this click on its icon, and then select 'Format Disk' from the Workbench menu.\nFormating a disc DESTROYS ALL the data on a disc.\nPress YES when done or NO to quit."))
(set deviceTooSmall   (cat " bytes,\nand so " @app-name " cannot fit onto it.\n\nTry using RAM:, or buy a hard drive.\n\n\n\n(You won't regret it;-)"))
(set noRoom           (cat " bytes free, and\n\n" @app-name " needs " arcSize " bytes."))
(set @askchoice-help  (cat "\n\nEach button represent a destination. You can select either to extract the program into RAM:, or onto a floppy disc using one of the drives.\n\nSimply press the appropriate button, then proceed."))
(set wrongKick        (cat "\n\nWarning, you need at least Kickstart v" requiredKick " (" Kickversion ")\n\nto use " @app-name ".\n\n\nPress 'proceed' to continue anyway;\n\n\n\nBut you won't be able to run the program!"))

(if (getassign "DF1" "d") ;check for external disc drive, and set correct procedure
  (procedure @noviceGetDest

    (set destination (cat (askchoice
                        (prompt "Where do you want me to put " @app-name "?")
                        (choices "RAM: {Recommended}" "DF0: {Internal Drive}" "DF1: {External Drive}")
                        (help @askchoice-help)
                       ) )
    )
  )
  (procedure @noviceGetDest
    (set destination (cat (askchoice
                        (prompt "Where do you want me to put " @app-name "?")
                        (choices "RAM: {Recommended}" "DF0: {Internal Drive}")
                        (help @askchoice-help)
                       ) )
    )
  )
)

(procedure @getdefault-dest
  (set destination (askdir
                      (help @askdir-help)
                      (prompt "Where Do you want " @app-name " extracting?")
                      (newpath)
                      (default @default-dest)
                     )
  )
  (set @default-dest destination)
)

(procedure @noviceUnArc ;handles quick extraction to ram or floppy
  (if (= @default-dest 0)                                     ;if RAM
    ( (set @default-dest "RAM:")
      (if (> arcSize totalMem) (abort lowMem))
    )
    ( (set @default-dest (cat "DF" (- @default-dest 1) ":") ) ;else
      (until (= finished 1)
        (while (OR (=   (getAssign (getDevice @default-dest) "d") originalDisc) ;wait for new disc
                   (NOT (getdiskspace @default-dest))
               )
          (if (= (getAssign (getDevice @default-dest) "d") originalDisc)
              (message removeCoverDisc @default-dest)
              (message discRequest @default-dest)
          )
        )
        (if (> arcSize (getDiskSpace @default-dest)) ;check for room
            ((if (askbool (prompt "\n\nSorry but the current disc in " @default-dest formatCheck) (help @askbool-help))
              (set finished 0) (abort "Ok, try using RAM or formatting the disc before hand.")
             )
             (if (AND (<   (getDiskSpace @default-dest) arcSize)
                      (NOT (= finished 1)) )
                  (abort "\n\nSorry, but " @default-dest " can only store " (getDiskSpace @default-dest) deviceTooSmall)
             )
            )
            (;(message (cat "\ndest " @default-dest "\nformat \ncheck " (getAssign (getDevice @default-dest) "d") "\norig " originalDisc "\n-END-"))
             (set finished 1)
            )
        )
      )
      (set @default-dest (getAssign (getDevice @default-dest) "d"))
    )
  )
)

(procedure @expertUnArc
  (if (AND (= (getDevice @default-dest) "RAM") (> arcSize totalMem))
    (abort lowMem)
    (if (AND (> arcSize (getDiskSpace @default-dest))
             (NOT (= (getDevice @default-dest) "RAM")) )
        (abort "\n\nSorry, but " @default-dest " only has\n" (getDiskSpace @default-dest) noRoom)
    )
  )
  (if (> (run unArc) 0) (abort extractionError @icon "\n\nDestination path " @default-dest))
)

;*********************************************************************

(user 2)

(if  (< (/ (getversion) 65536) requiredKick)
  (message wrongKick) )

(message hello)
(user level)
(welcome)

(if (= @user-level 0) ( (user 2) (@noviceGetDest) (set @default-dest destination) (@noviceUnArc) (user 0)))
(@getdefault-dest)
(user 2)

(if (NOT (= (substr @default-dest (- (strlen @default-dest) 1) 1) ":")) (set @default-dest (cat @default-dest "/")))
(set unArc (cat "lha x -m -k -r -x \"" @icon "\" \"" @default-dest "\""))
(working "\n\n\n\nExtracting " @app-name " to " @default-dest ", please wait.")
(@expertUnArc)

(exit "\n" @app-name " Has been successfully extracted,\nhope it wasn't too painful!!")