/packages/ptc/examples/flower.pp
Puppet | 222 lines | 187 code | 35 blank | 0 comment | 13 complexity | bdc95d0a85b1aa3bd00a3238f483ba84 MD5 | raw file
Possible License(s): LGPL-2.0, LGPL-2.1, LGPL-3.0
1{ 2Ported to FPC by Nikolay Nikolov (nickysn@users.sourceforge.net) 3} 4 5{ 6 Flower demo for OpenPTC 1.0 C++ API 7 Copyright (c) Scott Buchanan (aka Goblin) 8 This source code is licensed under the GNU GPL 9} 10 11program Flower; 12 13{$MODE objfpc} 14 15uses 16 ptc, Math; 17 18function pack(r, g, b: Uint32): Uint32; 19begin 20 { pack color integer } 21 pack := (r shl 16) or (g shl 8) or b; 22end; 23 24procedure generate_flower(flower: IPTCSurface); 25var 26 data: PUint8; 27 x, y, fx, fy, fx2, fy2: Integer; 28 TWO_PI: Single; 29begin 30 { lock surface } 31 data := flower.lock; 32 33 try 34 { surface width and height constants for cleaner code } 35 fx := flower.width; 36 fy := flower.height; 37 fx2 := fx div 2; 38 fy2 := fy div 2; 39 40 { useful 2*pi constant } 41 TWO_PI := 2 * PI; 42 43 { generate flower image } 44 for y := 0 to fy - 1 do 45 for x := 0 to fx - 1 do 46 data[x + y * fx] := Trunc(1.0 * Cos(18*ArcTan2((y - fy2),(x - fx2))) * 255 / TWO_PI + 47 0.3 * Sin(15*ArcTan2((y - fy2),(x - fx2))) * 255 / TWO_PI + 48 Sqrt((y - fy2) * (y - fy2) + (x - fx2) * (x - fx2))) and $FF; 49 50 { You might want to move the 1.0 and 0.3 and the 18 and the 15 51 to parameters passed to the generate function... 52 the 1.0 and the 0.3 define the 'height' of the flower, while the 53 18 and 15 control the number of 'petals' } 54 finally 55 flower.unlock; 56 end; 57end; 58 59procedure generate(palette: IPTCPalette); 60var 61 data: PUint32; 62 i, c: Integer; 63begin 64 { lock palette data } 65 data := palette.Lock; 66 67 try 68 { black to yellow } 69 i := 0; 70 c := 0; 71 while i < 64 do 72 begin 73 data[i] := pack(c, c, 0); 74 Inc(c, 4); 75 Inc(i); 76 end; 77 78 { yellow to red } 79 c := 0; 80 while i < 128 do 81 begin 82 data[i] := pack(255, 255 - c, 0); 83 Inc(c, 4); 84 Inc(i); 85 end; 86 87 { red to white } 88 c := 0; 89 while i < 192 do 90 begin 91 data[i] := pack(255, c, c); 92 Inc(c, 4); 93 Inc(i); 94 end; 95 96 { white to black } 97 c := 0; 98 while i < 256 do 99 begin 100 data[i] := pack(255 - c, 255 - c, 255 - c); 101 Inc(c, 4); 102 Inc(i); 103 end; 104 finally 105 { unlock palette } 106 palette.Unlock; 107 end; 108end; 109 110var 111 console: IPTCConsole; 112 format: IPTCFormat; 113 flower_surface: IPTCSurface; 114 surface: IPTCSurface; 115 palette: IPTCPalette; 116 area: IPTCArea; 117 time, delta: Single; 118 scr, map: PUint8; 119 width, height, mapWidth: Integer; 120 xo, yo, xo2, yo2, xo3, yo3: Single; 121 offset1, offset2, offset3: Integer; 122 x, y: Integer; 123begin 124 try 125 try 126 { create format } 127 format := TPTCFormatFactory.CreateNew(8); 128 129 { create console } 130 console := TPTCConsoleFactory.CreateNew; 131 132 { create flower surface } 133 flower_surface := TPTCSurfaceFactory.CreateNew(640, 400, format); 134 135 { generate flower } 136 generate_flower(flower_surface); 137 138 { open console } 139 console.open('Flower demo', 320, 200, format); 140 141 { create surface } 142 surface := TPTCSurfaceFactory.CreateNew(320, 200, format); 143 144 { create palette } 145 palette := TPTCPaletteFactory.CreateNew; 146 147 { generate palette } 148 generate(palette); 149 150 { set console palette } 151 console.palette(palette); 152 153 { set surface palette } 154 surface.palette(palette); 155 156 { setup copy area } 157 area := TPTCAreaFactory.CreateNew(0, 0, 320, 200); 158 159 { time data } 160 time := 0; 161 delta := 0.04; 162 163 { main loop } 164 while not console.KeyPressed do 165 begin 166 { lock surface pixels } 167 scr := surface.lock; 168 try 169 map := flower_surface.lock; 170 try 171 { get surface dimensions } 172 width := surface.width; 173 height := surface.height; 174 mapWidth := flower_surface.width; 175 176 xo := (width / 2) + 120 * sin(time * 1.1 + 1.5); 177 yo := (height / 2) + 90 * cos(time * 0.8 + 1.1); 178 offset1 := Trunc(xo) + Trunc(yo) * mapWidth; 179 180 xo2 := (width / 2) + 120 * sin(time * 0.9 + 4.2); 181 yo2 := (height / 2) + 90 * cos(time * 0.7 + 6.9); 182 offset2 := Trunc(xo2) + Trunc(yo2) * mapWidth; 183 184 xo3 := (width / 2) + 120 * sin(time * 0.9 + 3.1); 185 yo3 := (height / 2) + 90 * cos(time * 1.1 + 1.2); 186 offset3 := Trunc(xo3) + Trunc(yo3) * mapWidth; 187 188 { vertical loop } 189 for y := 0 to height - 1 do 190 { horizontal loop } 191 for x := 0 to width - 1 do 192 scr[x + y * width] := (map[x + y * mapWidth + offset1] + 193 map[x + y * mapWidth + offset2] + 194 map[x + y * mapWidth + offset3]) and $FF; 195 finally 196 { unlock surface } 197 flower_surface.unlock; 198 end; 199 finally 200 { unlock surface } 201 surface.unlock; 202 end; 203 204 { copy surface to console } 205 surface.copy(console, area, area); 206 207 { update console } 208 console.update; 209 210 { update time } 211 time := time + delta; 212 end; 213 finally 214 if Assigned(console) then 215 console.close; 216 end; 217 except 218 on error: TPTCError do 219 { report error } 220 error.report; 221 end; 222end.