Skip to content

Update main.rkt #9

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
TheMapotakes wants to merge 1 commit into
base: master
Choose a base branch
from
Open

Update main.rkt #9

Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
379 changes: 4 additions & 375 deletions main.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -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))