├── README.md ├── gopro.rkt ├── home.rkt ├── mafia-multi.rkt ├── office.rkt ├── remote.rkt ├── reversi.rkt ├── shader.rkt ├── spin.rkt ├── text-panels.rkt ├── tour.rkt ├── voice-around.rkt └── vr.rkt /README.md: -------------------------------------------------------------------------------- 1 | 2 | # vrscript-samples 3 | 4 | Some of John Carmack's VR scripts 5 | 6 | These scripts and git history were reconstructed from snippets posted online. 7 | -------------------------------------------------------------------------------- /gopro.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require "vr.rkt") 3 | 4 | 5 | (+shader "board" 6 | 7 | "#version 300 es 8 | uniform highp mat4 Mvpm; 9 | in highp vec4 Position; 10 | layout(location=1) in highp vec2 TexCoord; 11 | out highp vec2 oTexCoord; 12 | void main() 13 | { 14 | oTexCoord = TexCoord; 15 | gl_Position = Mvpm * Position; 16 | } 17 | " 18 | 19 | #;"#version 300 es 20 | in highp vec2 oTexCoord; 21 | uniform highp vec4 UniformColor; 22 | out lowp vec4 out_FragColor; 23 | void main() 24 | { 25 | int x = int( oTexCoord.x * 8.0 ); 26 | int y = int( oTexCoord.y * 8.0 ); 27 | int c = ( x ^ y ) & 1; 28 | out_FragColor = vec4( 0.0, 0.2 + 0.1 * float(c) , 0.0, 1.0); 29 | } 30 | " 31 | 32 | "#version 300 es 33 | in highp vec2 oTexCoord; 34 | out lowp vec4 out_FragColor; 35 | uniform sampler2D Texture0; 36 | void main() 37 | { 38 | out_FragColor = texture( Texture0, oTexCoord ); 39 | }" 40 | 41 | ) 42 | 43 | 44 | ; Returns a name for a geometry that can be drawn. 45 | 46 | (define sensor-width 4096.0) 47 | (define sensor-height 2160.0) 48 | (define corner-half-angle (degrees->radians 80.0)) 49 | (define factor 0.5) 50 | (define corner-length (sqrt (+ (* sensor-width sensor-width) (* sensor-height sensor-height)))) 51 | 52 | 53 | (define (distort dist) 54 | (define d (/ dist corner-length)) ; now in 0.0 to 1.0 range 55 | ; (* corner-half-angle d)) 56 | (* (tan (* factor d)) (* corner-half-angle (/ 1.0 (tan factor))))) 57 | 58 | (define (make-screen) 59 | ; The quads will be evenly spaced by texture coordinate, but the xy vertexes 60 | ; will be undistorted, giving a pincushion look. 61 | (define tess 16) ; number of quads from 0.0 to 1.0 62 | (define axis (+ 1 (* 2 tess))) 63 | (define geo (empty-geo)) 64 | (for-each (lambda (y) 65 | (define fy (/ (- y tess) tess)) 66 | (define sy (* sensor-height fy)) 67 | (for-each (lambda (x) 68 | (define fx (/ (- x tess) tess)) 69 | (define sx (* sensor-width fx)) 70 | (define dist (sqrt (+ (* sx sx) (* sy sy)))) 71 | (define angle (distort dist)) 72 | (if (and (= x tess) (= y tess)) 73 | (geo-add-vertex! geo '(0 0 -1) (list (+ 0.5 (* 0.5 fx)) (+ 0.5 (* -0.5 fy)))) 74 | (geo-add-vertex! geo 75 | (mat4-transform3 (mat4-rotate-z (atan sy sx)) 76 | (vec3 (sin angle) 0.0 (* -1.0 (cos angle)))) 77 | (list (+ 0.5 (* 0.5 fx)) (+ 0.5 (* -0.5 fy)))))) 78 | (iota axis))) 79 | (iota axis)) 80 | (for-each (lambda (y) 81 | (for-each (lambda (x) 82 | (define i (+ x (* y axis))) 83 | (when #t #;(= 0 (bitwise-and 1 (bitwise-xor x y))) 84 | (geo-add-indexes! geo i (+ i 1) (+ i axis 1) i (+ i axis 1) (+ i axis)))) 85 | (iota (- axis 1)))) 86 | (iota (- axis 1))) 87 | 88 | geo) 89 | 90 | (+geometry "screen" (make-screen) "board") 91 | 92 | (define (frame) 93 | (+hud (format "factor:~a angle:~a" factor corner-half-angle)) 94 | (when (pressed-dpad-up) 95 | (set! factor (+ factor 0.1)) 96 | (+geometry "screen" (make-screen) "board")) 97 | (when (pressed-dpad-down) 98 | (set! factor (- factor 0.1)) 99 | (+geometry "screen" (make-screen) "board")) 100 | (when (pressed-dpad-right) 101 | (set! corner-half-angle (+ corner-half-angle 0.1)) 102 | (+geometry "screen" (make-screen) "board")) 103 | (when (pressed-dpad-left) 104 | (set! corner-half-angle (- corner-half-angle 0.1)) 105 | (+geometry "screen" (make-screen) "board")) 106 | 107 | (+set-position (vec3 0.0 0.0 0.0) 0.0) 108 | (+pano "http://s3.amazonaws.com/o.oculuscdn.com/v/test/social/avatars/office_john.JPG") 109 | (+model "screen" 110 | (mat4-scale 90.0) 111 | ; (mat4-translate-z -1.0) 112 | ; (opt-texture "https://s3.amazonaws.com/o.oculuscdn.com/netasset/fisheye.jpg") 113 | (opt-texture "https://s3.amazonaws.com/o.oculuscdn.com/netasset/2k-frame0.jpg") 114 | ) 115 | ; (+quad "https://s3.amazonaws.com/o.oculuscdn.com/netasset/fisheye.jpg" (mat4-translate-z -1.0) ) 116 | 117 | ) 118 | 119 | (vrmain "172.22.52.41" frame) 120 | 121 | -------------------------------------------------------------------------------- /home.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require "vr.rkt") 3 | 4 | ; Data that will be pre-cached before the first frame is rendered. 5 | ; The uri macro defines the name and adds a cache command to the init command list. 6 | (uri WAV-ACTIVATE "http://s3.amazonaws.com/o.oculuscdn.com/netasset/wav/ui_object_activate_01.wav") 7 | 8 | 9 | ;----------------- 10 | ; link-button 11 | ;----------------- 12 | (define (link-button title height yaw target) 13 | (define bounds-trans (mat4-compose (mat4-translate -0.5 -0.3 -0.5) 14 | (mat4-scale/xyz 1.0 0.15 0.15) 15 | (mat4-translate 0.0 height -2.0) 16 | (mat4-rotate-y yaw))) 17 | (define gaze-now (gaze-on-bounds? bounds3-unit bounds-trans)) 18 | 19 | ; Position the text 20 | (+text title 21 | (mat4-compose 22 | (mat4-scale 2.0) 23 | (mat4-translate 0.0 height -2.0) 24 | (mat4-rotate-y yaw)) 25 | (if gaze-now 26 | (opt-parm 1.0 1.0 0.5 1.0) 27 | (opt-parm 0.5 0.5 1.0 1.0))) 28 | 29 | ; if an input click just happened and we are gazing on it, change rooms 30 | (when (and (pressed-action) gaze-now) 31 | (display (format "Going to ~a\n" target)) 32 | (+sound WAV-ACTIVATE) 33 | (+link target))) 34 | 35 | ; returns #f if not found 36 | ; scans forward 37 | (define (first-substring-index string substr) 38 | (define sublen (string-length substr)) 39 | (define stop (- (string-length string) sublen -1)) 40 | (define (scan index) 41 | (cond 42 | ((>= index stop) #f) 43 | ((string=? substr (substring string index (+ index sublen))) index) 44 | (#t (scan (+ 1 index))))) 45 | (scan 0)) 46 | 47 | ; returns #f if not found 48 | ; scans backwards 49 | (define (last-substring-index string substr) 50 | (define sublen (string-length substr)) 51 | (define (scan index) 52 | (cond 53 | ((< index 0) #f) 54 | ((string=? substr (substring string index (+ index sublen))) index) 55 | (#t (scan (- index 1))))) 56 | (scan (- (string-length string) sublen))) 57 | 58 | (define (isScript? s) 59 | (define ind (last-substring-index s ".rkt")) 60 | (and ind (= ind (- (string-length s) 4)))) 61 | 62 | 63 | ; Extract the last path component without the extension. 64 | ; "/subdir/name.tkt" -> "name" 65 | (define (script-label s) 66 | (define last/ (last-substring-index s "/")) 67 | (define last. (last-substring-index s ".")) 68 | (if (and last. last/ (> last. last/)) 69 | (substring s (+ 1 last/) last.) 70 | s)) 71 | 72 | ; Adds vrscript:// at the beginning if no :// is present 73 | (define (script-uri s) 74 | (if (first-substring-index s "://") 75 | s 76 | (string-append "vrscript://" s))) 77 | 78 | (define (main-links y lst) 79 | (unless (null? lst) 80 | (define btn (car lst)) 81 | (link-button (list-ref btn 0) y 0 (list-ref btn 1)) 82 | (main-links (- y 0.2) (cdr lst)))) 83 | 84 | ;----------------- 85 | ; frame function 86 | ;----------------- 87 | (define (frame) 88 | (+pano "http://s3.amazonaws.com/o.oculuscdn.com/v/test/social/avatars/office_lobby.JPG") 89 | 90 | (main-links 0.75 91 | '{ 92 | ("Office Tour" "vrscript://s3.amazonaws.com/o.oculuscdn.com/vrscript0.3/office.rkt") 93 | ("Shader Test" "vrscript://s3.amazonaws.com/o.oculuscdn.com/vrscript0.3/shader.rkt") 94 | ("Fisheye" "vrscript://s3.amazonaws.com/o.oculuscdn.com/vrscript0.3/gopro.rkt") 95 | ("Space Needle" "vrscript://s3.amazonaws.com/o.oculuscdn.com/vrscript0.3/space-needle.rkt") 96 | ("3D Audio" "vrscript://s3.amazonaws.com/o.oculuscdn.com/vrscript0.3/voice-around.rkt") 97 | ("World Tour" "vrscript://s3.amazonaws.com/o.oculuscdn.com/vrscript0.3/tour.rkt") 98 | ("Reversi Game" "vrscript://s3.amazonaws.com/o.oculuscdn.com/vrscript0.3/reversi.rkt") 99 | ; ("Mafia Multi" "vrscript://s3.amazonaws.com/o.oculuscdn.com/netasset/mafia-multi.rkt") 100 | }) 101 | 102 | (+text (format "phone ip: ~a" (init-parm "ip")) 103 | (mat4-compose 104 | (mat4-scale 2.0) 105 | (mat4-translate 0.0 -0.75 -2.0))) 106 | 107 | ; If the contents of the clipboard look like a script, add a link. 108 | ; This is a phone-only way to launch any script you want without needing 109 | ; a web page with a vrscript:// scheme uri or an AppLink. 110 | (let ((scr (init-parm "clipboard"))) 111 | (when (isScript? scr) 112 | (link-button (script-label scr) -1.0 (script-uri scr)))) 113 | 114 | ; Make link buttons for all the .rkt files in the local /sdcard/Oculus/vrscript directory 115 | (let ((lst (init-parm "scripts"))) 116 | (for-each (lambda (ind) 117 | (define lnk (list-ref lst ind)) 118 | (link-button (script-label lnk) 119 | (- 0.75 (* 0.2 ind)) 120 | (* 0.5 -pi/2) 121 | (string-append "file://" lnk))) 122 | (iota (length lst)))) 123 | ) 124 | 125 | ; This connects to the vrscript. 126 | ; Replace the IP address with the value shown on the phone when NetHmd is run for remote 127 | ; debugging, it is ignored for embedded execution. 128 | (vrmain "192.168.1.147" frame) 129 | 130 | -------------------------------------------------------------------------------- /mafia-multi.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require "remote.rkt") 3 | ; Everything up to this mark will be stripped and replaced 4 | ; for the embedded version. 5 | ; %%%END-OF-HEADER%%% 6 | ;---------------------------------------------------------------------------------- 7 | 8 | (uri WAV-LULLABY "http://s3.amazonaws.com/o.oculuscdn.com/netasset/wav/mafia_lullaby.wav") 9 | 10 | ;----------------- 11 | ; These procedures are different in racket/base and in chibi's r7rs, so re-defining them here. 12 | ;----------------- 13 | (define (remov3 obj lst) 14 | (filter (lambda (item) (not (equal? obj item))) lst)) 15 | 16 | (define (remov3* lst1 lst2) 17 | (filter (lambda (obj) (not (member obj lst1))) lst2)) 18 | 19 | (define (empty? lst) (= 0 (length lst))) 20 | 21 | (define (andm4p proc lst) 22 | (empty? (filter (lambda (obj) (not (proc obj))) lst))) 23 | 24 | ;----------------- 25 | ; Server State 26 | ; (game-mode player-state-1 player-state-2 ...) 27 | ; game-mode: symbol, can be one of WAITING, PLAYING, WIN-KILLERS or WIN-VILLAGERS 28 | ; player-state-i: state of a player, see below 29 | ; 30 | ; Player State 31 | ; (id role is-dead is-exiled is-awake) 32 | ; id: integer, player id 33 | ; role: symbol, role assigned to this player (god, killer, angel, detective or villager) 34 | ; is-dead: boolean, means player can't talk but can see everything (doesn't sleep) 35 | ; is-exiled: boolean, means player can't talk but still sleeps/wakes-up 36 | ; is-awake: boolean, means player can see what's happening (as opposed to a black screen when sleeping) 37 | ;----------------- 38 | 39 | (define server-parms '(8 #t "Mafia" "https://s3.amazonaws.com/o.oculuscdn.com/v/test/social/reversi.jpg")) 40 | 41 | ; Local server state for testing 42 | ;(define *local-player-id* 1) 43 | ;(define *local-server-state* (list "WAITING" 44 | ; '(1 "GOD" #f #f #t) 45 | ; '(2 "ANGEL" #f #f #t) 46 | ; '(3 "KILLER" #f #f #t) 47 | ; '(4 "VILLAGER" #f #f #t) 48 | ; '(5 "DETECTIVE" #f #f #t))) 49 | ;(define *local-client-positions* (list (list 1 (make-vec3 0.0 0.0 0.0)) 50 | ; (list 2 (make-vec3 2.0 0.0 -1.5)) 51 | ; (list 3 (make-vec3 2.0 0.0 -3.0)) 52 | ; (list 4 (make-vec3 -2.0 0.0 -3.0)) 53 | ; (list 5 (make-vec3 -2.0 0.0 -1.5)))) 54 | 55 | (set-server-state! (list 'WAITING (list *local-client-id* 'GOD #f #f #t))) 56 | 57 | (define (get-game-mode) (car *server-state*)) 58 | (define (get-player-states) (cdr *server-state*)) 59 | (define (get-player-ids) (map car (get-player-states))) 60 | 61 | (define (get-player-state player-id) (assoc player-id (get-player-states))) 62 | (define (get-player-role player-id) (cadr (get-player-state player-id))) 63 | 64 | (define (is-god? player-id) (eq? 'GOD (get-player-role player-id))) 65 | (define (is-angel? player-id) (eq? 'ANGEL (get-player-role player-id))) 66 | (define (is-killer? player-id) (eq? 'KILLER (get-player-role player-id))) 67 | (define (is-villager? player-id) (eq? 'VILLAGER (get-player-role player-id))) 68 | (define (is-detective? player-id) (eq? 'DETECTIVE (get-player-role player-id))) 69 | 70 | (define (is-dead? player-id) (list-ref (get-player-state player-id) 2)) 71 | (define (is-exiled? player-id) (list-ref (get-player-state player-id) 3)) 72 | (define (is-awake? player-id) (list-ref (get-player-state player-id) 4)) 73 | 74 | (define (set-game-mode! new-mode) 75 | (set-server-state! (cons new-mode (cdr *server-state*)))) 76 | (define (set-player-states! new-states) 77 | (set-server-state! (cons (car *server-state*) new-states))) 78 | (define (set-player-state! new-state) 79 | (define player-id (car new-state)) 80 | (set-player-states! (cons new-state (remov3 (get-player-state player-id) (get-player-states))))) 81 | 82 | (define (set-player-state-value! player-id value-pos new-value) 83 | (set-player-state! (list player-id 84 | (if (= value-pos 1) new-value (get-player-role player-id)) 85 | (if (= value-pos 2) new-value (is-dead? player-id)) 86 | (if (= value-pos 3) new-value (is-exiled? player-id)) 87 | (if (= value-pos 4) new-value (is-awake? player-id))))) 88 | 89 | (define (set-player-role! player-id new-role) (set-player-state-value! player-id 1 new-role)) 90 | 91 | (define (kill-player! player-id) (set-player-state-value! player-id 2 #t)) 92 | (define (awake-player! player-id) (set-player-state-value! player-id 4 #t)) 93 | (define (set-player-dead! player-id v) (set-player-state-value! player-id 2 v)) 94 | (define (set-player-exiled! player-id v) (set-player-state-value! player-id 3 v)) 95 | (define (set-player-awake! player-id v) (set-player-state-value! player-id 4 v)) 96 | 97 | (define (set-everyone-awake!) 98 | (for-each (lambda (player-state) (set-player-awake! (car player-state) #t)) (get-player-states))) 99 | (define (set-everyone-asleep!) 100 | (for-each (lambda (player-state) (set-player-awake! (car player-state) #f)) (get-player-states))) 101 | 102 | (define (reset-player-state! player-id) 103 | (set-player-dead! player-id #f) 104 | (set-player-exiled! player-id #f) 105 | (set-player-awake! player-id #t)) 106 | (define (reset-game!) 107 | (set-game-mode! 'WAITING) 108 | (for-each reset-player-state! (get-player-ids))) 109 | 110 | (define (add-player! player-id) 111 | (set-player-state! (list player-id 'VILLAGER #f #f #t))) 112 | (define (remove-player! player-id) 113 | (set-player-states! (remov3 (get-player-state player-id) (get-player-states)))) 114 | 115 | ; TODO: try to get rid of this 116 | (define *has-started* #f) 117 | (define (start-game!) 118 | (set-game-mode! 'WAITING) 119 | (set-player-states! (list (list *local-client-id* 'GOD #f #f #t)))) 120 | 121 | ;----------------- 122 | ; Util UI components. 123 | ;----------------- 124 | (define (get-rot-y position) 125 | (define player-position (mat4-origin (list->mat4 (client-pose (client-by-id *local-client-id*))))) 126 | (define dx (- (vec3-x position) (vec3-x player-position))) 127 | (define dz (- (vec3-z position) (vec3-z player-position))) 128 | (define rad (atan (/ (abs dz) (abs dx)))) 129 | (define op1 (if (< dx 0) + -)) 130 | (define op2 (if (< dz 0) - +)) 131 | (if (< (abs dx) 0.0001) 0.0 (op1 0.0 (op2 pi/2 rad)))) 132 | 133 | (define (draw-text! text position scale color) 134 | (define rot-y (get-rot-y position)) 135 | (+text text 136 | (mat4-compose (mat4-scale scale) (mat4-rotate-y rot-y) (mat4-translatev position)) 137 | (opt-parmv color))) 138 | 139 | (define (draw-instructions! text) 140 | (draw-text! text (make-vec3 0.0 -0.2 0.0) 2.0 (make-vec4 1.0 1.0 0.5 1.0))) 141 | 142 | ; Draw text on top of player's head 143 | (define (draw-player-text! player-id text height scale color) 144 | ;(define player-position (cadr (assoc player-id *local-client-positions*))) 145 | ; TODO: maybe use seat position instead, so text doesn't move as users look around 146 | (define player-position (mat4-origin (list->mat4 (client-pose (client-by-id player-id))))) 147 | (define text-position (make-vec3 (vec3-x player-position) height (vec3-z player-position))) 148 | (draw-text! text text-position scale color)) 149 | 150 | (define (draw-button! text position is-selected on-click) 151 | (define bounds-trans (mat4-compose (mat4-translate -0.5 -0.3 -0.5) 152 | (mat4-scale/xyz 1.0 0.15 0.15) 153 | (mat4-rotate-y (get-rot-y position)) 154 | (mat4-translatev position))) 155 | 156 | (define gaze-now (gaze-on-bounds? bounds3-unit bounds-trans)) 157 | 158 | ; Highlightable text 159 | (draw-text! text position 2.0 (cond (gaze-now (make-vec4 1.0 1.0 0.5 1.0)) 160 | (is-selected (make-vec4 0.5 1.0 0.5 1.0)) 161 | (else (make-vec4 0.5 0.5 1.0 1.0)))) 162 | 163 | ; Run on-click procedure if button is pressed 164 | (when (and (pressed-action) gaze-now) (on-click))) 165 | 166 | ; Draw button on top of player's head 167 | (define (draw-player-button! player-id text height is-selected on-click) 168 | ;(define player-position (cadr (assoc player-id *local-client-positions*))) 169 | (define player-position (mat4-origin (list->mat4 (client-pose (client-by-id player-id))))) 170 | (define button-position (make-vec3 (vec3-x player-position) height (vec3-z player-position))) 171 | (draw-button! text button-position is-selected on-click)) 172 | 173 | ;----------------- 174 | ; God - Lobby 175 | ; God will need to assign all required roles and start the game. 176 | ;----------------- 177 | (define (draw-role-button! player-id role height) 178 | (draw-player-button! player-id (symbol->string role) height 179 | (eq? role (get-player-role player-id)) 180 | (lambda () (set-player-role! player-id role)))) 181 | 182 | (define (draw-role-buttons! player-id) 183 | (for-each 184 | (lambda (role height) (draw-role-button! player-id role height)) 185 | '(VILLAGER DETECTIVE KILLER ANGEL) '(0.25 0.45 0.65 0.85))) 186 | 187 | (define (draw-start-button!) 188 | (draw-button! "Start Game" (make-vec3 0 -0.5 0) #f (lambda () (set-game-mode! 'PLAYING)))) 189 | 190 | (define (tic-god-waiting) 191 | ; Reset game on first load 192 | (unless *has-started* (start-game!) (set! *has-started* #t)) 193 | 194 | ; Explanation text 195 | (draw-instructions! "You're God!\nSelect players' roles before starting the game.") 196 | 197 | ; Add newcomers to server state 198 | (for-each add-player! (remov3* (get-player-ids) (map client-id *clients*))) 199 | 200 | ; Buttons of role selection on top of players' heads 201 | (for-each 202 | (lambda (player-id) (draw-role-buttons! player-id)) 203 | (remov3 *local-client-id* (get-player-ids))) 204 | 205 | ; Start button. Must have at least one killer to start the game. 206 | ; TODO: actually need to have at least 2 other villagers otherwise killer wins. 207 | (when (not (empty? (filter is-killer? (get-player-ids)))) (draw-start-button!))) 208 | 209 | ;----------------- 210 | ; God - Playing - Day 211 | ; When the day starts, god may announce any deaths that happened during the night (and will need to 212 | ; click the appropriate button to kill that player). At the end of the day, god may also exile a 213 | ; villager (by clicking on the correct button above that player) if the city voted for it. 214 | ;----------------- 215 | (define (draw-kill-button! player-id) 216 | (draw-player-button! player-id "Kill" 0.70 #f (lambda () (kill-player! player-id)))) 217 | 218 | (define (draw-exile-button! player-id) 219 | (draw-player-button! player-id "Exile" 0.50 #f (lambda () (set-player-exiled! player-id #t)))) 220 | 221 | (define (draw-bring-back-button! player-id) 222 | (define (on-click) (set-player-exiled! player-id #f)) 223 | (draw-player-button! player-id "Bring Back" 0.50 #f on-click)) 224 | 225 | ; Villagers win when all killers are dead or exiled 226 | (define (have-villagers-won?) 227 | (andm4p (lambda (player-id) (or (is-dead? player-id) (is-exiled? player-id))) 228 | (filter is-killer? (get-player-ids)))) 229 | 230 | ; Killers win when the number of non-killers is less or equal the number killers 231 | (define (have-killers-won?) 232 | (define active-villagers 233 | (filter (lambda (p) (not (or (is-god? p) (is-dead? p) (is-exiled? p)))) (get-player-ids))) 234 | (<= (length active-villagers) (* 2 (length (filter is-killer? active-villagers))))) 235 | 236 | (define (tic-god-day) 237 | (define villagers (remov3 *local-client-id* (get-player-ids))) 238 | (define alive-villagers (filter (lambda (player-id) (not (is-dead? player-id))) villagers)) 239 | (define exiled-villagers (filter is-exiled? alive-villagers)) 240 | (define non-exiled-villagers (remov3* exiled-villagers alive-villagers)) 241 | 242 | ; Draw Kill button above all alive villagers 243 | (for-each draw-kill-button! alive-villagers) 244 | 245 | ; Draw "Exile" button above all alive non-exiled villagers 246 | (for-each draw-exile-button! non-exiled-villagers) 247 | 248 | ; Draw "Bring Back" above the exiled ones 249 | (for-each draw-bring-back-button! exiled-villagers) 250 | 251 | ; Check end of the game 252 | (cond ((have-killers-won?) (set-game-mode! 'WIN-KILLERS)) 253 | ((have-villagers-won?) (set-game-mode! 'WIN-VILLAGERS))) 254 | 255 | ; Put everyone to sleep when button clicked 256 | (draw-button! "Start Night" (make-vec3 0.0 -0.5 0.0) #f set-everyone-asleep!)) 257 | 258 | ;----------------- 259 | ; God - Playing - Night 260 | ; During the night, god may awake players with special roles to gather their actions. 261 | ;----------------- 262 | (define (draw-awake-button! text height player-ids) 263 | (draw-button! text (make-vec3 0.0 height 0.0) #f (lambda () (for-each awake-player! player-ids)))) 264 | 265 | ; Receives a list of buttons' data containing the button's text and list of players in that role. 266 | ; Recursively draws the buttons, from bottom to top, adjusting the height accordingly. 267 | (define (draw-awake-buttons-rec! buttons-data base-height) 268 | (when (not (empty? buttons-data)) 269 | (let* ((current (car buttons-data)) (current-has-ids (not (empty? (cadr current))))) 270 | (when current-has-ids (draw-awake-button! (car current) base-height (cadr current))) 271 | (draw-awake-buttons-rec! (cdr buttons-data) (+ base-height (if current-has-ids 0.2 0.0)))))) 272 | 273 | (define (draw-awake-buttons! actionable-players) 274 | (define buttons-data (list (list "Awake Detectives" (filter is-detective? actionable-players)) 275 | (list "Awake Angels" (filter is-angel? actionable-players)) 276 | (list "Awake Killers" (filter is-killer? actionable-players)))) 277 | (draw-awake-buttons-rec! buttons-data -0.3)) 278 | 279 | (define (draw-stare! player-id) 280 | (define player-pose (list->mat4 (client-pose (client-by-id player-id)))) 281 | (define origin (mat4-origin player-pose)) 282 | (define forward (mat4-forward player-pose)) 283 | (define x0 (vec3-x origin)) 284 | (define z0 (vec3-z origin)) 285 | (define x1 (+ x0 (vec3-x forward))) 286 | (define z1 (+ z0 (vec3-z forward))) 287 | (define a (+ (* (- x1 x0) (- x1 x0)) (* (- z1 z0) (- z1 z0)))) 288 | (define b (* 2 (+ (* x0 (- x1 x0)) (* z0 (- z1 z0))))) 289 | (define c (- (+ (* x0 x0) (* z0 z0)) 4)) 290 | (define delta (- (* b b) (* 4 (* a c)))) 291 | (define t (/ (+ (- b) (sqrt delta)) (* 2 a))) 292 | (define xf (+ x0 (* t (vec3-x forward)))) 293 | (define zf (+ z0 (* t (vec3-z forward)))) 294 | (define position (make-vec3 xf -0.7 zf)) 295 | (define bounds-trans (mat4-compose (mat4-scale/xyz 0.5 0.9 0.5) 296 | (mat4-translatev position))) 297 | (+model "_bounds" bounds-trans (opt-parm 1.0 0.0 0.0 1.0))) 298 | 299 | (define (tic-god-night) 300 | ; Players who can awake: not a villager, not dead and not exiled 301 | (define actionable-players 302 | (filter (lambda (p) (not (or (is-dead? p) (is-exiled? p) (is-villager? p)))) 303 | (remov3 *local-client-id* (get-player-ids)))) 304 | 305 | ; If there are awaken players, only show "Put to Sleep" button. 306 | ; Otherwise show buttons to awake specific roles. 307 | (if (> (length (filter is-awake? actionable-players)) 0) 308 | (begin 309 | (for-each draw-stare! (filter is-awake? actionable-players)) 310 | (draw-button! "Put to Sleep" (make-vec3 0.0 -0.5 0.0) #f set-everyone-asleep!)) 311 | (begin 312 | (draw-awake-buttons! actionable-players) 313 | (draw-button! "Start Day" (make-vec3 0.0 -0.5 0.0) #f set-everyone-awake!)))) 314 | 315 | ;----------------- 316 | ; God - Playing 317 | ; God can see players' roles and act on players' states depending on the time of the day. 318 | ;----------------- 319 | (define (draw-player-role! player-id) 320 | (draw-player-text! player-id (get-player-role player-id) 0.35 1.5 (make-vec4 1. 1. 1. 1.))) 321 | 322 | (define (tic-god-playing) 323 | ; Draw players' roles 324 | (for-each draw-player-role! (remov3 *local-client-id* (get-player-ids))) 325 | 326 | ; Check whether it's day (everyone awake) or night 327 | (if (andm4p is-awake? (get-player-ids)) (tic-god-day) (tic-god-night))) 328 | 329 | ;----------------- 330 | ; Humans - Lobby 331 | ; Not really much to do while waiting for other players or waiting for God to assign roles. 332 | ;----------------- 333 | (define (tic-human-waiting) (draw-instructions! "Waiting for other players..")) 334 | 335 | ;----------------- 336 | ; Humans - Playing 337 | ; Dead players can't talk, but can see everything. 338 | ; Exiled players can't talk, but sleep as usual. 339 | ; While asleep, players can't see. 340 | ;----------------- 341 | ; TODO: add some stars, use +geometry to make it a globe 342 | (+shader "nightsky" 343 | " 344 | uniform highp mat4 Mvpm; 345 | attribute highp vec4 Position; 346 | void main() 347 | { 348 | gl_Position = Mvpm * Position; 349 | } 350 | " 351 | " 352 | void main() 353 | { 354 | gl_FragColor = vec4(vec3(0.0), 1.0); 355 | } 356 | ") 357 | 358 | (define (draw-sleep-box-wall! sx sy rx ry tx ty tz) 359 | ; TODO: Grrrr 360 | (define seat-num (- (length *client-seats*) (length (member *local-client-id* *client-seats*)))) 361 | (define angle (+ (if (odd? seat-num) pi 0) 362 | (* (quotient seat-num 2) (/ pi*2 (length *client-seats*))))) 363 | (+quad "_background" (mat4-compose (mat4-translate -0.5 -0.5 0.0) 364 | (mat4-scale/xyz sx sy 0) 365 | (mat4-rotate-x rx) 366 | (mat4-rotate-y ry) 367 | (mat4-translate tx ty tz) 368 | (mat4-rotate-y angle)) 369 | (opt-shader "nightsky"))) 370 | 371 | (define (draw-sleep-box!) 372 | (draw-sleep-box-wall! 6.0 2.0 0.0 (* -10 pi/180) 0.0 0.0 0.8) ; Right 373 | (draw-sleep-box-wall! 6.0 2.0 0.0 (* 10 pi/180) 0.0 0.0 -0.8) ; Left 374 | (draw-sleep-box-wall! 6.0 2.0 pi/2 0.0 0.0 0.5 0.0) ; Up 375 | (draw-sleep-box-wall! 6.0 2.0 pi/2 0.0 0.0 -0.5 0.0) ; Down 376 | (draw-sleep-box-wall! 2.0 1.0 0.0 pi/2 0.5 0.0 0.0) ; Front 377 | (draw-sleep-box-wall! 1.0 1.0 0.0 pi/2 -2.4 0.0 0.0)) ; Back 378 | 379 | (define (tic-human-playing) 380 | (unless *has-started* (set! *has-started* #t)) 381 | 382 | ; Show player's role 383 | (draw-instructions! 384 | (format "\n\nYou are a: ~a" (symbol->string (get-player-role *local-client-id*)))) 385 | 386 | ; Player states 387 | (if (is-dead? *local-client-id*) 388 | ; Dead player 389 | (draw-instructions! "You're dead and can't talk!") 390 | 391 | ; Alive 392 | (begin 393 | 394 | ; Exiled player can't talk. TODO: mute player 395 | (when (is-exiled? *local-client-id*) (draw-instructions! "You're exiled and can't talk!")) 396 | 397 | ; Sleeping player can't see 398 | (when (not (is-awake? *local-client-id*)) 399 | (draw-sleep-box!) 400 | (draw-instructions! "\nYou're sleeping!"))))) 401 | 402 | ;----------------- 403 | ; 404 | ;----------------- 405 | (define (tic-god) 406 | ; Remove from the server state the players who have quit 407 | (for-each 408 | (lambda (player-id) (when (not (client-by-id player-id)) (remove-player! player-id))) 409 | (get-player-ids)) 410 | 411 | (cond ((eq? 'WAITING (get-game-mode)) (tic-god-waiting)) 412 | ((eq? 'PLAYING (get-game-mode)) (tic-god-playing)) 413 | (else (draw-button! "Restart Game" (make-vec3 0 -0.5 0) #f reset-game!)))) 414 | 415 | (define (tic-human) 416 | (if (eq? 'WAITING (get-game-mode)) (tic-human-waiting) (tic-human-playing))) 417 | 418 | ;----------------- 419 | ; tic 420 | ; 421 | ;----------------- 422 | (define (draw-player-status! player-id) 423 | (define status (cond ((is-god? player-id) "(God)") 424 | ((is-dead? player-id) "(Dead)") 425 | ((is-exiled? player-id) "(Exiled)") 426 | (else #f))) 427 | (when status (draw-player-text! player-id status 0.25 1.0 (make-vec4 1.0 1.0 1.0 1.0)))) 428 | 429 | (define (draw-share-server-button!) 430 | (define (on-click) (apply +share-server server-parms)) 431 | (draw-button! "Share Server" (make-vec3 0.0 -0.25 -2.0) #f on-click)) 432 | 433 | ; Position players in a circle. Seat #1 is opposite to seat #0, #3 is opposite to #2 and so on. 434 | (define (set-player-position!) 435 | (define seat-num (- (length *client-seats*) (length (member *local-client-id* *client-seats*)))) 436 | (define angle (+ (if (odd? seat-num) pi 0) 437 | (* (quotient seat-num 2) (/ pi*2 (length *client-seats*))))) 438 | (+set-position (make-vec3 (- (* 2 (cos angle))) 0.0 (* 2 (sin angle))) (- angle pi/2))) 439 | 440 | (define (tic-connected) 441 | ; Print end of the game 442 | (cond ((eq? 'WIN-KILLERS (get-game-mode)) (draw-instructions! "\nKillers won!")) 443 | ((eq? 'WIN-VILLAGERS (get-game-mode)) (draw-instructions! "\nVillagers won!"))) 444 | 445 | ; Position player in a circle 446 | (set-player-position!) 447 | 448 | ; Player-specific logic 449 | (if (controlling-client?) (tic-god) (tic-human)) 450 | 451 | ; Draw players' status (exiled/dead) 452 | (when *has-started* (for-each draw-player-status! (remov3 *local-client-id* (get-player-ids))))) 453 | 454 | (define (tic) 455 | ; Draw the environment 456 | (+pano "http://s3.amazonaws.com/ovr-360/photos/OTOY_May/16055_9C31448B-E5C2-4269-BC98-49B1F4A8D5B3_pano.jpg") 457 | 458 | ; Start server if it hasn't started yet. 459 | (if social? (tic-connected) (draw-share-server-button!))) 460 | 461 | ; We need to define an init function to guarantee that the message 462 | ; containing the results of all top-level code executed during 463 | ; startup get processed before the first (tic) call. 464 | (define (init init-parms) 465 | ;(reset-game!) 466 | (display (format "(init ~a)\n" init-parms))) 467 | 468 | ; This connects to the HMD over TCP when run from DrRacket, and is ignored when embedded. 469 | ; Replace the IP address with the value shown on the phone when NetHmd is run. 470 | ; The init function is optional, use #f if not defined. 471 | (remote "172.24.251.163" #f tic server-parms) -------------------------------------------------------------------------------- /office.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require "vr.rkt") 3 | 4 | ; mutable state 5 | (define *room* 'lobby) 6 | (define *info-visible* #f) 7 | 8 | ; Data that will be pre-cached before the first frame is rendered. 9 | ; The uri macro defines the name and adds a cache command to the init command list. 10 | (uri WAV-ACTIVATE "http://s3.amazonaws.com/o.oculuscdn.com/netasset/wav/ui_object_activate_01.wav") 11 | (uri WAV-VOICE-TEST "http://s3.amazonaws.com/o.oculuscdn.com/netasset/wav/mono_human_voice_test_01b.wav") 12 | (uri PIC-SPEAKER "http://www.socnazlavalette.com/Speaker.jpg") 13 | (uri PIC-TEXT "http://t1.ftcdn.net/jpg/00/21/27/24/400_F_21272487_XfD7kRAOOJG91jvjMh0atLRgg7I4kKg7.jpg") 14 | 15 | ;----------------- 16 | ; gaze-button 17 | ; 18 | ; Draws the button and tests for gaze, returns true if it was clicked on. 19 | ;----------------- 20 | (define (gaze-button xform pic-off pic-on pic-activate) 21 | (define gaze-now (gaze-on-bounds? bounds3-unit xform)) 22 | (+quad (cond 23 | ((and gaze-now (held-action)) pic-activate) 24 | (gaze-now pic-on) 25 | (else pic-off)) 26 | xform 27 | (if gaze-now 28 | (opt-parm 1.0 1.0 0.5 1.0) 29 | (opt-parm 1.0 1.0 1.0 1.0))) 30 | (and (pressed-action) gaze-now)) 31 | 32 | 33 | (define (button-xform degree-angle) 34 | (mat4-compose 35 | (mat4-translate -0.5 -0.5 -0.5) 36 | (mat4-scale/xyz 0.2 0.2 0.01) 37 | (mat4-translate 0.0 0.75 -2.0) 38 | (mat4-rotate-y (degrees->radians degree-angle)))) 39 | 40 | ;----------------- 41 | ; speaker-button 42 | ; Audio annotation button. 43 | ;----------------- 44 | (define (speaker-button degree-angle wav) 45 | (define bounds-trans (button-xform degree-angle)) 46 | (cond ((gaze-button 47 | bounds-trans 48 | PIC-SPEAKER PIC-SPEAKER PIC-SPEAKER) 49 | (+stop-sounds) 50 | (+sound wav (opt-position (mat4-origin bounds-trans)))))) 51 | 52 | ;----------------- 53 | ; text-panel 54 | ; 55 | ; Draw a panel of text. 56 | ;----------------- 57 | (define (count-newlines txt) 58 | (define (cnd index so-far) 59 | (cond 60 | ((= index -1) so-far) 61 | (#t (cnd (- index 1) (if (eq? (string-ref txt index) #\newline) (+ 1 so-far) so-far))))) 62 | (cnd (- (string-length txt) 1) 0)) 63 | 64 | ; Draw a normal blended quad with the background color, then draw a non-blended quad with the 65 | ; alpha mask to enable the signed distance field TimeWarp filter. 66 | (define (text-panel text degree-angle) 67 | (define lines (+ 1.0 (count-newlines text))) 68 | ; normal blended-edge quad that always writes alpha = 1 69 | (+quad "_background" 70 | (mat4-compose (mat4-translate -0.5 -0.5 0.0) 71 | (mat4-scale 1.4) 72 | (mat4-scale/xyz 1.35 (+ 0.1 (* 0.072 lines)) 0.0) 73 | (mat4-translate 0.0 0.0 -3.1) 74 | (mat4-rotate-y (degrees->radians degree-angle)) ) 75 | (opt-parm 0.1 0.1 0.1 1.0) 76 | (opt-blend-ext GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA GL_ONE GL_ONE GL_FUNC_ADD GL_FUNC_ADD) 77 | 'depth-mask) 78 | ; text will blend on top 79 | (+text-ext text TEXT_HORIZONTAL_CENTER TEXT_VERTICAL_CENTER 80 | (mat4-compose (mat4-scale 1.4) (mat4-translate 0.0 0.0 -2.95) (mat4-rotate-y (degrees->radians degree-angle)) ))) 81 | 82 | ;----------------- 83 | ; text-button 84 | ; 85 | ; Text annotation button. 86 | ;----------------- 87 | (define (text-button text degree-angle) 88 | (cond ((gaze-button 89 | (button-xform degree-angle) 90 | PIC-TEXT PIC-TEXT PIC-TEXT) 91 | (set! *info-visible* (not *info-visible*)) 92 | (+sound WAV-ACTIVATE))) 93 | (cond (*info-visible* (text-panel text degree-angle)))) 94 | 95 | ;----------------- 96 | ; floor-tag 97 | ; Primary navigation tool. 98 | ;----------------- 99 | (define (floor-tag title deg room) 100 | (define bounds-trans (mat4-compose (mat4-translate -0.5 -0.5 -0.5) 101 | (mat4-scale/xyz 1.0 0.25 0.25) 102 | (mat4-translate 0.0 -1.0 -2.0) 103 | (mat4-rotate-y (degrees->radians deg)))) 104 | (define gaze-now (gaze-on-bounds? bounds3-unit bounds-trans)) 105 | 106 | ; Position the text 107 | (+text title 108 | (mat4-compose 109 | (mat4-scale 2.0) 110 | (mat4-translate 0.0 -1.0 -2.0) 111 | (mat4-rotate-y (degrees->radians deg))) 112 | (if gaze-now 113 | (opt-parm 1.0 1.0 0.5 1.0) 114 | (opt-parm 1.0 1.0 1.0 1.0))) 115 | 116 | ; if an input click just happened and we are gazing on it, change rooms 117 | (when (and (pressed-action) gaze-now) 118 | (display (format "Changing to room ~a\n" room)) 119 | (+stop-sounds) 120 | (+sound WAV-ACTIVATE) 121 | (set! *room* room))) 122 | 123 | ;----------------- 124 | ; frame function 125 | ;----------------- 126 | (define (frame) 127 | ; per-room actions 128 | (cond 129 | ((eq? *room* 'lobby) 130 | (+pano "http://s3.amazonaws.com/o.oculuscdn.com/v/test/social/avatars/office_lobby.JPG") 131 | (floor-tag "John's Office" 20.0 'john-office) 132 | (floor-tag "Demo Room" -40.0 'demo-room) 133 | (text-button 134 | "Alan Kay has famously described Lisp as 135 | the \"Maxwell's equations of software\". 136 | He describes the revelation he 137 | experienced when, as a graduate student, 138 | he was studying the LISP 1.5 139 | Programmer's Manual and realized that 140 | \"the half page of code on the bottom of 141 | page 13... was Lisp in itself. These 142 | were \"Maxwell's Equations of Software!\" 143 | This is the whole world of programming 144 | in a few lines that I can put my hand 145 | over.\"" 146 | 40.0) 147 | (speaker-button 0.0 WAV-VOICE-TEST)) 148 | 149 | ((eq? *room* 'john-office) 150 | (+pano "http://s3.amazonaws.com/o.oculuscdn.com/v/test/social/avatars/office_john.JPG") 151 | (floor-tag "Lobby" 160.0 'lobby)) 152 | 153 | ((eq? *room* 'demo-room) 154 | (+pano "http://s3.amazonaws.com/o.oculuscdn.com/v/test/social/avatars/office_demo.JPG") 155 | (floor-tag "Lobby" 45.0 'lobby))) 156 | ) 157 | 158 | 159 | (vrmain "192.168.1.147" frame) 160 | 161 | -------------------------------------------------------------------------------- /remote.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require racket/tcp) 3 | (require racket/port) 4 | (require "vr.rkt") 5 | (require ffi/unsafe) 6 | 7 | ; Try to provide everything that the scripts will use, 8 | ; to reduce boilerplate code at the top. 9 | (provide remote 10 | (all-from-out "vr.rkt") 11 | ) 12 | 13 | ; from http://macrologist.blogspot.com/2012/03/avoid-flushing-your-wire-protocols.html 14 | (define IPPROTO_TCP 6) 15 | (define TCP_NODELAY 1) 16 | 17 | (define setsockopt_tcp_nodelay 18 | (get-ffi-obj "setsockopt" #f 19 | (_fun (socket enabled?) :: 20 | (socket : _int) 21 | (_int = IPPROTO_TCP) 22 | (_int = TCP_NODELAY) 23 | (enabled-ptr : (_ptr i _int) 24 | = (if enabled? 1 0)) 25 | (_int = (compiler-sizeof 'int)) 26 | -> (result : _int) 27 | -> (if (zero? result) 28 | (void) 29 | (error 'set-tcp-nodelay! "failed"))))) 30 | 31 | (define scheme_get_port_socket 32 | (get-ffi-obj "scheme_get_port_socket" #f 33 | (_fun (port) :: 34 | (port : _racket) 35 | (socket : (_ptr o _intptr)) 36 | -> (result : _int) 37 | -> (and (positive? result) socket)))) 38 | 39 | ; set-tcp-nodelay! : tcp-port boolean -> void 40 | (define (set-tcp-nodelay! port enabled?) 41 | (let ([socket (scheme_get_port_socket port)]) 42 | (setsockopt_tcp_nodelay socket enabled?))) 43 | 44 | ;-------------------------------------- 45 | ; main loop 46 | ;-------------------------------------- 47 | 48 | (define target-phone-port 8008) 49 | 50 | (define (loop2 in out tic) 51 | ; block until a byte is available 52 | ; (define evt (peek-bytes-evt 1 0 #f in)) 53 | ; (define start (current-inexact-milliseconds)) 54 | ; (sleep 0.008) 55 | ; (sync evt) 56 | ; (define end (current-inexact-milliseconds)) 57 | ; (printf "blocked ~a ms\n" (- end start)) 58 | 59 | ; read an entire s-expression 60 | (define sexp (read in)) 61 | (write (tic-wrap tic sexp) out) 62 | (flush-output out) 63 | (loop2 in out tic)) 64 | 65 | ; Interactively loop for the HMD 66 | ; 67 | ; The parms s-expression is sent to the target ip-address to 68 | ; allow it to be configured for multiplayer development. 69 | ; 70 | ; For local execution on the phone, the ip-address is forced to "localhost" 71 | (define (remote/parms parms ip-address init tic) 72 | ; If the ports are set to completely unbuffered, each object in a printf 73 | ; winds up in a separate message and on a separate logcat line, which we 74 | ; do not want. 75 | ; (file-stream-buffer-mode (current-output-port) 'none) 76 | ; (file-stream-buffer-mode (current-error-port) 'none) 77 | ; On Mac, we don't seem to be able to change buffering on the output port 78 | ; (file-stream-buffer-mode (current-output-port) 'line) 79 | ; (file-stream-buffer-mode (current-error-port) 'line) 80 | 81 | (define cust (make-custodian)) 82 | (parameterize ([current-custodian cust]) 83 | (printf "connecting\n") 84 | (define-values (in out) (tcp-connect ip-address target-phone-port)) 85 | (set-tcp-nodelay! out #t) 86 | ; (file-stream-buffer-mode out 'none) 87 | (file-stream-buffer-mode out 'block) 88 | (printf "Write configuration: ~a\n" parms ) 89 | (write parms out) 90 | (flush-output out) 91 | 92 | (printf "read init-parms\n") 93 | (define init-parms (read in)) 94 | 95 | (printf "run init\n") 96 | (define init-out (init-wrap init init-parms)) 97 | 98 | (printf "write init-out\n") 99 | (write init-out out) 100 | (flush-output out) 101 | 102 | (printf "\nlooping\n") 103 | (loop2 in out tic) 104 | (close-input-port in) 105 | (close-output-port out))) 106 | 107 | ; Start a remote session, optionally with server-parms 108 | (define (remote ip-address frame . opts) 109 | (printf "(system-type 'os) -> ~a\n" (system-type 'os)) 110 | ; server parms are empty unless both init and server parms are specified 111 | (define server-parms 112 | (if (= (length opts) 2) 113 | (append (list 'server) (list-ref opts 1) (list (sexpr->string *server-state*))) 114 | '())) 115 | (define init 116 | (if (>= (length opts) 1) 117 | (list-ref opts 0) 118 | #f)) 119 | (remote/parms server-parms ip-address init frame)) 120 | -------------------------------------------------------------------------------- /reversi.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require "vr.rkt") 3 | ; Export the identifiers needed for simultanious social development. 4 | (provide init frame server-parms) 5 | 6 | (uri scene-model "https://s3.amazonaws.com/ovr-vrscript-public/assets/scenes/space_room_game.ovrscene") 7 | 8 | (uri WAV-ACTIVATE "http://s3.amazonaws.com/o.oculuscdn.com/netasset/wav/ui_object_activate_01.wav") 9 | ; TODO: get a wav for this 10 | (uri WAV-BAD-MOVE "https://s3.amazonaws.com/o.oculuscdn.com/netasset/wav/bad_move.wav") 11 | 12 | ; To allow social parameters to be set up the same way for both user-invoked and 13 | ; remote development invoked, the parameters are defined here, and passed in 14 | ; both places. 15 | ; ( max-players shutdown-on-empty title icon ) 16 | (define server-parms '(4 #t "Reversi" "https://s3.amazonaws.com/o.oculuscdn.com/v/test/social/reversi.jpg")) 17 | 18 | 19 | ;--------------- multi player ----------------- 20 | 21 | ; Support two players and two spectators. 22 | ; 23 | ; The server state is: 24 | ; #( move-number board-list ) 25 | ; 26 | ; The seats are: 27 | ; ( black-client-id white-client-id spec1-id spec2-id 0 0 0 0 ) 28 | ; 29 | ; The client state is: 30 | ; #( move-number x y ) 31 | ; 32 | ; Server move-number starts at 2 and monotonically increases. It is not reset when 33 | ; the board is cleared, otherwise the first move could be unintentionally repeated. 34 | ; 35 | ; Client move-numebr starts at 0. If the server move-number is even, black can move. 36 | ; If odd, white can move. A move is selected by setting the client move-number to the 37 | ; server move-number and setting x and y. 38 | ; 39 | ; When the server sees the current black/white client has a move-number equal to the 40 | ; server move-number, the move is applied and it changes to the next move-number. 41 | ; 42 | ; The server controls who is in the white and black chairs and each spectator spot. 43 | ; 44 | ; This default server state will be set during load and returned by the (init) function, 45 | ; so there should always be valid state for (tic). 46 | ; 47 | ; Social script processing does not start until the first server state message is received from 48 | ; the packet server. This will always include a server-state, which always replaces the 49 | ; server-state returned by init. 50 | ; 51 | ; Should there be a way to run a script as social without starting out single user? 52 | ; No, we wouldn't have a way to give the packet server an initial server-state. 53 | ; 54 | ; The first time a client runs a script tic will define their client-state. The controlling 55 | ; client cannot directly change any client-state but their own, they can only signal in 56 | ; server-state that clients should make their own changes. 57 | ; 58 | ; Client-state is information that all other clients can use to render the player. 59 | ; 60 | ; When a script is initially started for social applications there will only be a single 61 | ; client, the controlling one. 62 | ; 63 | ; Default seat assignment is handled by the system, but the controlling client can swap 64 | ; seats for any reason. 65 | ; 66 | ; Never acknowledge the existence of clients that the controlling-client has not acknowledged 67 | ; the existence of. 68 | ; 69 | ; Client asks the master server to join a server. 70 | ; Master server adds the client to the server's client list and responds with a packet server 71 | ; address and apk to launch. 72 | ; Client apk starts up HeadNet and waits for a server message from the packet server. 73 | ; If server message says they are the controlling client, (init) and (tic) scripts can be started. 74 | ; If server message says they are not the controlling client, they must wait until their client-id 75 | ; is recognized by the controlling client. 76 | ; A client will be recognized by the controlling client when it shows up in the seat array. 77 | 78 | ; This needs to be valid for reset-game! to work. 79 | (set-server-state! (vector 2 (make-vector 64 0))) 80 | 81 | (define (ss-black-id) (seat-get 0)) 82 | (define (ss-white-id) (seat-get 1)) 83 | (define (ss-spec1-id) (seat-get 2)) 84 | (define (ss-spec2-id) (seat-get 3)) 85 | 86 | (define (ss-move-number) (vector-ref *server-state* 0)) 87 | (define (ss-board-vector) (vector-ref *server-state* 1)) 88 | 89 | ; Only the server can perform these actions, but the results will be 90 | ; propagated to all clients. 91 | (define (ss-move-number! move-num) (vector-set! *server-state* 0 move-num)) 92 | (define (ss-board-vector! vec) (vector-set! *server-state* 1 vec)) 93 | 94 | (define (set-black-id! cid) (seat-set! 0 cid)) 95 | (define (set-white-id! cid) (seat-set! 1 cid)) 96 | (define (set-spec1-id! cid) (seat-set! 2 cid)) 97 | (define (set-spec2-id! cid) (seat-set! 3 cid)) 98 | 99 | ;-------------------------------------------------------- 100 | 101 | ; This default value will always be applied before the first (frame), 102 | ; then it can be modified at will, and it will be communicated to the 103 | ; other clients. 104 | (set-local-client-state! (vector 0 0 0)) 105 | 106 | (define (cs-move-number cl) 107 | (vector-ref (client-state cl) 0)) 108 | 109 | (define (cs-move-x cl) 110 | (vector-ref (client-state cl) 1)) 111 | 112 | (define (cs-move-y cl) 113 | (vector-ref (client-state cl) 2)) 114 | 115 | ; If (ss-move-number) == *last-move-number* + 1, we can 116 | ; animate to the current server-state. If it is more 117 | ; divergent, the server state should be accepted without 118 | ; change. 119 | (define *last-move-number* 0) 120 | 121 | ; When a client chooses a move, set the client state 122 | ; so the server will apply it. 123 | (define (set-move! x y) 124 | (set-local-client-state! (vector (ss-move-number) x y))) 125 | 126 | 127 | ;-------------------------------------------------------- 128 | 129 | ; The board will hold these values, or 0 for an empty spot. 130 | (define player-black 1) 131 | (define player-white 2) 132 | (define (current-player) 133 | (+ 1 (remainder (ss-move-number) 2))) 134 | 135 | ; It will never be a spectator's turn. 136 | ; Note that a single client-id can play both sides. 137 | (define (my-turn?) 138 | (define move (remainder (ss-move-number) 2)) 139 | (or 140 | (and (= 0 move) 141 | (= (ss-black-id) *local-client-id*)) 142 | (and (= 1 move) 143 | (= (ss-white-id) *local-client-id*)))) 144 | 145 | (define (reset-game!) 146 | (clear-board!) 147 | ; The server move number must be bumped to an even number, but 148 | ; should stay monotonically increasing. 149 | (set-server-state! (vector (+ (ss-move-number) (remainder (ss-move-number) 2)) *board*)) 150 | (printf "reset server state: ~a\n" *server-state* )) 151 | 152 | ; If the player who's turn it is has set a move, apply it and 153 | ; go to the next move. 154 | (define (apply-new-moves!) 155 | (define black-client (client-by-id (ss-black-id))) 156 | (define white-client (client-by-id (ss-white-id))) 157 | (define move (remainder (ss-move-number) 2)) 158 | (define (move-client cl pl) 159 | (place (cs-move-x cl) (cs-move-y cl) pl) 160 | (ss-move-number! (+ 1 (ss-move-number)))) 161 | (cond 162 | ((and (= move 0) black-client (= (cs-move-number black-client) (ss-move-number))) 163 | (move-client black-client player-black)) 164 | ((and (= move 1) white-client (= (cs-move-number white-client) (ss-move-number))) 165 | (move-client white-client player-white)))) 166 | 167 | ;--------------- reversi rules ----------------- 168 | 169 | ; board value 0 = empty, 1 = black, 2 = white 170 | (define *board* (make-vector 64 0)) 171 | 172 | (define (board-get x y) 173 | (vector-ref *board* (+ (* y 8) x))) 174 | 175 | (define (board-set! x y c) 176 | (vector-set! *board* (+ (* y 8) x) c)) 177 | 178 | ; Debug printing tool 179 | (define (board) 180 | (define (row y) 181 | (for-each (lambda (x) (display (board-get x y))) (iota 8)) 182 | (newline)) 183 | (for-each row (iota 8))) 184 | 185 | (define (clear-board!) 186 | (set! *board* (make-vector 64 0)) 187 | (board-set! 3 3 1) 188 | (board-set! 4 4 1) 189 | (board-set! 3 4 2) 190 | (board-set! 4 3 2)) 191 | 192 | ; place a color and capture in all directions 193 | (define (place x y c) 194 | (define take (if (= c 1) 2 1)) ; the color we can capture 195 | (define (scan-start dx dy) 196 | (define (flip fx fy) 197 | (cond 198 | ((and (= fx x) (= fy y)) #f) ; back to the start point 199 | (else (board-set! fx fy c) ; take it and continue flipping back 200 | (flip (- fx dx) (- fy dy))))) 201 | (define (scan sx sy) 202 | (cond 203 | ((not (and (< -1 sx 8) (< -1 sy 8))) #f) ; off the edge, didn't find a match 204 | ((= c (board-get sx sy)) (flip (- sx dx) (- sy dy))) ; we can take this, continue checking 205 | ((not (= take (board-get sx sy))) #f) ; hit a spot that isn't our take color 206 | (else (scan (+ sx dx) (+ sy dy))))) ; this may be flipable, keep looking 207 | (scan (+ x dx) (+ y dy))) 208 | (display (format "place: ~a ~a\n" x y)) 209 | (board-set! x y c) 210 | (scan-start 1 0) 211 | (scan-start 0 1) 212 | (scan-start -1 0) 213 | (scan-start 0 -1) 214 | (scan-start 1 1) 215 | (scan-start 1 -1) 216 | (scan-start -1 1) 217 | (scan-start -1 -1) 218 | ; Put the updated board vector back into the server-state list 219 | (ss-board-vector! *board*)) 220 | 221 | ; A move is only legal if it is to an empty space and it 222 | ; would result in at least one flip. 223 | (define (legal? x y c) 224 | (define take (if (= c 1) 2 1)) ; the color we can capture 225 | (define (scan-start dx dy) 226 | (define (flip fx fy) 227 | (cond 228 | ((and (= fx x) (= fy y)) #f) ; back to the start point 229 | (else #t))) ; an actual capture, the move is legal 230 | (define (scan sx sy) 231 | (cond 232 | ((not (and (< -1 sx 8) (< -1 sy 8))) #f) ; off the edge, didn't find a match 233 | ((= c (board-get sx sy)) (flip (- sx dx) (- sy dy))) ; we can take this, continue checking 234 | ((not (= take (board-get sx sy))) #f) ; hit a spot that isn't our take color 235 | (else (scan (+ sx dx) (+ sy dy))))) ; this may be flipable, keep looking 236 | (scan (+ x dx) (+ y dy))) 237 | (cond 238 | ((> (board-get x y) 0) #f) ; something else already there 239 | (#t (or (scan-start 1 0) 240 | (scan-start 0 1) 241 | (scan-start -1 0) 242 | (scan-start 0 -1) 243 | (scan-start 1 1) 244 | (scan-start 1 -1) 245 | (scan-start -1 1) 246 | (scan-start -1 -1))))) 247 | 248 | ;--------------- Computer play ---------------------- 249 | 250 | (define *computer-state* 0) 251 | 252 | (define (computer-move player) 253 | (define x (quotient *computer-state* 8)) 254 | (define y (remainder *computer-state* 8)) 255 | (set! *computer-state* (+ 1 *computer-state*)) 256 | (place x y player)) 257 | 258 | ;--------------- Procedural Board shaders ---------------------- 259 | 260 | ; encode the board 4 rows in each float 261 | (define (board-bits test b stop val) 262 | (if (= b stop) 263 | val 264 | (if (= test (vector-ref *board* b)) 265 | (board-bits test (- b 1) stop (+ (* 2 val) 1)) 266 | (board-bits test (- b 1) stop (* 2 val))))) 267 | 268 | (define (board->vec4 test) 269 | (vec4 (board-bits test 15 -1 0) 270 | (board-bits test 31 15 0) 271 | (board-bits test 47 31 0) 272 | (board-bits test 63 47 0))) 273 | 274 | 275 | (define board-vertex-shader 276 | "#version 300 es 277 | uniform highp mat4 Mvpm; 278 | in highp vec4 Position; 279 | in highp vec2 TexCoord; 280 | out highp vec2 oTexCoord; 281 | void main() 282 | { 283 | oTexCoord = TexCoord; 284 | gl_Position = Mvpm * Position; 285 | } 286 | ") 287 | 288 | (+shader "board" board-vertex-shader 289 | 290 | "#version 300 es 291 | in highp vec2 oTexCoord; 292 | uniform highp vec4 UniformColor; 293 | out lowp vec4 out_FragColor; 294 | void main() 295 | { 296 | int x = int( oTexCoord.x * 8.0 ); 297 | int y = int( oTexCoord.y * 8.0 ); 298 | int c = ( x ^ y ) & 1; 299 | out_FragColor = vec4( 0.0, 0.2 + 0.1 * float(c) , 0.0, 1.0); 300 | } 301 | ") 302 | 303 | (+shader "disc-white" board-vertex-shader 304 | "#version 300 es 305 | in highp vec2 oTexCoord; 306 | uniform highp vec4 UniformColor; 307 | out lowp vec4 out_FragColor; 308 | void main() 309 | { 310 | int x = int( oTexCoord.x * 8.0 ); 311 | int y = int( oTexCoord.y * 8.0 ); 312 | highp int isSet; 313 | if ( y < 2) isSet = int(UniformColor.x); 314 | else if ( y < 4) isSet = int(UniformColor.y); 315 | else if ( y < 6) isSet = int(UniformColor.z); 316 | else isSet = int(UniformColor.w); 317 | y &= 3; 318 | int bit = (1 << ((y<<3) + x)); 319 | mediump vec2 p = fract( oTexCoord * 8.0 ) - 0.5; 320 | mediump float dist = length( p ); 321 | mediump float on = (dist < 0.4) ? 1.0 : 0.0; 322 | if ( ((isSet & bit) > 0) && dist < 0.4 ) 323 | out_FragColor = vec4( 1.0, 1.0, 1.0, 1.0 ); 324 | else 325 | out_FragColor = vec4( 0.0, 0.0, 0.0, 0.0 ); 326 | } 327 | ") 328 | 329 | (+shader "disc-black" board-vertex-shader 330 | "#version 300 es 331 | in highp vec2 oTexCoord; 332 | uniform highp vec4 UniformColor; 333 | out lowp vec4 out_FragColor; 334 | void main() 335 | { 336 | int x = int( oTexCoord.x * 8.0 ); 337 | int y = int( oTexCoord.y * 8.0 ); 338 | highp int isSet; 339 | if ( y < 2) isSet = int(UniformColor.x); 340 | else if ( y < 4) isSet = int(UniformColor.y); 341 | else if ( y < 6) isSet = int(UniformColor.z); 342 | else isSet = int(UniformColor.w); 343 | y &= 3; 344 | int bit = (1 << ((y<<3) + x)); 345 | mediump vec2 p = fract( oTexCoord * 8.0 ) - 0.5; 346 | mediump float dist = length( p ); 347 | mediump float on = (dist < 0.4) ? 1.0 : 0.0; 348 | if ( ((isSet & bit) > 0) && dist < 0.4 ) 349 | out_FragColor = vec4( 0.0, 0.0, 0.0, 1.0 ); 350 | else 351 | out_FragColor = vec4( 0.0, 0.0, 0.0, 0.0 ); 352 | } 353 | ") 354 | 355 | 356 | (+shader "cursor" board-vertex-shader 357 | "#version 300 es 358 | in highp vec2 oTexCoord; 359 | uniform highp vec4 UniformColor; 360 | out lowp vec4 out_FragColor; 361 | void main() 362 | { 363 | mediump float d = length(oTexCoord - UniformColor.xy); 364 | int x = int( oTexCoord.x * 8.0 ); 365 | int y = int( oTexCoord.y * 8.0 ); 366 | int c = ( x ^ y ) & 1; 367 | if ( d < 0.02 ) 368 | out_FragColor = vec4( UniformColor.z, UniformColor.z, UniformColor.z, 1.0); 369 | else 370 | out_FragColor = vec4( 0.0, 0.0, 0.0, 0.0); 371 | } 372 | ") 373 | 374 | ;---------------------------------------------------------- 375 | 376 | (define *client-yaw* 0.0) 377 | 378 | ;----------------- 379 | ; text-button 380 | ; 381 | ; Position it 45 degree to the right of the primary view direction 382 | ;----------------- 383 | (define (text-button title height) 384 | (define bounds-trans (mat4-compose (mat4-translate -0.5 -0.3 -0.5) 385 | (mat4-scale/xyz 1.0 0.15 0.15) 386 | (mat4-translate 0.0 height -2.0) 387 | (mat4-rotate-y (- *client-yaw* (* 0.25 pi))))) 388 | (define gaze-now (gaze-on-bounds? bounds3-unit bounds-trans)) 389 | 390 | ; Position the text 391 | (+text title 392 | (mat4-compose 393 | (mat4-scale 2.0) 394 | (mat4-translate 0.0 height -2.0) 395 | (mat4-rotate-y (- *client-yaw* (* 0.25 pi)))) 396 | (if gaze-now 397 | (opt-parm 1.0 1.0 0.5 1.0) 398 | (opt-parm 0.5 0.5 1.0 1.0))) 399 | 400 | ; if an input click just happened and we are gazing on it, change rooms 401 | (if (and (pressed-action) gaze-now) 402 | (begin 403 | (+sound WAV-ACTIVATE) 404 | #t) 405 | #f) 406 | ) 407 | 408 | ;---------------------------------------------------------- 409 | 410 | ; If one of the main player slots is open, 411 | ; take a spectator if available. 412 | (define (choose-players!) 413 | (when (= 0 (ss-black-id)) 414 | (if (= 0 (ss-spec1-id)) 415 | (swap-seats! 0 3) 416 | (swap-seats! 0 2))) 417 | (when (= 0 (ss-white-id)) 418 | (if (= 0 (ss-spec1-id)) 419 | (swap-seats! 1 3) 420 | (swap-seats! 1 2)))) 421 | 422 | ; Swap the black and white players. 423 | (define (swap-sides!) 424 | (swap-seats! 0 1)) 425 | 426 | ; Swaps the white player for the next higher client-id that isn't 427 | ; the white player. 428 | (define (change-player!) 429 | (if (or 430 | (> (ss-spec1-id) (ss-white-id) (ss-spec2-id)) 431 | (> (ss-spec2-id) (ss-spec1-id) (ss-white-id)) 432 | (> (ss-white-id) (ss-spec2-id) (ss-spec1-id))) 433 | (swap-seats! 1 2) 434 | (swap-seats! 1 3))) 435 | 436 | ;---------------------------------------------------------- 437 | 438 | ; Board location centered at the origin, some distance below 0 y 439 | (define board-xform (mat4-compose (mat4-translate -0.5 -0.5 0.0) 440 | (mat4-scale 0.5) 441 | (mat4-rotate-x pi/2) 442 | (mat4-translate 0.0 -0.5 0.0) )) 443 | (define black-edge-xform (mat4-compose (mat4-translate -0.5 -0.5 0.0) 444 | (mat4-scale/xyz 0.5 0.125 0.0) 445 | (mat4-rotate-x pi/2) 446 | (mat4-translate 0.0 -0.5 0.3125) )) 447 | (define white-edge-xform (mat4-compose (mat4-translate -0.5 -0.5 0.0) 448 | (mat4-scale/xyz 0.5 0.125 0.0) 449 | (mat4-rotate-x pi/2) 450 | (mat4-translate 0.0 -0.5 -0.3125) )) 451 | (define black-text-xform (mat4-compose 452 | (mat4-rotate-x -pi/2) 453 | (mat4-translate 0.0 -0.5 0.33) )) 454 | (define white-text-xform (mat4-compose 455 | (mat4-rotate-x -pi/2) 456 | (mat4-rotate-y pi) 457 | (mat4-translate 0.0 -0.5 -0.33) )) 458 | 459 | ; The black and white players have fixed positions. 460 | ; The remaining players are sorted by client id number into 461 | ; the spectator spots. 462 | (define (set-position) 463 | (cond 464 | ((= *local-client-id* (ss-black-id)) 465 | (set! *client-yaw* 0.0) 466 | (+set-position (vec3 0.0 0.0 0.9) *client-yaw*)) 467 | ((= *local-client-id* (ss-white-id)) 468 | (set! *client-yaw* pi) 469 | (+set-position (vec3 0.0 0.0 -0.9) *client-yaw*)) 470 | ((= *local-client-id* (ss-spec1-id)) 471 | (set! *client-yaw* pi*3/2) 472 | (+set-position (vec3 -0.9 0.0 0.0) *client-yaw*)) 473 | ((= *local-client-id* (ss-spec2-id)) 474 | (set! *client-yaw* (- pi*3/2)) 475 | (+set-position (vec3 -0.9 0.0 0.0) *client-yaw*)) 476 | (#t (printf "Client-id ~a not in seat list\n" *local-client-id*)))) 477 | 478 | 479 | ;----------------- 480 | ; frame 481 | ; 482 | ;----------------- 483 | (define (frame) 484 | ; (printf "tic start server state: ~a\n" *server-state* ) 485 | 486 | ; Only perform server-state related tasks on the controlling client. 487 | (when (controlling-client?) 488 | ; If the current player has decided on a move, apply it 489 | ; and switch to the other player. 490 | (apply-new-moves!) 491 | 492 | ; Draw the UI buttons off to the side 493 | (when (and (not social?) 494 | (text-button "Share Server" 0.25)) 495 | (apply +share-server server-parms)) 496 | 497 | (when (text-button "Swap Sides" 0.0) 498 | (swap-sides!)) 499 | 500 | ; only allow change-player if more than 2 clients 501 | (when (and (> (length *clients*) 2) 502 | (text-button "Change Player" 0.25)) 503 | (change-player!)) 504 | 505 | ; Restart game valid at any time 506 | (when (text-button "Restart Game" -0.25) 507 | (reset-game!)) 508 | 509 | ; Reorganize the players if necessary. 510 | (choose-players!)) 511 | 512 | ; Set our view/avatar position based on where our client-id is in the server state. 513 | (set-position) 514 | 515 | ; Find the spot on the board the local client is looking at. 516 | (define spot (intersect-line-texture (mat4-origin *pose-inverse*) (mat4-forward *pose-inverse*) board-xform)) 517 | 518 | ; Reference the board out of server-state. 519 | (set! *board* (ss-board-vector)) 520 | 521 | ; Allow a play command to be set for this client if it is our turn 522 | ; and we have clicked on the board. 523 | ; We don't actually apply the move, just set it in our client-state, 524 | ; so the controlling-client (which may not be us) can apply it 525 | ; next tic. 526 | (when (and (my-turn?) 527 | (pressed-action) 528 | (< 0.0 (vec3-x spot) 1.0) 529 | (< 0.0 (vec3-y spot) 1.0)) 530 | (let ( (x (floor->exact (* 8 (vec3-x spot)))) 531 | (y (floor->exact (* 8 (vec3-y spot)))) ) 532 | (if (legal? x y (current-player)) 533 | (set-move! x y) 534 | (+sound WAV-BAD-MOVE)))) 535 | 536 | ; If a move was just made in the server state, play a sound 537 | (when (= (+ 1 *last-move-number*) (ss-move-number)) 538 | (+sound WAV-ACTIVATE)) 539 | (set! *last-move-number* (ss-move-number)) 540 | 541 | ; draw the environment 542 | (+model scene-model mat4-identity) 543 | ; (+pano "http://s3.amazonaws.com/o.oculuscdn.com/v/test/social/avatars/office_demo.JPG") 544 | 545 | ; draw the move-cursor on the board if it is the local client's turn 546 | (+quad "_white" 547 | board-xform 548 | 'depth-mask 549 | (opt-shader "board")) 550 | (+quad "_white" 551 | board-xform 552 | 'depth-mask 553 | (opt-parmv (board->vec4 player-white)) 554 | (opt-shader "disc-white")) 555 | (+quad "_white" 556 | board-xform 557 | 'depth-mask 558 | (opt-parmv (board->vec4 player-black)) 559 | (opt-shader "disc-black")) 560 | (when (my-turn?) 561 | (+quad "_white" 562 | board-xform 563 | 'depth-mask 564 | (opt-parm (vec3-x spot) 565 | (vec3-y spot) 566 | (if (= (current-player) player-black) 0.2 0.8) 567 | 0.0) 568 | (opt-shader "cursor"))) 569 | 570 | ; black edge 571 | (+quad "_white" 572 | black-edge-xform 573 | 'depth-mask 574 | (opt-parm 0.0 0.0 0.0 1.0)) 575 | ; white edge 576 | (+quad "_white" 577 | white-edge-xform 578 | 'depth-mask) 579 | 580 | ; Piece counts 581 | (define (count-pieces p) 582 | (define board (ss-board-vector)) 583 | (define (cv x total) 584 | (cond 585 | ((= x 64) total) 586 | ((= (vector-ref board x) p) (cv (+ 1 x) (+ 1 total))) 587 | (#t (cv (+ 1 x) total)))) 588 | (cv 0 0)) 589 | (+text (format "White:~a Black:~a" (count-pieces player-white) (count-pieces player-black)) 590 | (mat4-compose (mat4-rotate-y -pi/2) (mat4-translate 0.5 -0.3 0.0))) 591 | 592 | (+text "Your Move" 593 | (if (= 0 (remainder (ss-move-number) 2)) 594 | black-text-xform 595 | white-text-xform) 596 | (opt-parm 0.5 0.5 0.5 1.0)) 597 | 598 | ) 599 | 600 | ; We need to define an init function to guarantee that the message 601 | ; containing the results of all top-level code executed during 602 | ; startup get processed before the first (tic) call. 603 | (define (init init-parms) 604 | (set-black-id! *local-client-id*) 605 | (reset-game!) 606 | (display (format "(init ~a)\n" init-parms))) 607 | 608 | ; This connects to the HMD over TCP when run from DrRacket, and is ignored when embedded. 609 | ; Replace the IP address with the value shown on the phone when vrscript is run. 610 | ; 611 | ; If there is an optional server-parms parameter after tic, VrScript will 612 | ; attempt to connect to that social server, starting it if it doesn't exist. 613 | ; 614 | ; Other users can connect via social or an explicit intent, but they will be using the 615 | ; script downloaded from the net, which may be different than what is being run over TCP. 616 | ; 617 | ; IMPORTANT: *server-state* must have been initialized to something 618 | ; valid by top level function calls before remote is invoked, so it can be 619 | (reset-game!) 620 | 621 | ; To allow running multiple remote social instances at once, comment out 622 | ; the normal (remote ...) call, then create a separate file for each target phone 623 | ; with the following lines: 624 | ; 625 | ;#lang racket/base 626 | ;(require "reversi.rkt") 627 | ;(require "vr.rkt") 628 | ;(vrmain "172.22.52.41" frame init server-parms) 629 | ;(vrmain "172.22.52.94" frame init server-parms) 630 | 631 | 632 | (vrmain "172.22.52.41" frame init #;server-parms) 633 | -------------------------------------------------------------------------------- /shader.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require "vr.rkt") 3 | 4 | 5 | ; Shaders can be defined at any time, then referenced with a shader parm on a surface. 6 | (+shader "testshader" 7 | " 8 | uniform highp mat4 Mvpm; 9 | attribute highp vec4 Position; 10 | attribute highp vec2 TexCoord; 11 | varying highp vec2 oTexCoord; 12 | void main() 13 | { 14 | oTexCoord = TexCoord; 15 | gl_Position = Mvpm * Position; 16 | } 17 | " 18 | ; https://www.shadertoy.com/view/ldBGRR 19 | " 20 | varying highp vec2 oTexCoord; 21 | uniform highp vec4 UniformColor; 22 | void main() 23 | { 24 | highp vec2 p = -1.0 + 2.0 * oTexCoord.xy; 25 | highp float iGlobalTime = UniformColor.x; 26 | // main code, *original shader by: 'Plasma' by Viktor Korsun (2011) 27 | highp float x = p.x; 28 | highp float y = p.y; 29 | highp float mov0 = x+y+cos(sin(iGlobalTime)*2.0)*100.+sin(x/100.)*1000.; 30 | highp float mov1 = y / 0.9 + iGlobalTime; 31 | highp float mov2 = x / 0.2; 32 | highp float c1 = abs(sin(mov1+iGlobalTime)/2.+mov2/2.-mov1-mov2+iGlobalTime); 33 | highp float c2 = abs(sin(c1+sin(mov0/1000.+iGlobalTime)+sin(y/40.+iGlobalTime)+sin((x+y)/100.)*3.)); 34 | highp float c3 = abs(sin(c2+cos(mov1+mov2+c2)+cos(mov2)+sin(x/1000.))); 35 | gl_FragColor = vec4(c1,c2,c3,1); 36 | } 37 | ") 38 | 39 | (define (frame) 40 | (+pano "http://s3.amazonaws.com/o.oculuscdn.com/v/test/social/avatars/office_john.JPG") 41 | (+quad "_white" 42 | (mat4-translate -0.5 -0.45 -2.0) 43 | (opt-parm (input-time *input*) 0.0 0.5 0.0) 44 | (opt-shader "testshader"))) 45 | 46 | (vrmain "172.22.52.41" frame) 47 | -------------------------------------------------------------------------------- /spin.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require "remote.rkt") 3 | ; Everything up to this mark will be stripped and replaced 4 | ; for the embedded version. 5 | ; %%%END-OF-HEADER%%% 6 | ;---------------------------------------------------------------------------------- 7 | 8 | (define *tex* 0) 9 | 10 | (define textures 11 | '("file:///sdcard/temp/basketball.tga" 12 | "file:///sdcard/temp/volleyball.tga" 13 | "file:///sdcard/temp/baseball.tga")) 14 | 15 | ;----------------- 16 | ; tic function 17 | ;----------------- 18 | (define (tic) 19 | ; select a background 20 | (+pano "http://s3.amazonaws.com/o.oculuscdn.com/v/test/social/avatars/office_lobby.JPG") 21 | 22 | ; user swapping of texture 23 | (if (pressed-action) 24 | (set! *tex* (remainder (+ 1 *tex*) 3)) 25 | #f) 26 | 27 | ; spin a model in front of the view 28 | ; (cmd-model! "https://s3.amazonaws.com/o.oculuscdn.com/netasset/ball.ovrscene" 29 | (+model "http://s3.amazonaws.com/o.oculuscdn.com/v/test/social/avatars/head-0.ovrscene" 30 | (mat4-compose (mat4-rotate-y (input-time *input*)) 31 | (mat4-translate 0.0 0.0 -1.0)) 32 | ; (opt-texture (list-ref textures *tex*)) 33 | ) 34 | 35 | ; add a text label 36 | ) 37 | 38 | ; This connects to the HMD over TCP when run from DrRacket, and is ignored when embedded. 39 | ; Replace the IP address with the value shown on the phone when vrscript is run. 40 | ; The init function is optional, use #f if not defined. 41 | (remote "172.22.52.94" #f tic) 42 | ;(remote "172.22.52.248" #f tic) 43 | 44 | -------------------------------------------------------------------------------- /text-panels.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require "remote.rkt") 3 | ; Everything up to this mark will be stripped and replaced 4 | ; for the embedded version. 5 | ; %%%END-OF-HEADER%%% 6 | ;---------------------------------------------------------------------------------- 7 | 8 | ;----------------- 9 | ; text-panel 10 | ; Bring up a panel of text. 11 | ;----------------- 12 | (define (count-newlines txt) 13 | (define (cnd index so-far) 14 | (cond 15 | ((= index -1) so-far) 16 | (#t (cnd (- index 1) (if (eq? (string-ref txt index) #\newline) (+ 1 so-far) so-far))))) 17 | (cnd (- (string-length txt) 1) 0)) 18 | 19 | ; Draw a normal blended quad with the background color, then draw a non-blended quad with the 20 | ; alpha mask to enable the signed distance field TimeWarp filter. 21 | (define (text-panel txt degree-angle) 22 | (define lines (+ 1.0 (count-newlines txt))) 23 | ; normal blended-edge quad that always writes alpha = 1 24 | (+quad "_background" 25 | (mat4-compose (mat4-translate -0.5 -0.5 0.0) 26 | (mat4-scale 1.4) 27 | (mat4-scale/xyz 1.35 (+ 0.1 (* 0.072 lines)) 0.0) 28 | (mat4-translate 0.0 0.0 -3.1) 29 | (mat4-rotate-y (degrees->radians degree-angle)) ) 30 | (opt-parm 0.0 0.0 0.0 1.0) 31 | (opt-blend-ext GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA GL_ONE GL_ONE GL_FUNC_ADD GL_FUNC_ADD) 32 | 'depth-mask) 33 | ; slightly smaller non-blended mask 34 | (+quad "_white" 35 | (mat4-compose (mat4-translate -0.5 -0.5 0.0) 36 | (mat4-scale 1.4) 37 | (mat4-scale/xyz 1.3 (+ 0.05 (* 0.072 lines)) 0.0) 38 | (mat4-translate 0.0 0.0 -3.1) 39 | (mat4-rotate-y (degrees->radians degree-angle)) ) 40 | (opt-parm 0.0 0.0 0.0 0.0) 41 | (opt-blend-ext GL_ONE GL_ZERO GL_ONE GL_ZERO GL_FUNC_ADD GL_FUNC_ADD) 42 | 'depth-mask) 43 | ; text will blend on top 44 | (+text-ext txt TEXT_HORIZONTAL_CENTER TEXT_VERTICAL_CENTER 45 | (mat4-compose (mat4-scale 1.4) (mat4-translate 0.0 0.0 -2.95) (mat4-rotate-y (degrees->radians degree-angle)) ))) 46 | 47 | 48 | ;----------------- 49 | ; tic function 50 | ;----------------- 51 | (define (tic) 52 | ; background 53 | (+pano "http://s3.amazonaws.com/o.oculuscdn.com/v/test/social/avatars/office_lobby.JPG") 54 | 55 | ; text panels 56 | (text-panel 57 | "Asynchronous resource load options: 58 | 1: Freeze time while loading, allow the 59 | current frame to re-render. 60 | 2: Force a fade-out, allowing the current 61 | frame to re-render in freeze-time. 62 | 3: Ignore commands with unloaded assets" 63 | -50.0) 64 | 65 | (text-panel 66 | "Available only in the fragment shader, 67 | these functions return the partial 68 | derivative of expression p with respect 69 | to the window x coordinate (for dFdx*) 70 | and y coordinate (for dFdy*). 71 | 72 | dFdxFine and dFdyFine calculate 73 | derivatives using local differencing 74 | based on on the value of p for the 75 | current fragment and its immediate 76 | neighbor(s). 77 | 78 | dFdxCoarse and dFdyCoarse calculate 79 | derivatives using local differencing 80 | based on the value of p for the current 81 | fragment's neighbors, and will 82 | possibly, but not necessarily, include 83 | the value for the current fragment. 84 | That is, over a given area, the 85 | implementation can compute derivatives 86 | in fewer unique locations than would be 87 | allowed for the corresponding dFdxFine 88 | and dFdyFine functions." 89 | 0.0) 90 | 91 | (text-panel 92 | "Alan Kay has famously described Lisp as 93 | the \"Maxwell's equations of software\". 94 | He describes the revelation he 95 | experienced when, as a graduate student, 96 | he was studying the LISP 1.5 97 | Programmer's Manual and realized that 98 | \"the half page of code on the bottom of 99 | page 13... was Lisp in itself. These 100 | were \"Maxwell's Equations of Software!\" 101 | This is the whole world of programming 102 | in a few lines that I can put my hand 103 | over.\"" 104 | 50.0) 105 | 106 | ; done 107 | ) 108 | 109 | ; This connects to the HMD over TCP when run from DrRacket, and is ignored when embedded. 110 | ; Replace the IP address with the value shown on the phone when vrscript is run. 111 | ; The init function is optional, use #f if not defined. 112 | (remote "172.22.52.94" #f tic) 113 | -------------------------------------------------------------------------------- /tour.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require "vr.rkt") 3 | 4 | ; local mutable state for animations and transitions from server states 5 | (define *swipe-anim-dir* 0.0) ; yaw degrees of view to place the swipe anim 6 | (define *current-scene* -1) ; determine that the server has transitioned 7 | (define *current-destination* -1) 8 | 9 | ; When the scene transitions, all the uri needed for the new scene will be fetched. 10 | (define *fetch-gather* #f) 11 | (define *fetch-uri* '()) 12 | 13 | (define *transition-time* -100.0) ; time when *current-scene* finished fetching data 14 | 15 | ;----------------------------------------------------- 16 | ; Social 17 | ; 18 | ; Server state: 19 | ; #( destination scene cmd-num pic-visible ) 20 | ; 21 | (define (ss-destination) (vector-ref *server-state* 0)) 22 | (define (ss-scene) (vector-ref *server-state* 1)) 23 | (define (ss-cmd-num) (vector-ref *server-state* 2)) 24 | (define (ss-pic-visible) (vector-ref *server-state* 3)) 25 | 26 | (define (ss-destination! x) (vector-set! *server-state* 0 x)) 27 | (define (ss-scene! x) (vector-set! *server-state* 1 x)) 28 | (define (ss-cmd-num! x) (vector-set! *server-state* 2 x)) 29 | (define (ss-pic-visible! x) (vector-set! *server-state* 3 x)) 30 | 31 | 32 | ; initial server state: 33 | (set-server-state! (vector 0 0 0 "")) 34 | 35 | ; The server will execute the client commands, changing server-state. 36 | (define (client-command! cmd parm) 37 | (set-local-client-state! (vector (+ 1 (ss-cmd-num)) cmd parm))) 38 | 39 | ; initial client state: 40 | (set-local-client-state! (vector 0 1 #f #f)) 41 | 42 | 43 | ; To allow social parameters to be set up the same way for both user-invoked and 44 | ; remote development invoked, the parameters are defined here, and passed in 45 | ; both places. 46 | ; ( max-players shutdown-on-empty title icon ) 47 | (define server-parms '(3 #t "VR Tour" "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/tour.png")) 48 | 49 | ; Data that will be pre-cached before the first frame is rendered. 50 | ; The uri macro defines the name and adds a cache command to the init command list. 51 | (uri flightboard_main "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/Models/flightboard_main.ovrscene") 52 | (uri WAV-ACTIVATE "http://s3.amazonaws.com/o.oculuscdn.com/netasset/wav/ui_object_activate_01.wav") 53 | 54 | 55 | ;----------------- 56 | ; departure-button 57 | ; 58 | ; Tha airport destination buttons in two columns 59 | ;----------------- 60 | (define (departure-button title slot) 61 | (define xtrans (if (<= slot 5) -1.1 0.11)) 62 | (define ytrans (- 0.8 (* (remainder slot 6) 0.14))) 63 | (define bounds-trans (mat4-compose (mat4-translate 0.0 -0.3 -0.5) 64 | (mat4-scale/xyz 1.0 0.12 0.01) 65 | (mat4-translate xtrans ytrans -2.0))) 66 | (define gaze-now (gaze-on-bounds? bounds3-unit bounds-trans)) 67 | 68 | ; Position the text 69 | (+text-ext title TEXT_HORIZONTAL_LEFT TEXT_VERTICAL_BASELINE 70 | (mat4-compose 71 | (mat4-scale 1.8) 72 | (mat4-translate xtrans ytrans -2.0)) 73 | (if gaze-now 74 | (opt-parm 1.0 1.0 0.5 1.0) 75 | (opt-parm 1.0 1.0 1.0 1.0))) 76 | 77 | ; if an input click just happened and we are gazing on it, return true 78 | (if (and (pressed-action) gaze-now) 79 | (begin 80 | (+sound WAV-ACTIVATE) 81 | #t) 82 | #f) 83 | ) 84 | 85 | (define (departure-button-list lst) 86 | (for-each (lambda (index) 87 | (define db (list-ref lst index)) 88 | (define title (list-ref db 0)) 89 | (define pic-list (list-ref db 1)) 90 | (when (departure-button title index) 91 | (client-command! 'destination (+ 1 index)))) 92 | (iota (length lst)))) 93 | 94 | (define (share-button) 95 | (if social? 96 | (departure-button "Open for social!" 11) 97 | (when (departure-button "Share Server" 11) 98 | (apply +share-server server-parms)))) 99 | 100 | ;---------------------- 101 | ; set-position 102 | ; 103 | ; Seat all the clients relative to each other. 104 | ;---------------------- 105 | (define (set-position) 106 | (cond 107 | ((= *local-client-id* (seat-get 0)) (+set-position (vec3 0.0 0.0 0.0) 0.0)) 108 | ((= *local-client-id* (seat-get 1)) (+set-position (vec3 -0.5 0.0 0.0) 0.0)) 109 | ((= *local-client-id* (seat-get 2)) (+set-position (vec3 0.5 0.0 0.0) 0.0)) 110 | (#t (printf "Client-id ~a not in seat list\n" *local-client-id*)))) 111 | 112 | ;---------------------- 113 | ; execute-client-commands! 114 | ;---------------------- 115 | (define (set-scene! dest scene) 116 | (ss-pic-visible! "") 117 | (ss-destination! dest) 118 | (ss-scene! scene)) 119 | 120 | (define (execute-client-commands! cl) 121 | (define clstate (client-state cl)) 122 | (define movenum (vector-ref clstate 0)) 123 | (define cmd (vector-ref clstate 1)) 124 | (define parm (vector-ref clstate 2)) 125 | (when (> movenum (ss-cmd-num)) 126 | (ss-cmd-num! movenum) 127 | (cond 128 | ((eq? cmd 'next) 129 | (printf "exec Swipe-forward\n") 130 | (when (not (= (ss-destination) dest-airport)) 131 | (let ((num-scenes (length (list-ref *pic-list* (ss-destination))))) 132 | (if (= (ss-scene) (- num-scenes 1)) 133 | (set-scene! dest-airport 0) 134 | (set-scene! (ss-destination) (+ 1 (ss-scene))))))) 135 | 136 | ((eq? cmd 'prev) 137 | (printf "exec Swipe-back\n") 138 | (when (not (= (ss-destination) dest-airport)) 139 | (if (= (ss-scene) 0) 140 | (set-scene! dest-airport 0) 141 | (set-scene! (ss-destination) (- (ss-scene) 1))))) 142 | 143 | ((eq? cmd 'destination) 144 | (printf "exec destination\n") 145 | (set-scene! parm 0)) 146 | 147 | ((eq? cmd 'pic) 148 | (printf "exec pic\n") 149 | (ss-pic-visible! parm)) 150 | 151 | )) 152 | ) 153 | 154 | (define (match dest scene) (and (= (ss-destination) dest) (= (ss-scene) scene))) 155 | 156 | ;---------------------- 157 | ; (time-sound wav volume yaw-position) 158 | ; 159 | ; Start a wav file a certain number of seconds after changing to this scene 160 | ; An optional volume can scale the sound. 161 | ; An optional yaw-degrees will spatialize the sound (can't be a stereo sample!). 162 | ;---------------------- 163 | (define (time-sound time wav . options) 164 | ; add this to the fetch-list for preloading on scene transition 165 | (when *fetch-gather* 166 | (set! *fetch-uri* (cons wav *fetch-uri*))) 167 | 168 | (define volume (if (> (length options) 0) 169 | (list-ref options 0) 170 | 1.0)) 171 | (when (crossed-seconds (+ time *transition-time*)) 172 | (if (> (length options) 1) 173 | (+sound wav 174 | (opt-position (vec3 175 | (- 0.0 (sin (degrees->radians (list-ref options 1)))) 176 | 0.0 177 | (- 0.0 (cos (degrees->radians (list-ref options 1)))))) 178 | (opt-volume volume)) 179 | (+sound wav (opt-volume volume))))) 180 | 181 | ;---------------------- 182 | ; background sound will be looped 183 | ;---------------------- 184 | (define (background-sound wav . options) 185 | ; add this to the fetch-list for preloading on scene transition 186 | (when *fetch-gather* 187 | (set! *fetch-uri* (cons wav *fetch-uri*))) 188 | 189 | (define volume (if (> (length options) 0) 190 | (list-ref options 0) 191 | 1.0)) 192 | (when (crossed-seconds (+ 0.01 *transition-time*)) 193 | (+sound wav 'loop (opt-volume volume)))) 194 | 195 | 196 | ; Return the yaw degrees of the current view. 197 | ; You can get a quick display for tuning parms with (+hud (floor (view-yaw))) 198 | (define (view-yaw) 199 | (define fwd (mat4-forward *pose-inverse*)) 200 | (radians->degrees (atan (- 0.0 (vec3-x fwd)) (- 0.0 (vec3-z fwd))))) 201 | 202 | ; Convenience function for 2D images - given the width and height of the 203 | ; original image in pixels, it will be centered and scaled to natural 204 | ; resolution, modified by the floating point s scale value. 205 | (define (mat4-pic-scale w h s) 206 | (mat4-translate -0.5 -0.5 -0.5) 207 | (mat4-scale/xyz (* 0.001 w) (* 0.001 h) 1)) 208 | 209 | ; Given a 0.0 to 1.0 range, ramp the return value 210 | ; from 0.0 to 1.0 in the first 10%, then back down to 0.0 211 | ; in the last 10%. 212 | (define (fade-in-out f) 213 | (cond 214 | ((< f 0.1) (* 10.0 f)) 215 | ((> f 0.9) (* 10.0 (- 1.0 f))) 216 | (#t 1.0))) 217 | 218 | ;----------------- 219 | ; animate the swipe icon if the user has 220 | ; been sitting at the same scene for a long time. 221 | ;----------------- 222 | (uri headset-uri "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/2d/demo_headset.png") 223 | (uri swipe-arrow-uri "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/2d/SwipeSuggestionArrowRight.png") 224 | 225 | (define (swipe-anim first-time) 226 | (define repeat-time 10.0) 227 | (define anim-time 3.0) 228 | (when (and (> (- *script-seconds* *transition-time* ) first-time) (not (= (ss-destination) dest-airport))) 229 | (let* ( (cycle (/ (- *script-seconds* *transition-time* first-time) repeat-time)) 230 | (prev-cycle (/ (- *prev-script-seconds* *transition-time* first-time) repeat-time)) 231 | (cycle-frac (- cycle (floor cycle))) 232 | (anim-frac (* (/ repeat-time anim-time) cycle-frac )) ) 233 | ; at the crossing time, get the current view direction 234 | (when (not (= (floor prev-cycle) (floor cycle))) 235 | (set! *swipe-anim-dir* (view-yaw)) 236 | (printf "*swipe-anim-dir* ~a\n" *swipe-anim-dir*)) 237 | (when (< 0.0 anim-frac 1.0) 238 | (let ((anim (* 0.1 (- *script-seconds* (floor *script-seconds*)))) 239 | (fade (fade-in-out anim-frac))) 240 | (+quad headset-uri 241 | (mat4-compose 242 | (mat4-pic-scale 489 259 0.1) 243 | (mat4-translate 0.0 -0.75 -1.8) 244 | (mat4-rotate-y (degrees->radians *swipe-anim-dir*))) 245 | (opt-parm 1.0 1.0 1.0 fade)) 246 | (+quad swipe-arrow-uri 247 | (mat4-compose 248 | (mat4-pic-scale 20 35 0.1) 249 | (mat4-translate (+ 0.1 anim) -0.65 -1.79) 250 | (mat4-rotate-y (degrees->radians *swipe-anim-dir*))) 251 | (opt-parm 1.0 1.0 1.0 fade)) 252 | ))))) 253 | 254 | ; Given two degree mesurements that might include 255 | ; negative or > 360.0 values, return the distance 256 | ; between them in the 0.0 to 180.0 range. 257 | (define (delta-degrees x y) 258 | (define (fremainder v d) 259 | (- v (* d (floor (/ v d))))) 260 | (define z (fremainder (abs (- x y)) 360.0)) 261 | (if (> z 180.0) 262 | (- 360.0 z) 263 | z)) 264 | 265 | 266 | ;----------------- 267 | ; pic-button-yaw-pitch 268 | ; 269 | ; Place a single pic-button at the given yaw and pitch, then 270 | ; center the image if active. 271 | ;----------------- 272 | (uri pic-button-uri "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/2d/K+ghost+view.png") 273 | (uri pic-mini-button-uri "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/2d/point.png") 274 | 275 | (define (pic-button-yaw-pitch yaw-degrees pitch-degrees pic-def) 276 | ; add this to the fetch-list for preloading on scene transition 277 | (when *fetch-gather* 278 | (set! *fetch-uri* (cons (list-ref pic-def 3) *fetch-uri*))) 279 | 280 | (define tip-text (list-ref pic-def 0)) 281 | (define yaw (degrees->radians yaw-degrees)) 282 | (define pitch (degrees->radians pitch-degrees)) 283 | (define mat-yaw (mat4-rotate-y yaw)) 284 | (define vec-right (mat4-transform-dir mat-yaw (vec3 1.0 0.0 0.0))) 285 | (define angles (mat4-compose 286 | (mat4-rotate-y yaw) 287 | (mat4-rotate-around vec-right pitch))) 288 | (define xform (mat4-compose 289 | (mat4-translate -0.5 -0.5 -0.5) 290 | (mat4-scale/xyz 0.2 0.2 0.01) 291 | (mat4-translate 0.0 0.0 -2.0) 292 | angles)) 293 | (define showing (string=? (ss-pic-visible) tip-text)) 294 | 295 | (cond 296 | ; Draw the pic if active, using the underlay plane 297 | (showing 298 | (let* ( 299 | (w (list-ref pic-def 1)) 300 | (h (list-ref pic-def 2)) 301 | (scale (/ 2.0 (max w h))) 302 | (url (list-ref pic-def 3))) 303 | (+underlay url 304 | (mat4-compose (mat4-translate -0.5 -0.5 0.0) 305 | (mat4-scale/xyz (* scale w) (* scale h) 1.0) 306 | (mat4-translate 0.0 0.0 -1.99) 307 | angles)) 308 | ) 309 | ; if looking far degrees away, put the image away 310 | ; Don't do this in social, because other clients may 311 | ; be looking at it. 312 | (when (and (not social?) (> (delta-degrees (view-yaw) yaw-degrees) 80.0)) 313 | (client-command! 'pic "")) 314 | 315 | ) 316 | 317 | ; if any pic is up, hide all the other buttons 318 | ((> (string-length (ss-pic-visible)) 0) #f) 319 | 320 | ; Draw the icon and check for hit to bring up the pic 321 | (#t 322 | (let ((gaze-now (gaze-on-bounds? bounds3-unit xform))) 323 | (+quad (if *gaze-close-this-test* 324 | pic-button-uri 325 | pic-mini-button-uri) 326 | xform) 327 | 328 | ; tool tip if gazing on it 329 | (when gaze-now 330 | (+text tip-text 331 | (mat4-compose 332 | (mat4-translate 0.0 0.15 -1.8) 333 | angles)) 334 | ; toggle active if press 335 | (when (pressed-action) 336 | (+sound WAV-ACTIVATE) 337 | (client-command! 'pic (if (string=? (ss-pic-visible) tip-text) 338 | "" 339 | tip-text)))))))) 340 | 341 | 342 | (define dest-airport 0) 343 | (define dest-chichenitza 1) 344 | (define dest-christredeemer 2) 345 | (define dest-colosseum 3) 346 | (define dest-giza 4) 347 | (define dest-greatwall 5) 348 | (define dest-machupicchu 6) 349 | (define dest-petra 7) 350 | (define dest-tajmahal 8) 351 | 352 | ; This list determines how many scenes are in each destination. Swiping past the last 353 | ; scene returns to the airport. 354 | 355 | ; Most of these names could be generated by concatenating the scene number, but I assume 356 | ; we want the flexibility to swap things around without renaming files. 357 | (define *pic-list* 358 | '( 359 | ( 360 | "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/AirportTerminal/terminal_2.jpg" 361 | ) 362 | 363 | ( 364 | "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/chichenitza_1.jpg" 365 | "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/chichenitza_2.jpg" 366 | "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/chichenitza_3.jpg" 367 | "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/chichenitza_4.jpg" 368 | "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/chichenitza_5.jpg" 369 | ) 370 | 371 | ( 372 | "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/christredeemer_1.jpg" 373 | "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/christredeemer_2.jpg" 374 | ) 375 | 376 | ( 377 | "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/colosseum_1.jpg" 378 | "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/colosseum_2.jpg" 379 | "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/colosseum_3.jpg" 380 | "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/colosseum_4.jpg" 381 | ) 382 | ( 383 | "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/giza_1.jpg" 384 | "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/giza_2.jpg" 385 | "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/giza_3.jpg" 386 | "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/giza_4.jpg" 387 | ) 388 | ( 389 | "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/greatwall_1.jpg" 390 | "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/greatwall_2.jpg" 391 | "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/greatwall_3.jpg" 392 | "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/greatwall_4.jpg" 393 | "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/greatwall_5.jpg" 394 | ) 395 | ( 396 | "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/machupicchu_1.jpg" 397 | "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/machupicchu_2.jpg" 398 | "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/machupicchu_3.jpg" 399 | "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/machupicchu_4.jpg" 400 | ) 401 | ( 402 | "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/petra_1.jpg" 403 | "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/petra_2.jpg" 404 | "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/petra_3.jpg" 405 | ) 406 | ( 407 | "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/tajmahal_1.jpg" 408 | "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/tajmahal_2.jpg" 409 | "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/tajmahal_3.jpg" 410 | 411 | ))) 412 | 413 | 414 | ;----------------- 415 | ; frame function 416 | ;----------------- 417 | (define (frame) 418 | ; position social players 419 | (set-position) 420 | 421 | ; debug tool to see yaw angles for placement 422 | (when (held-left-trigger) 423 | (+hud (floor (view-yaw)))) 424 | 425 | ; a swipe will signal the controlling client to change rooms 426 | (when (or (pressed-swipe-forward) (pressed-dpad-right)) 427 | (printf "Swipe-forward\n") 428 | (client-command! 'next #f)) 429 | (when (or (pressed-swipe-back) (pressed-dpad-left)) 430 | (printf "Swipe-back\n") 431 | (client-command! 'prev #f)) 432 | 433 | ; a tap not near any gaze button will clear pics 434 | (when (and (pressed-action) 435 | (not *gaze-on-last-frame*) 436 | (not (string=? "" (ss-pic-visible)))) 437 | (client-command! 'pic "")) 438 | 439 | ; pressing the back button will go back to the airport, or exit the app 440 | (when (pressed-back) 441 | (back-handled) 442 | (if (match dest-airport 0) 443 | (+finish) 444 | (client-command! 'destination 0))) 445 | 446 | ; execute commands from each client 447 | (when (controlling-client?) 448 | (for-each execute-client-commands! *clients*)) 449 | 450 | 451 | ; present the current room panorama 452 | (+pano (list-ref (list-ref *pic-list* (ss-destination)) 453 | (ss-scene))) 454 | 455 | ; reorient whenver we change scenes 456 | (if (not (and (= (ss-destination) *current-destination*) 457 | (= (ss-scene) *current-scene*))) 458 | (begin 459 | (+reorient) 460 | (set! *current-destination* (ss-destination)) 461 | (set! *current-scene* (ss-scene)) 462 | ; We want to fetch all the data needed for each scene before the first frame of the 463 | ; scene is drawn. The background-sound, time-sound, and pic-button-yaw-pitch functions 464 | ; always add their URI to the *fetch-uri* list, even they aren't going to be drawn. 465 | (set! *fetch-gather* #t) 466 | (set! *fetch-uri* '())) 467 | 468 | ; We need to reset transition-time the frame after all the uri have been fetched, because 469 | ; an unknown amount of time is needed to ensure everything is cached. 470 | (when *fetch-gather* 471 | (set! *transition-time* *script-seconds*) 472 | (set! *fetch-gather* #f))) 473 | 474 | ; scene specific features 475 | (cond 476 | ;--------------- 477 | ; airport 478 | ;--------------- 479 | ((match dest-airport 0) 480 | (background-sound "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/lp_amb_airport_terminal_01.wav" 0.7) 481 | 482 | ; spatialized airplane sounds 483 | (time-sound 2.0 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/t_evt_plane_takeoff_01.wav" 1.0 90.0) 484 | (time-sound 7.0 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/t_evt_plane_takeoff_02.wav" 1.0 -90.0) 485 | (time-sound 12.0 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/t_evt_plane_takeoff_03.wav" 1.0 180.0) 486 | (time-sound 15.0 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/t_evt_plane_takeoff_04.wav" 1.0 -33.0) 487 | (time-sound 22.0 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/t_evt_plane_takeoff_05.wav" 1.0 45.0) 488 | (time-sound 28.0 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/t_evt_plane_takeoff_06.wav" 1.0 180.0) 489 | 490 | ; play the "welcome" clip only on initial launch, not every time you return to the airport 491 | (when (crossed-seconds 3.0) 492 | (+sound "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/vo_welcome_01.wav")) 493 | 494 | ; draw the departure board model 495 | (+model "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/Models/flightboard_main.ovrscene" 496 | (mat4-translate 0.0 0.5 -2.1)) 497 | 498 | ; Draw the share button on the board 499 | (share-button) 500 | 501 | ; add all the buttons 502 | (departure-button-list 503 | '( 504 | ( "Chichen Itza" chichenitza-pics ) 505 | ( "Christ the Redeemer" christredeemer-pics ) 506 | ( "Colosseum" colosseum-pics ) 507 | ( "Great Pyramid of Giza" giza-pics ) 508 | ( "Great Wall of China" greatwall-pics ) 509 | ( "Machu Picchu" machupicu-pics ) 510 | ( "Petra" petra-pics ) 511 | ( "Taj Mahal" tajmahal-pics ) 512 | ))) 513 | 514 | ;--------------- 515 | ; Christ Redeemer 516 | ;--------------- 517 | ((match dest-christredeemer 0) 518 | (background-sound "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/lp_background_generic_01.wav") 519 | (time-sound 2.0 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/vo_exp_rio_01.wav") 520 | (time-sound 7.3 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/vo_exp_rio_02.wav") 521 | (swipe-anim 17.0) 522 | (pic-button-yaw-pitch 5.0 -10.0 '( "Construction 1926-30" 436 700 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/christredeemer_2d_construction1926-30.jpg" )) 523 | (pic-button-yaw-pitch 0.0 35.0 '( "On Face closeup" 1920 1440 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/christredeemer_2d_face.jpg" )) 524 | (pic-button-yaw-pitch 100.0 20.0 '( "Redeemer from afar" 2560 1711 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/christredeemer_2d_afar.jpg" )) 525 | (pic-button-yaw-pitch -22.0 -10.0 '( "NOTE - Construction" 768 1024 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/christredeemer_2d_text_cost.jpg" )) 526 | (pic-button-yaw-pitch 40.0 -10.0 '( "NOTE - Creator" 768 1024 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/christredeemer_2d_text_creator.jpg" )) 527 | ) 528 | ((match dest-christredeemer 1) 529 | (background-sound "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/bg_1.wav") 530 | (time-sound 0.7 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/vo_exp_rio_04.wav") 531 | (time-sound 13.5 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/vo_exp_rio_03.wav") 532 | (swipe-anim 25.0) 533 | (pic-button-yaw-pitch -172.0 20.0 '( "Lightning Damage Jan 2014" 2560 1711 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/christredeemer_2d_lightning.jpg" )) 534 | (pic-button-yaw-pitch 168.0 10.0 '( "NOTE - Dimensions" 768 1024 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/christredeemer_2d_text_dimensions.jpg" )) 535 | (pic-button-yaw-pitch 180.0 -10.0 '( "NOTE - Levitation" 768 1024 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/christredeemer_2d_text_levitate.jpg" )) 536 | ) 537 | 538 | ;--------------- 539 | ; Colosseum 540 | ;--------------- 541 | ((match dest-colosseum 0) 542 | (background-sound "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/lp_background_generic_01.wav") 543 | (time-sound 2.0 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/vo_exp_colosseum_01.wav") 544 | (time-sound 7.3 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/vo_exp_colosseum_02.wav") 545 | (swipe-anim 18.0) 546 | (pic-button-yaw-pitch 45.0 20.0 '( "Colosseum from afar" 770 430 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/colosseum_2d_afar.jpg" )) 547 | (pic-button-yaw-pitch -35.0 10.0 '( "NOTE - Visitors" 768 1024 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/colosseum_2d_text_tourists.jpg" )) 548 | ) 549 | ((match dest-colosseum 1) 550 | (background-sound "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/lp_background_generic_01.wav") 551 | (time-sound 1.5 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/vo_exp_colosseum_03.wav") 552 | (swipe-anim 12.0) 553 | (pic-button-yaw-pitch 60.0 10.0 '( "Relief - Gladiator vs Beast" 500 413 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/colosseum_2d_reliefgladvsbeast.jpg" )) 554 | (pic-button-yaw-pitch -15.0 10.0 '( "NOTE - Entrances" 768 1024 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/colosseum_2d_text_entrances.jpg" )) 555 | ) 556 | ((match dest-colosseum 2) 557 | (background-sound "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/lp_background_generic_01.wav") 558 | (time-sound 0.1 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/lp_walla_crowd_stadium.wav" 0.7) 559 | (time-sound 3.0 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/vo_exp_colosseum_04.wav") 560 | (time-sound 11.0 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/vo_exp_colosseum_05.wav") 561 | (time-sound 13.0 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/lp_walla_crowd_stadium_gladiator_battle.wav" 0.7) 562 | (swipe-anim 20.0) 563 | (pic-button-yaw-pitch -75.0 10.0 '( "Detail Shot" 1024 683 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/colosseum_2d_detail.jpg" )) 564 | (pic-button-yaw-pitch 0.0 -15.0 '( "NOTE - Ship Battles" 768 1024 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/colosseum_2d_text_shipbattles.jpg" )) 565 | 566 | ) 567 | ((match dest-colosseum 3) 568 | (background-sound "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/lp_background_generic_01.wav") 569 | (time-sound 1.0 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/vo_exp_colosseum_06.wav") 570 | (swipe-anim 18.0) 571 | (pic-button-yaw-pitch -15.0 10.0 '( "Mosaic - Spectacles" 919 1321 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/colosseum_2d_mosaic_gladiator2.jpg" )) 572 | (pic-button-yaw-pitch -40.0 10.0 '( "NOTE - Animal Wipeout" 768 1024 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/colosseum_2d_text_animalwipeout.jpg" )) 573 | ) 574 | 575 | ;--------------- 576 | ; Taj Mahal 577 | ;--------------- 578 | ((match dest-tajmahal 0) 579 | (background-sound "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/bg_1.wav") 580 | (time-sound 1.0 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/vo_exp_taj_01.wav") 581 | (swipe-anim 11.0) 582 | (pic-button-yaw-pitch -65.0 25.0 '( "Taj Mahal from Afar" 700 464 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/tajmahal_2d_afar.jpg" )) 583 | (pic-button-yaw-pitch 5.0 14.0 '( "Building Facade Detail" 800 521 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/tajmahal_2d_detail2.jpg" )) 584 | (pic-button-yaw-pitch -6.0 14.0 '( "Archway Detail" 1023 685 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/tajmahal_2d_detail5.jpg" )) 585 | (pic-button-yaw-pitch 175.0 10.0 '( "Mosque Interior Archways" 1280 960 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/tajmahal_2d_mosquearchways.jpg" )) 586 | (pic-button-yaw-pitch 0.0 -6.0 '( "The Tombs" 798 307 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/tajmahal_2d_tomb.jpg" )) 587 | ) 588 | ((match dest-tajmahal 1) 589 | (background-sound "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/bg_2.wav") 590 | (time-sound 1.0 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/vo_exp_taj_02.wav") 591 | (swipe-anim 15.0) 592 | 593 | (pic-button-yaw-pitch 25.0 10.0 '( "NOTE - Plans for Dark Copy" 768 1024 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/tajmahal_2d_text_blackcopy.jpg" )) 594 | (pic-button-yaw-pitch -23.0 10.0 '( "NOTE - Dimensions" 768 1024 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/tajmahal_2d_text_height.jpg" )) 595 | (pic-button-yaw-pitch -13.0 10.0 '( "NOTE - Costs" 768 1024 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/tajmahal_2d_text_cost.jpg" )) 596 | (pic-button-yaw-pitch 15.0 10.0 '( "NOTE - Construction" 768 1024 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/tajmahal_2d_text_construction.jpg" )) 597 | ) 598 | ((match dest-tajmahal 2) 599 | (background-sound "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/lp_background_generic_01.wav") 600 | (time-sound 0.5 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/vo_exp_taj_03.wav") 601 | (swipe-anim 10.0) 602 | (pic-button-yaw-pitch 0.0 10.0 '( "Jeweled Inlay" 1600 1200 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/tajmahal_2d_detail.jpg" )) 603 | (pic-button-yaw-pitch -45.0 50.0 '( "Minaret Detail" 1200 1600 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/tajmahal_2d_detail4.jpg" )) 604 | (pic-button-yaw-pitch -60.0 10.0 '( "Building Corner Detail" 550 413 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/tajmahal_2d_detail3.jpg" )) 605 | (pic-button-yaw-pitch -25.0 10.0 '( "NOTE - Jewels Stolen & Restoration" 768 1024 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/tajmahal_2d_text_stolen.jpg" )) 606 | ) 607 | 608 | ;--------------- 609 | ; Chichen Itza 610 | ;--------------- 611 | ((match dest-chichenitza 0) 612 | (background-sound "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/lp_background_generic_01.wav") 613 | (time-sound 1.0 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/vo_exp_ci_01.wav") 614 | (time-sound 7.0 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/vo_exp_ci_02.wav") 615 | (swipe-anim 18.0) 616 | (pic-button-yaw-pitch -30.0 20.0 '( "Chichen Itza from afar" 1500 1000 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/chichenitza_2d_afar.jpg" )) 617 | (pic-button-yaw-pitch 141.0 15.0 '( "Carving Detail" 550 368 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/chichenitza_2d_detailskulls.jpg" )) 618 | (pic-button-yaw-pitch 22.0 10.0 '( "NOTE - Name Origins" 768 1024 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/chichenitza_2d_text_name.jpg" )) 619 | ) 620 | ((match dest-chichenitza 1) 621 | (background-sound "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/bg_1.wav") 622 | (time-sound 1.0 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/vo_exp_ci_03.wav") 623 | (swipe-anim 9.0) 624 | (pic-button-yaw-pitch 175.0 10.0 '( "Detailed Carving" 550 229 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/chichenitza_2d_carving.jpg" )) 625 | (pic-button-yaw-pitch -10.0 10.0 '( "Steps Detail" 1600 923 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/chichenitza_2d_detailsteps.jpg" )) 626 | (pic-button-yaw-pitch 4.0 17.0 '( "Building Detail" 3216 2136 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/chichenitza_2d_detail.jpg" )) 627 | (pic-button-yaw-pitch 115.0 10.0 '( "NOTE - Paved Roads" 768 1024 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/chichenitza_2d_text_pavedroads.jpg" )) 628 | ) 629 | ((match dest-chichenitza 2) 630 | (background-sound "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/lp_background_generic_01.wav") 631 | (time-sound 0.1 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/vo_exp_ci_06.wav") 632 | (swipe-anim 9.0) 633 | (pic-button-yaw-pitch -10.0 10.0 '( "Mesoamerican Ballgame Modern Painting" 350 267 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/chichenitza_2d_mesoamericanballgameartist.jpg" )) 634 | (pic-button-yaw-pitch 10.0 10.0 '( "Mesoamerican Ballgame Ancient Painting" 1461 1211 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/chichenitza_2d_ballgamepainting.jpg" )) 635 | ) 636 | ((match dest-chichenitza 3) 637 | (background-sound "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/lp_background_generic_01.wav") 638 | (time-sound 0.5 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/vo_exp_ci_04.wav") 639 | (swipe-anim 10.0) 640 | (pic-button-yaw-pitch -10.0 10.0 '( "Statue of god Chac Mool" 500 375 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/chichenitza_2d_statuegodchac-mool.jpg" )) 641 | ) 642 | ((match dest-chichenitza 4) 643 | (background-sound "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/bg_2.wav") 644 | (time-sound 0.5 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/vo_exp_ci_05.wav") 645 | (swipe-anim 9.0) 646 | (pic-button-yaw-pitch 80.0 10.0 '( "NOTE - Civil War" 768 1024 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/chichenitza_2d_text_civilwar.jpg" )) 647 | ) 648 | 649 | ;--------------- 650 | ; Great Wall 651 | ;--------------- 652 | ((match dest-greatwall 0) 653 | (background-sound "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/bg_2.wav") 654 | (time-sound 1.5 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/vo_exp_gwc_01.wav") 655 | (time-sound 12.0 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/vo_exp_gwc_03.wav") 656 | (swipe-anim 18.0) 657 | (pic-button-yaw-pitch -30.0 30.0 '( "The Great Wall from the Sky" 800 577 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/greatwall_2d_afar.jpg" )) 658 | (pic-button-yaw-pitch 35.0 10.0 '( "A Side View" 2582 619 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/greatwall_2d_sideview.jpg" )) 659 | ) 660 | ((match dest-greatwall 1) 661 | (background-sound "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/lp_background_generic_01.wav") 662 | (time-sound 1.0 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/vo_exp_gwc_02.wav") 663 | (swipe-anim 12.0) 664 | (pic-button-yaw-pitch 0.0 -10.0 '( "One of the many gates" 2208 1244 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/greatwall_2d_gateJiquan.jpg" )) 665 | ) 666 | ((match dest-greatwall 2) 667 | (background-sound "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/bg_1.wav") 668 | (time-sound 1.0 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/vo_exp_gwc_04.wav") 669 | (swipe-anim 20.0) 670 | ) 671 | ((match dest-greatwall 3) 672 | (background-sound "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/lp_background_generic_01.wav") 673 | (time-sound 1.0 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/vo_exp_gwc_05.wav") 674 | (swipe-anim 8.0) 675 | (pic-button-yaw-pitch -5.0 -10.0 '( "NOTE - Bricks" 768 1024 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/greatwall_2d_text_bricks.jpg" )) 676 | ) 677 | ((match dest-greatwall 4) 678 | (background-sound "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/lp_background_generic_01.wav") 679 | (time-sound 1.0 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/vo_exp_gwc_06.wav") 680 | (swipe-anim 14.0) 681 | ) 682 | 683 | ;--------------- 684 | ; Giza 685 | ;--------------- 686 | ((match dest-giza 0) 687 | (background-sound "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/lp_background_generic_01.wav") 688 | (time-sound 1.0 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/vo_exp_giza_01.wav") 689 | (time-sound 12.0 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/vo_exp_giza_04.wav") 690 | (swipe-anim 27.0) 691 | (pic-button-yaw-pitch 0.0 30.0 '( "View from Space" 858 536 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/giza_2d_fromspace.jpg" )) 692 | (pic-button-yaw-pitch 20.0 10.0 '( "NOTE - Cornerstone Construction" 768 1024 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/giza_2d_text_cornerstone.jpg" )) 693 | ) 694 | ((match dest-giza 1) 695 | (background-sound "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/lp_background_generic_01.wav") 696 | (time-sound 1.0 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/vo_exp_giza_03.wav") 697 | (time-sound 17.0 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/vo_exp_giza_02.wav") 698 | (swipe-anim 28.0) 699 | (pic-button-yaw-pitch -60.0 10.0 '( "View from the City" 1200 740 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/giza_2d_frommoderncity.jpg" )) 700 | (pic-button-yaw-pitch -5.0 10.0 '( "NOTE - Concave Sides" 768 1024 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/giza_2d_text_concave.jpg" )) 701 | (pic-button-yaw-pitch -5.0 25.0 '( "NOTE - Orion's Belt" 768 1024 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/giza_2d_text_orion.jpg" )) 702 | ) 703 | ((match dest-giza 2) 704 | (background-sound "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/lp_background_generic_01.wav") 705 | (time-sound 1.0 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/vo_exp_giza_05.wav") 706 | (time-sound 18.0 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/vo_exp_giza_06.wav") 707 | (swipe-anim 28.0) 708 | (pic-button-yaw-pitch 52.0 10.0 '( "Entrance" 1024 812 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/giza_2d_entrance.jpg" )) 709 | (pic-button-yaw-pitch 42.0 10.0 '( "Grand Gallery" 605 412 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/giza_2d_grandgallery.jpg" )) 710 | (pic-button-yaw-pitch 32.0 10.0 '( "Interior Details" 640 427 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/giza_2d_detail.jpg" )) 711 | (pic-button-yaw-pitch 22.0 10.0 '( "Kings Chamber" 640 408 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/giza_2d_kingschamber.jpg" )) 712 | ) 713 | ((match dest-giza 3) 714 | (background-sound "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/lp_background_generic_01.wav") 715 | (time-sound 1.0 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/vo_exp_giza_07.wav") 716 | (time-sound 12.0 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/vo_exp_giza_08.wav") 717 | (time-sound 29.0 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/vo_exp_giza_09.wav") 718 | (swipe-anim 34.0) 719 | (pic-button-yaw-pitch -40.0 10.0 '( "Sphinx" 768 1024 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/giza_2d_text_sphinx.jpg" )) 720 | (pic-button-yaw-pitch 18.0 10.0 '( "NOTE - Weight and Cost" 768 1024 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/giza_2d_text_weightcost.jpg" )) 721 | ) 722 | 723 | ;--------------- 724 | ; Machu Picchu 725 | ;--------------- 726 | ((match dest-machupicchu 0) 727 | (background-sound "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/lp_background_generic_01.wav") 728 | (time-sound 2.0 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/vo_exp_mp_01.wav") 729 | (time-sound 7.0 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/vo_exp_mp_02.wav") 730 | (swipe-anim 18.5) 731 | (pic-button-yaw-pitch -60.0 20.0 '( "Machu Picchu from Afar" 800 577 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/machupicchu_2d_afar.jpg" )) 732 | (pic-button-yaw-pitch -10.0 -10.0 '( "Carved Steps" 683 1024 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/machupicchu_2d_carvedsteps.jpg" )) 733 | (pic-button-yaw-pitch 0.0 -10.0 '( "Unique Flying Steps" 683 1024 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/machupicchu_2d_flyingsteps.jpg" )) 734 | (pic-button-yaw-pitch 10.0 -10.0 '( "Plumbing" 300 200 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/machupicchu_2d_plumbing.jpg" )) 735 | ) 736 | ((match dest-machupicchu 1) 737 | (background-sound "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/lp_background_generic_01.wav") 738 | (time-sound 2.0 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/vo_exp_mp_03.wav") 739 | (time-sound 10.0 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/vo_exp_mp_04.wav") 740 | (swipe-anim 18.5) 741 | (pic-button-yaw-pitch -51.0 30.0 '( "Top View of Architecture" 800 600 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/machupicchu_2d_architecturefromtop.jpg" )) 742 | (pic-button-yaw-pitch -40.0 10.0 '( "NOTE - Ashlar Construction" 768 1024 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/machupicchu_2d_text_ashlar.jpg" )) 743 | ) 744 | ((match dest-machupicchu 2) 745 | (background-sound "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/lp_background_generic_01.wav") 746 | (time-sound 2.0 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/vo_exp_mp_05.wav") 747 | (time-sound 11.0 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/vo_exp_mp_06.wav") 748 | (swipe-anim 17.0) 749 | (pic-button-yaw-pitch 85.0 -30.0 '( "The Steps Up" 350 525 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/machupicchu_2d_stepsup.jpg" )) 750 | ) 751 | ((match dest-machupicchu 3) 752 | (background-sound "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/lp_background_generic_01.wav") 753 | (time-sound 2.0 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/vo_exp_mp_07.wav") 754 | (swipe-anim 18.0) 755 | (pic-button-yaw-pitch 10.0 10.0 '( "Torreon" 3888 2424 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/machupicchu_2d_torreon.jpg" )) 756 | (pic-button-yaw-pitch -10.0 10.0 '( "NOTE - Astronomy" 768 1024 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/machupicchu_2d_text_astronomy.jpg" )) 757 | ) 758 | 759 | ;--------------- 760 | ; Petra 761 | ;--------------- 762 | ((match dest-petra 0) 763 | (background-sound "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/lp_background_generic_01.wav") 764 | (time-sound 0.5 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/vo_exp_petra_01.wav") 765 | (time-sound 12.0 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/vo_exp_petra_02.wav") 766 | (swipe-anim 22.0) 767 | (pic-button-yaw-pitch 7.0 50.0 '( "Detail Work Treasury" 533 800 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/petra_2d_detail1.jpg" )) 768 | (pic-button-yaw-pitch -24.0 28.0 '( "Detail Work Column" 525 350 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/petra_2d_detail2.jpg" )) 769 | (pic-button-yaw-pitch 0.0 10.0 '( "Inside View" 1024 344 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/petra_2d_inside.jpg" )) 770 | (pic-button-yaw-pitch -80.0 10.0 '( "NOTE - Another Name" 768 1024 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/petra_2d_text_rosecity.jpg" )) 771 | ) 772 | ((match dest-petra 1) 773 | (background-sound "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/lp_background_generic_01.wav") 774 | (time-sound 1.0 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/vo_exp_petra_03.wav") 775 | (time-sound 11.0 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/vo_exp_petra_04.wav") 776 | (swipe-anim 22.0) 777 | (pic-button-yaw-pitch 0.0 35.0 '( "Theater from above" 432 288 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/petra_2d_theater.jpg" )) 778 | (pic-button-yaw-pitch -85.0 10.0 '( "NOTE - Weathering" 768 1024 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/petra_2d_text_wethering.jpg" )) 779 | ) 780 | ((match dest-petra 2) 781 | (background-sound "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/lp_background_generic_01.wav") 782 | (time-sound 1.0 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/vo_exp_petra_05.wav") 783 | (time-sound 7.0 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/audio/vo_exp_petra_06.wav") 784 | (swipe-anim 16.0) 785 | (pic-button-yaw-pitch -35.0 -7.0 '( "Map" 900 600 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/petra_2d_map.jpg" )) 786 | (pic-button-yaw-pitch 5.0 10.0 '( "Monastary" 990 1487 "https://s3.amazonaws.com/o.oculuscdn.com/netasset/matt_test/New7Wonders/petra_2d_monastary.jpg" )) 787 | ) 788 | 789 | ) 790 | 791 | ; If we just transitioned to this scene, force everything that will be used to 792 | ; load before rendering it. 793 | (when *fetch-gather* 794 | (apply +fetch *fetch-uri*)) 795 | 796 | ) 797 | 798 | 799 | (vrmain "172.22.52.41" frame) 800 | -------------------------------------------------------------------------------- /voice-around.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require "vr.rkt") 3 | 4 | (uri WAV-VOICE-TEST "http://vr.oculuscdn.com/assets/sounds/test/mono_human_voice_test_01b.wav") 5 | 6 | (define NAME-VOICE 1) 7 | 8 | ;----------------- 9 | ; frame function 10 | ;----------------- 11 | (define (frame) 12 | (define xform (mat4-compose (mat4-rotate-y pi) 13 | (mat4-translate 0.0 0.0 2.0) 14 | (mat4-rotate-y (input-time *input*)))) 15 | 16 | ; select a background 17 | (+pano "http://vr.oculuscdn.com/assets/panos/office_demo.JPG") 18 | 19 | ; spin a model in front of the view 20 | (+model "http://vr.oculuscdn.com/assets/models/icon_speaker.ovrscene" 21 | xform) 22 | 23 | ; update the audio position 24 | (+sound WAV-VOICE-TEST 25 | (opt-name NAME-VOICE) 26 | 'loop 27 | (opt-position (mat4-origin xform))) 28 | ) 29 | 30 | ; This connects to the HMD over TCP when run from DrRacket, and is ignored when embedded. 31 | ; Replace the IP address with the value shown on the phone when vrscript is run. 32 | (vrmain "192.168.1.147" frame) 33 | 34 | -------------------------------------------------------------------------------- /vr.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | ; TODO: change things to be more r7rs like? 3 | 4 | ; Everything here is exported 5 | (provide (all-defined-out)) 6 | (require srfi/9) ; define-record-type 7 | 8 | ;(require rnrs/base-6) 9 | 10 | ; everything up to this mark will be stripped and replaced when embedded 11 | ; to work around compatibility issues 12 | ; %%%END-OF-HEADER%%% 13 | 14 | ;------------------------------------------------------------------ 15 | 16 | (define pi 3.141592657) 17 | (define pi/2 (/ 3.141592657 2.0)) 18 | (define pi*2 (* 3.141592657 2.0)) 19 | (define pi*3/2 (* 3.0 (/ 3.141592657 2.0))) 20 | (define -pi/2 (- 0.0 (/ 3.141592657 2.0))) 21 | (define -pi*2 (- 0.0 (* 3.141592657 2.0))) 22 | (define -pi*3/2 (- 0.0 (* 3.0 (/ 3.141592657 2.0)))) 23 | (define pi/180 (/ pi 180.0)) 24 | (define pi/180-inv (/ 180.0 pi)) 25 | 26 | (define (degrees->radians d) (* d pi/180)) 27 | (define (radians->degrees r) (* r pi/180-inv)) 28 | 29 | ; from OVR_Math.h, correct for float, should be different for Flonum, which is double 30 | (define SmallestNonDenormal 1.1754943508222875e-038) ; ( 1U << 23 ) 31 | (define HugeNumber 1.8446742974197924e+019) ; ( ( ( 127U * 3 / 2 ) << 23 ) | ( ( 1 << 23 ) - 1 ) ) 32 | 33 | (define (safe-rcp v) 34 | (if (> (abs v) SmallestNonDenormal) 35 | (/ 1.0 v) 36 | HugeNumber)) 37 | 38 | ; types 39 | (define-record-type vec3 (make-vec3 x y z) vec3? (x vec3-x) (y vec3-y) (z vec3-z)) 40 | (define-record-type vec4 (make-vec4 x y z w) vec4? (x vec4-x) (y vec4-y) (z vec4-z) (w vec4-w)) 41 | (define-record-type mat4 (make-mat4 m00 m01 m02 m03 m10 m11 m12 m13 m20 m21 m22 m23 m30 m31 m32 m33) 42 | mat4? 43 | (m00 mat4-m00) (m01 mat4-m01) (m02 mat4-m02) (m03 mat4-m03) 44 | (m10 mat4-m10) (m11 mat4-m11) (m12 mat4-m12) (m13 mat4-m13) 45 | (m20 mat4-m20) (m21 mat4-m21) (m22 mat4-m22) (m23 mat4-m23) 46 | (m30 mat4-m30) (m31 mat4-m31) (m32 mat4-m32) (m33 mat4-m33)) 47 | 48 | (define-record-type bounds3 (make-bounds3 min max) bounds3? (min bounds3-min) (max bounds3-max)) 49 | 50 | 51 | ; Type constants 52 | (define org3 (make-vec3 0.0 0.0 0.0)) 53 | (define mat4-identity (make-mat4 1.0 0.0 0.0 0.0 0.0 1.0 0.0 0.0 0.0 0.0 1.0 0.0 0.0 0.0 0.0 1.0)) 54 | (define bounds3-quad (make-bounds3 (make-vec3 -1.0 -1.0 0.0) (make-vec3 1.0 1.0 0.0))) 55 | (define bounds3-unit (make-bounds3 (make-vec3 0.0 0.0 0.0) (make-vec3 1.0 1.0 1.0))) 56 | 57 | ; Functions 58 | (define (vec3->list v) (list (vec3-x v) (vec3-y v) (vec3-z v))) 59 | (define (list->vec3 l) (make-vec3 (list-ref l 0) (list-ref l 1) (list-ref l 2))) 60 | 61 | (define (vec4->list v) (list (vec4-x v) (vec4-y v) (vec4-z v) (vec4-w v))) 62 | (define (list->vec4 l) (make-vec4 (list-ref l 0) (list-ref l 1) (list-ref l 2) (list-ref l 3))) 63 | 64 | (define (mat4->list m) (list 65 | (mat4-m00 m) (mat4-m01 m) (mat4-m02 m) (mat4-m03 m) 66 | (mat4-m10 m) (mat4-m11 m) (mat4-m12 m) (mat4-m13 m) 67 | (mat4-m20 m) (mat4-m21 m) (mat4-m22 m) (mat4-m23 m) 68 | (mat4-m30 m) (mat4-m31 m) (mat4-m32 m) (mat4-m33 m))) 69 | 70 | (define (list->mat4 l) (make-mat4 71 | (list-ref l 0) (list-ref l 1) (list-ref l 2) (list-ref l 3) 72 | (list-ref l 4) (list-ref l 5) (list-ref l 6) (list-ref l 7) 73 | (list-ref l 8) (list-ref l 9) (list-ref l 10) (list-ref l 11) 74 | (list-ref l 12) (list-ref l 13) (list-ref l 14) (list-ref l 15))) 75 | 76 | (define (mat4-translate x y z) (make-mat4 1.0 0.0 0.0 x 0.0 1.0 0.0 y 0.0 0.0 1.0 z 0.0 0.0 0.0 1.0)) 77 | (define (mat4-translate-x x) (make-mat4 1.0 0.0 0.0 x 0.0 1.0 0.0 0.0 0.0 0.0 1.0 0.0 0.0 0.0 0.0 1.0)) 78 | (define (mat4-translate-y y) (make-mat4 1.0 0.0 0.0 0.0 0.0 1.0 0.0 y 0.0 0.0 1.0 0.0 0.0 0.0 0.0 1.0)) 79 | (define (mat4-translate-z z) (make-mat4 1.0 0.0 0.0 0.0 0.0 1.0 0.0 0.0 0.0 0.0 1.0 z 0.0 0.0 0.0 1.0)) 80 | (define (mat4-translatev v) (make-mat4 1.0 0.0 0.0 (vec3-x v) 0.0 1.0 0.0 (vec3-y v) 0.0 0.0 1.0 (vec3-z v) 0.0 0.0 0.0 1.0)) 81 | (define (mat4-scale s) (make-mat4 s 0.0 0.0 0.0 0.0 s 0.0 0.0 0.0 0.0 s 0.0 0.0 0.0 0.0 1.0)) 82 | (define (mat4-scale/xyz x y z) (make-mat4 x 0.0 0.0 0.0 0.0 y 0.0 0.0 0.0 0.0 z 0.0 0.0 0.0 0.0 1.0)) 83 | 84 | (define (mat4-rotate-x radians) 85 | (define c (cos radians)) 86 | (define s (sin radians)) 87 | (make-mat4 1.0 0.0 0.0 0.0 0.0 c (- 0.0 s) 0.0 0.0 s c 0.0 0.0 0.0 0.0 1.0)) 88 | 89 | (define (mat4-rotate-y radians) 90 | (define c (cos radians)) 91 | (define s (sin radians)) 92 | (make-mat4 c 0.0 s 0.0 0.0 1.0 0.0 0.0 (- 0.0 s) 0.0 c 0.0 0.0 0.0 0.0 1.0)) 93 | 94 | (define (mat4-rotate-z radians) 95 | (define c (cos radians)) 96 | (define s (sin radians)) 97 | (make-mat4 c (- 0.0 s) 0.0 0.0 s c 0.0 0.0 0.0 0.0 1.0 0.0 0.0 0.0 0.0 1.0)) 98 | 99 | ; http://inside.mines.edu/fs_home/gmurray/ArbitraryAxisRotation/ 100 | (define (mat4-rotate-around unit-vector radians) 101 | (define c (cos radians)) 102 | (define s (sin radians)) 103 | (define mc (- 1.0 c)) 104 | (define u (vec3-x unit-vector)) 105 | (define v (vec3-y unit-vector)) 106 | (define w (vec3-z unit-vector)) 107 | (define u2 (* u u)) 108 | (define v2 (* v v)) 109 | (define w2 (* w w)) 110 | (make-mat4 (+ u2 (* (- 1.0 u2) c)) (- (* u v mc) (* w s)) (+ (* u w mc) (* v s)) 0.0 111 | (+ (* u v mc) (* w s)) (+ v2 (* (- 1.0 v2) c)) (- (* v w mc) (* u s)) 0.0 112 | (- (* u w mc) (* v s)) (+ (* v w mc) (* u s)) (+ w2 (* (- 1.0 w2) c)) 0.0 113 | 0.0 0.0 0.0 1.0)) 114 | 115 | 116 | ; Transform a vector by a matrix 117 | 118 | ; A direction is just transformed by the inner 3x3, ignoring translation. Should we still divide by w? 119 | (define (mat4-transform-dir m v) (make-vec3 (+ (* (mat4-m00 m) (vec3-x v)) (* (mat4-m01 m) (vec3-y v)) (* (mat4-m02 m) (vec3-z v))) 120 | (+ (* (mat4-m10 m) (vec3-x v)) (* (mat4-m11 m) (vec3-y v)) (* (mat4-m12 m) (vec3-z v))) 121 | (+ (* (mat4-m20 m) (vec3-x v)) (* (mat4-m21 m) (vec3-y v)) (* (mat4-m22 m) (vec3-z v))))) 122 | (define (mat4-transform3 m v) (make-vec3 (+ (* (mat4-m00 m) (vec3-x v)) (* (mat4-m01 m) (vec3-y v)) (* (mat4-m02 m) (vec3-z v)) (mat4-m03 m)) 123 | (+ (* (mat4-m10 m) (vec3-x v)) (* (mat4-m11 m) (vec3-y v)) (* (mat4-m12 m) (vec3-z v)) (mat4-m13 m)) 124 | (+ (* (mat4-m20 m) (vec3-x v)) (* (mat4-m21 m) (vec3-y v)) (* (mat4-m22 m) (vec3-z v)) (mat4-m23 m)))) 125 | (define (mat4-transform4 m v) (make-vec4 (+ (* (mat4-m00 m) (vec4-x v)) (* (mat4-m01 m) (vec4-y v)) (* (mat4-m02 m) (vec4-z v)) (* (mat4-m03 m) (vec4-w v))) 126 | (+ (* (mat4-m10 m) (vec4-x v)) (* (mat4-m11 m) (vec4-y v)) (* (mat4-m12 m) (vec4-z v)) (* (mat4-m13 m) (vec4-w v))) 127 | (+ (* (mat4-m20 m) (vec4-x v)) (* (mat4-m21 m) (vec4-y v)) (* (mat4-m22 m) (vec4-z v)) (* (mat4-m23 m) (vec4-w v))) 128 | (+ (* (mat4-m30 m) (vec4-x v)) (* (mat4-m31 m) (vec4-y v)) (* (mat4-m32 m) (vec4-z v)) (* (mat4-m33 m) (vec4-w v))))) 129 | 130 | ; Matrix multiplication. A vector will be transformed by the second matrix, then the first, when transformed by their product. 131 | (define (mat4-mul m1 m2) (make-mat4 132 | (+ (* (mat4-m00 m1) (mat4-m00 m2)) (* (mat4-m01 m1) (mat4-m10 m2)) (* (mat4-m02 m1) (mat4-m20 m2)) (* (mat4-m03 m1) (mat4-m30 m2))) 133 | (+ (* (mat4-m00 m1) (mat4-m01 m2)) (* (mat4-m01 m1) (mat4-m11 m2)) (* (mat4-m02 m1) (mat4-m21 m2)) (* (mat4-m03 m1) (mat4-m31 m2))) 134 | (+ (* (mat4-m00 m1) (mat4-m02 m2)) (* (mat4-m01 m1) (mat4-m12 m2)) (* (mat4-m02 m1) (mat4-m22 m2)) (* (mat4-m03 m1) (mat4-m32 m2))) 135 | (+ (* (mat4-m00 m1) (mat4-m03 m2)) (* (mat4-m01 m1) (mat4-m13 m2)) (* (mat4-m02 m1) (mat4-m23 m2)) (* (mat4-m03 m1) (mat4-m33 m2))) 136 | 137 | (+ (* (mat4-m10 m1) (mat4-m00 m2)) (* (mat4-m11 m1) (mat4-m10 m2)) (* (mat4-m12 m1) (mat4-m20 m2)) (* (mat4-m13 m1) (mat4-m30 m2))) 138 | (+ (* (mat4-m10 m1) (mat4-m01 m2)) (* (mat4-m11 m1) (mat4-m11 m2)) (* (mat4-m12 m1) (mat4-m21 m2)) (* (mat4-m13 m1) (mat4-m31 m2))) 139 | (+ (* (mat4-m10 m1) (mat4-m02 m2)) (* (mat4-m11 m1) (mat4-m12 m2)) (* (mat4-m12 m1) (mat4-m22 m2)) (* (mat4-m13 m1) (mat4-m32 m2))) 140 | (+ (* (mat4-m10 m1) (mat4-m03 m2)) (* (mat4-m11 m1) (mat4-m13 m2)) (* (mat4-m12 m1) (mat4-m23 m2)) (* (mat4-m13 m1) (mat4-m33 m2))) 141 | 142 | (+ (* (mat4-m20 m1) (mat4-m00 m2)) (* (mat4-m21 m1) (mat4-m10 m2)) (* (mat4-m22 m1) (mat4-m20 m2)) (* (mat4-m23 m1) (mat4-m30 m2))) 143 | (+ (* (mat4-m20 m1) (mat4-m01 m2)) (* (mat4-m21 m1) (mat4-m11 m2)) (* (mat4-m22 m1) (mat4-m21 m2)) (* (mat4-m23 m1) (mat4-m31 m2))) 144 | (+ (* (mat4-m20 m1) (mat4-m02 m2)) (* (mat4-m21 m1) (mat4-m12 m2)) (* (mat4-m22 m1) (mat4-m22 m2)) (* (mat4-m23 m1) (mat4-m32 m2))) 145 | (+ (* (mat4-m20 m1) (mat4-m03 m2)) (* (mat4-m21 m1) (mat4-m13 m2)) (* (mat4-m22 m1) (mat4-m23 m2)) (* (mat4-m23 m1) (mat4-m33 m2))) 146 | 147 | (+ (* (mat4-m30 m1) (mat4-m00 m2)) (* (mat4-m31 m1) (mat4-m10 m2)) (* (mat4-m32 m1) (mat4-m20 m2)) (* (mat4-m33 m1) (mat4-m30 m2))) 148 | (+ (* (mat4-m30 m1) (mat4-m01 m2)) (* (mat4-m31 m1) (mat4-m11 m2)) (* (mat4-m32 m1) (mat4-m21 m2)) (* (mat4-m33 m1) (mat4-m31 m2))) 149 | (+ (* (mat4-m30 m1) (mat4-m02 m2)) (* (mat4-m31 m1) (mat4-m12 m2)) (* (mat4-m32 m1) (mat4-m22 m2)) (* (mat4-m33 m1) (mat4-m32 m2))) 150 | (+ (* (mat4-m30 m1) (mat4-m03 m2)) (* (mat4-m31 m1) (mat4-m13 m2)) (* (mat4-m32 m1) (mat4-m23 m2)) (* (mat4-m33 m1) (mat4-m33 m2))) 151 | )) 152 | 153 | ; Matrix composition 154 | ; Multiply an arbitrary number of matrices together so that a vertex transformed by the result 155 | ; would have been transformed by the given matrices from left to right. This is the opposite 156 | ; order from an OVR_math binary multiply sequence: a * b * c == (mat4-compose c b a). 157 | ; 158 | ; (mat4-compose a b) == (mat4-mul b a) 159 | ; (mat4-compose a b c) == (mat4-mul c (mat4-mul b a)) 160 | ; etc 161 | 162 | (define (mat4-compose-list mats accum) 163 | (cond 164 | ((null? mats) accum) 165 | (#t (mat4-compose-list (cdr mats) (mat4-mul (car mats) accum))))) 166 | 167 | ;(: mat4-compose (-> mat4 * mat4)) 168 | (define (mat4-compose . mats) 169 | (mat4-compose-list (cdr mats) (car mats))) 170 | 171 | 172 | ; http://www.euclideanspace.com/maths/algebra/matrix/functions/inverse/fourD/index.htm 173 | (define (mat4-inverse m) 174 | (let ( (m00 (mat4-m00 m)) (m01 (mat4-m01 m)) (m02 (mat4-m02 m)) (m03 (mat4-m03 m)) 175 | (m10 (mat4-m10 m)) (m11 (mat4-m11 m)) (m12 (mat4-m12 m)) (m13 (mat4-m13 m)) 176 | (m20 (mat4-m20 m)) (m21 (mat4-m21 m)) (m22 (mat4-m22 m)) (m23 (mat4-m23 m)) 177 | (m30 (mat4-m30 m)) (m31 (mat4-m31 m)) (m32 (mat4-m32 m)) (m33 (mat4-m33 m)) ) 178 | (define det (+ 179 | (* m03 m12 m21 m30) (* -1.0 m02 m13 m21 m30) (* -1.0 m03 m11 m22 m30) (* m01 m13 m22 m30) 180 | (* m02 m11 m23 m30) (* -1.0 m01 m12 m23 m30) (* -1.0 m03 m12 m20 m31) (* m02 m13 m20 m31) 181 | (* m03 m10 m22 m31) (* -1.0 m00 m13 m22 m31) (* -1.0 m02 m10 m23 m31) (* m00 m12 m23 m31) 182 | (* m03 m11 m20 m32) (* -1.0 m01 m13 m20 m32) (* -1.0 m03 m10 m21 m32) (* m00 m13 m21 m32) 183 | (* m01 m10 m23 m32) (* -1.0 m00 m11 m23 m32) (* -1.0 m02 m11 m20 m33) (* m01 m12 m20 m33) 184 | (* m02 m10 m21 m33) (* -1.0 m00 m12 m21 m33) (* -1.0 m01 m10 m22 m33) (* m00 m11 m22 m33) )) 185 | (define oodet (safe-rcp det)) 186 | (make-mat4 187 | (* oodet (+ (* m12 m23 m31) (* -1.0 m13 m22 m31) (* m13 m21 m32) (* -1.0 m11 m23 m32) (* -1.0 m12 m21 m33) (* m11 m22 m33))) 188 | (* oodet (+ (* m03 m22 m31) (* -1.0 m02 m23 m31) (* -1.0 m03 m21 m32) (* m01 m23 m32) (* m02 m21 m33) (* -1.0 m01 m22 m33))) 189 | (* oodet (+ (* m02 m13 m31) (* -1.0 m03 m12 m31) (* m03 m11 m32) (* -1.0 m01 m13 m32) (* -1.0 m02 m11 m33) (* m01 m12 m33))) 190 | (* oodet (+ (* m03 m12 m21) (* -1.0 m02 m13 m21) (* -1.0 m03 m11 m22) (* m01 m13 m22) (* m02 m11 m23) (* -1.0 m01 m12 m23))) 191 | (* oodet (+ (* m13 m22 m30) (* -1.0 m12 m23 m30) (* -1.0 m13 m20 m32) (* m10 m23 m32) (* m12 m20 m33) (* -1.0 m10 m22 m33))) 192 | (* oodet (+ (* m02 m23 m30) (* -1.0 m03 m22 m30) (* m03 m20 m32) (* -1.0 m00 m23 m32) (* -1.0 m02 m20 m33) (* m00 m22 m33))) 193 | (* oodet (+ (* m03 m12 m30) (* -1.0 m02 m13 m30) (* -1.0 m03 m10 m32) (* m00 m13 m32) (* m02 m10 m33) (* -1.0 m00 m12 m33))) 194 | (* oodet (+ (* m02 m13 m20) (* -1.0 m03 m12 m20) (* m03 m10 m22) (* -1.0 m00 m13 m22) (* -1.0 m02 m10 m23) (* m00 m12 m23))) 195 | (* oodet (+ (* m11 m23 m30) (* -1.0 m13 m21 m30) (* m13 m20 m31) (* -1.0 m10 m23 m31) (* -1.0 m11 m20 m33) (* m10 m21 m33))) 196 | (* oodet (+ (* m03 m21 m30) (* -1.0 m01 m23 m30) (* -1.0 m03 m20 m31) (* m00 m23 m31) (* m01 m20 m33) (* -1.0 m00 m21 m33))) 197 | (* oodet (+ (* m01 m13 m30) (* -1.0 m03 m11 m30) (* m03 m10 m31) (* -1.0 m00 m13 m31) (* -1.0 m01 m10 m33) (* m00 m11 m33))) 198 | (* oodet (+ (* m03 m11 m20) (* -1.0 m01 m13 m20) (* -1.0 m03 m10 m21) (* m00 m13 m21) (* m01 m10 m23) (* -1.0 m00 m11 m23))) 199 | (* oodet (+ (* m12 m21 m30) (* -1.0 m11 m22 m30) (* -1.0 m12 m20 m31) (* m10 m22 m31) (* m11 m20 m32) (* -1.0 m10 m21 m32))) 200 | (* oodet (+ (* m01 m22 m30) (* -1.0 m02 m21 m30) (* m02 m20 m31) (* -1.0 m00 m22 m31) (* -1.0 m01 m20 m32) (* m00 m21 m32))) 201 | (* oodet (+ (* m02 m11 m30) (* -1.0 m01 m12 m30) (* -1.0 m02 m10 m31) (* m00 m12 m31) (* m01 m10 m32) (* -1.0 m00 m11 m32))) 202 | (* oodet (+ (* m01 m12 m20) (* -1.0 m02 m11 m20) (* m02 m10 m21) (* -1.0 m00 m12 m21) (* -1.0 m01 m10 m22) (* m00 m11 m22)))))) 203 | 204 | (define (cross a b) (make-vec3 (- (* (vec3-y a) (vec3-z b)) (* (vec3-z a) (vec3-y b))) 205 | (- (* (vec3-z a) (vec3-x b)) (* (vec3-x a) (vec3-z b))) 206 | (- (* (vec3-x a) (vec3-y b)) (* (vec3-y a) (vec3-x b))))) 207 | 208 | (define (dot3 a b) (+ (* (vec3-x a) (vec3-x b)) (* (vec3-y a) (vec3-y b)) (* (vec3-z a) (vec3-z b)))) 209 | (define (add3 a b) (make-vec3 (+ (vec3-x a) (vec3-x b)) (+ (vec3-y a) (vec3-y b)) (+ (vec3-z a) (vec3-z b)))) 210 | (define (sub3 a b) (make-vec3 (- (vec3-x a) (vec3-x b)) (- (vec3-y a) (vec3-y b)) (- (vec3-z a) (vec3-z b)))) 211 | (define (mul3 a b) (make-vec3 (* (vec3-x a) (vec3-x b)) (* (vec3-y a) (vec3-y b)) (* (vec3-z a) (vec3-z b)))) 212 | (define (neg3 a) (make-vec3 (- 0.0 (vec3-x a)) (- 0.0 (vec3-y a)) (- 0.0 (vec3-z a)))) 213 | (define (scale3 a s) (make-vec3 (* (vec3-x a) s) (* (vec3-y a) s) (* (vec3-z a) s))) 214 | 215 | (define (vec3-length v) (sqrt (dot3 v v))) 216 | (define (vec3-normalize v) (scale3 v (/ 1.0 (vec3-length v)))) 217 | (define (vec3->string v) (format "(~a ~a ~a)" (vec3-x v) (vec3-y v) (vec3-z v))) 218 | 219 | (define (bounds3-midpoint b) (scale3 (add3 (bounds3-min b) (bounds3-max b)) 0.5)) 220 | 221 | ; Extract information from a mat4 model matrix 222 | (define (mat4-origin m) (make-vec3 (mat4-m03 m) (mat4-m13 m) (mat4-m23 m))) 223 | (define (mat4-forward m) (mat4-transform-dir m (make-vec3 0.0 0.0 -1.0))) 224 | (define (mat4-back m) (mat4-transform-dir m (make-vec3 0.0 0.0 1.0))) 225 | (define (mat4-left m) (mat4-transform-dir m (make-vec3 -1.0 0.0 0.0))) 226 | (define (mat4-right m) (mat4-transform-dir m (make-vec3 1.0 0.0 0.0))) 227 | (define (mat4-up m) (mat4-transform-dir m (make-vec3 0.0 1.0 0.0))) 228 | (define (mat4-down m) (mat4-transform-dir m (make-vec3 0.0 -1.0 0.0))) 229 | 230 | ;------------------------------------------------------- 231 | ; Ray / line tracing 232 | ;------------------------------------------------------- 233 | 234 | ; Straight port from ModelTrace.cpp 235 | ; returns true if the ray starting from start and extending 236 | ; infinitely in dir hits the bounds. 237 | ; 238 | (define (ray-hits-min-max? start dir mins maxs) 239 | (define rcpDir (make-vec3 (safe-rcp (vec3-x dir)) (safe-rcp (vec3-y dir)) (safe-rcp (vec3-z dir)))) 240 | (define s (mul3 (sub3 mins start) rcpDir)) 241 | (define t (mul3 (sub3 maxs start) rcpDir)) 242 | (define minHit (make-vec3 (min (vec3-x s) (vec3-x t)) (min (vec3-y s) (vec3-y t)) (min (vec3-z s) (vec3-z t)))) 243 | (define maxHit (make-vec3 (max (vec3-x s) (vec3-x t)) (max (vec3-y s) (vec3-y t)) (max (vec3-z s) (vec3-z t)))) 244 | (define t0 (max (vec3-x minHit) (vec3-y minHit) (vec3-z minHit))) 245 | (define t1 (min (vec3-x maxHit) (vec3-y maxHit) (vec3-z maxHit))) 246 | (and (> t0 0.0) (<= t0 t1))) 247 | 248 | ; Test if a ray intercepts a transformed bounds 249 | (define (ray-hits-bounds? start dir b) 250 | (ray-hits-min-max? start (vec3-normalize dir) (bounds3-min b) (bounds3-max b))) 251 | 252 | (define (ray-hits-transformed-bounds? start dir b xform) 253 | (define inv (mat4-inverse xform)) ; FIXME: slow! 254 | (ray-hits-bounds? (mat4-transform3 inv start) (mat4-transform-dir inv dir) b)) 255 | 256 | 257 | ; Returns the xy0 intersection of a line on the z=0 plane of xform. 258 | ; Dir does not need to be normalized. 259 | ; The line is infinite in both directions. 260 | ; Very large, but not crashing, values will be returned 261 | ; for a parallel trace that would not, in theory, intersect. 262 | (define (intersect-line-plane start dir xform) 263 | (define inv (mat4-inverse xform)) 264 | (define lstart (mat4-transform3 inv start)) 265 | (define ldir (mat4-transform-dir inv dir)) 266 | (define spd (safe-rcp (vec3-z ldir))) 267 | (define pt (sub3 lstart (scale3 ldir (* (vec3-z lstart) spd)))) 268 | (make-vec3 (vec3-x pt) (vec3-y pt) 0.0)) 269 | 270 | ; 1-y flips the y coordinate of intersect-plane for when you want 271 | ; a texture coordinate instead of a position, since our default 272 | ; geometry flips the y texcoord like almost all engines do. 273 | (define (intersect-line-texture start dir xform) 274 | (define pt (intersect-line-plane start dir xform)) 275 | (make-vec3 (vec3-x pt) (- 1.0 (vec3-y pt)) 0.0)) 276 | 277 | 278 | ; Orients Z along the line to viewer, up as close to +Y as possible, and X derived 279 | (define (sprite-matrix sprite-org view-org) 280 | (define z (vec3-normalize (sub3 view-org sprite-org))) 281 | (define y (sub3 (make-vec3 0.0 1.0 0.0) (scale3 z (vec3-y z)))) 282 | (define x (cross z y)) 283 | (make-mat4 (vec3-x x) (vec3-y x) (vec3-z x) (vec3-x sprite-org) 284 | (vec3-x y) (vec3-y y) (vec3-z y) (vec3-y sprite-org) 285 | (vec3-x z) (vec3-y z) (vec3-z z) (vec3-z sprite-org) 286 | 0.0 0.0 0.0 1.0)) 287 | 288 | ; Orients Z parallel with the view 289 | 290 | 291 | ;------------------------------------------------------- 292 | ; Misc scheme helpers 293 | ;------------------------------------------------------- 294 | 295 | ; Having problems importing SRFI 1 296 | ; iota returns a list from 0 (inclusive) to stop (exclusive) 297 | (define (iota stop) 298 | (define (rev x) 299 | (if (= x stop) 300 | '() 301 | (cons x (rev (+ x 1))))) 302 | (rev 0)) 303 | 304 | 305 | (define (floor->exact x) (inexact->exact (floor x))) 306 | 307 | ; Return a new list with one element replaced. 308 | ; TODO: get vectors working for tic-parms, need to fix some stuff in the C++ Sexp. 309 | (define (list-replace lst x v) 310 | (cond 311 | ((= x 0) (cons v (cdr lst))) 312 | (#t (cons (car lst) (list-replace (cdr lst) (- x 1) v))))) 313 | 314 | ;(: safe-ref (-> Any Nonnegative-Integer Any)) 315 | (define (safe-ref l r) 316 | (cond 317 | ((and (list? l) (> (length l) r)) (list-ref l r)) 318 | (else #f))) 319 | 320 | ; The *client-state* and *server-state* s-expressions need to be 321 | ; turned into a single string that is passed through the network 322 | ; system without being broken down into constituent s-expressions. 323 | ; This allows any data type that is handled by read and write to 324 | ; be communicated without my C++ sexpr parsing needing to understand it. 325 | (define (sexpr->string s) 326 | (define p (open-output-string)) 327 | (write s p) 328 | (get-output-string p)) 329 | 330 | (define (string->sexpr s) 331 | (define p (open-input-string s)) 332 | (read p)) 333 | 334 | ; https://en.wikipedia.org/wiki/Linear_congruential_generator 335 | (define *rand-seed* 1234) 336 | (define rand-max 32767) 337 | 338 | ; (0 to rand-max) 339 | (define (rand!) 340 | ; This is going to exceed the fixnum range in 32 bit scheme as 341 | ; an intermediate if nothing else. If I turn off bignum support 342 | ; in Chibi it will have to be revisited. 343 | (set! *rand-seed* (bitwise-and #xffffffff (+ 12345 (* 1103515245 *rand-seed*)))) 344 | (bitwise-and rand-max (arithmetic-shift *rand-seed* -16))) 345 | 346 | ; (0 to max) 347 | (define (random-int! max) 348 | (remainder (rand!) max)) 349 | 350 | ; (0.0 to 1.0] 351 | (define (random-float!) 352 | (* (rand!) 0.000030517578125)) 353 | 354 | ; [-1.0 to 1.0] 355 | (define (random-float-c!) 356 | (- (* (random-float!) 2.0) 1.0)) 357 | 358 | ;------------------------------------------------------------ 359 | ; social commands 360 | ; 361 | ; Names are unique across accounts, but a single account can 362 | ; be logged into multiple devices, so per-session fixnum 363 | ; client-id are required to differentiate them. Client-id 364 | ; for a real client will never be 0, so that is a safe "no-client" 365 | ; value. 366 | ; 367 | ; The system automatically adds and removes client-id from the 368 | ; *client-seats* list, zeroing out clients that leave and placing 369 | ; new clients in the first zero slot. It is guaranteed that when 370 | ; frame is called, *local-client-id* will be present in *client-seats*. 371 | ; The controlling client is free to rearrange the seating whenever 372 | ; desired. 373 | ; 374 | ; There will be brief periods when a client-id is present in the 375 | ; *client-seats* list, but not in the *clients* list, meaning it has 376 | ; been assigned a spot, but we haven't received a state packet from 377 | ; it yet, so we don't know the client-state. 378 | ; 379 | ; These variables are not valid during (init) 380 | ;------------------------------------------------------------ 381 | 382 | ; This is necessary to distinguish between the case of a single-player 383 | ; experience and a multi-player experience with only only player currently 384 | ; connected. 385 | ; 386 | ; Set at init and never dynamically modified. 387 | (define social? #f) 388 | 389 | (define *local-client-id* 0) ; this is never going to change, should we remove *earmuffs*? 390 | (define *controlling-client-id* 0) ; The client-id that controls the server-state and client-seats 391 | (define *server-state* '()) 392 | (define *client-state* '()) ; copy of (client-state (client 0)) 393 | 394 | (define *client-seats* '(0 0 0 0 0 0 0 0)) 395 | 396 | (define (seat-set! seat cid) 397 | (set! *client-seats* (list-replace *client-seats* seat cid))) 398 | 399 | (define (seat-get seat) 400 | (list-ref *client-seats* seat)) 401 | 402 | ; Swap-seats is preferred to seat-set!, because it can't break the invariant 403 | ; on *client-seats*. 404 | (define (swap-seats! a b) 405 | (define tmp (seat-get a)) 406 | (seat-set! a (seat-get b)) 407 | (seat-set! b tmp)) 408 | 409 | ; This list will always include the local client in the first position. 410 | (define *clients* '()) 411 | 412 | ; Convenience function 413 | (define (client-index x) 414 | (list-ref *clients* x)) 415 | 416 | ; It is an error to try to set server-state if you aren't the controlling-client. 417 | ; The packet server sets the controlling-client as the client that has been on the 418 | ; server longest. 419 | (define (controlling-client?) 420 | (= *controlling-client-id* *local-client-id* )) 421 | 422 | ; Racket doesn't allow you to directly set! a variable defined in another 423 | ; module, so these setter function are provided. They will both typically 424 | ; be vectors, which can have indiviual elements referenced and changed 425 | ; directly by scripts after they have been defined. 426 | (define (set-server-state! state) 427 | (set! *server-state* state)) 428 | 429 | (define (set-client-state! state) 430 | (set! *client-state* state)) 431 | 432 | ; Each frame will update all the players. 433 | ; TODO: add model index and any other client state 434 | (define-record-type client 435 | (make-client name id pose state) 436 | client? 437 | (name client-name) ; string 438 | (id client-id) ; integer user id 439 | (pose client-pose) ; mat4 440 | (state client-state)) ; arbitrary s-expression 441 | 442 | ; Returns a client, or #f if not found. 443 | (define (client-by-id id) 444 | (define (scan lst) 445 | (cond 446 | ((null? lst) #f) 447 | ((= id (client-id (car lst))) (car lst)) 448 | (#t (scan (cdr lst))))) 449 | (scan *clients*)) 450 | 451 | 452 | ;------------------------------------------------------- 453 | ; sys commands write to the communications channel 454 | ; 455 | ; The convention is to name functions that add commands to 456 | ; the *frame-commands* list with a leading +. While they 457 | ; do mutate global state, no other script code (should) looks 458 | ; at the state until it is returned to the host, so giving 459 | ; them the conventional ! suffic for a mutating function is 460 | ; unnecessary. 461 | ;------------------------------------------------------- 462 | 463 | ; A list of s-expressions that will be compressed and sent to the HMD. 464 | (define *frame-commands* '()) 465 | 466 | (define (+cmd s) 467 | (set! *frame-commands* (cons s *frame-commands*))) 468 | 469 | ; Finish will cause a fade to black and script exit as if the user 470 | ; had pressed the back button, popping back to the launching 471 | ; script or out to the launching application. 472 | (define (+finish) 473 | (+cmd '(finish))) 474 | 475 | ; The master server will be informed to start advertizing this 476 | ; script and acting as a packet server for it, and the script will 477 | ; be restarted in social mode with the current state. 478 | (define (+share-server max-clients public title icon-uri) 479 | (if (controlling-client?) 480 | (begin 481 | (display "Server shared!\n") 482 | (+cmd (list 'share-server max-clients public title icon-uri))) 483 | #f)) 484 | 485 | ; Load and run a new script, optionally passing an s-expression to the new init function. 486 | (define (+link uri . parms) (+cmd (append (list 'link uri) parms))) 487 | 488 | ; Abort the current script and display an error message 489 | (define (+error str) (+cmd (list 'error str))) 490 | 491 | ;------------------------------------------------------- 492 | ; user positioning 493 | ; 494 | ; If it is not explicitly set, the eye position when starting a script 495 | ; will be at (0 0 0) in standard OpenGL orientation -- looking down 496 | ; -Z, with +X to the right and +Y up. Users can turn around to 497 | ; any angle, but reset orientation will return here. 498 | ; 499 | ; Note that the head-neck model and HMD position tracking will move 500 | ; the exact view position somewhat away from the programmed foot 501 | ; position. 502 | ; 503 | ; Note that currently, free joypad movement is allowed if the position 504 | ; isn't reset every frame. This will probably be turned into an option. 505 | ; 506 | ; Move the local client to a new position and default orientation. 507 | ; This is the "neautral eye position", the foot position used by the host 508 | ; VrScene code for collision detection is derived from this, and the 509 | ; origin extracted from the input pose will move around somewhat based on the 510 | ; head/neck model. 511 | ; 512 | ; 0 yaw is default looking down -Z, pi/2 is 513 | ; lookingdown -X, pi is down +Z, pi*3/2 is down +X. 514 | ; 515 | ; No interface is given for adjusting reference pitch or roll 516 | ; angles, because the gravity vector should be sacrosanct in VR! 517 | ;------------------------------------------------------- 518 | 519 | (define (+set-position pos yaw-radians) 520 | (+cmd (list 'pos (vec3->list pos) yaw-radians))) 521 | ; TODO: velocity for extrapolation on dropped frames once I get the scripts 522 | ; running in another thread properly. 523 | 524 | ; Reorient will make the user's current direction yaw 0.0. 525 | ; If an environment lets them look in all directions, but you want 526 | ; each transition to look at a particular thing, reorient when 527 | ; doing the set-position. 528 | (define (+reorient) 529 | (+cmd (list 'reorient))) 530 | 531 | ;------------------------------------------------------------ 532 | ; video commands 533 | ; 534 | ; The video will appear as an external image on texture slot 0. 535 | ;------------------------------------------------------------ 536 | 537 | (define (+video uri . opts) 538 | (+cmd (append (list 'video uri) opts))) 539 | 540 | 541 | ;------------------------------------------------------------ 542 | ; audio commands 543 | ; 544 | ; TODO: volume and frequency control. 545 | ; TODO: precise timing for updates as well as starts? 546 | ; Note that stereo wav files cannot be positioned, they will 547 | ; always play the same to the left and right ears regardless 548 | ; of head orientation or specified position. 549 | ;------------------------------------------------------------ 550 | 551 | ; 'loop is a valid atomic option flag. 552 | (define (+sound uri . opts) 553 | (+cmd (append (list 'sound (list 'wav uri)) opts))) 554 | 555 | (define (+sound-update name . opts) 556 | (+cmd (append (list 'sound (list 'name name)) opts))) 557 | 558 | ; A sound without a position will play at full volume in both ears 559 | ; without 3D spatialization. Stereo wav files are always played 560 | ; without spatialization. 561 | (define (opt-position v) 562 | (list 'position (vec3->list v))) 563 | 564 | ; A static sound with a position will automatically update as the 565 | ; user looks around, but for a sound to travel with a moving object 566 | ; it must be given a name and have opt-position updated with subsequent 567 | ; additional cmd-sound! commands. 568 | ; Name should be an integer. 569 | (define (opt-name name) 570 | (list 'name name)) 571 | 572 | ; If sounds need to be precisely timed, they can be started at an 573 | ; exact time in the future, which will be sample-accurate. If the 574 | ; time is in the past, the start of the sound will be chopped off. 575 | ; TODO: buffer multiple sounds with the same name and different times. 576 | (define (opt-time time) 577 | (list 'time time)) 578 | 579 | (define (opt-volume volume) 580 | (list 'volume volume)) 581 | 582 | 583 | ; The only way to stop sounds without a name is to stop all sounds. 584 | (define (+stop-sounds) 585 | (+cmd (list 'stop-sounds))) 586 | 587 | ; experimental: option parms 588 | (define (+delimited-sound . args) 589 | (define wav #f) 590 | (define position #f) 591 | (define name 0) 592 | (define volume 1.0) 593 | (define looping #f) 594 | (define (parse args) 595 | (cond 596 | ((null? args) #f) 597 | ((eq? (car args) 'wav) (set! wav (cadr args)) 598 | (parse (cddr args))) 599 | ((eq? (car args) 'position) (set! position (vec3->list (cadr args))) 600 | (parse (cddr args))) 601 | ((eq? (car args) 'name) (set! name (cadr args)) 602 | (parse (cddr args))) 603 | ((eq? (car args) 'volume) (set! volume (cadr args)) 604 | (parse (cddr args))) 605 | ((eq? (car args) 'looping) (set! looping #t) 606 | (parse (cdr args))) 607 | (else (+error (format "cmd-sound! unknown option: ~a\n" (car args)))))) 608 | (if (null? args) 609 | (+error "cmd-sound! with no parameters") 610 | (begin 611 | (if (string? (car args)) 612 | (begin 613 | (set! wav (car args)) 614 | (parse (cdr args))) 615 | (parse args)) 616 | (+cmd 'sound wav position name volume looping)))) 617 | 618 | ;------------------------------------------------------------ 619 | ; model commands 620 | ;------------------------------------------------------------ 621 | 622 | (define TEXT_HORIZONTAL_LEFT 0) 623 | (define TEXT_HORIZONTAL_CENTER 1) 624 | (define TEXT_HORIZONTAL_RIGHT 2) 625 | 626 | (define TEXT_VERTICAL_BASELINE 0) ; align text by baseline of first row 627 | (define TEXT_VERTICAL_CENTER 1) 628 | (define TEXT_VERTICAL_CENTER_FIXEDHEIGHT 2) ; ignores ascenders/descenders 629 | (define TEXT_VERTICAL_TOP 3) 630 | 631 | ; Specify size as font height? 632 | (define (+text txt xform . options) (+cmd (append (list 'text txt TEXT_HORIZONTAL_CENTER TEXT_VERTICAL_BASELINE (mat4->list xform)) options))) 633 | (define (+text-ext txt horiz vert xform . options) (+cmd (append (list 'text txt horiz vert (mat4->list xform)) options))) 634 | 635 | ; Creates a textured quad that goes from 0.0 0.0 0.0 to 1.0 1.0 0.0 with texture 636 | ; coordinates that go from 0.0 0.0 to 1.0 1.0. 637 | ; The front face of the quad is the +Z side, so translating it by 0.0 0.0 -1.0 will 638 | ; make it occupy the upper right quarter of a 90 degree view from the origin with the 639 | ; expected orientation. 640 | (define (+quad uri xform . options) (+cmd (append (list 'quad uri (mat4->list xform)) options))) 641 | 642 | ; The previous frame will be faded to black before this frame is applied and faded in. 643 | ; TODO: test this still works 644 | (define (+fade) (+cmd (list 'fade))) 645 | 646 | ; Only yaw orientations make sense for most panos. 647 | ; Changing pano will imply a fade out / fade in. It may stay 648 | ; faded to black for a significant amount of time if the pano is large and the 649 | ; net is slow. 650 | (define (+pano uri) (+cmd (list 'pano uri))) 651 | 652 | (define (+clear r g b a) (+cmd (list 'clear r g b a))) 653 | 654 | (define (+model uri xform . options) (+cmd (append (list 'model uri (mat4->list xform)) options))) 655 | 656 | ; Shaders can be defined globally or during init, then referenced with a shader parm on a surface. 657 | ; It is not legal to define shaders later, because clients joining after that point would 658 | ; never execute that command. 659 | (define (+shader name vertex fragment) (if init-completed 660 | (+error (format "Shader ~a defined after init" name)) 661 | (+cmd (list 'shader name vertex fragment)))) 662 | 663 | ; A 0.0 distance disables the gaze cursor. 664 | (define (+gaze-cursor distance) (+cmd (list 'gaze-cursor distance))) 665 | 666 | ;-------------------------------------- 667 | ; blending and other surface options 668 | ;-------------------------------------- 669 | 670 | ; BlendingFactorDest 671 | (define GL_ZERO 0) 672 | (define GL_ONE 1) 673 | (define GL_SRC_COLOR #x0300) 674 | (define GL_ONE_MINUS_SRC_COLOR #x0301) 675 | (define GL_SRC_ALPHA #x0302) 676 | (define GL_ONE_MINUS_SRC_ALPHA #x0303) 677 | (define GL_DST_ALPHA #x0304) 678 | (define GL_ONE_MINUS_DST_ALPHA #x0305) 679 | 680 | ; BlendingFactorSrc 681 | ; GL_ZERO 682 | ; GL_ONE 683 | (define GL_DST_COLOR #x0306) 684 | (define GL_ONE_MINUS_DST_COLOR #x0307) 685 | (define GL_SRC_ALPHA_SATURATE #x0308) 686 | ; GL_SRC_ALPHA 687 | ; GL_ONE_MINUS_SRC_ALPHA 688 | ; GL_DST_ALPHA 689 | ; GL_ONE_MINUS_DST_ALPHA 690 | 691 | ; BlendEquationSeparate 692 | (define GL_FUNC_ADD #x8006) 693 | (define GL_BLEND_EQUATION #x8009) 694 | (define GL_BLEND_EQUATION_RGB #x8009) ; same as BLEND_EQUATION 695 | (define GL_BLEND_EQUATION_ALPHA #x883D) 696 | 697 | ; BlendSubtract 698 | (define GL_FUNC_SUBTRACT #x800A) 699 | (define GL_FUNC_REVERSE_SUBTRACT #x800B) 700 | 701 | ; Separate Blend Functions 702 | (define GL_BLEND_DST_RGB #x80C8) 703 | (define GL_BLEND_SRC_RGB #x80C9) 704 | (define GL_BLEND_DST_ALPHA #x80CA) 705 | (define GL_BLEND_SRC_ALPHA #x80CB) 706 | (define GL_CONSTANT_COLOR #x8001) 707 | (define GL_ONE_MINUS_CONSTANT_COLOR #x8002) 708 | (define GL_CONSTANT_ALPHA #x8003) 709 | (define GL_ONE_MINUS_CONSTANT_ALPHA #x8004) 710 | (define GL_BLEND_COLOR #x8005) 711 | 712 | ; TODO: BlendColor support? 713 | 714 | ; Override the default blend mode on a surface 715 | (define (opt-blend-ext srcRGB destRGB srcAlpha dstAlpha modeRGB modeAlpha) (list 'blend srcRGB destRGB srcAlpha dstAlpha modeRGB modeAlpha)) 716 | (define (opt-blend src dst) (opt-blend-ext src dst src dst GL_FUNC_ADD GL_FUNC_ADD)) 717 | 718 | ; Arbitrary uniform parameter for surfaces to override the default 1.0 1.0 1.0 1.0 719 | (define (opt-parm x y z w) (list 'parm x y z w)) 720 | (define (opt-parmv p) (cons 'parm (vec4->list p))) 721 | 722 | ; Shader override parm 723 | (define (opt-shader p) (list 'shader p)) 724 | 725 | ; Texture override 726 | ; Allow any number of textures to be set (limited in vrscript to MAX_PROGRAM_TEXTURES) 727 | (define (opt-texture tx . extra) (append (list 'texture tx) extra)) 728 | 729 | ;-------------------------------------- 730 | ; development output 731 | ; 732 | ; TODO: have app capture all log output and allow a console toggle. That should 733 | ; be handled completely outside script. 734 | ;-------------------------------------- 735 | 736 | ; Displays text in a juddering face-locked HUD. Don't use this for real applications! 737 | ; This is for continuously updated data, it vanishes the following frame. 738 | ; TODO: consider adding support for a TimeWarp HUD that would never judder, like Stratum. 739 | (define (+hud text) 740 | (+text text (mat4-compose (mat4-translate 0.0 0.5 -1.0) *pose-inverse*))) 741 | 742 | ;-------------------------------------- 743 | ; time 744 | ; 745 | ; *script-seconds* is a biased real-time value that is monotonically 746 | ; increasing with no per-frame clamping. It will not change during tic 747 | ; processing, so it cannot be used for profiling internal functions, but 748 | ; you can tell if there was an unusually large gap between tics. 749 | ; 750 | ; In a non-social game, *script-seconds* will start at 0.0 for the first (tic). 751 | ; 752 | ; In a social game, all clients see the same *script-seconds*, which starts at 753 | ; 0.0 when the server was first created on the master server, which will usually be 754 | ; a second or two before the initial client runs a (tic). A server that doesn't 755 | ; halt-on-empty may be up for weeks at a time, so the second count can get quite large, 756 | ; but flonums in scheme are doubles, so there is no danger of precision loss. 757 | ; 758 | ; Sounds and videos can (TODO) be explicitly referenced to script-seconds, instead of 759 | ; the implicit "now", but explicit time references are invalid during (init), 760 | ; before the time base has been set. 761 | ; 762 | ; Internally there are three time bases: local time, server time, and script time, 763 | ; but it is a bug if the system doesn't completely hide it from script. 764 | ; 765 | ; To be precise, the local time that script time is corrected to is the 766 | ; PredictedDisplayTimeInSeconds from VrFrame, which is the midpoint of the expected 767 | ; time that the frame generated by this (tic) will be scanned out to video. If you 768 | ; are holding frame rate, that will be when the raster is in the middle of the screen. 769 | ; 770 | ;-------------------------------------- 771 | 772 | ; Updated from input-time by (tic) 773 | (define *script-seconds* 0.0) 774 | 775 | ; *script-seconds* from previous (tic) 776 | ; will me MAX_FLT on the first tic, so no time triggers will fire 777 | ; when a client joins a server that has been running for some time. 778 | (define *prev-script-seconds* 3.402823466385288599e+38) 779 | 780 | (define (crossed-seconds s) 781 | (and (>= *script-seconds* s) (< *prev-script-seconds* s))) 782 | 783 | ;-------------------------------------- 784 | ; input 785 | ;-------------------------------------- 786 | 787 | ; The input structure is sent each frame 788 | ; Time will be synchronized for all social clients 789 | (define-record-type input (make-input time pose button-state) input? 790 | (time input-time) 791 | (pose input-pose) 792 | (button-state input-button-state)) 793 | 794 | (define (input-from-sexp s) 795 | (make-input (car s) (list->mat4 (car (cdr s))) (car (cdr (cdr s))))) 796 | 797 | ; It is often convenient to be able to refer to the previous frame's 798 | ; input to check for transitions. 799 | (define *input* (make-input 0.0 mat4-identity 0)) 800 | (define *input-prev* (make-input 0.0 mat4-identity 0)) 801 | 802 | ; Since this is commonly used, it will be set automatically each frame. 803 | ; The pose matrix sent over with input each frame is a view matrix, the 804 | ; matrix that transforms world coordinates to eye coordinates. The 805 | ; inverse of that would be the model matrix for a player head model with 806 | ; the origin at the eye center. 807 | (define *pose-inverse* '()) 808 | 809 | (define (pressed-bit bit-index) 810 | (and (bitwise-bit-set? (input-button-state *input*) bit-index) (not (bitwise-bit-set? (input-button-state *input-prev*) bit-index)))) 811 | 812 | (define (held-bit bit-index) 813 | (bitwise-bit-set? (input-button-state *input*) bit-index)) 814 | 815 | (define (pressed-a) (pressed-bit 0)) 816 | (define (pressed-b) (pressed-bit 1)) 817 | (define (pressed-x) (pressed-bit 2)) 818 | (define (pressed-y) (pressed-bit 3)) 819 | (define (pressed-start) (pressed-bit 4)) 820 | (define (pressed-back) (pressed-bit 5)) 821 | (define (pressed-select) (pressed-bit 6)) 822 | (define (pressed-menu) (pressed-bit 7)) 823 | (define (pressed-right-trigger)(pressed-bit 8)) 824 | (define (pressed-left-trigger) (pressed-bit 9)) 825 | (define (pressed-dpad-up) (pressed-bit 10)) 826 | (define (pressed-dpad-down) (pressed-bit 11)) 827 | (define (pressed-dpad-left) (pressed-bit 12)) 828 | (define (pressed-dpad-right) (pressed-bit 13)) 829 | (define (pressed-lstick-up) (pressed-bit 14)) 830 | (define (pressed-lstick-down) (pressed-bit 15)) 831 | (define (pressed-lstick-left) (pressed-bit 16)) 832 | (define (pressed-lstick-right) (pressed-bit 17)) 833 | (define (pressed-rstick-up) (pressed-bit 18)) 834 | (define (pressed-rstick-down) (pressed-bit 19)) 835 | (define (pressed-rstick-left) (pressed-bit 20)) 836 | (define (pressed-rstick-right) (pressed-bit 21)) 837 | (define (pressed-touch) (pressed-bit 22)) 838 | (define (pressed-swipe-up) (pressed-bit 23)) 839 | (define (pressed-swipe-down) (pressed-bit 24)) 840 | (define (pressed-swipe-forward) (pressed-bit 25)) 841 | (define (pressed-swipe-back) (pressed-bit 26)) 842 | 843 | (define (held-a) (held-bit 0)) 844 | (define (held-b) (held-bit 1)) 845 | (define (held-x) (held-bit 2)) 846 | (define (held-y) (held-bit 3)) 847 | (define (held-start) (held-bit 4)) 848 | (define (held-back) (held-bit 5)) 849 | (define (held-select) (held-bit 6)) 850 | (define (held-menu) (held-bit 7)) 851 | (define (held-right-trigger)(held-bit 8)) 852 | (define (held-left-trigger) (held-bit 9)) 853 | (define (held-dpad-up) (held-bit 10)) 854 | (define (held-dpad-down) (held-bit 11)) 855 | (define (held-dpad-left) (held-bit 12)) 856 | (define (held-dpad-right) (held-bit 13)) 857 | (define (held-lstick-up) (held-bit 14)) 858 | (define (held-lstick-down) (held-bit 15)) 859 | (define (held-lstick-left) (held-bit 16)) 860 | (define (held-lstick-right) (held-bit 17)) 861 | (define (held-rstick-up) (held-bit 18)) 862 | (define (held-rstick-down) (held-bit 19)) 863 | (define (held-rstick-left) (held-bit 20)) 864 | (define (held-rstick-right) (held-bit 21)) 865 | (define (held-touch) (held-bit 22)) 866 | (define (held-swipe-up) (held-bit 23)) 867 | (define (held-swipe-down) (held-bit 24)) 868 | (define (held-swipe-forward) (held-bit 25)) 869 | (define (held-swipe-back) (held-bit 26)) 870 | 871 | ; "action" can be either joypad A or touchpad tap 872 | (define (pressed-action) (or (pressed-a) (pressed-touch))) 873 | 874 | (define (held-action) (or (held-a) (held-touch))) 875 | 876 | ;-------------------------------------- 877 | ; uri / init 878 | ;-------------------------------------- 879 | 880 | ; This is mostly used by the uri macro, but it can be used to start 881 | ; a background download at any time. 882 | (define (+cache uri) 883 | (+cmd (list 'cache uri))) 884 | 885 | ; If strings are defined with this macro, they will be automatically 886 | ; pre-cached on startup: 887 | ; (uri WAV-GAZE-ON "http://s3.amazonaws.com/o.oculuscdn.com/netasset/wav/ui_object_gaze_on.wav") 888 | (define-syntax uri 889 | (syntax-rules () 890 | ((_ name address) 891 | (begin 892 | (+cache address) 893 | (define name address))))) 894 | 895 | ;----------------- 896 | ; gaze-on-bounds? 897 | ; 898 | ; Returns #t if the gaze is on the transformed bounds. 899 | ; Gaze is a ray defined by the current pose, extending forward to infinity. 900 | ; 901 | ; Tracks *gaze-on-this-frame* and *gaze-close-this-frame* based on all 902 | ; calls made to this test function. 903 | ; 904 | ; gaze-effects 905 | ; Plays enter/leave sounds and enabled/disables the gaze cursor based on 906 | ; all the calls to ui-bounds this frame. 907 | ;----------------- 908 | (define *gaze-close-this-frame* #f) 909 | (define *gaze-close-last-frame* #f) 910 | (define *gaze-on-this-frame* #f) 911 | (define *gaze-on-last-frame* #f) 912 | (define *debug-gaze* #f) ; if true, draw colored bounds for every gaze-on-bounds test 913 | 914 | ; Return the midpoint in world space of the transformed bounds 915 | (define (center-of-transformed-bounds bounds trans) 916 | (mat4-transform3 trans (bounds3-midpoint bounds))) 917 | 918 | (define *gaze-close-this-test* #f) ; hacky global for second return from gaze-on-bounds? 919 | 920 | (define (gaze-on-bounds? bounds xform) 921 | (define start (mat4-origin *pose-inverse*)) 922 | (define (bent-gaze-forward center) 923 | (define dir (mat4-forward *pose-inverse*)) 924 | (define dir-center (vec3-normalize (sub3 center start))) 925 | (define dir-delta (sub3 dir-center dir)) 926 | (define delta-len (vec3-length dir-delta)) 927 | (add3 dir (scale3 dir-delta (min 1.0 (/ 0.1 delta-len))))) 928 | 929 | ; Do the close test first, and skip the on test if not close 930 | (define forward (bent-gaze-forward (center-of-transformed-bounds bounds xform))) 931 | (set! *gaze-close-this-test* (ray-hits-transformed-bounds? start 932 | forward 933 | bounds 934 | xform)) 935 | 936 | ; Check for exactly hitting it 937 | (define gaze-on (and *gaze-close-this-test* 938 | (ray-hits-transformed-bounds? start 939 | (mat4-forward *pose-inverse*) 940 | bounds 941 | xform))) 942 | 943 | (set! *gaze-on-this-frame* (or *gaze-on-this-frame* gaze-on)) 944 | (set! *gaze-close-this-frame* (or *gaze-close-this-frame* *gaze-close-this-test*)) 945 | 946 | ; For debugging, draw the collision bounds in different colors based 947 | ; on if the gaze is on it or close. 948 | (if *debug-gaze* 949 | (+model "_bounds" xform (cond 950 | (gaze-on (opt-parm 1.0 0.0 0.0 1.0)) 951 | ; (gaze-close (opt-parm 1.0 1.0 0.0 1.0)) 952 | (else (opt-parm 0.0 1.0 0.0 1.0)))) 953 | #f) 954 | 955 | ; return value of test 956 | gaze-on) 957 | 958 | (uri WAV-GAZE-ON "http://s3.amazonaws.com/o.oculuscdn.com/netasset/wav/ui_object_gaze_on.wav") 959 | (uri WAV-GAZE-OFF "http://s3.amazonaws.com/o.oculuscdn.com/netasset/wav/ui_object_gaze_off.wav") 960 | 961 | (define (gaze-effects) 962 | ; if we are gazing on it now, and weren't last frame, play the on-sound 963 | (if (and *gaze-on-this-frame* (not *gaze-on-last-frame*)) 964 | (+sound WAV-GAZE-ON) 965 | #f) 966 | 967 | ; if the last gaze-on was the previous frame, play the off-sound 968 | (if (and *gaze-on-last-frame* (not *gaze-on-this-frame*)) 969 | (+sound WAV-GAZE-OFF) 970 | #f) 971 | 972 | ; enable the gaze cursor if gaze-on or gaze-close 973 | (+gaze-cursor 974 | (if (or *gaze-on-this-frame* *gaze-close-this-frame*) 975 | 1.4 976 | 0.0)) 977 | 978 | ; update state for next frame 979 | (set! *gaze-on-last-frame* *gaze-on-this-frame*) 980 | (set! *gaze-close-last-frame* *gaze-close-this-frame*) 981 | (set! *gaze-on-this-frame* #f) 982 | (set! *gaze-close-this-frame* #f) 983 | ) 984 | 985 | ;-------------------------------------- 986 | ; init-wrap 987 | ; 988 | ; An arbitrary sexpr can be passed to the script if it was launched from 989 | ; another script. 990 | ; 991 | ; The init function returns the command-list that has been built 992 | ; up by the uri macros and other functions before any frames have 993 | ; been executed. 994 | ; 995 | ; server-state must be initialized and returned, but social games 996 | ; will have it immediately replaced with the data from the packet server. 997 | ;-------------------------------------- 998 | 999 | ; Set this true to get dumps of input and output for (init) and the first (frame). 1000 | ; It can be rather bulky. 1001 | (define debug-messages #f) 1002 | 1003 | 1004 | ; Boilerplate called either by remote.rkt or directly form vrscript with Chibi. 1005 | 1006 | ; Some commands, like shader and geometry specification, are only 1007 | ; legal in global definitions or during init, because they must 1008 | ; always be available to clients that join later. 1009 | (define init-completed #f) 1010 | 1011 | (define init-parms '()) 1012 | 1013 | ; Arbitrary key/value information can be passed to the init function. 1014 | ; Defined symbols: 1015 | ; "ip" : ip address of phone 1016 | ; "social" : #t if running networked 1017 | ; 1018 | (define (init-parm key) 1019 | (define pair (assoc key init-parms)) 1020 | (if pair (cadr pair) #f)) 1021 | 1022 | (define (init-wrap init-function init-sexp) 1023 | (when debug-messages 1024 | (printf "init parms: ~s\n" init-sexp)) 1025 | 1026 | ; Pull some information out of init-sexp now, but 1027 | ; the full list is retained for later reference. 1028 | (set! init-parms init-sexp) 1029 | (set! social? (init-parm "social")) 1030 | 1031 | ; Run the init function if it exists. 1032 | (when init-function 1033 | (init-function init-sexp)) 1034 | 1035 | ; Always send the server state and client state 1036 | (+cmd (list 'client-state (sexpr->string *client-state*))) 1037 | (+cmd (list 'server-state (list *controlling-client-id* *client-seats* (sexpr->string *server-state*)))) 1038 | 1039 | ; Reverse the list so it is executed in the order it was created 1040 | (set! *frame-commands* (reverse *frame-commands*)) 1041 | 1042 | ; Dump for debugging. 1043 | (when debug-messages 1044 | (printf "Init return: ~s\n" *frame-commands*)) 1045 | 1046 | ; Shader and geometry generation is now illegal. 1047 | (set! init-completed #t) 1048 | 1049 | *frame-commands*) 1050 | 1051 | ;-------------------------------------- 1052 | ; tic-wrap 1053 | ; 1054 | ; ( (local-client-id (controlling-client-id (client-seats) server-state-string)) ( ... ) ) ) 1055 | ; Returns the *frame-commands* list. 1056 | ;-------------------------------------- 1057 | 1058 | (define *frame-number* 0) 1059 | (define *tic-input* '()) 1060 | 1061 | ; Boilerplate called either by remote.rkt or directly form NetHmd with Chibi. 1062 | (define (tic-wrap tic-function tic-input) 1063 | (when (and debug-messages (= 1 *frame-number*)) 1064 | (printf "Initial ~a tic parms: ~s\n" (length tic-input) tic-input)) 1065 | 1066 | (set! *tic-input* tic-input) 1067 | 1068 | ; pull out the multi-player 1069 | (define multi (list-ref tic-input 1)) 1070 | 1071 | (set! *local-client-id* (list-ref multi 0)) 1072 | 1073 | ; pull out the MutableServerState 1074 | (define mss (list-ref multi 1)) 1075 | 1076 | (set! *controlling-client-id* (list-ref mss 0)) 1077 | (set! *client-seats* (list-ref mss 1)) 1078 | 1079 | ; If in social mode, *server-state* may be modified by other clients 1080 | ; if we aren't the controlling client. 1081 | (when social? 1082 | (set! *server-state* (string->sexpr (list-ref mss 2)))) 1083 | 1084 | ; Turn each client list into a client record and convert the 1085 | ; opaque application specific state string into an s-expression. 1086 | (set! *clients* (map (lambda (c) 1087 | (make-client (list-ref c 0) (list-ref c 1) (list-ref c 2) (string->sexpr (list-ref c 3)))) 1088 | (list-ref multi 2))) 1089 | 1090 | (set! *input-prev* *input*) 1091 | (set! *input* (input-from-sexp (list-ref tic-input 0))) 1092 | (set! *pose-inverse* (mat4-inverse (input-pose *input*))) 1093 | (set! *frame-number* (+ 1 *frame-number*)) 1094 | (set! *script-seconds* (input-time *input*)) 1095 | 1096 | ; clear commands 1097 | (set! *frame-commands* '()) 1098 | 1099 | ; Run the frame to generate commands 1100 | ; and update global state. 1101 | (tic-function) 1102 | 1103 | ; Play sounds and enable the gaze cursor based on tests for active elements 1104 | (gaze-effects) 1105 | 1106 | ; Move over *prev-script-seconds* for the next frame 1107 | (set! *prev-script-seconds* *script-seconds*) 1108 | 1109 | ; Always add the client-state and server-state messages 1110 | (+cmd (list 'client-state (sexpr->string *client-state*))) 1111 | (+cmd (list 'server-state (list *controlling-client-id* *client-seats* (sexpr->string *server-state*)))) 1112 | 1113 | ; Reverse the list so it is executed in the order it was created 1114 | (set! *frame-commands* (reverse *frame-commands*)) 1115 | 1116 | ; Dump for debugging. 1117 | (when (and debug-messages (= 1 *frame-number*)) 1118 | (printf "Initial tic return: ~s\n" *frame-commands*)) 1119 | 1120 | ; Return the command list to the host program. 1121 | *frame-commands*) 1122 | 1123 | ; C accelerator functions 1124 | ;(define mt1 (mat4-rotate-x 1.0)) 1125 | ;(define mt2 (mat4-rotate-y 1.0)) 1126 | ;(printf "scheme: ~s\n" (mat4->list (mat4-mul mt1 mt2))) 1127 | ;(printf "ffi: ~s\n" (mat4->list (mat4-mul-c mt1 mt2))) 1128 | 1129 | --------------------------------------------------------------------------------