Skip to content

Instantly share code, notes, and snippets.

@Hamayama
Last active December 11, 2023 05:25
Show Gist options
  • Save Hamayama/8e66bc6a49ea9490f1cf4acae18b64f0 to your computer and use it in GitHub Desktop.
Save Hamayama/8e66bc6a49ea9490f1cf4acae18b64f0 to your computer and use it in GitHub Desktop.
Gauche で、call/cc によるコンテキストスイッチのサンプル
gosh callcc.scm
pause
(cond-expand
[gauche.os.windows
(add-load-path "." :relative)
(use char-ready-win)]
[else])
(define (input)
(while #t
(when (char-ready?)
(let ((cmd (read-line)))
(cond ((equal? cmd "change") (set! k2 world))
((equal? cmd "revert") (set! k2 hello))
((equal? cmd "end") (exit)))))
(sys-sleep 1)
(call/cc (lambda (k) (set! k1 k) (k2)))))
(define (hello)
(while #t
(print "Hello, ")
(sys-sleep 1)
(call/cc (lambda (k) (set! k2 k) (k1)))))
(define (world)
(while #t
(print "world!")
(sys-sleep 1)
(call/cc (lambda (k) (set! k2 k) (k1)))))
(define k1 input)
(define k2 hello)
(k1)
;;
;; char-ready? for windows
;;
(define-module char-ready-win
(use os.windows)
(export char-ready?))
(select-module char-ready-win)
(define (char-ready? :optional (port (current-input-port)))
(cond
((and (input-port? port)
(or (sys-isatty port)
(port-attribute-ref port 'windows-console-conversion #f)))
(let ((hdl (sys-get-std-handle STD_INPUT_HANDLE)))
(let loop ((irlist (sys-peek-console-input hdl)))
(if (null? irlist)
#f
(let ((ir (car irlist)))
;(print (slot-ref ir 'event-type))
;(print (slot-ref ir 'key.down))
;(print (slot-ref ir 'key.unicode-char))
;(print (slot-ref ir 'key.virtual-key-code))
;(print (slot-ref ir 'key.control-key-state))
(cond
((and (= (slot-ref ir 'event-type) 1) ; key event
(slot-ref ir 'key.down))
#t)
(else ; other event (focus, etc.)
(sys-read-console-input hdl)
(loop (sys-peek-console-input hdl)))))))))
(else
((with-module scheme char-ready?) port))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment