Commits

Paul Sexton committed 510ed92

GUI demo now uses an antialiased font by default.
New function: stop-gui (to be used during interactive development)

Comments (0)

Files changed (3)

 The [Doryen Library][libtcod], or `libtcod`, is a library that implements a
 truecolour console. It can be thought of as a souped-up alternative to
 [Curses][]. The console can be of any size that fits on the screen. Both
-keyboard and mouse events are handled. There is support for artibrarily large
+keyboard and mouse events are handled. There is support for arbitrarily large
 character sets, and font antialiasing. BMP and PNG images can be displayed
 alongside text.
 
   (:export #:start-gui
            #:main-gui-loop
            #:resume-gui
+           #:stop-gui
            #:*shift*
            #:*ctrl*
            #:*alt*
                   (renderer :RENDERER-GLSL)
                   (fullscreen? nil)
                   (font-file *default-font-file*)
+                  (antialiased? nil)
                   (fps 20)
                   ;;(font-file-chars-in-columns? t)
                   )
   (when font-file
     (assert (probe-file font-file))
     (console-set-custom-font font-file
-                             (if (listp *default-font-layout*)
-                                 *default-font-layout*
-                                 (list *default-font-layout*))
+                             (append (if (listp *default-font-layout*)
+                                         *default-font-layout*
+                                         (list *default-font-layout*))
+                                     (if antialiased?
+                                         (list :font-type-greyscale)
+                                         nil))
                              0 0)) ;; TCOD automatically deduces WxH
 
   ;; We can't access screen resolution until the console has been initialised.
              (t                         ; mouse "just hovering"
               (when *topwin*
                 (setf (gui-event-winx mouse-hover-event)
-                      (- *mouse-x* (window-tlx *topwin*)))
+                      (constrain (- *mouse-x* (window-tlx *topwin*))
+                                 0 (1- (window-width *topwin*))))
                 (setf (gui-event-winy mouse-hover-event)
-                      (- *mouse-y* (window-tly *topwin*)))
+                      (constrain (- *mouse-y* (window-tly *topwin*))
+                                 0 (1- (window-height *topwin*))))
                 (setf (gui-event-mouse-state mouse-hover-event) *rodent*)
                 (setf (gui-event-focus mouse-hover-event) nil)
                 ;;(format t "hover: ~S~%" mouse-hover-event)
       )))
 
 
-        ;; (t
-        ;;  (setf *rodent* (mouse-get-status t))
-        ;;  (unless (equal *rodent* *last-rodent*)
-        ;;    ;; Deal with mouse events
-        ;;    (setf *mouse-x* (mouse-cx *rodent*)
-        ;;          *mouse-y* (mouse-cy *rodent*)
-        ;;          *topwin* (window-with-mouse-focus))
-        ;;    (setf *focus-changed?* (not (eql *topwin* *last-topwin*)))
-        ;;    (cond
-        ;;      ((or (mouse-lbutton-pressed *rodent*)
-        ;;           (mouse-rbutton-pressed *rodent*)
-        ;;           (mouse-mbutton-pressed *rodent*))
-        ;;       ;; Mouse clicked
-        ;;       (send-mouse-click-event *rodent*))
-        ;;      ;; L button held down
-        ;;      ((mouse-lbutton *rodent*)
-        ;;       (when *topwin*
-        ;;         (raise-window *topwin*)
-        ;;         (let ((start (get-internal-real-time))
-        ;;               (dragged? nil))
-        ;;           (declare (ignorable dragged?))
-        ;;           (iterate
-        ;;             (while (mouse-lbutton (setf *rodent* (mouse-get-status t))))
-        ;;             (unless (and (< (get-internal-real-time)
-        ;;                             (+ start (/ (* *drag-delay* 1000)
-        ;;                                         internal-time-units-per-second)))
-        ;;                          (zerop (mouse-dx *rodent*))
-        ;;                          (zerop (mouse-dy *rodent*)))
-        ;;               (setf dragged? t)
-        ;;               (cond
-        ;;                 ((and (window-can-drag? *topwin*)
-        ;;                       (on-upper-window-border?
-        ;;                        *topwin*
-        ;;                        (- *mouse-x* (window-tlx *topwin*))
-        ;;                        (- *mouse-y* (window-tly *topwin*))))
-        ;;                  ;; Dragging on title bar - move the window
-        ;;                  (mouse-drag-window *topwin* *rodent*))
-        ;;                 ((and (window-can-resize? *topwin*)
-        ;;                       (= *mouse-y* (+ (window-tly *topwin*)
-        ;;                                       (1- (window-height *topwin*))))
-        ;;                       (= *mouse-x* (+ (window-tlx *topwin*)
-        ;;                                       (1- (window-width *topwin*)))))
-        ;;                  ;; Dragging on bottom right corner
-        ;;                  (mouse-resize-window *topwin* *rodent*))
-        ;;                 (t
-        ;;                  (send-to-window
-        ;;                   *topwin*
-        ;;                   (make-instance '<GUI-Mouse-Drag-Event>
-        ;;                                  :winx (- *mouse-x* (window-tlx *topwin*))
-        ;;                                  :winy (- *mouse-y* (window-tly *topwin*))
-        ;;                                  :mouse-state *rodent*))))
-        ;;               (return))))))
-        ;;
-        ;;      (t                         ; mouse "just hovering"
-        ;;       (when *topwin*
-        ;;         (setf (gui-event-winx mouse-hover-event)
-        ;;               (- *mouse-x* (window-tlx *topwin*)))
-        ;;         (setf (gui-event-winy mouse-hover-event)
-        ;;               (- *mouse-y* (window-tly *topwin*)))
-        ;;         (setf (gui-event-mouse-state mouse-hover-event) *rodent*)
-        ;;         (setf (gui-event-focus mouse-hover-event) nil)
-        ;;         (send-to-window *topwin* mouse-hover-event))))
-        ;;    ;; CONSOLE-FLUSH should not be done every iteration, which
-        ;;    ;; is what was happening below.
-        ;;    ;; This has been changed so now we only flush the console if the
-        ;;    ;; mouse moves/mouse status changes, or a key is pressed.
-        ;;    ;; It seems to work.
-        ;;    ;;
-        ;;    ;; Alternative plan could be to time since last flush, limit to
-        ;;    ;; < 20 fps.
-        ;;    (unless (equal *rodent* *last-rodent*)
-        ;;      (setf *last-rodent* *rodent*)
-        ;;      (console-flush))
-        ;;    ))))))
-
-
 
 (defun main-gui-loop (&optional tick-fn)
   "* Arguments
   (main-gui-loop))
 
 
+;; TODO this should really use a signal.
+(defun stop-gui ()
+  (setf *exit-gui?* t))
+
+
 (defun window-to-text (win)
   "Debugging function. Prints out the contents of the window WIN as text."
   (let ((line nil))
 R, G and B are byte values (0-255) that define the new colour.")
 
 (defvar *maze-file* "maze.txt")
-(defparameter *font-file* "MDA9x14.png")
+(defparameter *font-file* "freemono.png")
 
 (defvar *ht-database* nil)
 (defvar *hypertext-fg-colour* :light-blue)
                          :hyperlink-fg :light-blue))
     ;;(cffi::use-foreign-library tcod::libtcod)
     (setf *player* (make-instance '<Player>))
-    (start-gui :title "Dormouse demo" :width 100 :height 50
-               :font-file *font-file*)
+    (start-gui :title "Dormouse demo" :width 90 :height 35
+               :font-file *font-file* :antialiased? t)
     (dolist (col *custom-colours*)
       (destructuring-bind (name r g b) col
 	(tcod:make-colour name r g b)))
                                                :height 12))
     (share-map *smallvp* *viewport* 15 13)
     (setf *tipwin* (make-instance '<MyTooltip-Window>
-                                  :tlx 6 :tly 25 :width 30 :height 11
+                                  :tlx 6 :tly 25 :width 30 :height 8
                                   :title "Tooltips"
                                   :transparency +OPAQUE+))
     ;; Make windows
                                (add-message-and-redraw *msgwin*
                                                        "You clicked button `~A'."
                                                        (gui-event-string event))))))
-    (make-instance '<Window> :tlx 50 :tly 30 :width 20 :height 12
+    (make-instance '<Window> :tlx 50 :tly 20 :width 20 :height 12
                              :title "win2" :foreground :yellow
                              :background :dark-blue)
     (setf *termwin*
                          "Your path is blocked by a wall! Click 'X' to close."))
     (setf *listwin*
 	  (make-instance '<Filtered-Window>
-                         :tlx 21 :tly 38 :width 20 :height 9
+                         :tlx 21 :tly 18 :width 20 :height 9
                          :title "list" :transparency +OPAQUE+))
     (add-item *listwin* "a" "a. '{fg:green}apples{/}'" (make-simple-key #\a))
     (add-item *listwin* "b" "b. '{fg:red}plums{/}'" (make-simple-key #\b))
     (add-item *listwin* "d" "d. '{fg:brown}potatoes{/}'" (make-simple-key #\d))
     (add-item *listwin* "e" "e. '{fg:pink}yams{/}'" (make-simple-key #\e))
     (setf *msgwin*
-	  (make-instance '<Log-Window> :tlx 65 :tly 13 :width 33 :height 35
+	  (make-instance '<Log-Window> :tlx 55 :tly 5 :width 33 :height 28
                                        :title "Messages" :foreground :light-blue
                                        :background :dark-blue :transparency +OPAQUE+
                                        :transparency-unfocussed 50))
                              (add-message-and-redraw *msgwin* "You chose `~A'."
                                                      (gui-event-focus event))))))
     (setf *statwin*
-          (make-instance '<Statistics-Window> :tlx 3 :tly 43 :width 12 :height 4
+          (make-instance '<Statistics-Window> :tlx 3 :tly 28 :width 12 :height 4
                                               :background :dark-grey))
 
     (initialise-hypertext-database)
 
     (setf *htwin*
           (make-instance '<Hypertext-Window>
-                         :tlx 12 :tly 30 :width 30
+                         :tlx 12 :tly 25 :width 30
                          :height 12 :title "Hypertext" :foreground :white
                          :background :dark-blue
                          :hyperlink-fg *hypertext-fg-colour*
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.