(set @default-dest "")      ;vi behöver ingen default-katalog
(set DISK_NAME "DMZ03")     ;Ändras för varje diskett
(set NO_HELP "")            ;Finns med temporärt

;följande används för avslutningstexten och checken om det finns plats för att packa upp programmet.
;En variabel för varje program.

(set DEMOMANIAC 1)
(set prg_1 "")

(set AG2TXT 2)
(set prg_2 "")
(set AG2TXT_size 16000)

(set QDISK 4)
(set prg_3 "")
(set QDISK_SIZE 104000)

(set TRASHICON 8)
(set prg_4 "")
(set TRASHICON_SIZE 31000)

(set WBMIND 16)
(set prg_5 "")
(set WBMIND_SIZE 32374)

; Ser till att inte DMZ-disken elle Workbench-disketten skrivs över av misstag

(procedure CheckDiskDMS
    (
        (onerror (CleanUp)) ; efterson användaren kan avbryta vill vi städa upp efter oss

        ;--- Garanterar att folka tar ut en eventuell disk ur DF0:

        (while (<> (getassign "DF0" "d") "DF0") ;OBS! case sensitive
            (message ("Ta ut disketten %s ur DF0: och klicka på Proceed."  (getassign "DF0" "d")))
		); while getassign


        ;--- Ser till att det sätts in en ny diskett i DF0:

        (while (= (getassign "DF0" "d") "DF0")
            (
                (message "Sätt in en ny diskett i DF0:. Innehållet på den "
                            "disketten kommer att skrivas över.")
                (onerror (CleanUp))
         )
       ); while getassign


        ;--- Garanterar att inte DMz-disken ligger kvar i df0: och att
        ;--- användaren verkligen sätter in en ny diskett

        (while (= (getassign "DF0" "d") ("%s:" disk_name)) ;OBS! case sensitive
            (
                (message     "\nAchtung!\n\nDu vill väl inte att din DMZ-diskett skrivs över, "
                            "eller hur? Sätt in en annan diskett och klicka på Proceed.")
                (while (= (getassign "DF0" "d") "DF0") ;OBS! case sensitive
                    (
                        (message "Sätt in en ny diskett i DF0:. Innehållet på den disketten kommer "
                                  "att skrivas över." )
                   )
             ); while getassign
         )
      ); while getassign

    )
)


; Packar upp ett DMS-arkiv som tidigare har kopierats till RAM:

(procedure UnPackDMS
    (working ("Packar upp programmet %s.\nDet tar bara någon minut." prg_name))
    (run ("ram:dms write ram:%s.dms to df0:" prg_name))
)


; Packar upp ett LHa-arkiv till ett ställe användaren bestämmer själv

(procedure UnPackLHA
	(message (cat ("Nu ska programmet %s packas upp. I nästa steg kommer " prg_name)
			  "installationsprogrammet att fråga dig efter ett lämpligt ställe att packa upp till. "
			  ("Installationsprogrammet kontrollerar även om det finns plats för %s.\n\n" prg_name)
			  "OBS! Väljer du RAM-disken kan programmet inte kontrollera om det finns plats "
			  "Du får själv se till att utrymmet är tillräckligt.\n\n"
			  ("%s behöver ca. %ld Bytes" prg_name prg_size)))
    (set directory
        (askdir
            (prompt "Välj ett ställe där det färdigt uppackde programmet ska hamna. Du "
                    "behöver inte skapa en låda för programmet. Det görs automatiskt.")
            (help "Här ska du välja ett ställe som programmet ska packas upp till. "
                  "Om det inte finns plats nog för detta meddelar installationsprogrammet detta "
                  "och ger dig möjlighet att välja ett annat ställe.")
            (default "RAM:")
        );askdir
    )

	(if (<> (getdevice directory) "RAM")
    (while (> prg_size (getdiskspace directory))(
        (message (Cat ("Det finns inte tillräckligt med plats på enhet %s: för att " (getdevice directory))
                      ("installera %s. Det lediga utrymmet på enheten är %ld Bytes " prg_name (getdiskspace directory))
                      ("Programmet behöver ca. %ld Bytes. Klicka på proceed och försök med ett annat ställe." prg_size)))

        (set directory
            (askdir
                (prompt "Välj ett ställe där det färdigt uppackde programmet ska hamna. Du "
                        "behöver inte skapa en låda för programmet. Det görs automatiskt.")
      			(help 	"Här ska du välja ett ställe som programmet ska packas upp till. "
                  		"Om det inte finns plats nog för detta meddelar installationsprogrammet detta "
                  		"och ger dig möjlighet att välja ett annat ställe.")
                (default "RAM:")
            );askdir
        );set directory
        (if (= directory "RAM:")
        	(set prg_size 0))
        )
    );while
	);if ram:

    (if (<> directory "")
        (   ; Lha vill ha ett '/'-tecken bakom en sökväg som inte är rooten till ett device
            (set space (getdiskspace directory))
            (if (<> (getdevice directory) "RAM")
                (if (< space prg_size)
                    (message "Här borde man ha kod för att välja ett annat ställe")
                )
            )

            (set str_len (strlen directory))
            (set last_letter (substr directory (- str_len 1)))
            (if (<> last_letter ":") (set directory (cat directory "/")))

            (working ("Packar upp programet %s\nDet tar bara en kort stund..." prg_name))
            (run ("%s:c/lha x %s:%s.lha #? \"%s\"" DISK_NAME DISK_NAME prg_name directory))
        )

        (abort ("Hoppar över programmet %s" prg_name))
    )
)


; Kopierar programmet prg_name från disken DISK_NAME till ram:
; Detta behövs enbart för DMS-arkiv och är en avsäkrar os mot
; dem som enbart har en diskettstation

(procedure CopyPrg
    (copyfiles
       (prompt ("Nu kopieras arkivet %s från disketten till minnet" prg_name))
        (help NO_HELP)
        (source ("%s:%s.dms" DISK_NAME prg_name))
        (dest    "RAM:")
   ); copyfiles

   (copyfiles
       (prompt "Nu kopieras uppackningsprogrammet DMS från disketten till minnet")
       (help NO_HELP)
       (source ("%s:c/dms" DISK_NAME))
       (dest    "RAM:")
   ); copyfiles
);CopyPrg


(procedure CleanUp
    (Delete ("ram:%s.dms" prg_name))
    (Delete "ram:dms")
)


; main

(onerror (CleanUp))

(set prgbitmap
  (askoptions
    (prompt "Vilket/Vilka program vill du packa upp?")
    (help   "Vill du bara packa upp ett program så bockar du bara för just det "
            "programmet. Det går naturligtvis att packa upp alla på en gång. "
            "Var beredd på att du behöver två eller tre tomma disketter för "
            "att få plats med allt.")
    (choices	"DemoManiac"
    			"AG2TXT"
                "QDisk"
                "TrashIcon"
                "WBMind")

    (default 0) ; inga program förbockade från början
  )
)


(if (BITAND prgbitmap DEMOMANIAC)
    (
        (set prg_name "DemoManiac")
        (set prg_1 (cat prg_name "\n"))
        (CopyPrg)
        (CheckDiskDMS)
        (UnPackDMS)
        (CleanUp)
    )
)

(if (BITAND prgbitmap AG2TXT)
	(
    	(set prg_name "AG2TXT")
       	(set prg_2 (cat prg_name "\n"))
       	(set prg_size AG2TXT_SIZE)
	   	(UnPackLHA)
    )
)


(if (BITAND prgbitmap QDISK)
	(
   		(set prg_name "QDisk")
   		(set prg_3 (cat prg_name "\n"))
   		(set prg_size QDISK_SIZE)
	   	(UnPackLHA)
   	)
)

(if (BITAND prgbitmap TRASHICON)
	(
   		(set prg_name "TrashIcon")
   		(set prg_4 (cat prg_name "\n"))
   		(set prg_size TRASHICON_SIZE)
	   	(UnPackLHA)
   	)
)

(if (BITAND prgbitmap WBMIND)
	(
   		(set prg_name "WBMind")
   		(set prg_5 (cat prg_name "\n"))
   		(set prg_size WBMIND_SIZE)
	   	(UnPackLHA)
   	)
)


(message ("Följande program blev installerade:\n\n%s%s%s%s%s" prg_1 prg_2 prg_3 prg_4 prg_5))
(exit (quiet))