; Generic LHA extractor, by Pete Sullivan
; $VER: SulliTech lha Extractor (1st September 1998)
(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 "Programs1") ((set requiredKick 37) (set arcSize 180000)) )
(if (= @app-name "Programs2") ((set requiredKick 37) (set arcSize 110000)) )
(if (= @app-name "Programs3") ((set requiredKick 37) (set arcSize 210000)) )
(if (= @app-name "Programs4") ((set requiredKick 37) (set arcSize 130000)) )

(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 
(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}")
                        (help @askchoice-help)
                       ) )
    )
  )
  (procedure @noviceGetDest
    (set destination (cat (askchoice
                        (prompt "Where do you want me to put " @app-name "?")
                        (choices "RAM: {Recommended}")
                        (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)
             )
            )
            (
             (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)
(complete 10)

(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 ",\n\nplease wait....")
(@expertUnArc)

(complete 100)
(message "Installation complete!\n\n\n\n\n" @app-name " has been successfully extracted,\nand can be found in " @default-dest ".\n\nHope it wasn't too painful!!")
(exit (quiet))