1;;---------------------------------------------------------------------------- 2;; tblit.scm - a terrain-blitting mech 3;;---------------------------------------------------------------------------- 4 5;; Some convenient maps for blitting 6(kern-mk-map 7 'm_hall_section 3 3 pal_expanded 8 (list 9 ",, ,, ,," 10 ",, ,, ,," 11 ",, ,, ,," 12 )) 13 14(kern-mk-map 15 'm_deck_section 3 3 pal_expanded 16 (list 17 "ee ee ee" 18 "ee ee ee" 19 "ee ee ee" 20 )) 21 22 23;; A curried wrapper for kern-blit-map (note that place may legitimately be 24;; null during startup) 25(define (blit-map place x y w h map) 26 (if (notnull? place) 27 (kern-blit-map (kern-place-map place) x y map 0 0 w h))) 28 29;; Syntactic sugar to set blitter state 30(define (tblit-mk place-tag x y w h map-tag) (list place-tag x y w h map-tag)) 31 32;; Do the blit upon receiving an "on" signal. 33(define (tblit-on kobj) 34 (apply blit-map (map safe-eval (kobj-gob-data kobj)))) 35 36;; Blit mechs are not visible. 37(define (tblit-init kobj) 38 (kern-obj-set-visible kobj #f)) 39 40;; A blitter mech responds to an "on" signal by executing the blit 41(define tblit-ifc 42 (ifc '() 43 (method 'on tblit-on) 44 (method 'init tblit-init))) 45 46;; The kernel object type of a blitter 47(mk-obj-type 't_terrain_blitter '() '() layer-mechanism 48 tblit-ifc) 49 50;; Constructor 51(define (mk-tblitter place-tag x y w h map-tag) 52 (bind (kern-mk-obj t_terrain_blitter 1) 53 (tblit-mk place-tag x y w h map-tag))) 54