Pastebin launched a little side project called VERYVIRAL.com, check it out ;-) Want more features on Pastebin? Sign Up, it's FREE!
Guest

racket vs DrRacket window close

By: a guest on Jul 29th, 2010  |  syntax: Scheme  |  size: 1.11 KB  |  views: 284  |  expires: Never
download  |  raw  |  embed  |  report abuse  |  print
Text below is selected. Please press Ctrl+C to copy to your clipboard. (⌘+C on Mac)
  1. #lang racket
  2.  
  3. (require "libtcod.rkt")
  4.  
  5. (define (handle-keys)
  6.   (call/cc (lambda (k)
  7.              (let* ([key (tcod:console-wait-for-keypress #t)]
  8.                     [vk (tcod:key-vk key)]
  9.                     [char (integer->char (tcod:key-c key))])
  10.                (cond
  11.                 [(and (eq? 'key-enter vk) (tcod:key-left-alt key))
  12.                  (tcod:console-set-fullscreen (not (tcod:console-is-fullscreen?)))
  13.                  (k #f)]
  14.                 [(or (eq? 'key-escape vk) (and (eq? 'key-char vk) (eq? char #\Q) (tcod:key-left-ctrl key)))
  15.                  (k #t)]) ; shortcut
  16.                #f))))
  17.  
  18. (define (main-loop)
  19.   (tcod:console-set-custom-font "data/fonts/prestige12x12_gs_tc.png" 12 -1 -1)
  20.   (tcod:console-init-root 30 24 "scheme/libtcod tutorial" #f 'glsl)
  21.   (tcod:sys-set-fps 20)
  22.   (let* ([foo 1])
  23.     (let loop ([first #t])
  24.       (unless (tcod:console-is-window-closed?)
  25.         (when first
  26.           (tcod:console-flush))
  27.         (let ([break [and (not first) (handle-keys)]])
  28.           (unless break
  29.             (tcod:console-flush)
  30.             (loop #f)))))))
  31.  
  32. (main-loop)
clone this paste RAW Paste Data