rebol [ Title: "Christmas Drive" File: %christmas-drive2.0.1.r Date: 29-Dec-2005 Version: 2.0.1 Progress: 0.20 Status: "working" Needs: [View] Author: "Anton Rolls" Language: "English" Purpose: {} License: 'MIT ; see http://www.rebol.com/docs/bsd-mit-license.html Usage: {} History: [ 2.0.0 [27-Dec-2005 {First version forked from 1.0.0, created zooming frames, road, left and right banks, made it resizeable (simplistically), added zooming snow, trees, snowmen} "Anton"] 2.0.1 [29-Dec-2005 {improved snowman and snowflakes} "Anton"] ] ToDo: { - tween frames; the final img can be zoomed a few times before a new far frame has to be added and the frames zoomed. I think at least one tween frame will not be noticeable, but speed things up significantly. - objects appear to float above the ground a little bit sometimes - different types of trees and other objects (snowmen etc.) - several objects could be snowmen at various stages of completion - make it more resizeable, better variables etc. - resize tree and other objects when window resizes - car or a sled ? - simple horizontal scrolling mountainous backdrop ? } Notes: {} ] initial-size: 350x200 drive-scene: context [ tick: 0 ; frame counter img: none horizon: none ; Create tree tree: make image! 70x100 tree/alpha: 255 use [branches trunk spread size cen p1 p2 p3][ trunk: 0.1 ; width of base of trunk size: tree/size cen: size / 2 draw tree compose [ pen none fill-pen 180.170.150 triangle (cen * 1x0) (as-pair cen/x * (1 - trunk) size/y) (as-pair cen/x * (1 + trunk) size/y) ] branches: 8 repeat n branches [ p1: p2: p3: 0x0 p1/y: tree/size/y * (n - 1) / (branches + 1) p2/y: tree/size/y * n / (branches + 1) p3/y: p2/y - (tree/size/y / (branches + 1) * 0.1) spread: n / (branches + 1) ; width of branch p1/x: cen/x + (trunk * spread * cen/x) p2/x: cen/x + (spread * cen/x) p3/x: p1/x draw tree [pen none fill-pen 200.240.200 triangle p1 p2 p3] p1/x: cen/x - (trunk * spread * cen/x) p2/x: cen/x - (spread * cen/x) p3/x: p1/x draw tree [pen none fill-pen 200.240.200 triangle p1 p2 p3] ] ] ; Create snowman snowman: make image! 50x76 snowman/alpha: 255;225 ;255 ; <-- draw snowman compose [ pen snow fill-pen white ;snow circle 25x60 15 ; bottom circle 24x38 11 ; middle circle 25x20 8 ; head pen brown line 19x38 4x34 line 8x35 5x30 ; left arm line 30x39 45x36 line 40x37 44x30 ; right arm ; eyes pen black fill-pen black circle (25x20 + -3x-1) 1 circle (25x20 + 3x-1) 1 ; mouth pen black fill-pen none arc (25x20) 5x5 40 100 ; nose pen orange fill-pen orange triangle 26x21 29x23 24x21 ; hat pen black fill-pen black box (25x13 - 3x0) (25x13 + 3x-6) ellipse (25x13) 7x2 ] ;view center-face layout [image snowman] halt ; preview snowman ; Create snowflake snowflake: make image! 9x9 snowflake/rgb: white snowflake/alpha: 255 use [points cen][ points: 7 cen: snowflake/size / 2 repeat n points [ ;draw snowflake compose [transform (n * 360 / points) (cen) 1 1 0x0 line (cen * 0x1) (cen)] draw snowflake compose [pen white translate (cen) rotate (n * 360 / points + n) line 0x0 (cen * 0x1)] ] ] ;view center-face layout [backdrop 0.128.128 image snowflake snowflake/size * 10] halt ; preview snowflake ; create frames for zooming terrain n-frames: 12 ; higher = more detail frames: make block! n-frames closest: 0.5 distance: 4.0 repeat n n-frames [ append frames context [ image: make image! initial-size offset: 0x0 z: closest + distance - (n * distance / n-frames) image/alpha: 230 ; <-- initially semi-transparent ] ] road: make image! 50x20 lbank: make image! 50x20 ; left bank rbank: make image! 50x20 ; right bank draw-blk: copy [] redraw: func [image /local cen pos middle vr vb mag][ img: make image! pic/size cen: img/size / 2 horizon: img/size/y / 2 ; main drawing draw img compose [ pen none fill-pen linear 0x0 0 300 90 1 1 navy sky sky box 0x0 (img/size / 1x2) ; sky fill-pen linear 0x150 0 300 90 1 1 snow silver white box (img/size * 0x1 / 1x2) (img/size) ; plain snow surrounds ] ; rotate frames repeat n n-frames - 1 [ frames/(n-frames - n + 1)/image: frames/(n-frames - n)/image frames/(n-frames - n + 1)/offset: frames/(n-frames - n)/offset ] ; Draw new terrain image for furthest frame ; fill road and banks with randomized colours repeat n length? road [ poke road n (1.1.1 * random 140) + 115 ; snowy road surface ] repeat n length? lbank [ poke lbank n (1.1.1 * random 150) + 155 ; snowy surface poke rbank n (1.1.1 * random 150) + 155 ; snowy surface (assumes same image size as lbank) ] frames/1/image: make image! img/size frames/1/image/alpha: 255 ; transparent, so further frames underneath can be seen frames/1/offset: as-pair (img/size/x / 4 * (sine tick * 8) * sine tick) ; left and right (creates curves in the road) (img/size/y / 15 * (sine tick * 9) * sine tick / 2) ; up and down vr: as-pair img/size/x / 6 img/size/y * 0.13 ; road vector vb: as-pair img/size/x / 6 img/size/y * -0.06 ; bank vector mag: 1.1 ; <-- just guessing the magnification factor between frames for the moment... p1: -1x1 * vr + cen p2: vr + cen p3: vr * mag + p2 p4: -1x1 * vr * mag + p1 ; select randomly between tree and snowman (trees more often) obj: either 1 = random 20 [snowman][tree] draw frames/1/image compose [ ;image road 100x190 200x190 240x230 60x230 ;border ; stretch road for perspective image road (p1) (p2) (p3) (p4) ;border ; stretch road for perspective image lbank (vb * -1x1 + p1) (p1) (p4) (vb * -1x1 * mag + p4) image rbank (p2) (p2 + vb) (vb * mag + p3) (p3) image obj ( img/size * 0x3 / 1x5 ; from 3/5ths of the way down (just under the horizon) + (either random true [0x0][img/size * 2x0 / 3]) ; left or right thirds (not middle) + (random img/size / 3x2 - tree/size) ; somewhere in that 6th of the total image - (obj/size * 0x1) ; relative to base of obj ) ] ;draw frames/1/image [line-width 2 box 0x0 initial-size] ; <-- show edge of the frame ; draw zooming snowflakes loop 15 [draw frames/1/image compose [image snowflake (random img/size)]] ; draw zoomed terrain images clear draw-blk repeat n n-frames [ ;draw img compose [image (frames/:n/image) 0x0 (initial-size)] frame: frames/:n middle: (frame/image/size / frame/z / 2) insert insert insert insert tail draw-blk 'image (frames/:n/image) (cen + frame/offset - middle) (cen + frame/offset + middle) ] draw img draw-blk tick: tick + 1 img ] ] view/new/options window: center-face layout [ backcolor black origin 0 pic: image (make image! initial-size) (copy logo.gif) rate 48 edge none feel [ engage: func [face action event][ if action = 'time [ face/image: drive-scene/redraw face/image show face ] ] ] ] 'resize window/feel: make window/feel [ detect: func [face event][ if event/type = 'resize [pic/size: window/size] if event/type = 'close [unview/all] ; <- key handler was 'ere :) event ; allow event to continue ] ] do-events