#! /usr/bin/env guile # -*-scheme-*- !# ;;; 8sync --- Asynchronous programming for Guile ;;; Copyright © 2019 Jan (janneke) Nieuwenhuizen ;;; ;;; This file is part of 8sync. ;;; ;;; 8sync is free software: you can redistribute it and/or modify it ;;; under the terms of the GNU Lesser General Public License as ;;; published by the Free Software Foundation, either version 3 of the ;;; License, or (at your option) any later version. ;;; ;;; 8sync is distributed in the hope that it will be useful, ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;; GNU Lesser General Public License for more details. ;;; ;;; You should have received a copy of the GNU Lesser General Public ;;; License along with 8sync. If not, see . (define-module (8s-server) #:use-module (oop goops) #:use-module (8sync) #:use-module (8sync systems web) #:use-module (8sync systems websocket client) #:use-module (8sync systems websocket server) #:export (main)) (define %server-port 1236) (define-actor () ((*init* sleeper-loop)) (sleep-secs #:init-value 3 #:getter sleeper-sleep-secs)) (define (sleeper-loop actor message) (while (actor-alive? actor) (display "Zzzzzzzz....\n") ;; Sleep for a bit (8sleep (sleeper-sleep-secs actor)))) (define (main . args) (let* ((hive (make-hive)) (sleeper (bootstrap-actor hive )) (server (bootstrap-actor hive #:port %server-port #:on-ws-connection (lambda (ws) (format (current-error-port) "on-ws-connection: ws=~s\n" ws) (when #f (set! (.on-close ws) (lambda (ws) (format (current-error-port) "on-close: ~s\n" ws))) (set! (.on-error ws) (lambda (ws e) (format (current-error-port) "on-error: ~s, ~s\n" ws e))) (set! (.on-message ws) (lambda (ws msg) (format (current-error-port) "on-message: ~s\n" msg))) (set! (.on-open ws) (lambda (ws) (format (current-error-port) "on-open: ~s\n" ws))))) #:on-ws-close (lambda (ws) (format (current-error-port) "on-close: ~s\n" ws)) #:on-ws-error (lambda (ws e) (format (current-error-port) "on-error: ~s: ~s\n" ws e)) #:on-ws-message (lambda (ws msg) (format (current-error-port) "on-message: ~s: ~s\n" ws msg)) #:on-ws-open (lambda (ws) (format (current-error-port) "on-open: ~s\n" ws))))) (format (current-error-port) "listening: ~s\n" %server-port) (run-hive hive '()))) (main (command-line))