Compare commits
5 Commits
2148f868a6
...
c2d8885d80
Author | SHA1 | Date |
---|---|---|
|
c2d8885d80 | |
|
0591b412b1 | |
|
d2ddcd1499 | |
|
91edd190ca | |
|
20de7900ac |
|
@ -0,0 +1,121 @@
|
|||
#! /usr/bin/env racket
|
||||
#lang racket
|
||||
(require db racket/cmdline "world/blocks.rkt")
|
||||
|
||||
;; # Constants
|
||||
#! /usr/bin/env racket
|
||||
(define BATCH-SIZE 1000)
|
||||
|
||||
;; # Functions
|
||||
;; Functions that rely on database state have been incorporated into
|
||||
;; the command line tool instead of a library.
|
||||
|
||||
;; Mintest database row -> Mintest block
|
||||
;; Convert a single mintest world database row into a minetest-block
|
||||
|
||||
(define (minetest-row->minetest-block row)
|
||||
(minetest-block (vector-ref row 0) ;; the pos field
|
||||
(vector-ref row 1))) ;; data field
|
||||
|
||||
;; Database Pos -> ListOfBlocks
|
||||
;; Accept a database connection and a start (low) pos. Return
|
||||
;; a list of blocks, up to a maximum of BATCH-SIZE.
|
||||
|
||||
(define (retrieve-blocks source start)
|
||||
(map minetest-row->minetest-block (query-rows source
|
||||
"select pos, data from blocks where pos > ? order by pos asc limit ?"
|
||||
start
|
||||
BATCH-SIZE)))
|
||||
|
||||
;; Database connection -> Function
|
||||
;; Prepare an insert function to add blocks to the provided table.
|
||||
;; Insert SQL works faster if it is compiled only once. The created
|
||||
;; function has signature:
|
||||
;;
|
||||
;; MintestBlock -> ID
|
||||
;; Insert a block record into the destination database. Returns
|
||||
;; the pos identifier.
|
||||
|
||||
(define (prepare-insert destination)
|
||||
(let ([insert
|
||||
(prepare destination "insert into blocks(x,y,z,data) values (?,?,?,?)")])
|
||||
(lambda (block)
|
||||
(let* ([position (pos->point (minetest-block-pos block) empty)]
|
||||
[x (point-x position)]
|
||||
[y (point-y position)]
|
||||
[z (point-z position)]
|
||||
[data (minetest-block-data block)])
|
||||
(query-exec destination insert x y z data)
|
||||
(minetest-block-pos block)))))
|
||||
|
||||
|
||||
;; String -> Database connection
|
||||
;; Take a source database file name. Connect to it, or raise an
|
||||
;; exception. The exception is the only addition.
|
||||
|
||||
(define (open-database name)
|
||||
(let ([source (sqlite3-connect #:database name)])
|
||||
(cond [(connected? source) source]
|
||||
[else (raise (string-append "Unable to open: " name))])))
|
||||
|
||||
|
||||
;; String -> Database connection
|
||||
;; Takes the name of a destination file. Creates the appropriate database
|
||||
;; table and returns the SQLite connection.
|
||||
|
||||
(define (create-database name)
|
||||
(let ([new-db (sqlite3-connect #:database name
|
||||
#:mode 'create)])
|
||||
(cond [(connected? new-db)
|
||||
(query-exec new-db
|
||||
"create table blocks (id INTEGER PRIMARY KEY, x INTEGER, y INTEGER, z INTEGER, data BLOB, UNIQUE (x,y,z))")
|
||||
new-db]
|
||||
[else (raise (string-append "Could not create " name))])))
|
||||
|
||||
;; Database -> Integer
|
||||
;; From a world database, determine the lowest pos
|
||||
|
||||
(define (first-record db)
|
||||
(query-value db "select min(pos) from blocks"))
|
||||
|
||||
;; Database -> Integer
|
||||
;; From a world database, determine highest pos
|
||||
(define (last-record db)
|
||||
(query-value db "select max(pos) from blocks"))
|
||||
|
||||
;; Database Database Function Pos -> Pos
|
||||
;; Take a database source connection, destination, insert function and starting pos
|
||||
;; Migrates all records from the source to the destination, returns the last record.
|
||||
|
||||
(define (migrate-all src dest insert start)
|
||||
(cond [(>= start (last-record src)) start]
|
||||
[else
|
||||
(let ([blocks (retrieve-blocks src start)])
|
||||
(start-transaction dest)
|
||||
(map insert blocks)
|
||||
(commit-transaction dest)
|
||||
(migrate-all src dest insert (minetest-block-pos (last blocks))))]))
|
||||
|
||||
;; Database Database Function Pos -> Pos
|
||||
;; Take a database source connection, destination, insert function and starting pos
|
||||
;; Migrates all records from the source to the destination, returns the last record.
|
||||
|
||||
(define (validate-and-start source destination)
|
||||
(cond [(not (file-exists? source))
|
||||
(raise (string-append "Source file not found: " source))]
|
||||
[(file-exists? destination)
|
||||
(raise (string-append "Can not over-write existing database: " destination))]
|
||||
[else
|
||||
(let* ([src-db (open-database source)]
|
||||
[dest-db (create-database destination)]
|
||||
[insert (prepare-insert dest-db)])
|
||||
(migrate-all src-db dest-db insert (sub1 (first-record src-db))))]))
|
||||
|
||||
|
||||
(define source (make-parameter ""))
|
||||
(define destination (make-parameter ""))
|
||||
|
||||
(define main (command-line
|
||||
#:program "Translate Minetest Positions"
|
||||
#:args (source destination)
|
||||
(validate-and-start source destination)))
|
|
@ -0,0 +1,113 @@
|
|||
#!/usr/bin/env racket
|
||||
#lang racket
|
||||
(require db racket/cmdline "world/blocks.rkt")
|
||||
|
||||
;; # Constants
|
||||
|
||||
(define BATCH-SIZE 1000)
|
||||
|
||||
;; # Functions
|
||||
;; Functions that rely on database state have been incorporated into
|
||||
;; the command line tool instead of a library.
|
||||
|
||||
;; Mtc database row -> Mintest block
|
||||
;; Convert a single mintest world database row into a minetest-block
|
||||
|
||||
(define (mtc-row->minetest-block row)
|
||||
(minetest-block (point->pos (list (vector-ref row 1)
|
||||
(vector-ref row 2)
|
||||
(vector-ref row 3)))
|
||||
(vector-ref row 4)))
|
||||
|
||||
;; Database RowID -> ListOfRows
|
||||
;; Accept a start (low) record id and maximum number of records. Returns
|
||||
;; a batch of rows from the database, up to a total of BATCH-SIZE.
|
||||
|
||||
(define (retrieve-rows source start)
|
||||
(query-rows source
|
||||
"select id, x, y, z, data from blocks where id > ? order by id asc limit ?"
|
||||
start
|
||||
BATCH-SIZE))
|
||||
|
||||
;; Database connection -> Function
|
||||
;; Prepare an insert function to add blocks to the destination table.
|
||||
;; Insert SQL works faster if it is compiled only once. The created
|
||||
;; function has signature:
|
||||
;;
|
||||
;; Mtc row -> Pos
|
||||
;; Insert a block record into the destination database. Returns
|
||||
;; the pos identifier.
|
||||
|
||||
(define (prepare-insert destination)
|
||||
(let ([insert
|
||||
(prepare destination "insert into blocks(pos,data) values (?,?)")])
|
||||
(lambda (row)
|
||||
(let ([block (mtc-row->minetest-block row)])
|
||||
(query-exec destination insert (minetest-block-pos block) (minetest-block-data block))))))
|
||||
|
||||
;; String -> Database connection
|
||||
;; Take a source database file name. Connect to it, or raise an
|
||||
;; exception. The exception is the only addition.
|
||||
|
||||
(define (open-database name)
|
||||
(let ([source (sqlite3-connect #:database name)])
|
||||
(cond [(connected? source) source]
|
||||
[else (raise (string-append "Unable to open: " name))])))
|
||||
|
||||
|
||||
;; String -> Database connection
|
||||
;; Takes the name of a destination file. Creates the appropriate database
|
||||
;; table and returns the SQLite connection.
|
||||
|
||||
(define (create-database name)
|
||||
(let ([new-db (sqlite3-connect #:database name
|
||||
#:mode 'create)])
|
||||
(cond [(connected? new-db)
|
||||
(query-exec new-db
|
||||
"create table blocks (pos INTEGER PRIMARY KEY, data BLOB)")
|
||||
new-db]
|
||||
[else (raise (string-append "Could not create " name))])))
|
||||
|
||||
;; Database -> Integer
|
||||
;; From an mtc database, determine the lowest record id
|
||||
|
||||
(define (first-record db)
|
||||
(query-value db "select min(id) from blocks"))
|
||||
|
||||
;; Database -> Integer
|
||||
;; From a world database, determine highest pos
|
||||
(define (last-record db)
|
||||
(query-value db "select max(id) from blocks"))
|
||||
|
||||
;; Database Database Function Pos -> Pos
|
||||
;; Take a database source connection, destination, insert function and starting pos
|
||||
;; Migrates all records from the source to the destination, returns the last record.
|
||||
|
||||
(define (migrate-all src dest insert start)
|
||||
(cond [(>= start (last-record src)) start]
|
||||
[else
|
||||
(let ([rows (retrieve-rows src start)])
|
||||
(start-transaction dest)
|
||||
(map insert rows)
|
||||
(commit-transaction dest)
|
||||
(migrate-all src dest insert (vector-ref (last rows) 0)))]))
|
||||
|
||||
(define (validate-and-start source destination)
|
||||
(cond [(not (file-exists? source))
|
||||
(raise (string-append "Source file not found: " source))]
|
||||
[(file-exists? destination)
|
||||
(raise (string-append "Can not over-write existing database: " destination))]
|
||||
[else
|
||||
(let* ([src-db (open-database source)]
|
||||
[dest-db (create-database destination)]
|
||||
[insert (prepare-insert dest-db)])
|
||||
(migrate-all src-db dest-db insert (sub1 (first-record src-db))))]))
|
||||
|
||||
|
||||
(define source (make-parameter ""))
|
||||
(define destination (make-parameter ""))
|
||||
|
||||
(define main (command-line
|
||||
#:program "Translate Minetest Positions"
|
||||
#:args (source destination)
|
||||
(validate-and-start source destination)))
|
|
@ -1,6 +1,7 @@
|
|||
#lang racket
|
||||
(require test-engine/racket-tests)
|
||||
(provide pos-to-point point-to-pos)
|
||||
(provide pos->point point->pos (struct-out minetest-block)
|
||||
point-x point-y point-z)
|
||||
|
||||
;; #### Constants ####
|
||||
|
||||
|
@ -131,17 +132,17 @@
|
|||
;; which is the whole reason I'm writing a way to convert it in the first
|
||||
;; place.
|
||||
|
||||
(check-expect (pos-to-point -16756737 empty) (list -1 5 -1))
|
||||
(check-expect (pos-to-point -16752641 empty) (list -1 6 -1))
|
||||
(check-expect (pos-to-point 20479 empty) (list -1 5 0))
|
||||
(check-expect (pos->point -16756737 empty) (list -1 5 -1))
|
||||
(check-expect (pos->point -16752641 empty) (list -1 6 -1))
|
||||
(check-expect (pos->point 20479 empty) (list -1 5 0))
|
||||
|
||||
(define (pos-to-point pos build-point)
|
||||
(define (pos->point pos build-point)
|
||||
(cond [(not (number? pos)) (error "position must be a number")]
|
||||
[(> (length build-point) 3) (error "build-point too long")]
|
||||
[(= (length build-point) 3) (reverse build-point)]
|
||||
[else
|
||||
(let* ([coordinate (pos-to-coordinate pos)])
|
||||
(append (pos-to-point (splice-pos coordinate pos)
|
||||
(append (pos->point (splice-pos coordinate pos)
|
||||
(cons coordinate build-point))))]))
|
||||
|
||||
|
||||
|
@ -194,16 +195,16 @@
|
|||
(check-expect (splice-pos 5 0) 0)
|
||||
|
||||
(define (splice-pos coordinate pos)
|
||||
(round (/ (- pos coordinate) POS_MODULO)))
|
||||
(ceiling (/ (- pos coordinate) POS_MODULO)))
|
||||
|
||||
;; Point -> Pos
|
||||
;; Convert a Point into a Minetest block Pos
|
||||
|
||||
(check-expect (point-to-pos (list -1 5 -1)) -16756737)
|
||||
(check-expect (point-to-pos (list -1 6 -1)) -16752641)
|
||||
(check-expect (point-to-pos (list -1 5 0)) 20479)
|
||||
(check-expect (point->pos (list -1 5 -1)) -16756737)
|
||||
(check-expect (point->pos (list -1 6 -1)) -16752641)
|
||||
(check-expect (point->pos (list -1 5 0)) 20479)
|
||||
|
||||
(define (point-to-pos point)
|
||||
(define (point->pos point)
|
||||
(int64 (+ (point-x point)
|
||||
(* (point-y point) POS_MODULO)
|
||||
(* (point-z point) POS_BIGINT))))
|
||||
|
@ -215,6 +216,4 @@
|
|||
(define (int64 u)
|
||||
(cond [(and (<= u (expt 2 63)) (>= u (* -1 (expt 2 63)))) u]
|
||||
[(>= u (expt 2 63)) (int64 (- u (expt 2 63)))]
|
||||
[else (int64 (+ u (expt 2 63)))]))
|
||||
|
||||
(test)
|
||||
[else (int64 (+ u (expt 2 63)))]))
|
Loading…
Reference in New Issue