; Generic LHA extractor, by Neil Mohr
; $VER: Amiga Computing lha Extractor v0.55ß (14:52 30 June 95)

; Allows the user to extract any lha archive to a destination of their choice.
; Selecting NOVICE give quick extraction to RAM: or a floppy drive; Autochecks
; to see if a second drive exists,and allows them to choose it.
; Allows individual checking of archives for memory and kickstart version
; requirements. It will only quit if there is not enough disk/ram space.
; format & lha -=#MUST#=- be in ram.

(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"

;archive requirments(case sensitive)
(if (= @app-name "ClassAction") ((set requiredKick 39) (set arcSize 140000)) )
(if (= @app-name "ExchangeV200") ((set requiredKick 36) (set arcSize 140000)) )
(if (= @app-name "gfxcon") ((set requiredKick 33) (set arcSize 440000)) )
(if (= @app-name "jfif_dtc") ((set requiredKick 39) (set arcSize 160000)) )
(if (= @app-name "LockColors1_1A") ((set requiredKick 39) (set arcSize 40000)) )
(if (= @app-name "MCP104") ((set requiredKick 37) (set arcSize 580000)) )
(if (= @app-name "mfs21") ((set requiredKick 37) (set arcSize 50000)) )
(if (= @app-name "TUDE") ((set requiredKick 33) (set arcSize 70000)) )

;don't let them use the original disc
(if (OR (= (getDevice @icon) "DF0") (= (getDevice @icon) "DF1") (= (getDevice @icon) "DF2"))
    (set originalDisc (getAssign (getDevice @icon) "d")) )

(if (= requiredKick 33) (set Kickversion "1.2")) ;set kickstart versions
(if (= requiredKick 34) (set Kickversion "1.3"))
(if (= requiredKick 36) (set Kickversion "2.0"))
(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)

;append a '/' if dest is not a device name; done to stop confusing lha
(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)

;(message (cat "\ndest " @default-dest "\norig " originalDisc "\nkick " requiredKick "\narcsize " arcSize "\n" unArc "\ndf0 " (getAssign "DF0" "d") "\n" (cat "format DRIVE=\"" @default-dest "\" NAME=\"" @app-name"\"" ) "\n-END-"))
(exit "\n" @app-name " Has been successfully extracted,\nhope it wasn't too painful!!")