source: abuse/tags/pd/abuse/install.lsp @ 49

Last change on this file since 49 was 49, checked in by Sam Hocevar, 12 years ago
  • Imported original public domain release, for future reference.
File size: 12.4 KB
RevLine 
[49]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
Note: See TracBrowser for help on using the repository browser.