
; letterfall/kgtk.sscm - gtk and glib in a cps-wrapper
; Copyright (C) 2012 Alan Manuel K. Gloria
;
; This file is part of Letterfall.
;
; This program is free software; you can redistribute it and/or modify
; it under the terms of the GNU General Public License as published by
; the Free Software Foundation, either version 3 of the License, or
; (at your option) any later version.
;
; This program is distributed in the hope that it will be useful,
; but WITHOUT ANY WARRANTY, without even the implied warranty of
; MERCHANTIBILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
; GNU General Public License for more details.
;
; You should have received a copy of the GNU General Public License
; along with this program.  If not, see <http://www.gnu.org/licenses/>

define-module
  letterfall kgtk
  :export
  \\
    kgtk-start
    wait
    key-available?
    get-key
  :use-module
  \\ letterfall screen
  :re-export
  \\
    cls
    gotoxy
    print
    refresh-screen

use-modules
  ;
  ice-9 q
  oop goops
  ;
  gnome gobject
  gnome glib
  gnome gtk
  gnome gtk gdk-event
  ;
  letterfall kont

define toplevel-window #f
define drawing-area #f

define kgtk-start(title)
  kmonad-wrap $ lambda (pass)
    ;
    set! toplevel-window
      make <gtk-window>
        #:type \\ 'toplevel
        #:title \\ title
    set! drawing-area
      make <gtk-drawing-area>
    ;
    add toplevel-window drawing-area
    ;
    connect toplevel-window 'destroy
      lambda ___
        gtk-main-quit()
    connect toplevel-window 'key-press-event
      key-press-handler
    connect drawing-area 'key-press-event
      key-press-handler
    ;
    g-idle-add
      lambda ()
        pass '()
        #f ; don't repeat!
    ;
    screen-initialize-pre-show toplevel-window drawing-area
    show-all toplevel-window
    screen-initialize-post-show toplevel-window drawing-area
    ;
    gtk-window-maximize toplevel-window
    ;
    gtk-main()
    exit 0

define wait(ms)
  kmonad-wrap $ lambda (pass)
    g-timeout-add ms
      lambda ()
        pass '()
        #f ; disable timer
    '()

define key-q make-q()
define key-func #f

define key-available?
  lift $ not $ q-empty? key-q

define get-key
  kmonad-wrap $ lambda (pass)
    cond
      q-empty?(key-q)
        ; defer it
        set! key-func pass
        '()
      #t
        ; get it now
        pass $ deq! key-q

define key-press-handler(_w_ ev)
  let
    $ kv $ gdk-event-key:keyval ev
    cond
      { kv <= 126 } ; ASCII range
        ; candidate for handling:
        ; now determine if we should
        ; enqueue it or call some
        ; waiting function
        handle-char $ integer->char kv
      { kv = gdk:Escape }
        handle-char $ integer->char 27
      { kv = gdk:BackSpace }
        handle-char $ integer->char 8
      { kv = gdk:Return }
        handle-char $ integer->char 13
      #t
        #f ; didn't handle it

define handle-char(c) $ cond
  key-func $ let
               $ func $ key-func
               set! key-func #f
               func c
               #t
  #t       $ begin
               enq! key-q c
               #t

; vim: set ft=scheme : ;
