; 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 drvie exists,and allows them to choose it.
; Allows individual checking of archives for memory and kickstart version
; requirments. It will only quit if there is not enought 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 "ARCHandler2_0a") ((set requiredKick 37) (set arcSize 290000)) )
(if (= @app-name "ARexx&Assembler_src") ((set requiredKick 37) (set arcSize 20000)) )
(if (= @app-name "BouncyWorld") ((set requiredKick 33) (set arcSize 60000)) )
(if (= @app-name "FView151") ((set requiredKick 37) (set arcSize 180000)) )
(if (= @app-name "hdsleep") ((set requiredKick 37) (set arcSize 20000)) )
(if (= @app-name "InterPlay") ((set requiredKick 39) (set arcSize 125000)) )
(if (= @app-name "WINarng") ((set requiredKick 37) (set arcSize 85000)) )
(if (= @app-name "MathScript21") ((set requiredKick 36) (set arcSize 580000)) )

;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  ", this will destroy ALL data on the disc.\n\nEither press YES to format the current disc, or insert a new one and then press YES.\n\nPress NO to give up."))
(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 -b256 -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 succsefully exracted,\nhope it wasn't too painfull!")