1 2;;--------------------------------------------------------------- 3;; utility stuff 4 5(define (vehicle-broadside-facing vehicle dx dy) 6 (let ((facing (kern-obj-get-facing vehicle))) 7 (cond ((< dx 0) ;;west side 8 (if (equal? facing NORTH) NORTH SOUTH)) 9 ((> dx 0) ;;east side 10 (if (equal? facing SOUTH) SOUTH NORTH)) 11 ((< dy 0) ;;north side 12 (if (equal? facing WEST) WEST EAST)) 13 ((> dy 0) ;;south side 14 (if (equal? facing EAST) EAST WEST)) 15 (else facing) 16 ))) 17 18(define (map-paste-centered dst-map src-map src-x src-y src-w src-h dst-x dst-y dst-w dst-h) 19 (let* ((cw (min src-w dst-w)) 20 (ch (min src-h dst-h)) 21 (src-cx (floor (+ src-x (/ (- src-w cw) 2)))) 22 (dst-cx (floor (+ dst-x (/ (- dst-w cw) 2)))) 23 (src-cy (floor (+ src-y (/ (- src-h ch) 2)))) 24 (dst-cy (floor (+ dst-y (/ (- dst-h ch) 2))))) 25 (kern-blit-map dst-map dst-cx dst-cy 26 src-map src-cx src-cy 27 cw ch) 28 )) 29 30(define (place-add-objects-offset place src-x src-y src-w src-h dst-x dst-y dst-w dst-h objectlist) 31 (let* ((cw (min src-w dst-w)) 32 (ch (min src-h dst-h)) 33 (src-cx (floor (+ src-x (/ (- src-w cw) 2)))) 34 (dst-cx (floor (+ dst-x (/ (- dst-w cw) 2)))) 35 (src-cy (floor (+ src-y (/ (- src-h ch) 2)))) 36 (dst-cy (floor (+ dst-y (/ (- dst-h ch) 2)))) 37 (dx (- dst-cx src-cx)) 38 (dy (- dst-cy src-cy))) 39 (map 40 (lambda (objectentry) 41 (kern-obj-put-at (car objectentry) 42 (list place 43 (+ (cadr objectentry) dx) 44 (+ (caddr objectentry) dy) 45 )) 46 ) 47 objectlist 48 ) 49 )) 50 51(define (mk-vehicle ktype) 52 (kern-mk-vehicle ktype north 100)) 53 54(define (vehicle-object-list-rotate facing n-wid n-hgt objectlist) 55 (let* ((turn-matrix (cond 56 ((equal? facing NORTH) (list 0 0 1 0 0 1)) 57 ((equal? facing EAST) (list (- n-hgt 1) 0 0 -1 1 0)) 58 ((equal? facing WEST) (list 0 (- n-wid 1) 0 1 -1 0)) 59 (else (list (- n-wid 1) (- n-hgt 1) -1 0 0 -1)))) 60 (xoff (car turn-matrix)) 61 (yoff (cadr turn-matrix)) 62 (xxmult (list-ref turn-matrix 2)) 63 (xymult (list-ref turn-matrix 3)) 64 (yxmult (list-ref turn-matrix 4)) 65 (yymult (list-ref turn-matrix 5))) 66 (map 67 (lambda (objectentry) 68 (list 69 (car objectentry) 70 (+ xoff (* xxmult (cadr objectentry)) (* xymult (caddr objectentry))) 71 (+ yoff (* yxmult (cadr objectentry)) (* yymult (caddr objectentry))) 72 ) 73 ) 74 objectlist 75 ) 76 )) 77 78(define (facing-turn-90right facing) 79 (cond ((equal? facing NORTH) EAST) 80 ((equal? facing WEST) NORTH) 81 ((equal? facing EAST) SOUTH) 82 ((equal? facing SOUTH) WEST) 83 (else facing))) 84 85(define (facing-turn-90left facing) 86 (cond ((equal? facing NORTH) WEST) 87 ((equal? facing WEST) SOUTH) 88 ((equal? facing EAST) NORTH) 89 ((equal? facing SOUTH) EAST) 90 (else facing))) 91 92 93;;-------------------------------------------------------------------------- 94;; vehicle objects: wheel 95 96(define shipwheel-ifc 97 (ifc '() 98 (method 'init 99 (lambda (kwheel) 100 (kern-obj-set-facing kwheel (gob kwheel)) 101 )) 102 )) 103 104(mk-obj-type 't_shipswheel "ship's wheel" s_shipswheel layer-mechanism shipwheel-ifc) 105 106(define (vehicle-mk-wheel facing) 107 (let ((kwheel (kern-mk-obj t_shipswheel 1))) 108 (kern-obj-set-facing kwheel facing) 109 (bind kwheel facing) 110 kwheel)) 111 112;;--------------------------------------------------------------------------- 113;; boarding ramp handling 114 115(define onramp-ifc 116 (ifc '() 117 (method 'exec 118 (lambda (kramp) 119 (let* ((kloc (kern-obj-get-location kramp)) 120 (kplace (car kloc)) 121 (wid (kern-place-get-width kplace)) 122 (hgt (kern-place-get-height kplace)) 123 (rx (cadr kloc)) 124 (ry (caddr kloc))) 125 (define (vehicle-check-ramp x y) 126 (cond ((< x 0) 0) 127 ((> x wid) 0) 128 ((< y 0) 0) 129 ((> y hgt) 0) 130 ((kern-place-is-passable (list kplace x y) kramp) 1) 131 (else 132 (let ((objs (kern-get-objects-at (list kplace x y)))) 133 (if (and (not (null? objs)) 134 (equal? (kern-obj-get-type (car objs)) (eval 't_onramp))) 135 1 136 0))) 137 )) 138 (define (vehicle-trigger-ramp-neighbors x y) 139 (cond ((< x 0) 0) 140 ((> x wid) 0) 141 ((< y 0) 0) 142 ((> y hgt) 0) 143 (else 144 (let ((objs (kern-get-objects-at (list kplace x y)))) 145 (if (and (not (null? objs)) 146 (equal? (kern-obj-get-type (car objs)) (eval 't_onramp))) 147 ((kobj-ifc (car objs)) 'exec (car objs)) 148 0))) 149 )) 150 (if (< 1 151 (+ (vehicle-check-ramp (+ rx 1) ry) 152 (vehicle-check-ramp (- rx 1) ry) 153 (vehicle-check-ramp rx (+ ry 1)) 154 (vehicle-check-ramp rx (- ry 1)))) 155 (begin 156 (kern-place-set-terrain (list kplace rx ry) t_deck) 157 (kern-obj-remove kramp) 158 (vehicle-trigger-ramp-neighbors (+ rx 1) ry) 159 (vehicle-trigger-ramp-neighbors (- rx 1) ry) 160 (vehicle-trigger-ramp-neighbors rx (+ ry 1)) 161 (vehicle-trigger-ramp-neighbors rx (- ry 1)) 162 ) 163 (kern-obj-remove kramp) 164 ) 165 ))) 166 )) 167 168(mk-obj-type 't_onramp nil nil layer-none onramp-ifc) 169 170;;------------------------------------------------------------------------ 171;; ship 172 173(kern-mk-map 174 'm_ship_n 9 17 pal_expanded 175 (list 176 "-- -- -- -- -- -- -- -- --"; 177 "-- -- -- #e #a #f -- -- --"; 178 "-- -- #e #E ee #F #f -- --"; 179 "-- #e #E ee ee ee #F #f --"; 180 "-- #b ee ee ee ee ee #c --"; 181 "-- #b <n #= #= #= <n #c --"; 182 "-- ee ee ee oo ee ee ee --"; 183 "-- #b ee ee ee ee ee #c --"; 184 "-- #b ee ee ee ee ee #c --"; 185 "-- #b ee ee ee ee ee #c --"; 186 "-- ee ee ee ee ee ee ee --"; 187 "-- #b ee ee oo ee ee #c --"; 188 "-- #b <s #= #= #= <s #c --"; 189 "-- #b ee ee ee ee ee #c --"; 190 "-- #g #G ee ee ee #H #h --"; 191 "-- -- #g #d #d #d #h -- --"; 192 "-- -- -- -- -- -- -- -- --"; 193 )) 194 195(kern-mk-map 196 'm_ship_s 9 17 pal_expanded 197 (list 198 "-- -- -- -- -- -- -- -- --"; 199 "-- -- #e #a #a #a #f -- --"; 200 "-- #e #E ee ee ee #F #f --"; 201 "-- #b ee ee ee ee ee #c --"; 202 "-- #b <n #= #= #= <n #c --"; 203 "-- #b ee ee oo ee ee #c --"; 204 "-- ee ee ee ee ee ee ee --"; 205 "-- #b ee ee ee ee ee #c --"; 206 "-- #b ee ee ee ee ee #c --"; 207 "-- #b ee ee ee ee ee #c --"; 208 "-- ee ee ee oo ee ee ee --"; 209 "-- #b <s #= #= #= <s #c --"; 210 "-- #b ee ee ee ee ee #c --"; 211 "-- #g #G ee ee ee #H #h --"; 212 "-- -- #g #G ee #H #h -- --"; 213 "-- -- -- #g #d #h -- -- --"; 214 "-- -- -- -- -- -- -- -- --"; 215 )) 216 217(kern-mk-map 218 'm_ship_e 17 9 pal_expanded 219 (list 220 "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --"; 221 "-- -- #e #a #a #a ee #a #a #a ee #a #a #f -- -- --"; 222 "-- #e #E ee <w ee ee ee ee ee ee <e ee #F #f -- --"; 223 "-- #b ee ee #| ee ee ee ee ee ee #| ee ee #F #f --"; 224 "-- #b ee ee #| oo ee ee ee ee oo #| ee ee ee #c --"; 225 "-- #b ee ee #| ee ee ee ee ee ee #| ee ee #H #h --"; 226 "-- #g #G ee <w ee ee ee ee ee ee <e ee #H #h -- --"; 227 "-- -- #g #d #d #d ee #d #d #d ee #d #d #h -- -- --"; 228 "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --"; 229 )) 230 231(kern-mk-map 232 'm_ship_w 17 9 pal_expanded 233 (list 234 "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --"; 235 "-- -- -- #e #a #a ee #a #a #a ee #a #a #a #f -- --"; 236 "-- -- #e #E ee <w ee ee ee ee ee ee <e ee #F #f --"; 237 "-- #e #E ee ee #| ee ee ee ee ee ee #| ee ee #c --"; 238 "-- #b ee ee ee #| oo ee ee ee ee oo #| ee ee #c --"; 239 "-- #g #G ee ee #| ee ee ee ee ee ee #| ee ee #c --"; 240 "-- -- #g #G ee <w ee ee ee ee ee ee <e ee #H #h --"; 241 "-- -- -- #g #d #d ee #d #d #d ee #d #d #d #h -- --"; 242 "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --"; 243 )) 244 245(define vehicle-ship-handler 246 (lambda (place vehicle off_x off_y) 247 (let* ((facing (vehicle-broadside-facing vehicle off_x off_y)) 248 (vmap (get-cardinal-lref (list m_ship_n m_ship_w m_ship_e m_ship_s) facing)) 249 (src-w (kern-terrainmap-get-width vmap)) 250 (src-h (kern-terrainmap-get-height vmap)) 251 (dst-x (combat-off-to-dst off_x)) 252 (dst-y (combat-off-to-dst off_y)) 253 (dst-w (combat-off-to-len (kern-place-get-width place) off_x)) 254 (dst-h (combat-off-to-len (kern-place-get-height place) off_y))) 255 (map-paste-centered (kern-place-get-terrain-map place) vmap 256 0 0 src-w src-h 257 dst-x dst-y dst-w dst-h) 258 (place-add-objects-offset place 259 0 0 src-w src-h 260 dst-x dst-y dst-w dst-h 261 (vehicle-object-list-rotate facing 9 17 262 (list 263 (list (vehicle-mk-wheel facing) 4 12) 264 (list (arms-mk-cannon (facing-turn-90right facing)) 7 8) 265 (list (arms-mk-cannon (facing-turn-90left facing)) 1 8) 266 (list (kern-mk-obj t_onramp 1) 0 6) 267 (list (kern-mk-obj t_onramp 1) 8 6) 268 (list (kern-mk-obj t_onramp 1) 0 10) 269 (list (kern-mk-obj t_onramp 1) 8 10) 270 ))) 271 ))) 272 273 274(kern-mk-vehicle-type 't_ship ; tag 275 "ship" ; name 276 s_ship ; sprite 277 m_ship_n ; map 278 t_cannon ; ordnance 279 #t ; vulnerable 280 #t ; occupants die when destroyed 281 #t ; must turn 282 "sail" ; move description 283 sound-ship-move ; move sound 284 1 ; tailwind penalty 285 4 ; headwind penalty 286 2 ; crosswind penalty 287 100 ; max hp 288 speed-ship ; speed 289 mmode-ship ; pmask 290 vehicle-ship-handler; 291 ) 292 293(define (mk-ship) 294 (kern-mk-vehicle t_ship north 100)) 295 296;;---------------------------------------------------------------------------- 297;; voidship 298;;---------------------------------------------------------------------------- 299(kern-mk-map 300 'm_voidship_n 9 17 pal_expanded 301 (list 302 "** ** ** ** ** ** ** ** **" 303 "** ** ** ** ** ** ** ** **" 304 "** ** ** #i #A #j ** ** **" 305 "** ** #i #E ee #F #j ** **" 306 "** #i #E ee ee ee #F #j **" 307 "** #B ee ee 00 ee ee #C **" 308 "** #B ee ee 00 ee ee #C **" 309 "** #B ee ee ee ee ee #C **" 310 "** ee ee ee ee ee ee ee **" 311 "** #B ee ee ee ee ee #C **" 312 "#n #m #O ee ee ee #N #m #o" 313 "#m #m #M ee 00 ee #m #m #M" 314 "#m #m #M ee ## ee #m #m #M" 315 "#m #m #M #D ## #D #m #m #M" 316 "#m #m #M ** ** ** #m #m #M" 317 "#p #M #q ** ** ** #p #M #q" 318 "** ** ** ** ** ** ** ** **" 319 )) 320 321(kern-mk-map 322 'm_voidship_s 9 17 pal_expanded 323 (list 324 "** ** ** ** ** ** ** ** **" 325 "#n #m #o ** ** ** #n #m #o" 326 "#m #m #M ** ** ** #m #m #M" 327 "#m #m #M #A ## #A #m #m #M" 328 "#m #m #M ee ## ee #m #m #M" 329 "#m #m #M ee 00 ee #m #m #M" 330 "#p #M #Q ee ee ee #P #M #q" 331 "** #B ee ee ee ee ee #C **" 332 "** ee ee ee ee ee ee ee **" 333 "** #B ee ee ee ee ee #C **" 334 "** #B ee ee 00 ee ee #C **" 335 "** #B ee ee 00 ee ee #C **" 336 "** #k #G ee ee ee #H #l **" 337 "** ** #k #G ee #H #l ** **" 338 "** ** ** #k #D #l ** ** **" 339 "** ** ** ** ** ** ** ** **" 340 "** ** ** ** ** ** ** ** **" 341 )) 342 343(kern-mk-map 344 'm_voidship_e 17 9 pal_expanded 345 (list 346 "** #n #m #m #m #m #o ** ** ** ** ** ** ** ** ** **"; 347 "** #m #m #m #m #m #M #A ee #A #A #A #j ** ** ** **"; 348 "** #p #M #M #M #M #Q ee ee ee ee ee #F #j ** ** **"; 349 "** ** ** #B ee ee ee ee ee ee ee ee ee #F #j ** **"; 350 "** ** ** ## ## 00 ee ee ee ee 00 00 ee ee #C ** **"; 351 "** ** ** #B ee ee ee ee ee ee ee ee ee #H #l ** **"; 352 "** #n #m #m #m #m #O ee ee ee ee ee #H #l ** ** **"; 353 "** #m #m #m #m #m #M #D ee #D #D #D #l ** ** ** **"; 354 "** #p #M #M #M #M #q ** ** ** ** ** ** ** ** ** **"; 355 )) 356 357 358(kern-mk-map 359 'm_voidship_w 17 9 pal_expanded 360 (list 361 "** ** ** ** ** ** ** ** ** ** #n #m #m #m #m #o **"; 362 "** ** ** ** #i #A #A #A ee #A #m #m #m #m #m #M **"; 363 "** ** ** #i #E ee ee ee ee ee #P #M #M #M #M #q **"; 364 "** ** #i #E ee ee ee ee ee ee ee ee ee #C ** ** **"; 365 "** ** #B ee ee 00 00 ee ee ee ee 00 ## ## ** ** **"; 366 "** ** #k #G ee ee ee ee ee ee ee ee ee #C ** ** **"; 367 "** ** ** #k #G ee ee ee ee ee #N #m #m #m #m #o **"; 368 "** ** ** ** #k #D #D #D ee #D #m #m #m #m #m #M **"; 369 "** ** ** ** ** ** ** ** ** ** #p #M #M #M #M #q **"; 370 )) 371 372(define vehicle-voidship-handler 373 (lambda (place vehicle off_x off_y) 374 (let* ((facing (vehicle-broadside-facing vehicle off_x off_y)) 375 (vmap (get-cardinal-lref (list m_voidship_n m_voidship_w m_voidship_e m_voidship_s) facing)) 376 (src-w (kern-terrainmap-get-width vmap)) 377 (src-h (kern-terrainmap-get-height vmap)) 378 (dst-x (combat-off-to-dst off_x)) 379 (dst-y (combat-off-to-dst off_y)) 380 (dst-w (combat-off-to-len (kern-place-get-width place) off_x)) 381 (dst-h (combat-off-to-len (kern-place-get-height place) off_y))) 382 (map-paste-centered (kern-place-get-terrain-map place) vmap 383 0 0 src-w src-h 384 dst-x dst-y dst-w dst-h) 385 (place-add-objects-offset place 386 0 0 src-w src-h 387 dst-x dst-y dst-w dst-h 388 (vehicle-object-list-rotate facing 9 17 389 (list 390 (list (vehicle-mk-wheel facing) 4 6) 391 (list (arms-mk-cannon (facing-turn-90right facing)) 7 6) 392 (list (arms-mk-cannon (facing-turn-90left facing)) 1 6) 393 (list (kern-mk-obj t_onramp 1) 0 8) 394 (list (kern-mk-obj t_onramp 1) 8 8) 395 ))) 396 ))) 397 398(kern-mk-vehicle-type 't_voidship ; tag 399 "voidship" ; name 400 s_void_ship ; sprite 401 m_voidship_n ; map 402 t_cannon ; ordnance 403 #t ; vulnerable 404 #t ; occupants die when destroyed 405 #t ; must turn 406 "sail" ; move description 407 sound-ship-move ; move sound 408 1 ; tailwind penalty 409 4 ; headwind penalty 410 2 ; crosswind penalty 411 100 ; max hp 412 speed-ship ; speed 413 mmode-voidship ; pmask 414 vehicle-voidship-handler; 415 ) 416 417 418(define (mk-voidship) 419 (kern-mk-vehicle t_voidship north 100)) 420 421