home *** CD-ROM | disk | FTP | other *** search
/ PC Shareware 1996 December / PC_Shareware-1996-12.iso / bonus / abuse / install.lsp < prev    next >
Encoding:
Lisp/Scheme  |  1996-02-22  |  12.4 KB  |  307 lines
  1.  
  2. ;; If you aren't sure what to translate, give me call
  3. ;;  Billy is doing pig-lating :)
  4.  
  5. (perm-space)
  6.  
  7. (select platform
  8.         ('SGI (let ((cwd (get_cwd)))
  9.                 (chdir (getenv "HOME"))
  10.                 (system "ls")
  11.                 (print (concatenate 'string "tar -xvf " cwd "/linux/abuse.tar"))
  12.                 (system (concatenate 'string "cd ~/ ; tar -xvf " cwd "/linux/abuse.tar"))
  13.                 (print "Type cd ~/abuse ; abuse <ENTER> to begin")
  14.                 (quit)))
  15.         ('LINUX (let ((cwd (get_cwd)))
  16.                   (chdir (getenv "HOME"))
  17.                   (system "ls")
  18.                   (print (concatenate 'string "tar -xvf " cwd "/linux/abuse.tar"))
  19.                   (system (concatenate 'string "cd ~/ ; tar -xvf " cwd "/linux/abuse.tar"))
  20.                   (print "Type cd ~/abuse ; abuse <ENTER> to begin")
  21.                   (quit))))
  22.  
  23.  
  24.  
  25. (do ((ok nil nil))
  26.     ((eq ok T) nil)
  27.     (select (nice_menu "Abuse" "Select language" '("English" "Français" "Deutsch")) ; "Pig Latin"))
  28.             (-1 (quit))                    ;; can't ask to quit, because we don't know the language yet
  29.             (0 (setq lang 'english)
  30.                (setq title       "Abuse Installation")
  31.                (setq path-prompt "Enter path to install to")
  32.                (setq bad-path  '("You entered a bad path name"
  33.                                  "Press any key to re-enter, ESC to quit"))
  34.                (setq quit-title  "Quit?")
  35.                (setq yes-key     "Y")
  36.                (setq no-key      "N")
  37.                (setq quit-msg    "Do you you want to quit? (Y/N)")
  38.                (setq make-dir?  '("Directory does not exsist."
  39.                                   "Do you want to create it? (Y/N)"))
  40.                (setq mkdir-failed "Unable to create directory, retry? (Y/N)")
  41.                (setq nospace-dos  '("Not enough disk space available for this drive"
  42.                                     "You need at least 10.5MB free"
  43.                                     "Would you like to try another drive? (Y/N)"))
  44.                (setq next-disk  '("Insert this disk into disk drive and press SPACE BAR"
  45.                                   "to continue.  Press ESC to quit."))
  46.                (setq copy-title  "Copying files")
  47.                (setq start-msg   "Type abuse <ENTER> to begin")
  48.                (setq path_not_valid '("The pathname you entered is not valid, continue? (Y/N)"))
  49.                (setq ok T)
  50.                )
  51.  
  52.  
  53.             (1 (setq lang 'french)
  54.                (setq title       "Installation d'Abuse")
  55.                (setq path-prompt "Entrez le chemin sur lequel installer")
  56.                (setq bad-path  '("Le nom du chemin est incorrect"
  57.                                  "Appuyez sur une touche pour entrer a nouveau, sur ECHAP pour sortir"))
  58.                (setq quit-title  "Sortir ?")
  59.                (setq yes-key     "O")
  60.                (setq no-key      "N")
  61.                (setq quit-msg    "Voulez-vous sortir ? (O/N)")
  62.                (setq make-dir?  '("Ce répertoire n'existe pas."
  63.                                   "Voulez-vous le créer ? (O/N)"))
  64.                (setq mkdir-failed "Impossible de créer le répertoire, voulez-vous réessayer ? (O/N)")
  65.                (setq nospace-dos  '("Espace disque dur insuffisant pour ce lecteur"
  66.                                     "Vous devez avoir au moins 10,5 Mo disponibles"
  67.                                     "Voulez-vous essayer sur un autre lecteur ? (O/N)"))
  68.                (setq next-disk  '("Insérez la disquette dans le lecteur et appuyez sur la BARRE D'ESPACE"
  69.                                   "pour continuer.  Appuyez sur ECHAP pour sortir."))
  70.                (setq copy-title  "En train de copier les fichiers")
  71.                (setq start-msg   "Tapez abuse <ENTREE> pour commencer")
  72.                (setq path_not_valid '("Le nom du chemin est incorrect, voulez-vous continuer ? (O/N)"))
  73.                (setq ok T)
  74.                )
  75.  
  76.             (2 (setq lang 'german)
  77.                (setq title       "Abuse Installation")
  78.                (setq path-prompt "Geben Sie den Installations-Pfadnamen ein")
  79.                (setq bad-path  '("Pfadname ungültig"
  80.                                  "Beliebige Taste zur erneuten Eingabe drücken, ESC, um abzubrechen"))
  81.                (setq quit-title  "Abbrechen?")
  82.                (setq yes-key     "J")
  83.                (setq no-key      "N")
  84.                (setq quit-msg    "Wollen Sie abbrechen? (J/N)")
  85.                (setq make-dir?  '("Verzeichnis existiert nicht."
  86.                                   "Wollen Sie das Verzeichnis anlegen? (J/N)"))
  87.                (setq mkdir-failed "Verzeichnis kann nicht angelegt werden, erneut versuchen? (J/N)")
  88.                (setq nospace-dos  '("Nicht genug Festplattenspeicher für dieses Laufwerk."
  89.                                     "Sie benötigen mindestens 10,5 MB."
  90.                                     "Möchten Sie es auf einem anderen Laufwerk versuchen?(J/N)"))
  91.                (setq next-disk  '("Legen Sie die Diskette in das Laufwerk ein, und drücken Sie die LEERTASTE,"
  92.                                   "um weiterzumachen oder ESC, um abzubrechen."))
  93.                (setq copy-title  "Dateien kopieren")
  94.                (setq start-msg   "Tippen Sie abuse <EINGABE>, um mit dem Spiel zu beginnen.")
  95.                (setq path_not_valid '("Ungültiger Pfadname, fortfahren? (J/N)"))
  96.                (setq ok T)
  97.                )
  98.  
  99.             (3 (setq lang 'pig_latin
  100.                (setq title       "Abuse Installation")
  101.                (setq path-prompt "Enter path to install to")
  102.                (setq bad-path  '("You entered a bad path name"
  103.                                  "Press any key to re-enter, ESC to quit"))
  104.                (setq quit-title  "Quit?")
  105.                (setq yes-key     "Y")
  106.                (setq no-key      "N")
  107.                (setq quit-msg    "Do you want to quit? (Y/N)")
  108.                (setq make-dir?  '("Directory does not exsist."
  109.                                   "Do you want to create it? (Y/N)"))
  110.                (setq mkdir-failed "Unable to create directory, retry? (Y/N)")
  111.                (setq nospace-dos  '("Not enough disk space available for this drive"
  112.                                     "You need at least 10.5MB free"
  113.                                     "Would you like to try another drive? (Y/N)"))
  114.                (setq next-disk  '("Insert this disk into disk drive and press SPACE BAR"
  115.                                   "to continue.  Press ESC to quit."))
  116.                (setq copy-title  "Copying files")
  117.                (setq start-msg   "Type abuse <ENTER> to begin")
  118.                (setq path_not_valid '("The pathname you entered is not valid, continue? (Y/N)"))
  119.                (setq ok T)
  120.                )
  121.  
  122.             )))
  123.  
  124.  
  125. (defun quit-install ()
  126.   (if (show_yes_no quit-title quit-msg yes-key no-key)
  127.       (quit)))
  128.  
  129. (defun slash ()
  130.   (select platform
  131.           ('WATCOM   "\\")
  132.           ('UNIX "/")))
  133.  
  134.  
  135. (defun append-slash (path)
  136.   (if (equal (schar path (- (length path) 1)) (schar (slash) 0))
  137.       path
  138.     (concatenate 'string path (slash))))
  139.  
  140. (defun hack-string (x1 x2 st)
  141.   (if (<= x1 x2)
  142.       (cons (schar st x1) (hack-string (+ x1 1) x2 st))
  143.     nil))
  144.  
  145. (defun remove-slash (path)
  146.   (if (equal (schar path (- (length path) 1)) (schar (slash) 0))
  147.       (concatenate 'string (hack-string 0 (- (length path) 2) path))
  148.    path))
  149.  
  150.  
  151. (defun copy-file (disk-name path)
  152.   (do ((ok nil nil))
  153.       ((eq ok T) nil)
  154.       (if (file_exsist (concatenate 'string disk-name ".dat"))
  155.           (if (nice_copy copy-title (concatenate 'string disk-name ".dat")
  156.              (concatenate 'string path disk-name ".exe"))
  157.               (setq ok T))
  158.  
  159.     (if (not (show_yes_no title (cons disk-name next-disk) " " ESC_string))
  160.         (quit))))
  161.   T)
  162.  
  163.  
  164. (defun install (path)
  165.   (select platform
  166.           ('WATCOM
  167.            (if (< (K_avail path) 10500)     ; need ~8MB for game and and ~2.5MB extra for install
  168.                (if (show_yes_no title (cons install-path nospace-dos) yes-key no-key)
  169.                    nil
  170.                  (quit))
  171.              (if (and (copy-file "disk1" path)
  172.                       (copy-file "disk2" path)
  173.                       (copy-file "disk3" path))
  174.                  (progn
  175.                    (go_there path)
  176.                    (system "disk1.exe")
  177.                    (system "del disk1.exe")
  178.                    (system "disk2.exe")
  179.                    (system "del disk2.exe")
  180.                    (system "disk3.exe")
  181.                    (system "del disk3.exe")
  182.                    T)
  183.                nil)))
  184.           ('UNIX
  185.            (print (K_avail path))
  186.            (if (< (K_avail path) 8500)
  187.                (if (show_yes_no title (cons install-path nospace-unix) yes-key no-key)
  188.                    nil
  189.                  (quit))
  190.              (let ((cur-dir (get_cwd)))
  191.                (system (concatenate 'string "cd " path))
  192.                (system (concatenate 'string "tar -xvf " cur-dir " abuse.tar"))
  193.                T)))))
  194.  
  195.  
  196.  
  197.  
  198. (defun lstring (x st)
  199.   (if (< x (length st))
  200.       (progn (print (schar st x))
  201.              (lstring (+ x 1) st))))
  202.  
  203. (defun go_there (path)
  204.   (select platform
  205.           ('WATCOM
  206.            (if (and (< 2 (length path)) (eq (schar path 1) #\:))
  207.                        (system (concatenate 'string (list (schar path 0) #\:))))
  208.                    (chdir (remove-slash path)))
  209.           ('UNIX (chdir path))))
  210.  
  211. (defun ok_pathchar (char pos)
  212.   (or (and (>= (char-code char) (char-code #\a))
  213.            (<= (char-code char) (char-code #\z)))
  214.       (and (>= (char-code char) (char-code #\A))
  215.            (<= (char-code char) (char-code #\Z)))
  216.       (and (>= (char-code char) (char-code #\0))
  217.            (<= (char-code char) (char-code #\9)))
  218.       (eq char #\_)
  219.       (eq char #\-)
  220.       (eq char #\~)
  221.       (eq char #\!)
  222.       (eq char #\\)
  223.       (and (eq char #\:) (eq pos 1))
  224.       (eq char #\/)))
  225.  
  226.  
  227. (defun check_path_char (name x y)
  228.   (or (> x y)
  229.       (and (ok_pathchar (schar name x) x)
  230.            (check_path_char name (+ x 1) y))))
  231.  
  232. (defun ok_pathname (name)
  233.   (if (and (check_path_char name 0 (- (length name) 1))
  234.            (not (search "\\\\" name)))
  235.       T
  236.     nil))
  237.  
  238.  
  239.  
  240. (defun mkdir (path)
  241.   (select platform
  242.           ('WATCOM  (make_dir path))
  243.           ('UNIX
  244.            (print (remove-slash path))
  245.            (make_dir path))))
  246.  
  247.  
  248.  
  249.   (do ((ok nil nil))
  250.       ((eq ok T) nil)
  251.  
  252.       (let ((install-path  (nice_input title path-prompt
  253.                                        (select platform
  254.                                                ('WATCOM "c:\\abuse")
  255.                                                ('UNIX  "~/abuse")))))
  256.         (if (not install-path) (quit-install)
  257.           (if (not (ok_pathname install-path))
  258.               (if (not (show_yes_no title path_not_valid yes-key no-key))
  259.                        (quit))
  260.             (let ((install-path (modify_install_path (append-slash install-path))))
  261.               (if (or (dir_exsist (remove-slash install-path))
  262.                       (and (show_yes_no title (cons install-path make-dir?) yes-key no-key)
  263.                            (if (mkdir install-path)
  264.                                T
  265.                              (if (show_yes_no title (list install-path mkdir-failed) yes-key no-key)
  266.                                  nil
  267.                                (quit)))))
  268.                   (if (install install-path)
  269.                       (progn
  270.                         (go_there install-path)
  271.                         (setq ok T)))))))))
  272.  
  273.  
  274. (select lang
  275.         ('french (progn 
  276.            (open_file "lisp/english.lsp" "wb"  (print `(load ,(concatenate 'string '(#\") "lisp/french.lsp" '(#\")  ))))
  277.            (system "del setup.exe")
  278.            (system "del setup.ini")
  279.            (system "rename fren_set.exe setup.exe")
  280.            (system "rename fsetup.ini setup.ini")
  281.            (system "del germ_set.exe")
  282.            (system "del gsetup.ini")
  283.            ))
  284.         ('german (progn
  285.            (open_file "lisp/english.lsp" "wb"  (print `(load ,(concatenate 'string '(#\") "lisp/german.lsp" '(#\")  ))))
  286.            (system "del setup.exe")
  287.            (system "del setup.ini")
  288.            (system "rename germ_set.exe setup.exe")
  289.            (system "rename gsetup.ini setup.ini")
  290.            (system "del fren_set.exe")
  291.            (system "del fsetup.ini")
  292.            ))
  293.     ('english (progn
  294.             (system "del gsetup.ini")
  295.             (system "del fsetup.ini")
  296.             (system "del fren_set.exe")
  297.             (system "del germ_set.exe"))))
  298.          
  299.  
  300.  
  301. (print start-msg)
  302.  
  303.  
  304.  
  305.  
  306.  
  307.