diff --git a/main.rkt b/main.rkt index 3be6ce6..f0fc508 100644 --- a/main.rkt +++ b/main.rkt @@ -1,376 +1,5 @@ -#lang at-exp racket - -(provide once-upon-a-time - extra-unreal-command-line-args - multiplayer - server-ip-address - - demo-aether - current-file-name ;helps with simple mods - codespells-workspace - (all-from-out racket - codespells-server - codespells-server/unreal-js/unreal-client - codespells-runes codespells/demo-aether) - define-runtime-path - spawn-mod-blueprint ;should this file be providing this? - #%module-begin) - -(require codespells/demo-aether - codespells-runes - codespells-server/unreal-js/util - (rename-in racket [#%module-begin #%old-module-begin])) - -(module reader syntax/module-reader - codespells/main) - -(define server-ip-address (make-parameter "127.0.0.1")) - -(define multiplayer (make-parameter #f)) - -(define extra-unreal-command-line-args (make-parameter "")) - -(define (once-upon-a-time #:aether aether #:world world) - (displayln "Starting World and Aether") - - (world) - (parameterize ([running-as-multiplayer-server? (eq? 'server (multiplayer))]) - (aether)) - - (let loop () - (sleep 1) - (loop))) - - - - - -;Should move dl to utility (outside of CodeSpells) - -(provide dl) - -(define (find-dl-size url) - (local-require net/http-easy) - - (/ - (string->number (bytes->string/utf-8 (response-headers-ref (head url) 'Content-Length))) - 1000000)) - -(define (dl from to [size-in-megabytes (find-dl-size from)]) - (local-require net/url) - - (define the-url (string->url from)) - (define in (get-pure-port the-url)) - (define out (open-output-file to)) - - (thread (λ () (listen-for-progress in 0 size-in-megabytes))) - - (copy-port in out) - - (close-output-port out)) - -(define (listen-for-progress in last-percent-complete total-metabytes) - (sync (port-progress-evt in)) - (unless (port-closed? in) - (define-values [line col pos] (port-next-location in)) - ;pos is the byte position - - (define percent-complete (* 100 (exact->inexact (/ pos (* total-metabytes 1000000))))) - - ;(displayln percent-complete) - - (if (> percent-complete (+ 1 last-percent-complete)) - (begin - (printf "World download progress: ~a%\n" - (~r (min percent-complete 100) - #:precision 2)) - (listen-for-progress in percent-complete total-metabytes)) - (listen-for-progress in last-percent-complete total-metabytes)))) - - - -;TODO: Probably time to move this world stuff to a new file, if not a codespells-worlds repo -; Essentially a new module evolving below this line... - -(provide demo-world) - -(require racket/runtime-path - codespells-server - codespells-server/unreal-js/unreal-client) - -(define-runtime-path js-runtime "./js/on-start.js") - -(define codespells-workspace (make-parameter (current-directory))) - -(define (demo-world) - (fetch-and-run-world - "https://codespells-org.s3.amazonaws.com/WorldTemplates/demo-world/0.0/CodeSpellsDemoWorld.zip" - "CodeSpellsDemoWorld" - "Minimal_Default" - )) - -;TODO: Move to new package -(provide temple-world) -(define (temple-world) - (fetch-and-run-world - "https://codespells-org.s3.amazonaws.com/WorldTemplates/temple-world/0.0/TempleWorld.zip" - "TempleWorld" - "DemoMap3")) - -;TODO: Move to new package -(provide village-world) -(define (village-world) - (fetch-and-run-world - "https://codespells-org.s3.amazonaws.com/WorldTemplates/village-world/0.0/VillageWorld.zip" - "VillageWorld" - "AdvancedVillagePack_Showcase")) - -;TODO: Move to new package -(provide polar-facility-world) -(define (polar-facility-world) - (fetch-and-run-world - "https://codespells-org.s3.amazonaws.com/WorldTemplates/polar-facility-world/0.0/PolarFacilityWorld.zip" - "PolarFacilityWorld" - "PolarFacilityMap")) - -;TODO: Move to new package -(provide voxel-world) -(define (voxel-world) - (fetch-and-run-world - "https://codespells-org.s3.amazonaws.com/WorldTemplates/voxel-world/0.0/VoxelWorld.zip" - "VoxelWorld" - "VoxelWorld" - )) - -;TODO: Move to new package -(provide log-cabin-world) -(define (log-cabin-world) - (fetch-and-run-world - "https://codespells-org.s3.amazonaws.com/WorldTemplates/log-cabin-world/0.0/LogCabinWorld.zip" - "LogCabinWorld" - "Demonstration_Map")) - -;TODO: Move to new package -(provide forest-world) -(define (forest-world) - (fetch-and-run-world - "https://codespells-org.s3.amazonaws.com/WorldTemplates/forest-world/0.0/ForestWorld.zip" - "ForestWorld" - "Demo_Scene")) - -;TODO: Move to new package -(provide cave-world) -(define (cave-world) - (fetch-and-run-world - "https://codespells-org.s3.amazonaws.com/WorldTemplates/cave-world/0.0/CaveWorld.zip" - "CaveWorld" - "LV_Soul_Cave")) - -(provide arena-world) -(define (arena-world) - (fetch-and-run-world - "https://codespells-org.s3.amazonaws.com/WorldTemplates/arena-world/0.0/ArenaWorld.zip" - "ArenaWorld" - "DemoMap1")) - -(define (fetch-and-run-world world-installation-source world-name [map-name #f]) - (local-require file/unzip net/sendurl) - - (define zip-file-name (last (string-split world-installation-source "/"))) - (define world-installation-target (build-path (codespells-workspace) world-name)) - - (lambda () - (displayln (~a "Starting World: " world-name)) - - (when (and - (not (file-exists? (build-path (codespells-workspace) zip-file-name))) - (not (directory-exists? world-installation-target))) - (displayln "Downloading world zip file...") - - (dl world-installation-source - (build-path (codespells-workspace) zip-file-name) - )) - - (when (not (directory-exists? world-installation-target)) - (displayln "Unzipping") - (unzip (build-path (codespells-workspace) zip-file-name)) - (rename-file-or-directory - (build-path (current-directory) world-name) - world-installation-target)) - - (copy-file js-runtime - (build-path (codespells-workspace) - world-name - world-name - "Content" - "Scripts" - "on-start.js") - #t) - - (define multiplayer-command-line - (if (not (multiplayer)) - "" - (if (not map-name) - (error (~a "No map name is set for " world-name)) - (if (eq? (multiplayer) 'client) - (server-ip-address) - (~a map-name "?listen"))))) - - (define exe (~a (~s (~a(build-path world-installation-target (~a world-name ".exe")))) - " " multiplayer-command-line - " -unreal-server=" (unreal-server-port) - " -codespells-server=" (codespells-server-port) - " " (extra-unreal-command-line-args) - )) - (displayln (~a "Running " exe)) ;Assume Windows for now - - (thread (thunk (system exe))) - - - )) - - - -;Another module shaping up here - -(provide define-classic-rune - define-classic-rune-lang - spawn-this-mod-blueprint - (all-from-out 2htdp/image)) - -(require racket/runtime-path - syntax/parse/define - (for-syntax racket/syntax racket/path racket/list) - 2htdp/image) - -(define-syntax (define-classic-rune stx) - (syntax-parse stx - [(_ head #:background bg #:foreground fg lines ...) - #:with name (car (syntax-e #'head)) - #:with name-rune (format-id stx "~a-rune" #'name) - #:with name-rune-binding (format-id stx "~a-rune-binding" #'name) - - #`(begin - (provide name name-rune) - - (define head - lines ...) - - (define (name-rune) - (svg-rune-description - (rune-background - #:color bg - (rune-image fg)))) - - (define name-rune-binding - (html-rune 'name (name-rune))) - )])) - -(define-syntax (define-classic-rune-lang stx) - (syntax-parse stx - [(_ name #:eval-from eval-from (rune-names ...)) - #:with rune-bindings (map (lambda (n) (format-id stx "~a-rune-binding" n)) - (syntax->list #'(rune-names ...))) ;(format-id stx "~a-rune-binding" 'hello) - #`(begin - (provide name) - (define (name #:with-paren-runes? [with-paren-runes? #f]) - (local-require codespells-runes) - (rune-lang eval-from ;#,(syntax-source stx) - (rune-list #:with-paren-runes? with-paren-runes? - - #,@#'rune-bindings - ))))])) - - - -(require (for-syntax codespells/modding/lib racket/format)) - -(define-for-syntax (this-unreal-mod-location stx) - ;Hmmm. This doesn't work when we do `raco exe`, still references the old path - (build-path (path-only (syntax-source stx)) - "BuildUnreal" - "WindowsNoEditor" - (~a (racket-id->unreal-id - (find-pkg-root-dir (path-only (syntax-source stx))))) - "Content" - "Paks")) - -(define-for-syntax (this-unreal-mod-name stx) - (~a (racket-id->unreal-id - (find-pkg-root-dir (path-only (syntax-source stx)))))) - - -;TODO: Could check at compile time that this BP exists... -; Could tell them what to do in the Unreal project... - - -(define-syntax (#%module-begin stx) - (syntax-parse stx - [(_ things ...) - #`(#%old-module-begin - - things ... - )])) - -(define-syntax (spawn-this-mod-blueprint stx) - (syntax-parse stx - [(_ name) - - - #`(spawn-mod-blueprint - #,(datum->syntax stx 'MyPak) - #,(datum->syntax stx 'mod-name) - name) - - #; - #`(spawn-mod-blueprint - #,(this-unreal-mod-location stx) - #,(this-unreal-mod-name stx) - name) - ])) - -(define-syntax (current-file-name stx) - - (datum->syntax stx 'main.rkt) - - #; - #`#,(syntax-source stx)) - - -(provide require-mod) -(require syntax/parse/define - (for-syntax racket/syntax)) -(define-syntax (require-mod stx) - (syntax-parse stx - [(_ name) - #:with name: (format-id stx "~a:" #'name) - #'(begin - (provide (all-from-out name)) - - (require - (prefix-in name: (only-in name my-mod-lang)) - (except-in name my-mod-lang) - ))])) - - -(provide mod) -(define-syntax (mod stx) - (syntax-parse stx - [(mod the-mod-name - #:pak-folder - pak-folder-name) - #`(begin - (module mod-info racket - (define mod-name "MyMod") - ;(define-runtime-path main.rkt "main.rkt") - ;(define-runtime-path MyPak pak-folder-name) - ) - (require 'mod-info) - ) - #; - (datum->syntax stx `(begin - (define mod-name ,(syntax->datum #'the-mod-name)) - (define-runtime-path main.rkt "main.rkt") - (define-runtime-path MyPak ,(syntax->datum #'pak-folder-name)) - ))])) +#lang codespells +(once-upon-a-time + #:world (demo-world) + #:aether (demo-aether))