X-Git-Url: https://jxself.org/git/?a=blobdiff_plain;f=console.lisp;h=545d1e62d5f73d8e5047b0c657ca9947511ca277;hb=2d1a6f87c4d559af53eb5e5f0fe571caf14f8b29;hp=96d2e81da4c8e3a7b38ac10f92164d31f36f8c53;hpb=6dcb4441ced8cbe620510a0d8d039f7379382ebf;p=lifp.git

diff --git a/console.lisp b/console.lisp
index 96d2e81..545d1e6 100644
--- a/console.lisp
+++ b/console.lisp
@@ -6,15 +6,17 @@
 
 (in-package :cl-user)
 (defpackage :if-console
-  (:use :common-lisp :ltk :com.gigamonkeys.pathnames)
+  (:use :common-lisp :ltk :cl-fad)
   (:export :terminal-in :terminal-out
    :run-console :console-running-p :textwidth :offset :style
-   :*text* :get-input :ltk-after :*repl-mode* :*hard-quit* :quit-lisp
+   :*text* :get-input :ltk-after :*repl-mode* :*no-output*
+   :*hard-quit* :quit-lisp
    :close-console :load-module :print-message))
 
 (in-package :if-console)
 
 (defparameter *repl-mode* nil)
+(defparameter *no-output* nil)
 (defparameter *console-on* nil)
 (defparameter *text* nil)
 (defparameter *inp* nil)
@@ -35,9 +37,10 @@
 
 (defmethod gray:stream-write-char ((s terminal-out) char)
   (unless (console-running-p) (error "No console is running"))
+  (unless *no-output*
   (if *repl-mode* (princ char)
       (append-text (first *console-on*) 
-		   (make-string 1 :initial-element char))))
+		   (make-string 1 :initial-element char)))))
 
 (defmethod gray:stream-line-column ((s terminal-out))
   (offset s))
@@ -45,11 +48,12 @@
 (defmethod gray:stream-write-char-sequence ((s terminal-out) str
 					    &optional start end)
   (unless (console-running-p) (error "No console is running"))
+  (unless *no-output*
   (let ((toprint (subseq str (if start start 0) (if end end nil))))
     (if *repl-mode* (princ toprint)
 	(progn
 	  (append-text (first *console-on*) toprint)
-	  (see (first *console-on*) "insert")))))
+	  (see (first *console-on*) "insert"))))))
 
 (defmethod gray:stream-read-char ((s terminal-in))
   (if *repl-mode* (read-char *standard-input*)
@@ -137,19 +141,35 @@
 		 :defaults file))
       (values file dir))))
 
+(defun splice-filename (file)
+  "Returns file itself and its directory as the second value"
+  (values file (make-pathname
+		 :directory (pathname-directory file)
+		 :name nil
+		 :type nil
+		 :defaults file)))
 
 (defun load-module (startup lib-loader)
   "Loads IF module into the interpreter"
-  (multiple-value-bind (file dir) (pick-file)
-    (unless file (append-text *text* "Failed to load module.
-"))
+  (multiple-value-bind (file dir) 
+      (splice-filename (get-open-file :filetypes '(("Loadable files"
+                                                    "*.fas *.lisp")
+                                                   ("Compiled story files"
+                                                    "*.fas")
+                                                   ("Plain story files"
+                                                    "*.lisp")
+                                                   ("All files" "*"))
+                                      :title "Load story file"))
+      ;;(pick-file) <- was used before
+    (unless file (append-text *text* (format nil "Failed to load module.~%"))
+            (return-from load-module nil))
     (funcall lib-loader file dir)
     (funcall startup)))
 
 (defun run-console (startup lib-loader &key (interactive nil))
   (if *repl-mode* (progn (funcall startup) 
 			 (return-from run-console t))
-  (with-ltk ()
+  (with-ltk (:debug :develop :handle-warnings nil)
       (let* ((txt (make-instance 'text))
 	     (menu (make-menubar))
 	     (m-file (make-menu menu "File"))
@@ -190,5 +210,4 @@
 			 (terpri *standard-output*))
       (progn (configure *text* :state "normal")
 	     (append-text *text* (apply #'format nil string args))
-	     (append-text *text* "
-"))))
\ No newline at end of file
+	     (append-text *text* (make-string 1 :initial-element #\Newline)))))